open-insight/SYSPROG/STPROC/SRP_EDITTABLE_MANAGER.txt
2024-03-25 15:17:34 -07:00

399 lines
18 KiB
Plaintext

Function SRP_EditTable_Manager(Method, CtrlEntId, Param1, Param2, Param3, Param4, Param5, Param6, Param7, Param8, Param9, Param10)
/***********************************************************************************************************************
This program is proprietary and is not to be used by or disclosed to others, nor is it to be copied without written
permission from SRP Computer Solutions, Inc.
Name : SRP_EditTable_Manager
Description : Provides common setup and event features for the SRP OLE EditTable.
Notes : This is desiged to eliviate the need to duplicate large amounts of code to manage the SRP OLE
EditTable. Review the list of options in the top-level case statement of this program to see what is
available.
Some methods will call other methods. For instance, the BeforeUpdate method will call the Validate
method.
Parameters :
Method [in] -- A specific setup or event action to execute.
CtrlEntId [in] -- The full control entity ID for the SRP OLE EditTable.
Param2 [in] -- Generic parameter.
Param3 [in] -- Generic parameter.
Param4 [in] -- Generic parameter.
Param5 [in] -- Generic parameter.
Param6 [in] -- Generic parameter.
Param7 [in] -- Generic parameter.
Param8 [in] -- Generic parameter.
Param9 [in] -- Generic parameter.
Param10 [in] -- Generic parameter.
EventFlow [out] -- Flag to indicate how the calling routine should continue. This will return a 1 if everything
is successful.
History : (Date, Initials, Notes)
01/22/08 dmb Original programmer. Start with the Validate method.
01/24/08 dmb Add Clear and Read methods. Updated the WritePre method.
01/25/08 dmb Add GridLine color defaults for Setup1.
01/26/08 dmb Add Fill flag for Clear method.
01/26/08 dmb Add PopulateData method.
01/26/08 dmb Move LostFocus transfer data logic into its own gosub.
02/14/08 dmb Add support for custom clear fills (used by the Clear method). Add support for
@ROWSASCOLUMNS and @CELLSASFIELDS UDPs (used by Set_Record).
02/14/08 dmb Update Style1 to default all header row and data rows to 19 pixels and not resizeable.
02/16/08 dmb Add support for new UpdateCellEdit parameter in Transfer_EditTable_Data function. Only set
it to Yes$ during the WritePre method.
***********************************************************************************************************************/
$insert LOGICAL
GoSub Check_Variable_Assignments
Declare function SRP_Edittable_Manager, Get_Property, Send_Message
Declare subroutine Transfer_Edittable_Data, SRP_Edittable_Manager, Set_Record, Send_Message, Set_Property
Begin Case
// EditTable Events
Case Method EQ "BeforeUpdate" ; GoSub BeforeUpdate
Case Method EQ "AfterUpdate" ; GoSub AfterUpdate
Case Method EQ "PosChanged" ; GoSub PosChanged
Case Method EQ "AfterDeleteRecords" ; GoSub AfterDeleteRecords
Case Method EQ "LostFocus" ; GoSub LostFocus
// Window Events
Case Method EQ "WritePre" ; GoSub WritePre
Case Method EQ "Read" ; GoSub Read
Case Method EQ "Clear" ; GoSub Clear
// Event actions
Case Method EQ "Validate" ; GoSub Validate
Case Method EQ "Convert" ; GoSub Convert
// Data population
Case Method EQ "PopulateData" ; GoSub PopulateData
// Setup options
Case Method EQ "Setup1" ; GoSub Setup1
End Case
If Assigned(EventFlow) else EventFlow = 1 ; // If not method set this then assume all is well
Return EventFlow
Validate:
//////////////////////////////////////////////////////////////////////////////////////
//
// The Validate method requires the following parameters to be populated:
//
// Param1 = SelPos
// Param2 = Data
// Param3 = Validation
//
// Optionally, these parameters can also be use to override default settings:
//
// Param4 = ValidationMessage
// Param5 = ValidationTitle
// Param6 = ValidationDisplayLength
//
// If ValidationMessage is populated then the ShowBalloonTooltip will be used.
// Otherwise, it is assumed tha the validation method will display its own
// message, which is the case for many UDCs.
//
//////////////////////////////////////////////////////////////////////////////////////
Transfer Param1 to SelPos
Transfer Param2 to Data
Transfer Param3 to Validation
Transfer Param4 to ValidationMessage
If Len(Param5) then Transfer Param5 to ValidationTitle else ValidationTitle = "Validation Error"
If Len(Param6) then Transfer Param6 to ValidationDisplayLength else ValidationDisplayLength = 2000
Status() = 0
iData = IConv(Data, Validation)
If Status() NE 0 then
// Validation failed.
If Len(ValidationMessage) then
// Use the ShowBalloonTooltip to alert the user of the validation error.
Convert ";" to @FM in SelPos
Swap "@DATA" with Data in ValidationMessage
Config = ""
Config<1> = ValidationMessage ; // Message to display.
Config<2> = ValidationTitle ; // Title of the message.
Config<3> = 3 ; // Use the Error icon.
Config<4> = ValidationDisplayLength ; // Display for 2 seconds unless user clicks to close first.
Send_Message(CtrlEntId, "OLE.ShowBalloonTooltip", SelPos, Config)
end
Set_Property(CtrlEntId, "OLE.Cancel", 2) ; // This forces the focus to return to the current cell and highlight the cell text.
EventFlow = 0 ; // Indicate that this event chain needs to abort.
end
return
Convert:
//////////////////////////////////////////////////////////////////////////////////////
//
// The Convert method requires the following parameters to be populated:
//
// Param1 = SelPos
// Param2 = Data
// Param3 = Conversion
//
//////////////////////////////////////////////////////////////////////////////////////
Transfer Param1 to SelPos
Transfer Param2 to Data
Transfer Param3 to Conversion
NewData = Oconv(Iconv(Data, Conversion), Conversion) ; // Internally convert then externally convert the data to make sure it is formatted correctly.
Set_Property(CtrlEntId, "OLE.CellText[":SelPos:"]", NewData)
return
BeforeUpdate:
// The BeforeUpdate event can be used for validation checking.
Transfer Param1 to SelPos
Transfer Param2 to Data
Transfer Param3 to Validation
CellConv = Get_Property(CtrlEntId, "OLE.CellConv[":SelPos:"]")
ValidationMessage = CellConv<3>
// If the Validation parameter has something, do a validation check.
If Len(Validation) then
EventFlow = SRP_EditTable_Manager("Validate", CtrlEntId, SelPos, Data, Validation, ValidationMessage)
end
return
AfterUpdate:
// The AfterUpdate event can be used for conversion.
Transfer Param1 to SelPos
Transfer Param2 to Data
Transfer Param3 to Conversion
// If the Conversion parameter has something, perform the conversion.
If Len(Conversion) then SRP_EditTable_Manager("Convert", CtrlEntId, SelPos, Data, Conversion)
return
PosChanged:
// The PosChanged event can be used for defaults.
Transfer Param1 to SelPos
Transfer Param2 to PrevSelPos
Transfer Param3 to Cause
Transfer Param4 to Default ; // Note: this parameter is not a part of the PosChanged event
// but the calling routine can pass this in to allow default handling.
// Get the data in the current cell. If null and a default value has been passed in then update the cell text.
Data = Get_Property(CtrlEntId, "OLE.CellText[":SelPos:"]")
If Data EQ "" AND Len(Default) then
Set_Property(CtrlEntId, "OLE.CellText[":SelPos:"]", Default)
Send_Message(CtrlEntId, "OLE.EditCell", "")
end
// Since the PosChanged event can add default data make sure these changes are transferred to the OI EditTable.
UpdateCellEdit = No$
GoSub Update_Databound_EditTable
return
AfterDeleteRecords:
// Since deleting a record from the EditTable changes data make sure these changes are transferred to the OI
// EditTable.
UpdateCellEdit = No$
GoSub Update_Databound_EditTable
return
LostFocus:
UpdateCellEdit = No$
GoSub Update_Databound_EditTable
return
Read:
Record = Param1
Set_Record(Record, "", Yes$)
return
Clear:
// Find all the OLE EditTables and Clear them.
Transfer Param1 to DefaultClearFill
If DefaultClearFill EQ "" then DefaultClearFill = 1
CtrlMap = Get_Property(@Window, "CTRLMAP")
Convert @FM to @RM in CtrlMap
ProgIDs = Get_Property(CtrlMap, "OLE.ProgID")
BytePos = 1 ; // Byte position within the string. Used by the Remove statement
Flag = "" ; // Flag used by the Remove statement
RPos = 0 ; // Record position within the @RM delimited string
Loop
Remove ProgID from ProgIDs at BytePos setting Flag
RPos += 1
If ProgID _EQC "SRP.EditTable.1" then
// This is an OLE EditTable so send the Clear method.
Ctrl = Field(CtrlMap, @RM, RPos)
ClearFill = Get_Property(Ctrl, "@CLEARFILL")
If ClearFill EQ "" then ClearFill = DefaultClearFill
Send_Message(Ctrl, "OLE.Clear", ClearFill)
end
While Flag
Repeat
return
WritePre:
CtrlEntId = Get_Property(@Window, "FOCUS")
ProgID = Get_Property(CtrlEntId, "OLE.ProgID")
If ProgID _EQC "SRP.EditTable.1" then
// Control with focus is an SRP OLE EditTable. Before the system event handler executes, update the current cell
// text and then transfer the data from the OLE EditTable to the OI EditTable.
CellContents = Send_Message(CtrlEntId, "OLE.UpdateCellEdit")
If CellContents<2> EQ "" then
// The attempt to update the cell failed. Probably due to a validation error. Abort the event.
EventFlow = 0
end else
// Cell update was successful. Transfer data to OI EditTable.
UpdateCellEdit = Yes$
GoSub Update_Databound_EditTable
end
end
return
PopulateData:
// It is assumed that @ID, @RECORD, and @DICT is already populated. This method uses
// the Calculate function which requires these system variables.
Transfer Param1 to DataArray ; // Dynamic array of field names. Used by the Calculate function to compute the value.
DictFields = Param2 ; // The %FIELDS% record from the dictionary table. Used to get the output conversion format.
Transfer Param3 to ArrayFlag ; // Flag that indicates if the DataArray is in Array or List format. Default is Array.
If ArrayFlag EQ "" then ArrayFlag = Yes$
NumRows = FieldCount(DataArray, @FM)
For RowCnt = 1 to NumRows
NumCols = FieldCount(DataArray<RowCnt>, @VM)
For ColCnt = 1 to NumCols
FieldName = DataArray<RowCnt, ColCnt>
Locate FieldName in DictFields<3> using @VM setting vPos then
FieldData = Calculate(FieldName)
Format = DictFields<12, vPos>
If Len(Format) then FieldData = Oconv(FieldData, Format)
DataArray<RowCnt, ColCnt> = FieldData
end
Next ColCnt
Next RowCnt
If ArrayFlag then Prop = "OLE.Array" else Prop = "OLE.List"
Set_Property(CtrlEntId, Prop, DataArray)
return
Setup1:
Transfer Param1 to ArrayDimension
Transfer Param2 to TitleList
Transfer Param3 to ColumnWidths
Transfer Param4 to ColumnAlignments
Transfer Param5 to VirtualPos
Transfer Param6 to RowsAsColumns
Transfer Param7 to CellsAsFields
Transfer Param8 to ClearFill
Transfer Param9 to RowsToRecord
// Set up general properties that affect the entire EditTable.
Set_Property(CtrlEntId, "OLE.BorderType", "XP Flat") ; // XP border when possible.
Set_Property(CtrlEntId, "OLE.WorkspaceBkColor", "Window") ; // Fill in the space with no cells with the current theme's Window color.
If ArrayDimension then Set_Property(CtrlEntId, "OLE.Dimension", ArrayDimension) ; // Create the number of columns and rows for this EditTable.
If RowsToRecord then Set_Property(CtrlEntId, "OLE.RowsToRecords", RowsToRecord) ; // Set up RowsToRecord if required.
// Set up properties that affect navigation functional and visual behavior.
Set_Property(CtrlEntId, "OLE.QuickTabOut", Yes$) ; // Force the focus to move to the next control if the user tries to navigate on an empty row (i.e. just like AREV). "Yes" is the default, but it is added here anyway to help explain what the EditTable can do.
Set_Property(CtrlEntId, "OLE.CellEditMode[All; All]", "Edit") ; // Put the cell into edit mode upon entry. Notice that properties that accept coordinates can accept the keyword "All".
Set_Property(CtrlEntId, "OLE.AutoColors" , "Row(Auto; Auto; Auto; 3DFace L=95; 1)") ; // Automatically alternate the color of every other row. This makes different rows easier to identify, especially since we have set 2 RowsToRecord.
Set_Property(CtrlEntId, "OLE.SelectionStyle", @VM:"S L=80":@FM:@VM:"S L=95") ; // Automatically highlight the current row with one color and highlight the current row with another color.
// Set up the Column and Row headers.
If Len(TitleList) then
If TitleList then Set_Property(CtrlEntId, "OLE.TitleList", TitleList) ; // Set up the text to be displayed in each column header.
end else
Set_Property(CtrlEntId, "OLE.HeaderRow[1]", @FM:No$) ; // Hide the header row if no TitleList was passed in.
end
Set_Property(CtrlEntId, 'OLE.HeaderFont[All;All]', 'Segoe UI' : @SVM : 9)
Set_Property(CtrlEntId, 'OLE.CellFont[All;All]', 'Segoe UI' : @SVM : 9)
Set_Property(CtrlEntId, "OLE.HeaderRow[All]", "19":@FM:"":@FM:No$) ; // Make all column header rows to be 19 pixels tall and unable to be resized.
Set_Property(CtrlEntId, "OLE.DataRow[All]", "19":@FM:"":@FM:No$) ; // Make all data rows to be 19 pixels tall and unable to be resized.
Set_Property(CtrlEntId, "OLE.HeaderColumn[1]", "20":@FM:"":@FM:No$) ; // Make the row header column to be 20 pixels wide and unable to be resized.
Set_Property(CtrlEntId, "OLE.AutoNumbers", "I":@VM:1) ; // Make the row header column auto number with an integer starting with 1.
// Set up column properties.
If ColumnWidths then
NumColumns = Count(ColumnWidths, @FM) + (ColumnWidths NE "")
CharPos = 1
For ColPos = 1 to NumColumns
Remove ColWidth from ColumnWidths at CharPos setting Flag
Begin Case
Case Num(ColWidth) ; Set_Property(CtrlEntId, "OLE.DataColumn[":ColPos:"]", ColWidth) ; // Set column to fixed width
Case ColWidth EQ "A" ; Set_Property(CtrlEntId, "OLE.DataColumn[":ColPos:"]", @FM:@FM:@FM:Yes$) ; // Set column to autosized
End Case
Next ColPos
end
If ColumnAlignments then
NumColumns = Count(ColumnAlignments, @FM) + (ColumnAlignments NE "")
CharPos = 1
For ColPos = 1 to NumColumns
Remove ColumnAlignment from ColumnAlignments at CharPos setting Flag
If Len(ColumnAlignment) then Set_Property(CtrlEntId, "OLE.CellAlignment[":ColPos:"; All]", @FM:ColumnAlignment) ; // Set the column alignment
Next ColPos
end
// Set up the @POS UDP for Set_Record
If VirtualPos then Set_Property(CtrlEntId, "@POS", VirtualPos)
If RowsAsColumns then Set_Property(CtrlEntId, "@ROWSASCOLUMNS", RowsAsColumns)
If CellsAsFields then Set_Property(CtrlEntId, "@CELLSASFIELDS", CellsAsFields)
If ClearFill then Set_Property(CtrlEntId, "@CLEARFILL", ClearFill)
GoSub Qualify_Events
return
//////////////////////////////////////////////////////////////////
///////////////// Internal methods ///////////////////////////////
//////////////////////////////////////////////////////////////////
Check_Variable_Assignments:
If Assigned(Method) else Method = ""
If Assigned(CtrlEntId) else CtrlEntId = ""
If Assigned(Param1) else Param1 = ""
If Assigned(Param2) else Param2 = ""
If Assigned(Param3) else Param3 = ""
If Assigned(Param4) else Param4 = ""
If Assigned(Param5) else Param5 = ""
If Assigned(Param6) else Param6 = ""
If Assigned(Param7) else Param7 = ""
If Assigned(Param8) else Param8 = ""
If Assigned(Param9) else Param9 = ""
If Assigned(Param10) else Param10 = ""
return
ParseParam1:
SelPos1 = Param1
FieldPos1 = Field(SelPos1, ";", 1)
RecordPos1 = Field(SelPos1, ";", 2)
return
ParseParam2:
SelPos2 = Param2
FieldPos2 = Field(SelPos2, ";", 1)
RecordPos2 = Field(SelPos2, ";", 2)
return
Update_Databound_EditTable:
// Transfer the Array property of the OLE EditTable to the DEFPROP property of the OI EditTable. Assumes that the
// OLE EditTable begins with "OLE_EDT" and that the OI EditTable begins with "EDT" and it also assumes the rest of
// the control names match.
OIEditTable = CtrlEntId
Swap "OLE_EDT" with "EDT" in OIEditTable
Transfer_EditTable_Data(CtrlEntId, OIEditTable, No$, UpdateCellEdit)
// Force a redisplay of any symbolic columns in the window.
Set_Record("", "SYM")
return
Qualify_Events:
// Enable OLE event processing for this control. Set the Synchronous event flag for better event control.
Qualify = ""
Qualify<1> = 1 ; // Enable OLE event
Qualify<4> = 2 ; // Synchronous event processing
Send_Message(CtrlEntId, "QUALIFY_EVENT", "ALL_OLES", Qualify)
return