Use dfAllEnt.pkg Use SelectDatabasefile.dg Activate_View Activate_datainit_vw For datainit_vw Object datainit_vw Is A dbView Property Integer pDataRecUsed public 0 //Number of init-records Property Integer pDataRecNum public 0 //Actual init-record Property Integer pDataNumFields public 0 //Number of fields in a init-record Property String pSpnIndex public 0 //Indexnumber for intialization Property Integer LeaveNoAsk public 0 //Exit window without any questions Property Integer pSystemfile public 0 //Is this a systemfile Property Integer pSpecialfile public 0 //Is it CODEMAST, CODETYPE Property String psFilenumber // Current selected filenumber or CODEMAST, CODETYPE Property String psDescriptionDir Property String sActLogicalname Object aData Is An array End_Object Object aForceInit Is An array End_Object Procedure DoSaveInField Integer ActField Integer strTemp Set value Of (Datagrid(Container3d1(Self))) item ((ActField * 2) -1) To strTemp End_Procedure Function FetchFromField global Integer ActField Returns String String sOutTxt Get value Of (Datagrid(Container3d1(Self))) item ((ActField * 2) -1) To sOutTxt Function_Return sOutTxt End_Function Procedure DoUpdateRecstatus String strTemp sLogicalname Integer iActRecord iMaxRecord ActField iNoOfFields Integer oData iOffset iSysfil iForceInit oForceInit Move (aData(Self)) To oData Move (aForceInit(Self)) To oForceInit Get pDataRecNum To iActRecord Get pDataRecUsed To iMaxRecord Get pDataNumFields To iNoOfFields Get sActLogicalname To sLogicalname Get pSystemfile To iSysfil calc ((iActRecord-1) * iNoOfFields) To iOffset If (iActRecord <= iMaxRecord) Begin For ActField From 1 To iNoOfFields Get string_Value Of oData item (ActField + iOffset -1) To strTemp Send DoSaveInField ActField strTemp Loop Get integer_value Of oForceInit item (iActRecord -1) To iForceInit Set checked_state Of (chkForceInit(Container3d1(Self))) To iForceInit End Else Begin //Show an empty record. For ActField From 1 To iNoOfFields Send DoSaveInField ActField "" Loop Set checked_state Of (chkForceInit(Container3d1(Self))) To False End Move sLogicalname To strTemp Append strTemp " - Record: " Get pDataRecNum To iActRecord Get pDataRecUsed To iMaxRecord Append strTemp iActRecord " of " iMaxRecord If iSysfil Append strTemp " (systemfile)" Set label Of (lRecStatus(Container3d1(Self))) To strTemp End_Procedure Procedure LoadData String sInDir Integer iNo iMaxRecord iActRec iNoOfFields oData retval oFildef Integer iFound oForceInit iReadNoFields iActField iFieldFound iSrchField String sSpnIndex sLogicalname sFileIn strTemp strTest sDescribe Integer iSeqFile Get psDescriptionDir to sInDir Move (aData(Self)) To oData Move (aForceInit(Self)) To oForceInit Move (fildef(datagrid(container3d1(Self)))) To oFildef Get pDataNumFields To iNoOfFields Get sActLogicalname To sLogicalname Send delete_data To oData Send delete_data To oForceInit Set pDataRecUsed To 0 Set pDataRecNum To 0 Set pspnIndex To 0 Send cursor_wait To (cursor_control(current_object)) Move (sInDir + "\" + sLogicalname + ".NTI") To sFileIn Get vFilePathExists sFileIn To iFound If iFound Begin Get Seq_New_Channel To iSeqFile Direct_Input Channel iSeqFile sFileIn Readln Channel iSeqFile sSpnIndex iMaxRecord iReadNoFields If (sSpnIndex = 0) Move "-" To sSpnIndex Set pSpnIndex To sSpnIndex Set pDataRecUsed To iMaxRecord Move 0 To iActRec While (iActRec < iMaxRecord) Readln Channel iSeqFile strTemp Set array_value Of oForceInit item iActRec To strTemp For iActField From 0 To (iReadNoFields - 1) Readln Channel iSeqFile strTest Move 0 To iFieldFound Move 1 To iSrchField While ((iSrchField =< iNoOfFields) And (iFieldFound = 0)) Get String_value Of oFildef item (iSrchField * 4) To sDescribe If (Trim(sDescribe) = strTest) Move iSrchField To iFieldFound Increment iSrchField Loop If (iFieldFound = 0) Begin Move "Initializingdata for the field named " To strTemp Append strTemp strTest " is present but the fieldname does not exist in the databasefile. " Append strTemp "The data for this field will not be loaded." Get Message_Box strTemp "Field not found!" MB_OK MB_ICONWARNING To retval Readln Channel iSeqFile strTemp End Else Begin Readln Channel iSeqFile strTemp Set array_Value Of oData item ((iActRec * iNoOfFields) + iFieldFound - 1) To StrTemp End Loop Increment iActRec Loop Close_Input Channel iSeqFile sFileIn Send Seq_Release_Channel iSeqFile Send cursor_ready To (cursor_control(current_object)) End End_Procedure Set Label To "Databaseinitializing" Set Size to 197 437 Set Location To 6 6 Object Container3d1 Is A Container3d Set Size To 170 433 Set Location To 2 2 Object Datagrid Is A Grid Set Location To 2 2 Set Size To 150 360 Set Line_Width To 2 0 Set GridLine_Mode To GRID_VISIBLE_HORZ Set Header_Label item 0 To 'Fieldname and fieldtype' Set form_width item 0 To 150 Set Header_Label item 1 To 'Contents' Set form_width item 1 To 200 Set select_mode To no_select Object fildef Is An array End_Object Function DescribeFieldtype Integer iFieldType Returns String String sMessage If (iFieldType = DF_ASCII) Move "ASC" To sMessage If (iFieldType = DF_BCD) Move "NUM" To sMessage If (iFieldType = DF_DATE) Move "DATE" To sMessage If (iFieldType = DF_TEXT) Move "TEXT" To sMessage If (iFieldType = DF_BINARY) Move "BIN" To sMessage If (iFieldType = DF_OVERLAP) Move "OVLP" To sMessage Function_Return sMessage End_Function Procedure Fill_the_List Integer itms iNoOfFields iActPos lcif rcif iSysfil Integer iFilenum oFildef iFieldType iFieldLng iFieldComma Integer iSpecFile String strTemp sDescribe sLogicalname Send cursor_wait To (cursor_control(current_object)) Move (fildef(Self)) To oFildef Send delete_data To oFildef Set pSpecialfile To 0 Set pSystemfile To 0 Send delete_data //The Grid Get psFilenumber to strTemp If ((strTemp = "CODETYPE") Or (strTemp = "CODEMAST")) Begin Set pSpecialfile To True Move strTemp To sLogicalname Move 1 To iSpecFile End Else Move (Integer(strtemp)) To iFilenum If ((iFilenum) Or (iSpecFile)) Begin //Only if there has been selected a file! If iSpecFile Begin If (sLogicalname = "CODETYPE") Begin Open "CODETYPE" as 207 //mode DF_EXCLUSIVE //"open ... as" will include the .FD file Move 207 To iFilenum End If (sLogicalname = "CODEMAST") Begin Open "CODEMAST" as 208 //mode DF_EXCLUSIVE Move 208 To iFilenum End End Else Open iFilenum //mode DF_EXCLUSIVE If (Found) Begin //The file was opened sucessfull If Not iSpecFile Get_Attribute DF_FILE_LOGICAL_NAME Of iFilenum To sLogicalname Set sActLogicalname To sLogicalname Get_Attribute DF_FILE_NUMBER_FIELDS Of iFilenum To iNoOfFields Set pDataNumFields To iNoOfFields Get_Attribute DF_FILE_IS_SYSTEM_FILE Of iFilenum To iSysfil Set pSystemfile To iSysfil For iActPos From 1 To iNoOfFields Get_Attribute DF_FIELD_NAME Of iFilenum iActPos To strTemp Set array_value Of oFildef item (iActPos * 4) To strTemp Get_Attribute DF_FIELD_TYPE Of iFilenum iActPos To iFieldType Set array_value Of oFildef item ((iActPos * 4) + 1) To iFieldType Get_Attribute DF_FIELD_LENGTH Of iFilenum iActPos To iFieldLng Set array_value Of oFildef item ((iActPos * 4) + 2) To iFieldLng If (iFieldType = DF_BCD) Begin Get_Attribute DF_FIELD_PRECISION Of iFilenum iActPos To iFieldComma Set array_value Of oFildef item ((iActPos * 4) + 3) To iFieldComma End Loop End Close iFilenum For iActPos From 1 To iNoOfFields Get String_value Of oFildef item (iActPos * 4) To sDescribe Get integer_value Of oFildef item ((iActPos * 4) + 1) To iFieldType Move (DescribeFieldtype(Self, iFieldType)) To strtemp Append sDescribe ", " strtemp Get integer_value Of oFildef item ((iActPos * 4) + 2) To iFieldLng Append sDescribe ", " iFieldLng If (iFieldType = DF_BCD) Begin Get integer_value Of (fildef(Self)) item ((iActPos * 4) + 3) To iFieldComma calc (iFieldLng - iFieldComma) To lcif Move iFieldComma To rcif Append sDescribe " (" lcif "," rcif ")" End Send Add_Item 0 sDescribe Send Add_Item 0 "" Get Item_Count To Itms Set entry_state item (itms -2) To False Set item_color item (itms-2) To clLtgray If ((iFieldType = DF_BINARY) Or (iFieldType = DF_OVERLAP)) Begin Set shadow_state item (itms-1) To True Set item_color item (itms-1) To clRed Set item_color item (itms-2) To clRed End Loop End Send CheckForSysfile Send LoadData Set pDataRecNum To 1 Send DoUpdateRecstatus Set current_item To 1 //Top of datacolumn Send cursor_ready To (cursor_control(current_object)) End_Procedure Procedure Set Current_Item Integer Itm Integer oldst lcif rcif Integer iFieldLng iActPos iFieldType iFieldComma Get dynamic_update_state To oldst Set Dynamic_Update_State To False calc (itm / 2) To iActPos Increment iActPos Forward Set Current_Item To Itm If (Mod(itm, 2)) Begin //Only column 2 (every second item ie. 1, 3, 5...) //Initialize, so that a change to ie. a date-field does not erase the current field Get integer_value Of (fildef(Self)) item ((iActPos * 4) + 1) To iFieldType Get integer_value Of (fildef(Self)) item ((iActPos * 4) + 2) To iFieldLng If (iFieldType = DF_DATE) Begin Move 10 To iFieldLng Set form_datatype Item 1 To date_window Set form_margin item 1 To iFieldLng End If (iFieldType = DF_ASCII) Begin Set form_datatype Item 1 To ascii_window Set form_margin item 1 To iFieldLng End If (iFieldType = DF_BCD) Begin Get integer_value Of (fildef(Self)) item ((iActPos * 4) + 3) To iFieldComma If iFieldComma Increment iFieldLng //Room for comma Set Form_datatype item 1 To ascii_window Set form_margin item 1 To iFieldLng End If (iFieldType = DF_TEXT) Begin Set form_datatype Item 1 To ascii_window Set form_margin item 1 To iFieldLng End If (iFieldType = DF_BINARY) Begin Set form_datatype Item 1 To ascii_window Set form_margin item 1 To 1 //Is normally locked End If (iFieldType = DF_OVERLAP) Begin Set form_datatype Item 1 To ascii_window Set form_margin item 1 To 1 //Is normally locked End End Set dynamic_update_State To OldSt End_Procedure Procedure item_change Integer fromi Integer toi Returns Integer Integer rval iError Integer iActPos iFieldType String strTemp Number nTest Date dTest calc (fromi / 2) To iActPos Increment iActPos If (Mod(fromi, 2)) Begin //Only column 2 (every second item ie. 1, 3, 5...) Get integer_value Of (fildef(Self)) item ((iActPos * 4) + 1) To iFieldType If (iFieldType = DF_DATE) Begin Get FetchFromField iActPos To strTemp indicate err False movedate strTemp To dTest //Will generate error 16 if this is not a valid date. [err] Procedure_Return fromi Send DoSaveInField iActPos dTest End // If (iFieldType = DF_ASCII) begin // end If (iFieldType = DF_BCD) Begin //Make sure that this is a valid numer (without any letters and so forth.) Get FetchFromField iActPos To strTemp indicate err False moveint strTemp To nTest //Will generate error 51, 52 or 54 if this is not a valid number. [err] Procedure_Return fromi Send DoSaveInField iActPos nTest End // If (iFieldType = DF_TEXT) begin // end // If (iFieldType = DF_BINARY) begin // end // If (iFieldType = DF_OVERLAP) begin // end End Forward Get msg_item_change fromi toi To rval Procedure_Return rval End_Procedure Procedure Next Send Key kDownarrow End_Procedure Procedure Previous Send Key kUparrow End_Procedure On_Key Key_F2 Send KeyAction To (cmdSave(Self)) On_Key Key_Shift+Key_F2 Send KeyAction To (cmdErase(Self)) On_Key Key_F7 Send KeyAction To (cmdPrevious(Self)) On_Key Key_F8 Send KeyAction To (cmdNext(Self)) On_Key Key_F5 Send KeyAction To (cmdNew(Self)) End_Object Object lRecstatus Is A textbox Set Size To 15 120 Set Location To 154 2 Set label To "Record: x of x" End_Object Object chkForceInit Is A checkbox Set Location To 154 130 Set Label To "Force init" Set Checked_State To False End_Object Object cmdFirst Is A button Set Size To 15 60 Set Location To 2 366 Set label To "First" Procedure OnClick Set pDataRecNum To 1 Send DoUpdateRecstatus End_Procedure End_Object Object cmdPrevious Is A button Set Size To 15 60 Set Location To 19 366 Set label To "Previous" Procedure OnClick Integer iActRecord Get pDataRecNum To iActRecord Decrement iActRecord If (iActRecord < 1) Move 1 To iActRecord Set pDataRecNum To iActRecord Send DoUpdateRecstatus End_Procedure End_Object Object cmdNext Is A button Set Size To 15 60 Set Location To 36 366 Set label To "Next" Procedure OnClick Integer iActRecord iMaxRecord Get pDataRecNum To iActRecord Get pDataRecUsed To iMaxRecord Increment iActRecord If (iActRecord > iMaxRecord) Move iMaxRecord To iActRecord If (iActRecord = 0) Move 1 To iActRecord Set pDataRecNum To iActRecord Send DoUpdateRecstatus End_Procedure End_Object Object cmdLast Is A button Set Size To 15 60 Set Location To 53 366 Set label To "Last" Procedure OnClick Integer iActRecord Get pDataRecUsed To iActRecord If (iActRecord = 0) Move 1 To iActRecord Set pDataRecNum To iActRecord Send DoUpdateRecstatus End_Procedure End_Object Object cmdNew Is A button Set Size To 15 60 Set Location To 70 366 Set label To "New" Procedure OnClick Integer iActRecord Get pDataRecUsed To iActRecord Increment iActRecord Set pDataRecNum To iActRecord Send DoUpdateRecstatus Set current_item Of (datagrid(Self)) To 1 End_Procedure End_Object Object cmdErase Is A button Set Size To 15 60 Set Location To 87 366 Set label To "Erase" Procedure onClick Integer iActRecord iMaxRecord iNoOfFields iActOffset iForceInit Integer iActField oData iOffset iNo iOffsetEnd iActRec String strTemp Move (aData(Self)) To oData Get pDataRecNum To iActRecord Get pDataRecUsed To iMaxRecord Get pDataNumFields To iNoOfFields If (iActRecord > iMaxRecord) Begin Send info_box "There is no record to erase." End Else Begin Get confirm "Do you wish to erase this record?" To iNo If Not iNo Begin Send cursor_wait To (cursor_control(current_object)) Move iActRecord To iActRec While (iActRec < iMaxRecord) Get integer_value Of (aForceInit(Self)) item iActRec To iForceInit Set array_value Of (aForceInit(Self)) item (iActRec -1) To iForceInit For iActField From 0 To (iNoOfFields - 1) Get string_Value Of oData item ((iActRec * iNoOfFields) + iActField) To StrTemp Set array_Value Of oData item (((iActRec-1) * iNoOfFields) + iActField) To StrTemp Loop Increment iActRec Loop Decrement iMaxRecord If (iActRecord > iMaxRecord) Move iMaxRecord To iActRecord If (iActRecord = 0) Move 1 To iActRecord Set pDataRecUsed To iMaxRecord Set pDataRecNum To iActRecord Send DoUpdateRecstatus Send cursor_ready To (cursor_control(current_object)) // Send info_box "The record has been erased from memory." //actually this is not needed for. End End End_Procedure End_Object Object cmdSave Is A button Set Size To 15 60 Set Location To 104 366 Set label To "Save" Procedure onClick Integer iActRecord iMaxRecord iNoOfFields Integer ActField oData iOffset iForceInit String strTemp Move (aData(Self)) To oData Get pDataRecNum To iActRecord Get pDataRecUsed To iMaxRecord Get pDataNumFields To iNoOfFields calc ((iActRecord-1) * iNoOfFields) To iOffset For ActField From 1 To iNoOfFields Get FetchFromField ActField To strTemp Set array_Value Of oData item (ActField + iOffset -1) To strTemp Loop Get checked_state Of (chkForceInit(Container3d1(Self))) To iForceInit Set array_value Of (aForceInit(Self)) item (iActRecord -1) To iForceInit If (iActRecord > iMaxRecord) Move iActRecord To iMaxRecord Set pDataRecUsed To iMaxRecord Send DoUpdateRecstatus Send info_box "The record is saved in memory." End_Procedure End_Object Object spnIndex Is An comboform Set Size To 50 25 Set Location To 152 401 Set Label To "Initialize by index:" Set Label_row_Offset To -1 Set Label_Col_Offset To 70 Set Entry_State item 0 to False Procedure Combo_Fill_List Integer iFilenum iNoOfIndex iActIndex iNoOfSegments iSpecFile String strTemp sLogicalname Send Combo_delete_data Get psFilenumber to strTemp If ((strTemp = "CODETYPE") Or (strTemp = "CODEMAST")) Begin Set pSpecialfile To True Move strTemp To sLogicalname Move 1 To iSpecFile End Else Move (Integer(strtemp)) To iFilenum If ((iFilenum) Or (iSpecFile)) Begin //KOnly if there has been selected a file! //Open iFilenum mode DF_EXCLUSIVE If iSpecFile Begin If (sLogicalname = "CODETYPE") Begin Open "CODETYPE" as 207 //mode DF_EXCLUSIVE Move 207 To iFilenum End If (sLogicalname = "CODEMAST") Begin Open "CODEMAST" as 208 //mode DF_EXCLUSIVE Move 208 To iFilenum End // If (sLogicalname = "FLEXERRS") begin // Open "FLEXERRS" as 50 //mode DF_EXCLUSIVE // move 50 to iFilenum // end End Else Open iFilenum //mode DF_EXCLUSIVE If ((Found) Or (iSpecFile)) Begin //The file was opened sucessfull Send Combo_Add_Item "-" //no index - use recnum Get_Attribute DF_FILE_LAST_INDEX_NUMBER Of iFilenum To iNoOfIndex For iActIndex From 1 To iNoOfIndex Get_Attribute DF_INDEX_NUMBER_SEGMENTS Of iFilenum (String(iActIndex)) To iNoOfSegments If iNoOfSegments Send Combo_Add_Item iActIndex Loop End Close iFilenum End Get pSpnIndex To strTemp Set value item 0 To strTemp End_Procedure End_Object Procedure CheckForSysFile Integer iSysfil Get pSystemfile To iSysfil If iSysfil Begin Set enabled_state Of (cmdFirst(Self)) To False Set enabled_state Of (cmdPrevious(Self)) To False Set enabled_state Of (cmdNext(Self)) To False Set enabled_state Of (cmdLast(Self)) To False Set enabled_state Of (cmdNew(Self)) To False Set enabled_state Of (cmdErase(Self)) To False Set enabled_state Of (spnIndex(Self)) To False End Else Begin Set enabled_state Of (cmdFirst(Self)) To True Set enabled_state Of (cmdPrevious(Self)) To True Set enabled_state Of (cmdNext(Self)) To True Set enabled_state Of (cmdLast(Self)) To True Set enabled_state Of (cmdNew(Self)) To True Set enabled_state Of (cmdErase(Self)) To True Set enabled_state Of (spnIndex(Self)) To True End End_Procedure End_Object // Container3d1 Object cmdGenerate Is A button Set Size To 15 70 Set Location To 176 99 Set label To "Generate" Procedure onClick Integer iNo iMaxRecord iNoOfFields oData iActRec iActField Integer oFildef iForceInit String sSpnIndex sOutDir sLogicalname sFileout strTemp sDescribe Integer iSeqFile Move (aData(Self)) To oData Move (Fildef(datagrid(container3d1(Self)))) To oFildef Get pDataRecUsed To iMaxRecord Get pDataNumFields To iNoOfFields If iMaxRecord Begin Get confirm "Do you wish to generate the initializingfile now?" To iNo If Not iNo Begin Send cursor_wait To (cursor_control(current_object)) Get value Of (spnIndex(container3d1(Self))) To sSpnIndex If (sSpnIndex = "-") Move "0" To sSpnIndex Get psDescriptionDir to sOutDir Get sActLogicalname To sLogicalname Move (sOutDir + "\" + sLogicalname + ".NTI") To sFileout Get Seq_New_Channel To iSeqFile Direct_Output Channel iSeqFile sFileout Writeln Channel iSeqfile sSpnIndex ", " iMaxRecord ", " iNoOfFields Move 0 To iActRec Move (aData(Self)) To oData While (iActRec < iMaxRecord) Get integer_value Of (aForceInit(Self)) item iActRec To iForceInit Writeln Channel iSeqFile iForceInit For iActField From 0 To (iNoOfFields - 1) Get String_value Of oFildef item ((iActField + 1) * 4) To sDescribe Writeln Channel iSeqFile (Trim(sDescribe)) Get string_Value Of oData item ((iActRec * iNoOfFields) + iActField) To StrTemp Writeln Channel iSeqFile (Trim(strTemp)) Loop Increment iActRec Loop Close_Output Channel iSeqFile sFileout Send Seq_Release_Channel iSeqFile Send cursor_ready To (cursor_control(current_object)) Send info_box "Initializingfile has been generated!" Set LeaveNoAsk To True Send close_panel //Awoid confirmation of cancel by forwarding End End Else Send info_box "There is no record in memory." End_Procedure End_Object Object cmdCancel Is A button Set Size To 15 70 Set Location To 176 267 Set label To "Cancel" Procedure OnClick Send close_panel End_Procedure End_Object Procedure Fill_the_list String sFilenumber String sDescDir Set psFilenumber to sFilenumber Set psDescriptionDir to sDescDir Send fill_the_list To (Datagrid(Container3d1(Self))) Send Combo_Fill_List To (spnIndex(container3d1(Self))) End_Procedure Procedure Close_panel Integer iNo iLeaveNoAsk Get LeaveNoAsk To iLeaveNoAsk If Not iLeaveNoAsk Begin Get confirm "Abandon all changes?" To iNo If Not iNo Forward Send close_panel End Else Forward Send close_panel End_Procedure End_Object // datainit_vw