Use WebForm.nui // cWebForm class Use DDOCallBack.nui // Procedure DDO_Callback (that calls back for DDO's in a DDO structure) object oWebFormCallStack is a cArray end_object // Both wfBasicControl and wfBasicContainer inherit from this class wfBasicDisplayElement is a cArray procedure construct_object forward send construct_object property integer phWriter public 0 // Handle to object that writes out the XHTML property integer piType public 0 // 0:Container 1:Control (is used to inform the DoLayout procedure of the cFormWriter class) end_procedure function hWriter returns integer integer lhWriter get phWriter to lhWriter ifnot lhWriter delegate get hWriter to lhWriter function_return lhWriter end_function procedure DoCBCtrl // wfBasicDisplayElement end_procedure procedure DoLayout // wfBasicDisplayElement end_procedure procedure OnWriteHtml // wfBasicDisplayElement end_procedure procedure DoReadContainerPopupIds // wfBasicDisplayElement end_procedure end_class enumeration_list // Container classes define WFCC_UI // The outermost container. Must be present! define WFCC_GROUP define WFCC_TAB_DIALOG define WFCC_TAB_PAGE define WFCC_GRID define WFCC_FREESTYLE end_enumeration_list enumeration_list // Container properties //> WFCP_ID identifies the container in the following situations: //> * Within a XML document the defines the form. //> * When the parent containers psPopupID value matches, only this container is displayed //> * The layout object calls back with this value define WFCP_ID define WFCP_TITLE //> Will display when appropriate (as lengend in a field set or as a tab page label) define WFCP_POPUP_STATE //> When this is TRUE, the container will only display if psPopupID of the parent container is identical define WFCP_MAIN_TABLE //> Used to identify the DDO to use. If 0, we ask the wForm object itself define WFCP_LOCATION //> 0=Below 1=Right (of fieldset) define WFCP_LOCATION_SPAN //> 0=No span,x=span x columns, -1=span to end of row define WFCP_MAX_SIZE //> Inputs in this container may not be set any wider than this number of characters define WFCP_ENC_ELEM //> 0=none 1=div 2=span 3=fieldset define WFCP_ENC_WIDTH //> blank=100% define WFCP_ENC_COLOR //> define WFCP_ENC_BORDER_STYLE //> "solid" or "none" define WFCP_FIELDSET_ELEM //> If TRUE a fieldset tag will be generated define WFCP_ERROR_TEXT_MODE //> 0:None 1:Error in widget cell 2:Error in spanned cells 3:Error in widget cell (after field) 4:Error in spanned cells (after field) define WFCP_EXTRA_INFO_MODE //> 0:None 1:Extra info in widget cell 2:Extra info in spanned cells define WFCP_HIDDEN_STATE //> 0:Display 1:No display end_enumeration_list //> This class forms the basis class wfBasicControl is a wfBasicDisplayElement // All control classes are based on this procedure construct_object forward send construct_object //> Should the writing of this control be done by the phWriter (FALSE) or by ourself (TRUE)? property integer pbSelfHtmlWriter public FALSE set piType to 1 // It's a control. end_procedure function bAutoLink returns integer function_return (integer(value(self,WFIP_LABEL_AUTO_LINK))) end_function // Is called every time the form is displayed procedure OnStyle integer liWhat integer lhStyler // liWhat: 0=Label 1=Input 2=ExtraInfo 3=ErrorText // Depending on the value of liWhat, you can make the final changes to // CSS_FORM_INPUTLABEL, CSS_FORM_INPUTWIDGET, CSS_FORM_INPUTERROR and CSS_FORM_INPUTINFO end_procedure // Procedure OnStyleTableCell is only called during the layout of the form (not at each request) procedure OnStyleTableCell integer lhStyler integer liWhat // liWhat: 0=Label 1=Input 2=ExtraInfo 3=ErrorText // Depending on the value of liWhat, you can make the final changes to // CSS_FORM_LABELCELL and CSS_FORM_INPUTCELL end_procedure // This only gets called if we're a self-writer procedure DoWriteHtml integer liWhat // wfBasicControl (liWhat: 0=Label 1=Input 2=ExtraInfo 3=ErrorText) end_procedure function bContentEnabled returns integer // wfBasicControl function_return TRUE end_function procedure DoSeedFindValues // wfBasicControl end_procedure procedure DoReadPostedFormValues // wfBasicControl end_procedure procedure DoEntryUpdate // wfBasicControl end_procedure procedure DoEntryDisplay // wfBasicControl end_procedure procedure DoCBCtrl // wfBasicControl send DoCBCtrlForm self end_procedure procedure OnClick string lsDetectionValue end_procedure procedure DoSubmitAction // wfBasicControl string lsName lsValue lsInputName if (integer(value(self,WFIP_AUTO_SUBMIT))) begin // If we're an "auto submitter" get WafGetHtmlFormValue "AutoSubmitter" to lsName get sInputNamePrefix to lsInputName // (Delegates to wForm) move (lsInputName+value(self,WFIP_NAME)) to lsInputName if (lsName=lsInputName) begin send priv.OnButton lsName // Caught by wForm object. Makes sure that records are found and posted form values are read send OnClick lsName end end else begin get value WFIP_SUBMIT_DETECT to lsName if (lsName<>"") begin get WafGetHtmlFormValue lsName to lsValue // OK if (lsValue<>"") begin send priv.OnButton lsName // Caught by wForm object. Makes sure that records are found and posted form values are read send OnClick lsName end end end end_procedure procedure DoReadSubmitErrors // wfBasicControl integer liTable liField lhForm string lsError get value WFIP_DB_FILE to liTable get value WFIP_DB_FIELD to liField if liField begin get WebForm_ObjectId to lhForm get file_field_errortext of oWebFormSubmitErrors lhForm liTable liField to lsError set value WFIP_ERROR_TEXT to lsError end end_procedure procedure DoClearSubmitErrors // wfBasicControl set value WFIP_ERROR_TEXT to "" end_procedure procedure end_construct_object // wfBasicControl string lsName forward send end_construct_object if (value(self,WFIP_NAME)="") begin get sAutoInputName to lsName // Delegates to encapsulating wForm object set value WFIP_NAME to lsName end delegate send register_input self // Inform incapsulating container of our presence end_procedure end_class // wfBasicControl class wfInput is a wfBasicControl // The input controls that accepts input procedure construct_object // wfInput forward send construct_object property integer phSelectOptions public 0 // Handle to value set object end_procedure procedure DoCreateOptionsObject // wfInput integer lhValueSet liType get value WFIP_INPUT_TYPE to liType if (liType=WFIT_DROPDOWN or liType=WFIT_RADIO) begin get phSelectOptions to lhValueSet ifnot lhValueSet begin object oValueSet is a WebInputValueOptions move self to lhValueSet end_object set phSelectOptions to lhValueSet end end end_procedure procedure DoAddOption string lsCode string lsLabel send add_option of (phSelectOptions(self)) lsCode lsLabel end_procedure procedure DoResetOptions send delete_data of (phSelectOptions(self)) end_procedure procedure DoSeedFindValues // wfInput integer liTable liField string lsValue if (bContentEnabled(self)) begin // DoSeedFindValues get value WFIP_DB_FILE to liTable if liTable begin get value WFIP_DB_FIELD to liField get value WFIP_VALUE to lsValue set_field_value liTable liField to lsValue end end end_procedure //> Read values posted from form as part of a submit and place in WFIP_VALUE (and WFIP_CHANGED_STATE) properties procedure DoReadPostedFormValues // wfInput integer liType liPos lbChanged lbCapslock lbShowLn string lsValue lsChanged lsAlreadyChanged lsInputName if (bContentEnabled(self)) begin // DoReadPostedFormValues get WafGetHtmlFormValue "ChangedStates" To lsChanged get sFormValue "AlreadyChangedStates" To lsAlreadyChanged move 0 to lbShowLn get sInputNamePrefix to lsInputName // (Delegates to wForm) move (lsInputName+value(self,WFIP_NAME)) to lsInputName get WafGetHtmlFormValue lsInputName To lsValue // OK get value WFIP_INPUT_TYPE to liType if (liType=WFIT_CHECKBOX) move (lsValue<>"") to lsValue if lbShowLn begin showln "" showln "Testing input name: " lsInputName " (value: " lsValue ")" showln "ChangedStates: " lsChanged showln "AlreadyChangedStates" lsAlreadyChanged end move (pos(lsInputName,lsChanged)) to liPos ifnot liPos move -1 To lbChanged // This won't happen. But if it does, we'll assume it's changed else move (if(mid(lsChanged,1,liPos-1)="+",1,0)) to lbChanged ifnot lbChanged begin // Check if it was already changed at display time move (lsAlreadyChanged contains ("|"+lsInputName+"|")) to lbChanged if (lbChanged and lbShowln) showln ("Caught: "+lsInputName) end if lbShowln showln lsInputName ", Changed_State: " (if(lbChanged,"True","False")) get value WFIP_CAPSLOCK to lbCapslock if lbCapslock move (uppercase(lsValue)) to lsValue set value WFIP_VALUE to lsValue set value WFIP_CHANGED_STATE to lbChanged end end_procedure //> If this input represents a db field and its value has been changed by the user, this procedure //> moves the value of the input to the local record buffer of the DD object or, if not DD //> connected, to the global record buffer. procedure DoEntryUpdate // wfInput integer lbChanged liTable liField lhServer string lsValue if (bContentEnabled(self)) begin // DoEntryUpdate get server to lhServer get value WFIP_DB_FILE to liTable get value WFIP_CHANGED_STATE to lbChanged if (liTable and lbChanged) begin // Only if DB connected get value WFIP_DB_FIELD to liField get value WFIP_VALUE to lsValue if lhServer begin if liField set file_field_changed_value of lhServer liTable liField to lsValue else begin send find_by_recnum of lhServer liTable (integer(lsValue)) end end else begin if liField set_field_value liTable liField to lsValue else begin clear liTable set_field_value liTable 0 to lsValue vfind liTable 0 EQ end end end end end_procedure procedure DoEntryDisplay // wfInput integer liTable liField lhServer lbChanged string lsValue if (bContentEnabled(self)) begin // DoEntryDisplay get server to lhServer get value WFIP_DB_FILE to liTable if liTable begin get value WFIP_DB_FIELD to liField if lhServer begin get file_field_current_value of lhServer liTable liField to lsValue get file_field_changed_state of lhServer liTable liField to lbChanged end else begin get_field_value liTable liField to lsValue move 0 to lbChanged end set value WFIP_VALUE to lsValue set value WFIP_CHANGED_STATE to lbChanged end end end_procedure // DoEntryDisplay procedure DoSetAlreadyChanged // wfInput string lsAlreadyChanged lsInputName if (integer(value(self,WFIP_CHANGED_STATE))) begin get priv.AlreadyChanged to lsAlreadyChanged get sInputNamePrefix to lsInputName // (Delegates to wForm) move (lsInputName+value(self,WFIP_NAME)) to lsInputName move (lsAlreadyChanged+"|"+lsInputName+"|") to lsAlreadyChanged set priv.AlreadyChanged to lsAlreadyChanged end end_procedure // DoSetAlreadyChanged procedure DoSetFileField integer liTable integer liField set value WFIP_DB_FILE to liTable set value WFIP_DB_FIELD to liField end_procedure procedure DoSetFileFieldDD integer liTable integer liField integer liInputType integer lhServer // The main data dictionary of the form integer lhDD // The data dictionary handling liTable integer liLen integer liDec integer liType integer lhValTbl integer lhValueSet integer lbReadonly integer liOptions integer lbCapslock integer liMaxSizeVertical integer lhValTable string lsLabel lsLength lsName lsControl lsFieldName lsTrueValue lsToolTip send DoSetFileField liTable liField // Set file and field properties get server to lhServer get data_set of lhServer liTable to lhDD // Get the DDO responsible for liTable ifnot lhDD begin error 403 ("Table "+string(liTable)+" is not represented by a DDO") procedure_return end get FieldInf_FieldType liTable liField to liType get FieldInf_Field_Length_String liTable liField to lsLength get FieldInf_FieldLabel_Long liTable liField to lsLabel get FDX_FieldName 0 liTable liField true to lsFieldName get ExtractInteger lsLength 1 to liLen get ExtractInteger lsLength 2 to liDec if liDec move (liLen+1+liDec) to liLen get sFileFieldInputName.ii liTable liField to lsName set value WFIP_NAME to lsName set value WFIP_LABEL to lsLabel move "" to lsToolTip move "" to lsTrueValue if lhDD begin if (liInputType=WFIT_AUTO) begin // field_class_name doesn't have a file_field equivalent. Therefore: get field_class_name of lhDD liField to lsControl //if (lowercase(lsControl)="dbbitmap") move to liType if (lowercase(lsControl)="dbcheckbox") move WFIT_CHECKBOX to liInputType if (lowercase(lsControl)="dbcomboform") move WFIT_DROPDOWN to liInputType if (lowercase(lsControl)="dbedit") move WFIT_TEXTAREA to liInputType if (lowercase(lsControl)="dbform") move WFIT_SIMPLE to liInputType if (liInputType=WFIT_AUTO) begin get Field_Table_Object of lhDD liField to lhValTable if lhValTable move WFIT_DROPDOWN to liInputType end //if (lowercase(lsControl)="dbgrid") move to liType //if (lowercase(lsControl)="dbspinform") move to liType end get File_Field_Options of lhServer liTable liField to liOptions move (liOptions iAnd DD_NOENTER) to lbReadonly move (liOptions iAnd DD_CAPSLOCK) to lbCapslock if (liInputType=WFIT_CHECKBOX) get Field_CheckBox_Value of lhDD liField TRUE to lsTrueValue get File_Field_Status_Help of lhDD liTable liField to lsToolTip end else begin move 0 to lbReadonly move 0 to lbCapslock end if (liInputType=WFIT_AUTO) begin if (liType=DF_TEXT) move WFIT_TEXTAREA to liInputType else move WFIT_SIMPLE to liInputType end set value WFIP_INPUT_TYPE to liInputType get value of (parent(self)) WFCP_MAX_SIZE to liMaxSizeVertical if (liInputType=WFIT_SIMPLE) begin set value WFIP_SIZE to (liLen min liMaxSizeVertical) set value WFIP_MAXLENGTH to liLen end if (liInputType=WFIT_TEXTAREA) begin set value WFIP_ROWS to 3 set value WFIP_COLS to liMaxSizeVertical end if (liInputType=WFIT_RADIO) begin end if (liInputType=WFIT_CHECKBOX) begin set value WFIP_DB_TRUE_VALUE to lsTrueValue end if (liInputType=WFIT_DROPDOWN) begin end if (liInputType=WFIT_PASSWORD) begin set value WFIP_SIZE to (liLen min liMaxSizeVertical) set value WFIP_MAXLENGTH to liLen end if (liInputType=WFIT_RADIO or liInputType=WFIT_DROPDOWN) begin if lhDD begin get Field_Table_Object of lhDD liField to lhValTbl if lhValTbl begin send DoCreateOptionsObject get phSelectOptions to lhValueSet send fill_from_validationtable_setup of lhValueSet lhValTbl end end end set value WFIP_DB_FILE to liTable set value WFIP_DB_FIELD to liField set value WFIP_DB_FIELDNAME to lsFieldName set value WFIP_READONLY to lbReadonly set value WFIP_CAPSLOCK to lbCapslock set value WFIP_TOOLTIP to lsToolTip end_procedure // DoSetFileFieldDD // Make as combo field, fill from parent table. procedure DoParentTableCombo integer liTable integer liField integer liIndex integer lbStatic integer lhValueSet set value WFIP_INPUT_TYPE to WFIT_DROPDOWN set value WFIP_DB_FIELD to 0 set value WFIP_READONLY to 0 send DoCreateOptionsObject get phSelectOptions to lhValueSet send fill_from_table_setup of lhValueSet liTable liIndex liField lbStatic end_procedure end_class // wfInput class wfButton is a wfBasicControl // A button control procedure construct_object forward send construct_object set value WFIP_INPUT_TYPE to WFIT_BUTTON end_procedure procedure set button_value string lsLabel string lsName set value WFIP_LABEL to lsLabel set value WFIP_SUBMIT_DETECT to lsName end_procedure procedure OnClick string lsName end_procedure end_class // wfButton class wfButtonArrayHelper is a cArray item_property_list item_property string psLabel.i // --- If both are blank, a space will be added. If only label is item_property string psName.i // specified the text will be displayed (not as a button) item_property integer pbDisabled.i // If true, the button will not be clickable item_property integer pbHref.i // 0=submit button, 1=href button (the actual link value is queried by the button_href_value function) item_property integer pbWindowOpen.i // item_property string psToolTip.i // Tooltip end_item_property_list wfButtonArrayHelper end_class // wfButtonArrayHelper class wfButtonArray is a wfBasicControl // A button control procedure construct_object forward send construct_object set value WFIP_INPUT_TYPE to WFIT_BUTTON_ARRAY set value WFIP_SPAN to TRUE // Span both columns of the layout object oButtons is a wfButtonArrayHelper end_object end_procedure function button_disabled integer liRow returns integer integer lbDisabled get value WFIP_READONLY to lbDisabled // If true, all buttons are disabled ifnot lbDisabled get pbDisabled.i of oButtons liRow to lbDisabled function_return lbDisabled end_function procedure set button_array_value integer liRow string lsLabel string lsName integer lhButtons move oButtons to lhButtons set psLabel.i of lhButtons liRow to lsLabel set psName.i of lhButtons liRow to lsName end_procedure procedure add_button_value string lsLabel string lsName integer lhButtons liRow move oButtons to lhButtons get row_count of lhButtons to liRow set psLabel.i of lhButtons liRow to lsLabel set psName.i of lhButtons liRow to lsName end_procedure // When using the add_href_button one could insert something like this: //send add_href_button (language_coded_value(oButtonLabels,LV.BTN.CANCEL)) //function button_href_value integer liRow returns string // string lsRoot // get waf_config_value WACFG_ASP_FILE to lsRoot // send QryString_Prepare lsRoot // send QryString_AddQryString (value(oBaseSessionVariables,WSV_PREV_QRYSTR)) // function_return (QryString_Value()) //end_function procedure add_href_button string lsLabel integer lhButtons liRow move oButtons to lhButtons get row_count of lhButtons to liRow set psLabel.i of lhButtons liRow to lsLabel set pbHref.i of lhButtons liRow to TRUE end_procedure procedure add_href_button_open_window string lsLabel integer lhButtons liRow move oButtons to lhButtons get row_count of lhButtons to liRow set psLabel.i of lhButtons liRow to lsLabel set pbHref.i of lhButtons liRow to TRUE set pbWindowOpen.i of lhButtons liRow to TRUE end_procedure function button_href_value integer liRow returns string function_return "" end_function procedure DoSubmitAction // wfButtonArray integer lhButtons liMax liRow string lsName lsValue move oButtons to lhButtons get row_count of lhButtons to liMax decrement liMax for liRow from 0 to liMax get psName.i of lhButtons liRow to lsName get sFormValue lsName to lsValue if (lsValue<>"") begin send priv.OnButton lsName // Caught by wForm object. Makes sure that records are found and posted form values are read send OnClick lsName end loop end_procedure // --- Short hand for creating main table buttons: procedure DoAddFindButtons send add_button_value "<<" "findfirst" send add_button_value "<" "findprev" send add_button_value "=" "find" send add_button_value ">" "findnext" send add_button_value ">>" "findlast" end_procedure procedure DoAddEditButtons send add_button_value "ls.btn.save" "save" send add_button_value "ls.btn.delete" "delete" send add_button_value "ls.btn.clear" "clear" end_procedure // --- Short hand for creating grid buttons: procedure DoAddGridScrollButtons integer lhGrid string lsGridPrefix get value of lhGrid WFIP_NAME to lsGridPrefix send add_button_value "<<" (lsGridPrefix+"first") send add_button_value "<" (lsGridPrefix+"prev") send add_button_value ">" (lsGridPrefix+"next") send add_button_value ">>" (lsGridPrefix+"last") end_procedure procedure DoAddGridClearButton integer lhGrid string lsGridPrefix get value of lhGrid WFIP_NAME to lsGridPrefix send add_button_value "ls.btn.clear" (lsGridPrefix+"clear") end_procedure procedure DoAddGridCancelButton integer lhGrid string lsGridPrefix get value of lhGrid WFIP_NAME to lsGridPrefix send add_button_value "ls.btn.cancel" (lsGridPrefix+"cancel") end_procedure procedure DoAddGridCreateButton integer lhGrid string lsGridPrefix get value of lhGrid WFIP_NAME to lsGridPrefix send add_button_value "ls.btn.create" (lsGridPrefix+"create") end_procedure procedure OnClick string lsName end_procedure end_class // wfButtonArray class wfFreeStyleControl is a wfBasicControl // A do-it-yourself control procedure construct_object forward send construct_object set pbSelfHtmlWriter to TRUE end_procedure end_class // wfFreeStyleControl class wfGridServer is a cIndexScanner procedure construct_object forward send construct_object property integer priv.phReportColumnLayout // property integer piFirstRecord // property integer piLastRecord property string psTitle public "" //> NOT USED ANYMORE: Property psSellistId identifies the object uniquely within a WebForm. It is used to decode //> form actions regarding this list (like: previous next first last). It is also used to name //> hidden forms with first and last record of the list. end_procedure function bSelect returns integer function_return 1 end_function procedure OnPageHeader integer lhColumnLayout get priv.phReportColumnLayout to lhColumnLayout if lhColumnLayout begin send WriteTableBegin of lhColumnLayout (psTitle(self)) send OutputHeaderRow of lhColumnLayout end end_procedure procedure OnSelected // OBS. Records in related tables are not found at the time of calling this. integer lhColumnLayout get priv.phReportColumnLayout to lhColumnLayout if lhColumnLayout send OnWriteRecord of lhColumnLayout end_procedure procedure OnFiller // May be used to write empty rows (to maintain a constant list height) integer lhColumnLayout get priv.phReportColumnLayout to lhColumnLayout if lhColumnLayout send OutputEmptyRow of lhColumnLayout end_procedure procedure OnPageFooter integer lhColumnLayout get priv.phReportColumnLayout to lhColumnLayout if lhColumnLayout send WriteTableEnd of lhColumnLayout end_procedure procedure DoWriteHtml integer liRecord integer liFindDirection integer lhTmpServer integer lhGrid integer lhPushServer lhColumnLayout lhServer set priv.phReportColumnLayout to lhGrid if lhTmpServer begin get phServer to lhPushServer set phServer to lhTmpServer end send OnPageHeader send DoScan liRecord liFindDirection send OnPageFooter send WriteFirstLastRecords of lhGrid (piFirstRecnum(self)) (piLastRecnum(self)) if lhTmpServer set phServer to lhPushServer end_procedure end_class // wfGridServer class priv.wfGridColumns is a cArray item_property_list item_property integer pbDeactivate.i //> If<>0: Do not write column item_property string psLabel.i item_property string psWidth.i item_property integer piAlign.i //> Should be set to 0:"Left", 1:"Right", 2:"Center" item_property string psValue.i item_property string psLink.i item_property string psCellColor.i item_property integer piSpanColumns.i end_item_property_list priv.wfGridColumns end_class // priv.wfGridColumns class wfGrid is a wfBasicControl // A grid for selecting a record procedure construct_object forward send construct_object property integer piLinkType public 0 // 0:Link 1:Submit RowId 2:Submit link value property integer pbScrollable public FALSE // If TRUE instruct phWriter to put a scrollable DIV around the grid (excluding column headers) property integer phGridController public 0 // Handle to a WebSelectionlist object property integer priv.NextScrollAction public 0 // 0=First, 1=Previous, 2=Next, 3=Last property string psTableStyle public "border: solid gray 1px; border-top: none" property string psTableHeaderStyle public "color:darkblue; background-color:silver; font-family:arial; font-size:13px; padding-left:3px; padding-right:3px" property string psTableDataStyle public "font-family:arial; font-size:12px; padding-left:3px; padding-right:3px" property string psSubmitLinkStyle public "border: 0px inset;background-color: transparent;color: blue;text-decoration: underline;cursor: pointer;padding:0px;margin:0px;text-align:left;white-space:normal;" property string psBorder public "0" property string psCellSpacing public "2" property string psCellPadding public "2" property string psTableWidth public "" set pbSelfHtmlWriter to TRUE // This means that the phWriter will let the control write itself set value WFIP_INPUT_TYPE to WFIT_GRID set value WFIP_SPAN to TRUE // Span both columns of the layout set value WFIP_GRID_HEIGHT to "200px" set value WFIP_GRID_WIDTH to "300px" object oColumns is a priv.wfGridColumns end_object end_procedure function iColumnCount returns integer integer liMax liRow liRval lhColumns move oColumns to lhColumns move 0 to liRval get row_count of lhColumns to liMax decrement liMax for liRow from 0 to liMax ifnot (pbDeactivate.i(lhColumns,liRow)) increment liRval loop function_return liRval end_function //> Adds a column to the layout. The lsLabel parameter will be used //> as column header, lsWidth (if not blank) will be used to set //> the column width, and liAlign will determine the justification //> of that column (0=left,1=center,2=right) procedure AddColumn string lsName string lsWidth integer liAlign integer liRow lhColumns move oColumns to lhColumns get row_count of lhColumns to liRow set psLabel.i of lhColumns liRow to lsName set psWidth.i of lhColumns liRow to lsWidth set piAlign.i of lhColumns liRow to liAlign end_procedure procedure set ColumnValue integer liRow string lsValue string lsLink integer lhColumns move oColumns to lhColumns set psValue.i of lhColumns liRow to (rtrim(lsValue)) // Might be a DB field set psLink.i of lhColumns liRow to lsLink end_procedure procedure OnRecordSelected // If the thing is popped up, logic to pop off should be insterted here. end_procedure // Called as part of DoSubmitAction in this object to activate // the record selected procedure DoRecordSelected integer liTable integer liRecnum integer lhServer get find_server to lhServer if lhServer send find_by_recnum of lhServer liTable liRecnum send OnRecordSelected end_procedure procedure DoSubmitAction // wfGrid integer lhGridController liTable liRecnum string lsName lsValue get phGridController to lhGridController // DoSubmitAction if lhGridController begin // First we check if a record has been selected: get value WFIP_NAME to lsName get piMainFile of lhGridController to liTable get sFormValue (lsName+"selectedrowid") to liRecnum if liRecnum begin send priv.OnButton "" // Caught by wForm object. Makes sure that records are found and posted form values are read send DoRecordSelected liTable liRecnum end else begin // If a record wasn't selected, we check if any list-navigation button has been pressed: get sFormValue (lsName+"first") to lsValue if (lsValue<>"") set priv.NextScrollAction to 4 else begin get sFormValue (lsName+"prev") to lsValue if (lsValue<>"") set priv.NextScrollAction to 1 else begin get sFormValue (lsName+"next") to lsValue if (lsValue<>"") set priv.NextScrollAction to 2 else begin get sFormValue (lsName+"last") to lsValue if (lsValue<>"") set priv.NextScrollAction to 3 else begin get sFormValue (lsName+"clear") to lsValue if (lsValue<>"") send DoRecordSelected liTable 0 // 0 means clear end end end end end end end_procedure function sGridNamePrefix returns string string lsPrefix lsName get sInputNamePrefix to lsPrefix get value WFIP_NAME to lsName function_return (lsPrefix+lsName) end_function procedure WriteTitleRow string lsTitle // OK integer liSpan if (lsTitle<>"") begin get iColumnCount to liSpan // Get number of active columns send XHTML_Add_Open_Element "tr" send XHTML_Add_Open_Element "td" send XHTML_Add_Attribute "colspan" liSpan send XHTML_Add_Closed_Element "h2" lsTitle send XHTML_Close_Element // td send XHTML_Close_Element // tr end end_procedure procedure WriteTableBegin string lsTitle // OK string lsSubmitIdPrefix string lsClass lsWidth lsStyle string lsBorder lsCellSpacing lsCellPadding lsBorderThick if (piLinkType(self)>=1) begin // If submit style write a hidden input for storing selected record get sGridNamePrefix to lsSubmitIdPrefix send XHTML_Add_Closed_Element "input" "" // Add an input for detecting name of form send XHTML_Add_Attribute "type" "hidden" send XHTML_Add_Attribute "name" (lsSubmitIdPrefix+"selectedrowid") send XHTML_Add_Attribute "value" "" end send XHTML_Add_Open_Element "table" get psBorder to lsBorder get psCellSpacing to lsCellSpacing get psCellPadding to lsCellPadding get psTableWidth to lsWidth move "" to lsClass //get psTableClass to lsClass get psTableStyle to lsStyle if (lsBorder<>"") send XHTML_Add_Attribute "border" lsBorder if (lsCellSpacing<>"") send XHTML_Add_Attribute "cellspacing" lsCellSpacing if (lsCellPadding<>"") send XHTML_Add_Attribute "cellpadding" lsCellPadding if (lsWidth<>"") send XHTML_Add_Attribute "width" lsWidth if (lsClass<>"") send XHTML_Add_Attribute "class" lsClass if (lsStyle<>"") send XHTML_Add_Attribute "style" lsStyle send WriteTitleRow lsTitle end_procedure procedure WriteTableEnd // OK if (pbScrollable(self)) begin send XHTML_Close_Element // table send XHTML_Close_Element // div send XHTML_Close_Element // td send XHTML_Close_Element // tr // Create a table cell that will span all column send XHTML_Close_Element // table end else send XHTML_Close_Element // table end_procedure procedure OutputHeaderRowHelp integer lbDoHeader // OK integer liRow liMax liAlign lhColumns string lsClass lsValue lsWidth lsAlign lsColor lsStyle move "" to lsClass get psTableHeaderStyle to lsStyle move oColumns to lhColumns get row_count of lhColumns to liMax decrement liMax for liRow from 0 to liMax ifnot (pbDeactivate.i(lhColumns,liRow)) begin send XHTML_Add_Closed_Element "colgroup" "" send XHTML_Add_Attribute "span" "1" get psWidth.i of lhColumns liRow to lsWidth if (lsWidth<>"") begin send CSS_Reset_Properties "" set CSS_Property_Value CSSPS_DIMEN_WIDTH to lsWidth send XHTML_Add_Attribute "style" (CSS_InLineStyle()) end end loop if lbDoHeader begin send XHTML_Add_Open_Element "tr" for liRow from 0 to liMax ifnot (pbDeactivate.i(lhColumns,liRow)) begin get piAlign.i of lhColumns liRow to liAlign get psLabel.i of lhColumns liRow to lsValue get psCellColor.i of lhColumns liRow to lsColor if (liAlign=0) move "left" to lsAlign if (liAlign=1) move "center" to lsAlign if (liAlign=2) move "right" to lsAlign send XHTML_Add_Closed_Element "th" lsValue if (lsClass<>"") send XHTML_Add_Attribute "class" lsClass if (lsStyle<>"") send XHTML_Add_Attribute "style" lsStyle if (lsAlign<>"") send XHTML_Add_Attribute "align" lsAlign if (lsColor<>"") send XHTML_Add_Attribute "bgcolor" lsColor end loop send XHTML_Close_Element // tr end end_procedure procedure OutputHeaderRow // OK integer liPush liSpan lbOverflowXY string lsPush if (pbScrollable(self)) begin send OutputHeaderRowHelp TRUE // Write column titles send XHTML_Add_Open_Element "tr" // Create a table cell that will span all column send XHTML_Add_Open_Element "td" get iColumnCount to liSpan // Get number of active columns send XHTML_Add_Attribute "colspan" liSpan send XHTML_Add_Open_Element "div" send CSS_Reset_Properties "" set CSS_Property_Value CSSPS_DIMEN_HEIGHT to (value(self,WFIP_GRID_HEIGHT)) set CSS_Property_Value CSSPS_DIMEN_WIDTH to (value(self,WFIP_GRID_WIDTH)) get value of oWebBrowserInfo WBI_OVERFLOW_XY to lbOverflowXY if lbOverflowXY begin // Browser can handle overflow in X and Y deimensions independantly set CSS_Property_Value CSSPS_POS_OVERFLOW_Y to "scroll" set CSS_Property_Value CSSPS_POS_OVERFLOW_X to "visible" end else begin set CSS_Property_Value CSSPS_POS_OVERFLOW to "scroll" end send XHTML_Add_Attribute "style" (CSS_InLineStyle()) get piLinkType to liPush set piLinkType to 0 // Setting this temporarily to 0 makes WriteTableBegin not write a second (hidden) input get psTableStyle to lsPush set psTableStyle to "border:none" send WriteTableBegin "" // The blank parameter ensures that WriteTableBegin doen't write a second title bar set psTableStyle to lsPush set piLinkType to liPush send OutputHeaderRowHelp FALSE // No column titles end else send OutputHeaderRowHelp TRUE end_procedure procedure OnWriteRecord // OK end_procedure procedure OutputDataRow string lsRowId // (recnum for now) OK integer liRow liMax liSpan liAlign liLinkType lhColumns string lsClass lsValue lsLink lsAlign lsAttributes lsColor string lsSubmitLinkStyle lsSubmitIdPrefix lsSubmitValueInput string lsStyle move "" to lsClass // get psDataClass to lsClass send XHTML_Add_Open_Element "tr" move 0 to liSpan move oColumns to lhColumns get piLinkType to liLinkType if (liLinkType>=1) begin get psSubmitLinkStyle to lsSubmitLinkStyle get sGridNamePrefix to lsSubmitIdPrefix move (lsSubmitIdPrefix+"selectedrowid") to lsSubmitValueInput end get psTableDataStyle to lsStyle get row_count of lhColumns to liMax decrement liMax for liRow from 0 to liMax ifnot (pbDeactivate.i(lhColumns,liRow)) begin if (liSpan>0) decrement liSpan else begin get psValue.i of lhColumns liRow to lsValue get psLink.i of lhColumns liRow to lsLink get piAlign.i of lhColumns liRow to liAlign get piSpanColumns.i of lhColumns liRow to liSpan get psCellColor.i of lhColumns liRow to lsColor if (lsValue="") move "" to lsLink // If there's no value => there's no link if (liAlign=0) move "left" to lsAlign if (liAlign=1) move "center" to lsAlign if (liAlign=2) move "right" to lsAlign send XHTML_Add_Open_Element "td" if (lsClass<>"") send XHTML_Add_Attribute "class" lsClass if (lsStyle<>"") send XHTML_Add_Attribute "style" lsStyle if (lsAlign<>"") send XHTML_Add_Attribute "align" lsAlign if (lsColor<>"") send XHTML_Add_Attribute "bgcolor" lsColor if (liSpan>1) begin send XHTML_Add_Attribute "colspan" liSpan decrement liSpan end if (liLinkType=1) begin // Submit row id // Create a button and let the CSS style (lsSubmitLinkStyle) make it look like a normal link send XHTML_Add_Closed_Element "button" lsValue send XHTML_Add_Attribute "type" "submit" if (lsSubmitLinkStyle<>"") send XHTML_Add_Attribute "style" lsSubmitLinkStyle send XHTML_Add_Attribute "onclick" ("waf_set_form_input_value(this,'"+lsSubmitValueInput+"','"+lsRowId+"')") // send XHTML_Add_Attribute "name" (lsSubmitIdPrefix+"listselect") end else if (liLinkType=2) begin // Submit link value if (lsLink<>"") begin send XHTML_Add_Closed_Element "button" lsValue send XHTML_Add_Attribute "type" "submit" if (lsSubmitLinkStyle<>"") send XHTML_Add_Attribute "style" lsSubmitLinkStyle send XHTML_Add_Attribute "onclick" ("waf_set_form_input_value(this,'"+lsSubmitValueInput+"','"+lsLink+"')") end else begin send XHTML_Add_Closed_Element "span" lsValue end end else begin // Link style if (lsLink<>"") begin if (lowercase(left(lsLink,4))="ext:") move (replace("ext:",lsLink,"http://")) to lsLink send XHTML_Add_Open_Element "a" send XHTML_Add_Attribute "href" lsLink end send XHTML_Add_Closed_Element "span" lsValue if (lsLink<>"") send XHTML_Close_Element // a end send XHTML_Close_Element // td end set psValue.i of lhColumns liRow to "" set psLink.i of lhColumns liRow to "" set psCellColor.i of lhColumns liRow to "" set piSpanColumns.i of lhColumns liRow to 0 end loop send XHTML_Close_Element // tr end_procedure procedure OutputEmptyRow // May be used to write empty rows (to maintain a constant list height) OK integer liRow liMax liAlign lhColumns string lsClass lsAlign lsColor //get psHeaderClass to lsClass move oColumns to lhColumns send XHTML_Add_Open_Element "tr" get row_count of lhColumns to liMax decrement liMax for liRow from 0 to liMax ifnot (pbDeactivate.i(lhColumns,liRow)) begin get piAlign.i of lhColumns liRow to liAlign get psCellColor.i of lhColumns liRow to lsColor if (liAlign=0) move "left" to lsAlign if (liAlign=1) move "center" to lsAlign if (liAlign=2) move "right" to lsAlign send XHTML_Add_Closed_Element "th" "ÿ" if (lsClass<>"") send XHTML_Add_Attribute "class" lsClass if (lsAlign<>"") send XHTML_Add_Attribute "align" lsAlign if (lsColor<>"") send XHTML_Add_Attribute "bgcolor" lsColor end loop send XHTML_Close_Element // tr end_procedure procedure WriteFirstLastRecords integer liFirstRecnum integer liLastRecnum string lsSubmitIdPrefix get sGridNamePrefix to lsSubmitIdPrefix send XHTML_Add_Closed_Element "input" "" // Add an input for detecting name of form send XHTML_Add_Attribute "type" "hidden" send XHTML_Add_Attribute "name" (lsSubmitIdPrefix+"FirstRecId") send XHTML_Add_Attribute "value" liFirstRecnum send XHTML_Add_Closed_Element "input" "" // Add an input for detecting name of form send XHTML_Add_Attribute "type" "hidden" send XHTML_Add_Attribute "name" (lsSubmitIdPrefix+"LastRecId") send XHTML_Add_Attribute "value" liLastRecnum end_procedure function find_server returns integer integer lhServer liTable lhGridController lhFormServer get phGridController to lhGridController // find_server get phServer of lhGridController to lhServer ifnot lhServer begin get piMainFile of lhGridController to liTable get server to lhServer if lhServer get Data_Set of lhServer liTable to lhServer end function_return lhServer end_function function RecordCreateLink returns string integer lhServer liTable lhGridController string lsValue get find_server to lhServer if lhServer begin get main_file of lhServer to liTable get QryString_RecordCreateLink liTable lhServer to lsValue end else move "" to lsValue function_return lsValue end_function function RecordEditLink returns string integer lhServer liTable string lsRecId lsValue get find_server to lhServer if lhServer begin get main_file of lhServer to liTable get current_record of lhServer to lsRecId get QryString_RecordEditLink liTable lsRecId to lsValue end else move "" to lsValue function_return lsValue end_function //hejsa procedure DoRefindRecords integer lhDD integer liFile integer liRecord get current_record of lhDD to liRecord clear liFile if liRecord begin set_field_value liFile 0 to liRecord vfind liFile 0 EQ end send find_by_recnum of lhDD liFile liRecord //send refind_records of lhDD end_procedure procedure DoWriteHtml integer liWhat // wfGrid (liWhat: 0=Label 1=Input 2=ExtraInfo 3=ErrorText) integer lhGridController // Handle to a WebSelectionlist object integer liFirstRecnum liLastRecnum // Values presumaably posted in the form integer liFindDirection // 0:next,1:prev,2:next,3:last,4:last integer liRecnum integer lhForm integer lhServer integer liScrollAction // Indicates the search mode (relative to liFirstRecnum and liLastRecnum) string lsName if (liWhat=1) begin // 1=Input get phGridController to lhGridController // DoWriteHtml if lhGridController begin //get psSubmitIdPrefix of lhGridController to lsName get value WFIP_NAME to lsName get sFormValue (lsName+"FirstRecId") to liFirstRecnum get sFormValue (lsName+"LastRecId") to liLastRecnum // priv.NextScrollAction tells us what action to perform (which way to search) get priv.NextScrollAction to liScrollAction // ------------------------------------------------------------------------ // We must however make sure that this indication stems from a submit on THIS form get WebForm_ObjectId to lhForm if (lhForm<>ghFormSubmitted) begin // It didn't... move 0 to liScrollAction move 0 to liFirstRecnum move 0 to liLastRecnum end // ------------------------------------------------------------------------ if (liScrollAction=0) begin move liFirstRecnum to liRecnum move 2 to liFindDirection // Find next end if (liScrollAction=1) begin move liFirstRecnum to liRecnum move 1 to liFindDirection // Find previous end if (liScrollAction=2) begin move liLastRecnum to liRecnum move 2 to liFindDirection // Find next end if (liScrollAction=3) begin move 0 to liRecnum move 3 to liFindDirection // Find last end if (liScrollAction=4) begin move 0 to liRecnum move 0 to liFindDirection // Find last end set priv.NextScrollAction to 0 // Reset get find_server to lhServer // Find the server handling the grid main table if (lhServer) begin // If there is a server we have better let it self and its parents refind their intended records send DDO_CallbackReset send DDO_Callback lhServer DFTRUE DFFALSE DFTRUE DFTRUE MSG_DoRefindRecords self end send DoWriteHtml of lhGridController liRecnum liFindDirection lhServer self end else send XHTML_Add_Closed_Element "div" ("Missing grid controller in object "+name(self)) end end_procedure // DoWriteHtml end_class // wfGrid //class wfEntryGrid is a wfBasicControl // A grid for entering data // procedure construct_object // forward send construct_object // end_procedure //end_class // wfEntryGrid class wfContainerChildren is a cArray item_property_list item_property integer phObject.i item_property integer priv.ChainNextInput.i // Set by auto_layout. 0:No chain, 1:Right, 2:Right+Space (private) end_item_property_list wfContainerChildren procedure add_object integer lhObj set phObject.i (row_count(self)) to lhObj end_procedure end_class class wfBasicContainer is a wfBasicDisplayElement // <--- All container classes are based on this procedure construct_object forward send construct_object set piType to 0 // It's a container property integer piContainerClass public -1 property integer piCssElement public -1 property string psPopupID public "" // Pops up the child container with WFC_ID=psPopupID property integer priv.pbInputContainer public -1 // A container contains either inputs or other containers. (-1:Un-determined) object oChildren is a wfContainerChildren end_object property integer phLayout public 0 // Handle to object that defines the layout of this container end_procedure function hFindInputName.s string lsName returns integer integer lhChildren liRow liMax lhObj lbInputCont lhRval get priv.pbInputContainer to lbInputCont if (lbInputCont=>0) begin // If not un-determined move oChildren to lhChildren get row_count of lhChildren to liMax decrement liMax for liRow from 0 to liMax get phObject.i of lhChildren liRow to lhObj if lbInputCont begin if (value(lhObj,WFIP_NAME)=lsName) function_return lhObj // Found! end else begin get hFindInputName.s of lhObj lsName to lhRval if lhRval function_return lhRval end loop end function_return 0 // Not Found end_function procedure DoWriteHtmlAllNonPopup integer lhChildren liRow liMax lhObj move oChildren to lhChildren get row_count of lhChildren to liMax decrement liMax for liRow from 0 to liMax get phObject.i of lhChildren liRow to lhObj if (value(lhObj,WFCP_POPUP_STATE)=0) send DoWriteHtml of lhObj loop end_procedure procedure OnStyle integer lhStyler // wfBasicContainer // You can make the final changes to CSS_FORM_FORM_ENCAP, CSS_FORM_FIELDSET and CSS_FORM_FIELDSETLEGEND end_procedure procedure DoReadContainerPopupIds // wfBasicContainer //set psPopupID to "" string lsPopupId string lsInputNamePrefix get sInputNamePrefix to lsInputNamePrefix // (Delegates to wForm) get WafGetHtmlFormValue (lsInputNamePrefix+lowercase(value(self,WFCP_ID)+"__popupid")) to lsPopupId set psPopupID to lsPopupId end_procedure function bContentEnabled returns integer // wfBasicContainer function_return TRUE end_function function bControlContainer returns integer // Returns TRUE if this container contains inputs and such function_return (priv.pbInputContainer(self)=1) end_function function hChildObject integer liRow returns integer function_return (phObject.i(oChildren,liRow)) end_function procedure DoLayout // wfBasicContainer integer lhWriter get hWriter to lhWriter if (phLayout(self)=0) send DoLayout of lhWriter self end_procedure //> Returns the object ID of the "nearest" encapsulating contaner with type as specified in liContainerClass function hFindParentContainer integer liContainerClass returns integer integer lhRval if (liContainerClass=piContainerClass(self)) function_return self else begin if (piContainerClass(self)=WFCC_UI) function_return 0 delegate get hFindParentContainer to lhRval function_return lhRval end function_return 0 end_function //> Returns the object ID of the child container that has an WFCP_ID that matches parameter lsId function hFindChildContainer string lsId returns integer integer liMax liRow lhObj lhChildren move (oChildren(self)) to lhChildren get row_count of lhChildren to liMax decrement liMax for liRow from 0 to liMax get phObject.i of lhChildren liRow to lhObj if (lsID=value(lhObj,WFCP_ID)) function_return lhObj loop function_return 0 end_function procedure register_container integer lhObj //> Internal for registering container objects within the container integer lbInputContainer get priv.pbInputContainer to lbInputContainer send add_object of oChildren lhObj if (lbInputContainer=-1) set priv.pbInputContainer to FALSE if (lbInputContainer=TRUE) error 401 "Illegal location of wForm container object" end_procedure procedure register_input integer lhObj //> Internal for registering input objects within the container integer lbInputContainer get priv.pbInputContainer to lbInputContainer send add_object of oChildren lhObj if (lbInputContainer=-1) set priv.pbInputContainer to TRUE if (lbInputContainer=FALSE) error 402 "Illegal location of wForm input object" end_procedure procedure DoControlBroadcast integer lhMsg // wfBasicContainer integer liMax liRow lhObj lhChildren lbPopupState lbInputContainer string lsPopupId get psPopupId to lsPopupId // Is a popup object specified? get bControlContainer to lbInputContainer move oChildren to lhChildren get row_count of lhChildren to liMax decrement liMax for liRow from 0 to liMax get phObject.i of lhChildren liRow to lhObj if (bContentEnabled(lhObj)) begin if lbInputContainer begin // Children are controls // If the control is enabled, send whatever message to it send lhMsg of lhObj end else begin // Children are containers (so we have to figure out some popup state details) get value of lhObj WFCP_POPUP_STATE to lbPopupState // Checkout the popup rules // if ((lsPopupId="" and lbPopupState=FALSE) or ; if ((lbPopupState=FALSE) or ; (lsPopupId=value(lhObj,WFCP_ID) and lbPopupState=TRUE) or ; (piContainerClass(lhObj)=WFCC_TAB_PAGE)) begin // send lhMsg of lhObj send DoControlBroadcast of lhObj lhMsg end end end loop end_procedure procedure DoBroadcastAll integer lhMsg integer liMax liRow lhObj lhChildren lbInputContainer get bControlContainer to lbInputContainer move oChildren to lhChildren get row_count of lhChildren to liMax decrement liMax for liRow from 0 to liMax get phObject.i of lhChildren liRow to lhObj send lhMsg of lhObj ifnot lbInputContainer send DoBroadcastAll of lhObj lhMsg loop end_procedure //> DoSeedFindValues gets the posted value of all DB connected fields and place it in the record buffer. procedure DoSeedFindValues // wfBasicContainer end_procedure //> Procedure DoReadPostedFormValues reads the posted values into the WebInput objects (WebForm) procedure DoReadPostedFormValues // wfBasicContainer // string lsPopupId // get WafGetHtmlFormValue (lowercase(value(self,WFCP_ID)+"__popupid")) to lsPopupId // set psPopupID to lsPopupId end_procedure //> DoEntryUpdate un-conditionally gets all posted values to the corresonding input objects //> (of WebInput class). Furthermore, if the input is DB connected and the value was //> changed by the user, the value is placed in the (newly reread) record buffer. procedure DoEntryUpdate // wfBasicContainer end_procedure //> Procedure DoEntryDisplay sets the internal input value of all DB connected inputs to the value currently in the record buffer. procedure DoEntryDisplay // wfBasicContainer end_procedure //> Procedure DoSubmitAction goes through all the button type inputs of the form in order to figure out //> which one was clicked. procedure DoSubmitAction // wfBasicContainer end_procedure // DoSubmitAction procedure DoReadSubmitErrors // wfBasicContainer end_procedure // DoReadSubmitErrors procedure DoClearSubmitErrors // wfBasicContainer end_procedure // DoClearSubmitErrors procedure DoSetAlreadyChanged // wfBasicContainer end_procedure // DoSetAlreadyChanged procedure DoWriteHtml // wfBasicContainer integer lhForm get WebForm_ObjectId to lhForm send DoWriteContainer of (hWriter(self)) lhForm self end_procedure // DoWriteHtml procedure end_construct_object // wfBasicContainer forward send end_construct_object delegate send register_container self // Inform incapsulating container of our presence (if outermost, the wForm object will catch this) end_procedure end_class // wfBasicContainer class wfUserInterface is a wfBasicContainer // A place holder for all other containers and controls in the form. One must be declared in a wForm object. procedure construct_object forward send construct_object set piContainerClass to WFCC_UI set piCssElement to CSS_FORM_FORM_ENCAP set value WFCP_ENC_ELEM to 1 set value WFCP_ENC_WIDTH to "400px" set value WFCP_ID to "uiroot" end_procedure end_class // wfUserInterface class wfGroup is a wfBasicContainer // Contains a label column and a data column of input fields procedure construct_object forward send construct_object set piContainerClass to WFCC_GROUP set piCssElement to CSS_FORM_FORM_ENCAP set value WFCP_MAX_SIZE to "30" set value WFCP_FIELDSET_ELEM to 1 set value WFCP_ERROR_TEXT_MODE to 1 set value WFCP_EXTRA_INFO_MODE to 0 end_procedure end_class // wfGroup class wfBarContainer is a wfBasicContainer // Contains a label column and a data column of input fields procedure construct_object forward send construct_object set piContainerClass to WFCC_GROUP // Behave like a group in all other matters than default settings set piCssElement to CSS_FORM_BAR_CONTAINER set value WFCP_FIELDSET_ELEM to 0 set value WFCP_ENC_ELEM to 1 set value WFCP_ENC_WIDTH to "100%" end_procedure end_class // wfBarContainer class wfTabDialog is a wfBasicContainer // Container object for wfTabPage objects procedure construct_object forward send construct_object set piContainerClass to WFCC_TAB_DIALOG end_procedure end_class // wfTabDialog class wfTabPage is a wfBasicContainer // A tab page within a wfTabDialog object procedure construct_object forward send construct_object set piContainerClass to WFCC_TAB_PAGE // set value WFCP_ENC_ELEM to 1 // div // set value WFCP_ENC_WIDTH to "100%" end_procedure end_class // wfTabPage class wfFreeStyleContainer is a wfBasicContainer // A do-it-yourself container procedure construct_object forward send construct_object set piContainerClass to WFCC_FREESTYLE end_procedure end_class // wfFreeStyleContainer //class wfGridContainer is a wfBasicContainer // // procedure construct_object // forward send construct_object // set piContainerClass to WFCC_GRID // end_procedure //end_class // wfGridContainer class wFormCurrentRecords is a cArray item_property_list item_property integer piTable.i item_property integer piRec.i end_item_property_list wFormCurrentRecords function table_row integer liTable returns integer integer liRow liMax get row_count to liMax decrement liMax for liRow from 0 to liMax if (piTable.i(self,liRow)=liTable) function_return liRow loop function_return -1 end_function procedure set piRecnum.i integer liTable integer liRecnum integer liRow get table_row liTable to liRow if (liRow=-1) get row_count to liRow set piTable.i liRow to liTable set piRec.i liRow to liRecnum end_procedure function piRecnum.i integer liTable returns integer integer liRow get table_row liTable to liRow if (liRow=-1) function_return 0 function_return (piRec.i(self,liRow)) end_function end_class // wFormCurrentRecords class wForm is a cArray procedure construct_object forward send construct_object property integer phUiContainer public 0 property integer server public 0 // wForm property integer piMainFileFindIndex public 1 property integer phWriter public 0 //> (oStandardFormWriter(self)) //> Handle to object that writes out the XHTML property integer pbSubmitHandled private 0 //> Used to keep track of submit actions during DoSubmitAction property string psHandleSubmitRval private "" //> property string priv.AlreadyChanged public "" //> Used temporarily while calling function sAlreadyChangedStates property integer pbAutoQueryStringScan public TRUE //> If pbAutoQueryStringScan is TRUE procedure DoWriteHTML will scan the URL query string for indications of which record to display. property string psFormName public "" //> Name of the form (also written as a hidden field). If blank the logical name of the main file will be used property string psFormCollection public "" //> Used to minimize the need for unique form names in the application property integer pbMessageLine public TRUE //> Draw a message-line property string psFormTitle public "" //> Title property string psFormDirections public "" //> Directions of use property string psFormAction public "" //> Name of the ASP page to receive the posted information property string psFormMenuEntry public "" //> Name as it should appear in the menues property integer pbAutoServerState public FALSE //> This determines if the popup works based on the caller forms server (if any). A form with this property set can not be called except when as a popup (Popup_Form message). property integer pbAllowCommentState public TRUE property integer priv.phPopupForm public 0 // These properties are used to set up a popup chain property integer priv.phBackgroundForm public 0 // of forms. property integer priv.InputCounter public 0 // Used in function sAutoInputName property integer priv.CallBackMsg public 0 property integer priv.CallBackObj public 1 object oSnapshotCurrentRecords is an wFormCurrentRecords end_object end_procedure function sAutoInputName returns string // Used to auto assign WFIP_NAME to wfBasicControl if none has been given integer liCount get priv.InputCounter to liCount increment liCount set priv.InputCounter to liCount function_return ("ain"+string(liCount)) end_function function psPopupID returns string // The display mechnism will query this. Returns blank to make sure that the main container is always displayed function_return "" end_function // This procedure catches the event that the outermost UI container object registers with its encapsulating object procedure register_container integer lhObj set phUiContainer to lhObj end_procedure function hWriter returns integer function_return (phWriter(self)) end_function function WebForm_ObjectId returns integer // So that embedded objects may query the ID of their WebForm function_return self end_function function main_file returns integer integer lhServer get server to lhServer if lhServer function_return (main_file(lhServer)) function_return 0 end_function // Call this to make sure that the next call to DoWriteHtml writes this other form. Our own form // will be pushed on the form call stack (oWebFormCallStack) procedure form_popup string lsFormName string lsFormCollection end_procedure // Call this to close the form (and pop it from the form call stack) and exit to the previous form // in the call stack. procedure form_exit end_procedure // This is called when the form is re-entered from a previous form_popup. procedure form_reentry string lsFormName string lsFormcollection end_procedure procedure DoSeedFindValues // wForm send DoControlBroadcast of (phUiContainer(self)) MSG_DoSeedFindValues end_procedure procedure DoReadPostedFormValues // wForm send DoReadPostedFormValues of (phUiContainer(self)) send DoBroadcastAll of (phUiContainer(self)) MSG_DoReadPostedFormValues end_procedure procedure DoEntryUpdate // wForm send DoControlBroadcast of (phUiContainer(self)) MSG_DoEntryUpdate end_procedure procedure DoEntryDisplay // wForm send DoControlBroadcast of (phUiContainer(self)) MSG_DoEntryDisplay end_procedure procedure DoSubmitAction // wForm send DoControlBroadcast of (phUiContainer(self)) MSG_DoSubmitAction end_procedure procedure DoReadSubmitErrors // wForm send DoControlBroadcast of (phUiContainer(self)) MSG_DoReadSubmitErrors end_procedure procedure DoClearSubmitErrors // wForm send DoControlBroadcast of (phUiContainer(self)) MSG_DoClearSubmitErrors end_procedure //> Go through all the display elements and create layout objects for those that don't already have one. procedure DoLayout // wForm send InitializeLayouter of (phWriter(self)) send DoLayout of (phUiContainer(self)) send DoBroadcastAll of (phUiContainer(self)) MSG_DoLayout end_procedure procedure OnStyle integer lhStyler // wForm // You can make the final changes to CSS_FORM_FORM here, if really needed. But it feels dirty. end_procedure function sAlreadyChangedStates returns string // wForm set priv.AlreadyChanged to "" send DoControlBroadcast of (phUiContainer(self)) MSG_DoSetAlreadyChanged function_return (priv.AlreadyChanged(self)) end_function procedure DoRebuildAllConstraints // wForm broadcast send rebuild_constraints of (parent(self)) end_procedure procedure DoReadContainerPopupIds // wForm send DoReadContainerPopupIds of (phUiContainer(self)) send DoBroadcastAll of (phUiContainer(self)) MSG_DoReadContainerPopupIds end_procedure procedure DoScanQueryStringHelp integer lhDD integer liTable integer lhConnectedToDD // wForm integer liRecnum string lsParam lsRecnum get_attribute DF_FILE_LOGICAL_NAME of liTable to lsParam get WafGetQueryString (lowercase(lsParam)+"_rid") to lsRecnum if (lsRecnum<>"") begin get ExtractInteger lsRecnum 1 to liRecnum send find_by_recnum of lhDD liTable liRecnum end end_procedure procedure DoScanQueryString // wForm integer lhServer get server to lhServer if lhServer begin send DoScanQueryStringHelp lhServer (main_file(lhServer)) 0 send DDO_CallbackReset // Up Recursive ParentFirst ExclVisited send DDO_Callback lhServer TRUE TRUE FALSE FALSE MSG_DoScanQueryStringHelp self // Scan query string for row id's end end_procedure function sFileFieldInputName.ii integer liTable integer liField returns string string lsTable lsField get_attribute DF_FILE_LOGICAL_NAME of liTable to lsTable get_attribute DF_FIELD_NAME of liTable liField to lsField function_return (lowercase(lsTable+"__"+lsField)) end_function function sHiddenRecnumFieldName integer liTable returns string string lsValue lsInputNamePrefix get sInputNamePrefix to lsInputNamePrefix get_attribute DF_FILE_LOGICAL_NAME of liTable to lsValue function_return (lsInputNamePrefix+lowercase(lsValue)+"__rid") end_function procedure DoRefindPostedRecordsHelp integer lhDD integer liTable integer lhConnectedToDD integer liRecnum string lsHiddenInputName get sHiddenRecnumFieldName liTable to lsHiddenInputName get WafGetHtmlFormValue lsHiddenInputName to liRecnum send find_by_recnum of lhDD liTable liRecnum end_procedure procedure DoRefindPostedRecords integer lhServer get server to lhServer if lhServer begin // Read all the record ids from main DD and up. send DoRefindPostedRecordsHelp lhServer (main_file(lhServer)) 0 send DDO_CallbackReset // Up Recursive ParentFirst ExclVisited send DDO_Callback lhServer TRUE TRUE FALSE TRUE MSG_DoRefindPostedRecordsHelp self // Refind records end end_procedure procedure MainTableFind integer liMode integer liFile liIndex lhServer get Server to lhServer if lhServer begin get main_file of lhServer to liFile get piMainFileFindIndex to liIndex send request_find of lhServer liMode liFile liIndex end end_procedure procedure GotoOkPage end_procedure procedure DoSubmitFindFirst send MainTableFind FIRST_RECORD ifnot (found) set psServiceMessage of oWebFormSubmitErrors to "No records" end_procedure procedure DoSubmitFindPrev send DoSeedFindValues send MainTableFind LT ifnot (found) set psServiceMessage of oWebFormSubmitErrors to "Beginning of table" end_procedure procedure DoSubmitFind send DoSeedFindValues send MainTableFind GE ifnot (found) set psServiceMessage of oWebFormSubmitErrors to "End of table" end_procedure procedure DoSubmitFindNext send DoSeedFindValues send MainTableFind GT ifnot (found) set psServiceMessage of oWebFormSubmitErrors to "End of table" end_procedure procedure DoSubmitFindLast send MainTableFind LAST_RECORD ifnot (found) set psServiceMessage of oWebFormSubmitErrors to "No records" end_procedure procedure DoSubmitSave integer lhServer lbErr get server to lhServer if lhServer begin get Request_Validate_All of lhServer to lbErr // Validate-All Fields (includes FindReq) ifnot lbErr Begin Send Request_Save of lhServer // Ask DD to save the Record Move (Err) to lbErr // Err indicator is returned if failure (we don't use this for anything) if lbErr set psServiceMessage of oWebFormSubmitErrors to "Errors during save" else begin set psServiceMessage of oWebFormSubmitErrors to "Record saved" send GotoOkPage end end end end_procedure procedure DoSubmitDelete integer lhServer lbErr get server to lhServer if lhServer begin send Request_Delete of lhServer Move (Err) to lbErr if lbErr set psServiceMessage of oWebFormSubmitErrors to "Errors during delete" else begin set psServiceMessage of oWebFormSubmitErrors to "Record deleted" send Clear of lhServer send GotoOkPage end end end_procedure procedure DoSubmitClear integer lhServer get server to lhServer if lhServer send clear of lhServer end_procedure procedure OnButton string lsDetectionValue if (lsDetectionValue="findfirst") send DoSubmitFindFirst if (lsDetectionValue="findprev") send DoSubmitFindPrev if (lsDetectionValue="find") send DoSubmitFind if (lsDetectionValue="findnext") send DoSubmitFindNext if (lsDetectionValue="findlast") send DoSubmitFindLast if (lsDetectionValue="save") send DoSubmitSave if (lsDetectionValue="delete") send DoSubmitDelete if (lsDetectionValue="clear") send DoSubmitClear set !$.psHandleSubmitRval to lsDetectionValue end_procedure procedure priv.OnButton string lsDetectionValue ifnot (!$.pbSubmitHandled(self)) begin send DoRefindPostedRecords // Refind records of posted form send DoReadPostedFormValues // Transfer other values from posted form to WebInput objects send DoEntryUpdate // Transfer values of all DD connected inputs to DDO's send OnButton lsDetectionValue // Handle submit action (if it's one of the standard ones) set !$.pbSubmitHandled to TRUE // Indicate that an action has been handled. end end_procedure procedure CheckBackgroundSubmit integer lhBackgnd string lsBackgndName lsBackgndCollection get sFormValue "backgndform" to lsBackgndName get sFormValue "backgndcoll" to lsBackgndCollection if ((lsBackgndName+lsBackgndCollection)<>"") begin get WebForm_FindFormObject lsBackgndName lsBackgndCollection to lhBackgnd set priv.phBackgroundForm to lhBackgnd set priv.phPopupForm of lhBackgnd to self // Establish connection if (pbAutoServerState(self)) set server to (server(lhBackgnd)) send HandleBackgroundSubmit of lhBackgnd end end_procedure procedure HandleBackgroundSubmit // Called from pop'ped up form #IFDEF Is$WebApp send CheckBackgroundSubmit // Handle cascading popup forms. send DoRebuildAllConstraints send DoReadContainerPopupIds send DoRefindPostedRecords // Refind records of posted form send DoReadPostedFormValues // Transfer other values from posted form to WebInput objects #ENDIF end_procedure //> This function is called in order to make the form handle a submit (data has been posted). It returns //> the detection value of the button that was clicked (if anybody outside needs it). function HandleSubmit returns string // wForm #IFDEF Is$WebApp send CheckBackgroundSubmit set !$.psHandleSubmitRval to "" // This way, we let the DoWriteHtml procedure know if it's "painting" the // form that generated the errors that may be in the oWebFormSubmitErrors // object: move self to ghFormSubmitted send DoRebuildAllConstraints send DoReadContainerPopupIds send ErrorQueueStart of ghInetSession // Pick up errors during pre-submit code. set !$.pbSubmitHandled to FALSE // Indicate that an action has not yet been handled. send DoSubmitAction send ErrorQueueEnd of ghInetSession send DoGetErrors of oWebFormSubmitErrors self function_return (!$.psHandleSubmitRval(self)) #ENDIF end_function // HandleSubmit //> May me used to add further query string parameters when sFormAction is called procedure OnFormActionAddParam end_procedure function sFormAction returns string // wForm string lsAction lsValue lsModule lsPage get psFormAction to lsAction if (lsAction="") get waf_config_value WACFG_ASP_FILE to lsAction send QryString_Prepare lsAction get value of oBaseSessionVariables WSV_MODULE_NAME to lsModule get value of oBaseSessionVariables WSV_PAGE_NAME to lsPage send QryString_AddParam "m" lsModule send QryString_AddParam "p" lsPage send OnFormActionAddParam function_return (QryString_Value()) end_function // Used to prefix all input names in order to make them unique across the // complete application. Why? Because this enables us to pack hidden versions // of forms inside other forms. function sInputNamePrefix returns string // wForm function_return (psFormName(self)+"_"+psFormCollection(self)+"_") end_function function sFormValue string lsInputName returns string function_return (WafGetHtmlFormValue(sInputNamePrefix(self)+lsInputName)) end_function procedure OnSetDefaultValues end_procedure procedure DoWriteBackgroundForm integer lhBackgroundForm lhWriter string lsInputNamePrefix get priv.phBackgroundForm to lhBackgroundForm if lhBackgroundForm begin // If there is a background form get phWriter to lhWriter get sInputNamePrefix to lsInputNamePrefix send DoWriteHiddenInput of lhWriter (lsInputNamePrefix+"backgndform") (psFormName(lhBackgroundForm)) send DoWriteHiddenInput of lhWriter (lsInputNamePrefix+"backgndcoll") (psFormCollection(lhBackgroundForm)) send DoWriteHtmlHidden of lhBackgroundForm end // integer lhWriter // get hWriter of (phUiContainer(self)) to lhWriter // send DoWriteHiddenInput of lhWriter lsName lsValue end_procedure // Perform clean up after having written the XHTML. This is necessary // in order not to disturb another session with property values stuck // from this session. procedure DoEndWriteHtml set priv.phPopupForm to 0 set priv.phBackgroundForm to 0 end_procedure procedure DoWriteHtmlHidden // wForm integer lhServer lhWriter get server to lhServer send DoClearSubmitErrors // send DoEntryDisplay // Move data from record buffers to input objects (WebForm) get hWriter of (phUiContainer(self)) to lhWriter send DoWriteFormHidden of lhWriter self send DoEndWriteHtml // (clean up) end_procedure function bValidateRecord returns integer // wForm // If this function returns 0 the form will not maint at all function_return 1 end_function procedure DoWriteHtml // wForm integer lhServer lhWriter lhPopupForm lbOk get priv.phPopupForm to lhPopupForm if lhPopupForm begin set priv.phBackgroundForm of lhPopupForm to self // Establish contact send DoWriteHtml of lhPopupForm end else begin get server to lhServer send DoClearSubmitErrors if (self=ghFormSubmitted) send DoReadSubmitErrors // Place field specific error messages in input objects else begin send DoRebuildAllConstraints send DoReadContainerPopupIds if lhServer send Clear of lhServer send OnSetDefaultValues end if (lhServer and pbAutoQueryStringScan(self)) send DoScanQueryString send DoEntryDisplay // Move data from record buffers to input objects (WebForm) get bValidateRecord to lbOk if lbOk begin get hWriter of (phUiContainer(self)) to lhWriter send DoWriteForm of lhWriter self end else begin send XHTML_Add_Closed_Element "div" "Record authorization failed" end send DoEndWriteHtml // (clean up) end end_procedure procedure Popup_Form string lsFormName string lsCollectionName integer lhPopupForm get WebForm_FindFormObject lsFormName lsCollectionName to lhPopupForm if lhPopupForm begin set priv.phPopupForm to lhPopupForm set priv.phBackgroundForm of lhPopupForm to self if (pbAutoServerState(lhPopupForm)) set server of lhPopupForm to (server(self)) move lhPopupForm to ghFormSubmitted // Don't make DoWriteHtml clear it's DDO's end end_procedure // This is called to guard the closing of the form (which need to be popped up) function bValidateFormClose returns integer function_return TRUE end_function // This procedure of the background form is called as part of the closing of a popped up form. It should // be used to get the values/records from the popped up form and put them in the background form. procedure GetPopupFormValues string lsFormName string lsFormCollection integer lhPopupForm //send DoEntryDisplay if (pbAutoServerState(lhPopupForm)) begin end end_procedure procedure DoSnapShotCurrentRecordsHelp integer lhDD integer liTable integer liRecnum get current_record of lhDD to liRecnum set piRecnum.i of oSnapshotCurrentRecords liTable to liRecnum end_procedure //> Takes the current_record of each DDO and stores it in the embedded oSnapshotCurrentRecords object procedure DoSnapShotCurrentRecords integer lhServer send delete_data of oSnapshotCurrentRecords get server to lhServer if lhServer begin // Read all the record ids from main DD and up. send DoSnapShotCurrentRecordsHelp lhServer (main_file(lhServer)) 0 send DDO_CallbackReset // Up Recursive ParentFirst ExclVisited send DDO_Callback lhServer TRUE TRUE FALSE TRUE MSG_DoSnapShotCurrentRecordsHelp self end end_procedure function hFindInputName.s string lsName returns integer integer lhRval get hFindInputName.s of (phUiContainer(self)) to lhRval function_return lhRval end_function procedure set form_input_value string lsName string lsValue integer lhInput get hFindInputName.s lsName to lhInput if lhInput set value of lhInput WFIP_NAME to lsValue end_procedure function form_input_value string lsName returns string integer lhInput string lsValue get hFindInputName.s lsName to lhInput if lhInput get value of lhInput WFIP_NAME to lsValue else move "" to lsValue function_return lsValue end_function //> This is used in procedure GetPopupFormValues for retrieving //> current_records of the popped up form function form_row_id integer liTable returns integer integer liRecnum get piRecnum.i of oSnapshotCurrentRecords liTable to liRecnum function_return liRecnum end_function //> This is used while stowing down current_records of a background form procedure set form_row_id integer liTable integer liRecnum set piRecnum.i of oSnapshotCurrentRecords liTable to liRecnum end_procedure // Close Form: // // 1. Validate popup form (bValidateFormClose) // 2. Snap shot current_records from popup forms DDO's // 3. Restore background forms records and values including changes // 4. Let background form get it's values // a. Get Current_Record of lhPopupForm customer.file_number // b. Get Input_Value of lhPopupForm // 5. Close the popup form // // procedure Close_Popup integer lhBackgroundForm get priv.phBackgroundForm to lhBackgroundForm if lhBackgroundForm begin if (bValidateFormClose(self)) begin send DoSnapShotCurrentRecords // Hertil send HandleBackgroundSubmit of lhBackgroundForm // Once more: Restore background everything. NOTE: This may be the second time this is called during one submit. send DoEntryUpdate of lhBackgroundForm // Transfer values of all DD connected inputs to DDO's send GetPopupFormValues of lhBackgroundForm (psFormName(self)) (psFormCollection(self)) self move lhBackgroundForm to ghFormSubmitted // Don't make DoWriteHtml clear it's DDO's set priv.phBackgroundForm to 0 set priv.phPopupForm of lhBackgroundForm to 0 end end end_procedure procedure Cancel_Popup integer lhBackgroundForm get priv.phBackgroundForm to lhBackgroundForm if lhBackgroundForm begin send HandleBackgroundSubmit of lhBackgroundForm // Once more: Restore background everything. NOTE: This may be the second time this is called during one submit. send DoEntryUpdate of lhBackgroundForm // Transfer values of all DD connected inputs to DDO's move lhBackgroundForm to ghFormSubmitted // Don't make DoWriteHtml clear it's DDO's set priv.phBackgroundForm to 0 set priv.phPopupForm of lhBackgroundForm to 0 end end_procedure procedure end_construct_object // wForm forward send end_construct_object send add_webform of oWebFormList self // Register with global list of wForm objects send DoLayout end_procedure procedure DoCBCtrlForm integer lhControl // This is called from all wfBasicControl as a consequence of Callback_Controls below integer lhMsg lhObj get priv.CallBackMsg to lhMsg get priv.CallBackObj to lhObj send lhMsg of lhObj lhControl end_procedure //> Send lhMsg to lhObj for all inputs in this form procedure Callback_Controls integer lhMsg integer lhObj set priv.CallBackMsg to lhMsg set priv.CallBackObj to lhObj send DoBroadcastAll of (phUiContainer(self)) MSG_DoCBCtrl end_procedure end_class // wForm Use WebFormWriter.nui