//**************************************************************************** // $Module type: Package // $Module name: cDynamicReadOnlyGrid.pkg // $Author : Nils G. Svedmyr // Created : 2001-10-10 @ 16:08 // // Description : // // $Rev History // 2001-10-10 Module header created //**************************************************************************** Use Working.pkg Use SyncFuncs.pkg Register_Object oCurrentColumn_fm Register_Object oFieldType_fm Register_Object oFieldLength_fm Class cDynamicReadOnlyGrid Is A Grid Procedure Construct_Object Handle ho Integer iColor Forward Send Construct_Object Property Handle phoFieldArray Property Integer piOffset 5 Property Integer piMaxCols 6 Property Integer piColWidth 80 Property Integer piFile 0 Property Integer piPaintCol -1 Property Integer piIndex -1 Property String psMoveValueOut "" Property Boolean pbMultiType False // False = Only display ASCII fields. Else; Ascii, Numeric and Date fields. Property Boolean pbCheckAnsi True // If Auto Ansi check should be done at all while filling grid data. Property Boolean pbFirstAnsi True // Only display Ansi check once on each popup and display info_box Property Boolean pbAnsi False // Was an ANSI value found? Property Boolean pbFirst True // So that no check on record exists during first fill is performed. Property Boolean pbHeaderWidth True Set AutoSize_Height_State To False Set Highlight_Row_state To True Set Select_Mode To No_Select Get ReadDWord Of ghoApplication "Preferences" "CurrentRowColor" 0 To iColor If Not iColor Move clAqua To iColor Set CurrentRowColor To iColor Get ReadDWord Of ghoApplication "Preferences" "CurrentCellColor" 0 To iColor If Not iColor Move clYellow To iColor Set CurrentCellColor To iColor Set Size To 10 10 Set Line_Width To 3 0 Get Create U_Array To ho Set phoFieldArray To ho On_Key kEnter Send DoMoveValueOut On_Key Key_Home Send Home On_Key Key_End Send End On_Key Key_PgDn Send NextSet On_Key Key_PgUp Send FirstSet On_Key Key_Tab Send Switch On_Key Key_F6 Send Switch On_Key Key_Shift+Key_F6 Send Switch_Back End_Procedure // Construct_Object Procedure End_Construct_Object Forward Send End_Construct_Object End_Procedure // End_Construct_Object Procedure Mouse_Click Integer iWin Integer iChar Forward Send Mouse_Click iWin iChar Send DoMoveValueOut End_Procedure // Mouse_Click Procedure DoCreateColumns Handle hoArray Boolean bMultiType bOk bHeaderWidth Integer iFile iMaxCols iCount iColCount iColWidth Integer iFields iType iLength iOffset iStart iIndex String sFieldName sChar sText sDriver Move (phoFieldArray(Self)) To hoArray Send Delete_Data Of hoArray // Delete old items. Send Delete_Data Get piFile To iFile Get piIndex To iIndex If Not iFile Begin Error DfErr_Program "piFile has not been specified." Procedure_Return End // If Not iFile Begin Get piMaxCols To iMaxCols Get piColWidth To iColWidth Get piOffset To iOffset Get pbMultiType To bMultiType Get pbHeaderWidth To bHeaderWidth Get_Attribute DF_FILE_DRIVER Of iFile To sDriver Get_Attribute DF_FILE_NUMBER_FIELDS Of iFile To iFields If (Uppercase(sDriver) = FLEX_DRV_ID) Move 0 To iStart Else Move 1 To iStart Clear iFile For iCount From iStart To iFields Get_Attribute DF_FIELD_NAME Of iFile iCount To sFieldname Get_Attribute DF_FIELD_TYPE Of iFile iCount To iType Get_Attribute DF_FIELD_LENGTH Of iFile iCount To iLength If bHeaderWidth ; Get Text_Extent sFieldname To iLength Else Begin If (iType = DF_ASCII) Begin Move (Repeat("d", iLength)) To sText Get Text_Extent sText To iLength End End // Else Begin Move (Low(iLength)) To iLength Move (False) To bOk If (bMultiType And (iType = DF_ASCII Or iType = DF_BCD Or iType = DF_DATE)) ; Move (True) To bOk Else If (Not(bMultiType) And iType = DF_ASCII) ; Move (True) To bOk If bOk Begin Get UpperFirstChar sFieldName To sFieldName If (iLength < iColWidth + iOffset) ; Set Form_Width item iColCount To (iLength + iOffset) Else ; Set Form_Width item iColCount To iColWidth Set Header_Label item iColCount To sFieldName Set Array_Value Of hoArray item (Item_Count(hoArray)) To iCount Increment iColCount Set Line_Width To (iColCount + 1) Set Matrix_Size To (iColCount + 1) End // If bOk Begin Loop // For iCount from iStart to iFields Set Line_Width To iColCount 0 Set Matrix_Size To iColCount 0 Send Ignore_Error Of Error_Info_Object 12292 Indicate Err False Clear iFile vFind iFile iIndex Gt Set pbFirst To True Send Trap_Error Of Error_Info_Object 12292 End_Procedure // DoCreateColumns Function CreateColumns Returns Integer Indicate Err False Send DoCreateColumns // If (Err) Function_Return 0 // Else Function_Return (Line_Size(Self)) Function_Return (Line_Size(Self)) End_Function // CreateColumns Function IsMoreData Returns Integer Boolean bFound Integer iFile iIndex // Constrained_Find Next Get piFile To iFile Get piIndex To iIndex vFind iFile iIndex Gt Move (Found) To bFound // 2003-07-13 ------------------------------------ Start Nils G. Svedmyr // If Not bFound vFind iFile iIndex Lt If bFound vFind iFile iIndex Lt // 2003-07-13 ------------------------------------ Stop Nils G. Svedmyr Function_Return bFound End_Function // IsMoreData Procedure DoFillData Handle hoArray Integer iFile iField iCount iColCount iFieldCount iMaxItems iCrnt iCol Integer iLength iCount2 iRetval iIndex String sValue sChar sCompValue Boolean bAnsi If Not (pbFirst(Self)) Begin Get IsMoreData To iCount Set Enabled_State Of oNext_bn To iCount If Not iCount Begin Send Info_Box "Reached end of data. No more records to display." Procedure_Return End // If Not iCount Begin End // If Not (pbFirst(Self) Begin Set pbFirst To False // Has been set to True in DoCreateColumns. Move (phoFieldArray(Self)) To hoArray Get piFile To iFile Get piIndex To iIndex Get Current_Item To iCrnt // To restore current item after record finds. // Change logic to create, fill data after displayed on screen: // Get Matrix_Size xxx Get Line_Size To iColCount Get Display_Size To iMaxItems Get piPaintCol To iCol Set Dynamic_Update_State To False Send Delete_Data // Delete old items. Send Ignore_Error Of Error_Info_Object 14 // Please enter a number While (Found) If Not (Found) Break // We're done. For iCount From 0 To (iColCount -1) Get Integer_Value Of hoArray item iCount To iField Get_Field_Value iFile iField To sValue Move (Trim(sValue)) To sValue If (Not(pbMultiType(Self)) And Not(bAnsi) And pbCheckAnsi(Self) And pbFirstAnsi(Self)) Begin Move (Length(sValue)) To iLength If (iLength > 0) Begin Move sValue To sCompValue For iCount2 From 1 To iLength Move (Left(sCompValue, 1)) To sChar Move (Replace(sCompValue, sChar, "")) To sCompValue If (Ascii(sChar) > 168) Move (True) To bAnsi // Not 127! If bAnsi Break Loop // For iCount2 from 1 to iLength End // If iLength Begin End // If (pbCheckAnsi(Self) and pbFirstAnsi(Self)) Begin Send Add_Item msg_None sValue Set Entry_State item iFieldCount To False If (iCol > -1 And (iCol = iCount)) Begin Set ItemColor Item iFieldCount To clMenu Set ItemTextColor Item iFieldCount To clWindowText End // If (iCol > -1 and (iCol = iCount)) Begin Increment iFieldCount Loop // For iCount from 1 to (iColCount -1) // Constrained_Find Next vFind iFile iIndex Gt If (iFieldCount = iMaxItems) Break // Then all grid items has been filled. Until (Not(Found)) Send Trap_Error Of Error_Info_Object 14 // Please enter a number Set Enabled_State Of oNext_bn To (Found) If (iCol > 0) Move iCol To iCrnt // Else If (Line_Size(Self) < iCrnt) Move 0 To iCrnt Set Current_Item To iCrnt // Reset current item to what it was before finding records. Set Dynamic_Update_State To True Send Paint If (Not(pbMultiType(Self)) And pbCheckAnsi(Self) And pbFirstAnsi(Self)) Begin If bAnsi Begin Send Info_Box ("An ANSI value has been found and so data probably has been saved in ANSI format for this table.") Set pbFirstAnsi To False End // If bAnsi Begin Else Begin Get YesNo_Box ("No ANSI values have been found. Either the data for this table has been saved in OEM format or you need to run the OEM/ANSI check on the next set of data. Do you want to be able to check with further data?") To iRetval If (iRetval = MBR_Yes) Set pbFirstAnsi To True Else Set pbFirstAnsi To False End // Else Begin End // If (pbCheckAnsi and pbFirstAnsi) Begin End_Procedure // DoFillData Procedure Set Current_Item Integer iItem Handle hoArray Integer iCol iField iFile iType iLength iPrec String sType Forward Set Current_Item To iItem Move (phoFieldArray(Self)) To hoArray Get Current_Col To iCol Get Integer_Value Of hoArray item iCol To iField Get piFile To iFile Get_Attribute DF_FIELD_TYPE Of iFile iField To iType Get_Attribute DF_FIELD_LENGTH Of iFile iField To iLength Get_Attribute DF_FIELD_PRECISION Of iFile iField To iPrec If (iType = DF_BCD) Move (iLength - iPrec) To iLength Get FieldType iType To sType If (oCurrentColumn_fm(Self)) Set Value Of oCurrentColumn_fm To iField If (oFieldType_fm(Self)) Set Value Of oFieldType_fm To sType If (oFieldLength_fm(Self)) Set Value Of oFieldLength_fm To (String(iLength) + "," + String(iPrec)) End_Procedure // Set Current_Item Procedure NextSet Send StartWorkingMessage "Fetching next set of data..." Send DoFillData Send StopWorkingMessage End_Procedure // NextSet Procedure FirstSet Integer iFile iIndex Get piFile To iFile Get piIndex To iIndex If iFile Begin Send StartWorkingMessage "Fetching first set of data..." // Constrained_Find First iFile by iIndex Clear iFile vFind iFile iIndex Gt Set pbFirst To True Send DoFillData Send StopWorkingMessage End // If ho Begin End_Procedure // FirstSet Procedure Home Integer iCol iCrnt Get Current_Col To iCol Get Current_Item To iCrnt Set Current_Item To (iCrnt - iCol) End_Procedure // Home Procedure End Integer iCol iCrnt iCols Get Current_Col To iCol Get Line_Size To iCols Get Current_Item To iCrnt Set Current_Item To (iCrnt - iCol + iCols -1) End_Procedure // End Procedure DoMoveValueOut Handle hoFocus Integer iPaintCol iCol iCrnt iItem String sValue Move (Focus(Desktop)) To hoFocus If (hoFocus <> Self) Begin Set psMoveValueOut To "" If (hoFocus = (oClose_bn(Self))) Send KeyAction Of oClose_bn If (hoFocus = (oFirst_bn(Self))) Send KeyAction Of oFirst_bn If (hoFocus = (oNext_bn(Self))) Send KeyAction Of oNext_bn Procedure_Return End // If (hoFocus <> Self) Begin Get piPaintCol To iPaintCol If (iPaintCol < 0) Begin Send KeyAction Of oNext_bn Procedure_Return End // If (iPaintCol < 0) Begin Get Current_Item To iCrnt Get Current_Col To iCol If (iCol = iPaintCol) Move iCrnt To iItem Else If (iCol < iPaintCol) Move (iCrnt + (iPaintCol - iCol)) To iItem Else If (iCol > iPaintCol) Move (iCrnt - (iCol - iPaintCol)) To iItem Get Value item iItem To sValue Set psMoveValueOut To (Trim(sValue)) Send Close_Panel End_Procedure // DoMoveValueOut // HOW SHOULD THIS BE HANDLED IF THERE'S ONLY MULTI-SEGMENT INDEXES, OR NO INDEX DEFINED??? // Example: See IBM DB2 "SAMPLE" DATABASE; TABLE "SALES" // // This can be called for CLI drivers to auto set the file record // identity. // It will set the piIndex property to -1 if a unique record identifier was found // Else it sets piIndex to the index with the least number of index segments. Procedure DoSetPrimaryIndex Integer iFile Integer iField iIndexes iCount iSegments iIndex iLowSegments iFields iType Get_Attribute DF_FILE_RECORD_IDENTITY Of iFile To iField If (iField > 0) ; Get_Attribute DF_FIELD_INDEX Of iFile iField To iIndex If (iField <= 0) Begin Move 100 To iLowSegments // Just a high number Get_Attribute DF_FILE_LAST_INDEX_NUMBER Of iFile To iIndexes For iCount From 1 To iIndexes Get_Attribute DF_INDEX_NUMBER_SEGMENTS Of iFile iCount To iSegments If (iSegments = 1) Break If (iSegments < iLowSegments) Begin Move iCount To iIndex // Index with the lowest number of index segments Move iSegments To iLowSegments End // If (iSegments < iLowSegments) Begin Loop // For iCount From 1 To iIndexes If (iSegments = 1) Begin Get_Attribute DF_INDEX_SEGMENT_FIELD Of iFile iCount 1 To iField Get_Attribute DF_FIELD_INDEX Of iFile iField To iIndex // Move -1 To iIndex End // If (iSegments = 1) Begin Else Begin Get_Attribute DF_FILE_NUMBER_FIELDS Of iFile To iFields For iCount from 1 to iFields Get_Attribute DF_FIELD_TYPE Of iFile To iType If (iType = DF_BCD) Break Loop // For iCount from 1 to iFields Move iCount To iField End // Else Begin Set_Attribute DF_FILE_RECORD_IDENTITY Of iFile To iField End // If (iField <= 0) Begin //showln "iField = " iField " iIndex = " iIndex Set piIndex To iIndex End_Procedure // DoSetPrimaryIndex End_Class // cDynamicReadOnlyGrid