added sysprog entities
This commit is contained in:
865
SYSPROG/STPROC/OBJ_APPWINDOW.txt
Normal file
865
SYSPROG/STPROC/OBJ_APPWINDOW.txt
Normal file
@ -0,0 +1,865 @@
|
||||
COMPILE FUNCTION obj_AppWindow(Method,Parms)
|
||||
|
||||
/*
|
||||
Methods for Application Windows
|
||||
|
||||
09/30/2001 by JCH - J.C. Henry, Inc
|
||||
|
||||
Properties:
|
||||
|
||||
|
||||
|
||||
Methods:
|
||||
|
||||
Create(Window) ;* ID of window to center
|
||||
Page(Window) ;* ID of window
|
||||
Read(Window) ;* Sets @PREV_ID & @PREV_REC if null after a read
|
||||
PreWrite(Window) ;* Sets @PREV_ID & @PREV_REC on write
|
||||
PrevRec(Window) ;* <ALT><C> - Copy previous record
|
||||
PrevVal(Window) ;* <ALT><O> - Copy old (previous) field value
|
||||
ReadOnly(Window,Clear) ;* Read Only
|
||||
LUValReturn(ValueReturned,FocusControl,FocusPos) ;* Return value and moves to next field with all events
|
||||
CardReturn()
|
||||
DetailReturn()
|
||||
SetDropDowns()
|
||||
|
||||
LoadFormKeys( FormName, FormKey)
|
||||
;* Parses and loads all or part of a multi part key into a form using that key then moves to next field.
|
||||
;* Triggers Read event if complete key is loaded.
|
||||
;* If a partial key is passed, the routine will sets focus to empty key field
|
||||
|
||||
ViewNewCard( CardWindow, CardKey, NewCardCtrl, RecalcCtrl, RecalcPos, [RetCtrl,RetPos] )
|
||||
|
||||
;* Views existing or creates new record in 'Card' type window. i.e. name,vendor, customer ...
|
||||
;* Cards have their ID used in a record and display information from the card.
|
||||
;* Card Records have single part keys and do not have a relational index to the table where used.
|
||||
|
||||
ViewNewDetail(DetWindow,DetKeys,DefaultRec,[RetKey,RetPage,RetCtrl,RetPos]) [optional parms]
|
||||
|
||||
;* Routine to Create or View 'Item Detail' type records from a master window.
|
||||
;* Used for things like Purchase Orders, Sales Orders, Parts and Part Revisions
|
||||
;* Detail records have a 2 part key and maintain a relational index back to the master table.
|
||||
;* This routine is used with an edit table in the Master Table window that displays the
|
||||
;* detail keys associated with it.
|
||||
|
||||
*/
|
||||
|
||||
DECLARE SUBROUTINE Set_Status,Set_Property, Send_Event, Start_Window, Post_Event
|
||||
DECLARE FUNCTION Get_Status,Get_Property, Utility
|
||||
|
||||
$INSERT Logical
|
||||
$INSERT CopyRight
|
||||
$INSERT DICT_EQUATES
|
||||
|
||||
EQU FIX_SUFFIX$ TO "_FIX"
|
||||
EQU TAB_PREFIX$ TO "PAGE_"
|
||||
EQU TAB_SUFFIX$ TO "_TAB"
|
||||
|
||||
EQU CRLF$ TO CHAR(13):CHAR(10)
|
||||
|
||||
EQU COL$ TO 1
|
||||
EQU ROW$ TO 2
|
||||
|
||||
EQU ReadOnlyStyle$ TO 2048
|
||||
|
||||
ErrTitle = 'Error in obj_AppWindows'
|
||||
|
||||
ErrorMsg = ''
|
||||
|
||||
IF NOT(ASSIGNED(Method)) THEN
|
||||
ErrorMsg = 'Unassigned parameter "Method" passed to subroutine.' ; Method = ''
|
||||
END ELSE
|
||||
IF Method = '' THEN
|
||||
ErrorMsg = 'Null parameter "Method" passed to subroutine'
|
||||
END
|
||||
END
|
||||
|
||||
IF ErrorMsg NE '' THEN
|
||||
stat = Set_Status(-1,ErrTitle:@SVM:ErrorMsg) ;* Initialization Errors
|
||||
RETURN ''
|
||||
END
|
||||
|
||||
IF NOT(ASSIGNED(Parms)) THEN Parms = ''
|
||||
|
||||
Result = ''
|
||||
|
||||
BEGIN CASE
|
||||
CASE Method = 'Create' ; GOSUB Create
|
||||
CASE Method = 'Page' ; GOSUB Page
|
||||
CASE Method = 'Read' ; GOSUB Read
|
||||
CASE Method = 'PreWrite' ; GOSUB PreWrite
|
||||
CASE Method = 'PrevRec' ; GOSUB PrevRec
|
||||
CASE Method = 'PrevVal' ; GOSUB PrevVal
|
||||
CASE Method = 'ReadOnly' ; GOSUB ReadOnly
|
||||
CASE Method = 'LUValReturn' ; GOSUB LUValReturn
|
||||
CASE Method = 'LoadFormKeys' ; GOSUB LoadFormKeys
|
||||
CASE Method = 'ViewNewCard' ; GOSUB ViewNewCard
|
||||
CASE Method = 'ViewNewDetail' ; GOSUB ViewNewDetail
|
||||
CASE Method = 'ViewRelated' ; GOSUB ViewRelated
|
||||
CASE Method = 'CardReturn' ; GOSUB CardReturn
|
||||
CASE Method = 'DetailReturn' ; GOSUB DetailReturn
|
||||
CASE Method = 'SetDropDowns' ; GOSUB SetDropDowns
|
||||
|
||||
CASE 1
|
||||
ErrMsg = 'Unknown Method ':QUOTE(Method):' passed to routine.'
|
||||
END CASE
|
||||
|
||||
IF ErrorMsg NE '' THEN
|
||||
stat = Set_Status(-1,ErrTitle:@SVM:ErrorMsg) ;* Initialization Errors
|
||||
END
|
||||
|
||||
RETURN Result
|
||||
|
||||
|
||||
* * * * * * *
|
||||
Create:
|
||||
* * * * * * *
|
||||
|
||||
* Center the window and make it visible
|
||||
* Cloned from RTI's supplied routine. Assumes window is NOT visible when called
|
||||
|
||||
Window = Parms[1,@RM]
|
||||
IF Window = '' THEN Window = @WINDOW
|
||||
|
||||
* Window id the name of the window to be centered
|
||||
* MDI_Name - the name of the MDI frame
|
||||
* SystemSize - the size of the system window
|
||||
* WindowSize - the size of the window to be cenered
|
||||
|
||||
MDI_Name = Get_Property(Window,'MDIFRAME')
|
||||
|
||||
* If the window is an MDI child, the name of the frame will be retrieved
|
||||
|
||||
WindowSize = Get_Property(Window,"SIZE")
|
||||
|
||||
IF MDI_Name EQ '' THEN
|
||||
SystemSize = Get_Property("SYSTEM","SIZE")
|
||||
xPos = SystemSize<1>/2 - WindowSize<3>/2
|
||||
yPos = SystemSize<2>/2 - WindowSize<4>/2
|
||||
END ELSE
|
||||
MDI_Size = Get_Property(MDI_Name,"CLIENTSIZE")
|
||||
xPos = MDI_Size<1>/2 - WindowSize<3>/2
|
||||
yPos = MDI_Size<2>/2 - WindowSize<4>/2
|
||||
END
|
||||
|
||||
Ctrls = Window:@RM
|
||||
Props = 'SIZE':@RM
|
||||
Vals = xPos:@FM:yPos:@FM:WindowSize<3>:@FM:WindowSize<4>:@RM ;* Center window in System Window
|
||||
|
||||
Ctrls := Window:@RM
|
||||
Props := 'VISIBLE':@RM
|
||||
Vals := '1':@RM ;* Make the window visible
|
||||
|
||||
CtrlList = ''
|
||||
cCtrlList = ''
|
||||
|
||||
CtrlList = Get_Property(Window,'CTRLMAP')
|
||||
|
||||
IF INDEX(CtrlList,'PAGE_1_TAB',1) THEN
|
||||
Send_Event(@WINDOW:'.PAGE_1_TAB','GOTFOCUS')
|
||||
END
|
||||
|
||||
FOR iCtrl = 1 TO COUNT(CtrlList,@FM) + (CtrlList NE '')
|
||||
|
||||
Ctrl = CtrlList<iCtrl>
|
||||
|
||||
IF Ctrl[-4, 4] = '_FIX' THEN
|
||||
Ctrls := Ctrl:@RM
|
||||
Props := "PAGELIST":@RM
|
||||
Vals := '-1':@RM ;* Show this control on all pages
|
||||
END
|
||||
|
||||
IF INDEX(Ctrl,'STATUSLINE',1) OR INDEX(Ctrl,'STATUSLINE_FIX',1) THEN
|
||||
Ctrls := Window:@RM
|
||||
Props := 'STATUSLINE':@RM
|
||||
Vals := Ctrl:@RM ;* Set window STATUSLINE to this control
|
||||
END
|
||||
IF INDEX(Ctrl,'STATUS_OUTLINE',1) OR INDEX(Ctrl,'STATUS_OUTLINE_FIX',1) THEN
|
||||
Ctrls := Ctrl:@RM
|
||||
Props := 'STYLE':@RM
|
||||
Vals := '0X50000008':@RM ;* Make background transparent
|
||||
END
|
||||
|
||||
NEXT iCtrl
|
||||
|
||||
Ctrls[-1,1] = '' ; Props[-1,1] = '' ; Vals[-1,1] = '' ;* Drop trailing Record Marks
|
||||
|
||||
Set_Property(Ctrls,Props,Vals)
|
||||
|
||||
* Build @ET_SYMBOLICS data structure for window
|
||||
|
||||
ETSymbolics = ''
|
||||
|
||||
EditTables = Utility ('OBJECTLIST', Window, 'EDITTABLE')
|
||||
|
||||
FOR I = 1 TO COUNT(EditTables,@FM) + (EditTables NE '')
|
||||
EditTable = EditTables<I>
|
||||
CtrlCols = Get_Property(EditTable,'COLUMN')
|
||||
CtrlTables = Get_Property(EditTable, 'TABLE')
|
||||
LastTable = ''
|
||||
FOR N = 1 TO COUNT(CtrlCols,@SVM) + (CtrlCols NE '')
|
||||
CtrlCol = CtrlCols<1,1,N>
|
||||
TableName = CtrlTables<1,1,N>
|
||||
IF TableName NE '' THEN
|
||||
IF TableName NE LastTable THEN
|
||||
DictStruct = XLATE('DICT.':TableName,'%FIELDS%','','X')
|
||||
LastTable = TableName
|
||||
END
|
||||
|
||||
LOCATE CtrlCol IN DictStruct<FIELDS_NAME$> USING @VM SETTING Pos THEN
|
||||
IF DictStruct<FIELDS_TYPE$,Pos> = 'S' THEN
|
||||
LOCATE EditTable IN ETSymbolics<1> USING @VM SETTING ETPos ELSE
|
||||
ETSymbolics = INSERT(ETSymbolics,1,ETPos,0,EditTable)
|
||||
END
|
||||
ETSymbolics<2,ETPos,-1> = N ;* Add Column Number to the list
|
||||
END
|
||||
END
|
||||
END
|
||||
NEXT N
|
||||
NEXT I
|
||||
|
||||
Set_Property(Window,'@ET_SYMBOLICS',ETSymbolics)
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
Page:
|
||||
* * * * * * *
|
||||
|
||||
Page = Get_Property(@WINDOW, 'VPOSITION')<1>
|
||||
Set_Property(@WINDOW:".":TAB_PREFIX$:Page:TAB_SUFFIX$, 'CHECK',TRUE$)
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
Read:
|
||||
* * * * * * *
|
||||
|
||||
Window = Parms[1,@RM]
|
||||
IF Window = '' THEN Window = @WINDOW
|
||||
|
||||
Ctrls = Window:@RM:Window:@RM:Window:@RM:Window
|
||||
Props = '@PREV_ID':@RM:'@PREV_REC':@RM:'ID':@RM:'RECORD'
|
||||
|
||||
Vals = Get_Property(Ctrls,Props)
|
||||
|
||||
PrevID = Vals[1,@RM]
|
||||
PrevRec = Vals[COL2()+1,@RM]
|
||||
ID = Vals[COL2()+1,@RM]
|
||||
Record = Vals[COL2()+1,@RM]
|
||||
|
||||
IF PrevID = '' THEN Set_Property(Window,'@PREV_ID',ID)
|
||||
IF PrevRec = '' THEN Set_Property(Window,'@PREV_REC',Record)
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
PreWrite:
|
||||
* * * * * * *
|
||||
|
||||
Window = Parms[1,@RM]
|
||||
IF Window = '' THEN Window = @WINDOW
|
||||
|
||||
Ctrls = Window:@RM:Window
|
||||
Props = 'ID':@RM:'RECORD'
|
||||
|
||||
Vals = Get_Property(Ctrls,Props)
|
||||
|
||||
ID = Vals[1,@RM]
|
||||
Record = Vals[COL2()+1,@RM]
|
||||
|
||||
Props = '@PREV_ID':@RM:'@PREV_REC'
|
||||
Vals = ID:@RM:Record
|
||||
|
||||
Set_Property(Ctrls,Props,Vals) ;* Store off ID and record for defaults
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
|
||||
* * * * * * *
|
||||
PrevRec:
|
||||
* * * * * * *
|
||||
|
||||
* <ALT><C> - Copy previous record
|
||||
|
||||
Ctrls = @WINDOW:@RM:@WINDOW:@RM:@WINDOW
|
||||
Props = 'FOCUS':@RM:'@PREV_REC':@RM:'CTRLMAP'
|
||||
|
||||
Vals = Get_Property(Ctrls,Props)
|
||||
|
||||
CtrlName = Vals[1,@RM]
|
||||
PrevRec = Vals[COL2()+1,@RM]
|
||||
CtrlMap = Vals[COL2()+1,@RM]
|
||||
|
||||
CONVERT @FM TO @RM IN CtrlMap
|
||||
|
||||
PosList = Get_Property(CtrlMap,STR('POS':@RM,COUNT(CtrlMap,@RM)):'POS')
|
||||
ConvList = Get_Property(CtrlMap,STR('CONV':@RM,COUNT(CtrlMap,@RM)):'CONV')
|
||||
|
||||
Ctrls = ''
|
||||
Props = ''
|
||||
Vals = ''
|
||||
|
||||
FOR I = 1 TO COUNT(PosList,@RM) + (PosList NE '')
|
||||
|
||||
Pos = FIELD(PosList,@RM,I)
|
||||
|
||||
IF Pos NE '' AND Pos > 0 THEN
|
||||
Conv = FIELD(ConvList,@RM,I)
|
||||
Ctrl = FIELD(CtrlMap,@RM,I)
|
||||
|
||||
IF INDEX(Pos,@SVM,1) THEN
|
||||
|
||||
* We're in a Multivalued control i.e. edittable
|
||||
|
||||
CtrlArray = ''
|
||||
|
||||
FOR N = 1 TO COUNT(Pos,@SVM) + (Pos NE '')
|
||||
ColPos = FIELD(Pos,@SVM,N)
|
||||
ColConv = FIELD(Conv,@SVM,N)
|
||||
ColValues = PrevRec<ColPos>
|
||||
IF ColConv NE '' THEN
|
||||
ColValues = OCONV(ColValues,ColConv)
|
||||
END
|
||||
|
||||
CtrlArray<N> = ColValues
|
||||
NEXT N
|
||||
|
||||
Ctrls := Ctrl:@RM
|
||||
Props := 'DEFPROP':@RM
|
||||
Vals := CtrlArray:@RM
|
||||
|
||||
END ELSE
|
||||
|
||||
Value = PrevRec<Pos>
|
||||
|
||||
IF Conv NE '' THEN Value = OCONV(Value,Conv)
|
||||
|
||||
Ctrls := FIELD(CtrlMap,@RM,I):@RM
|
||||
Props := 'DEFPROP':@RM
|
||||
Vals := Value:@RM
|
||||
END
|
||||
|
||||
END
|
||||
NEXT I
|
||||
|
||||
Ctrls[-1,1] = ''
|
||||
Props[-1,1] = ''
|
||||
Vals[-1,1] = ''
|
||||
|
||||
Set_Property(Ctrls,Props,Vals)
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
PrevVal:
|
||||
* * * * * * *
|
||||
|
||||
* <ALT><O> - Copy previous field value, also works in the keys fields
|
||||
|
||||
Ctrls = @WINDOW:@RM:@WINDOW:@RM:@WINDOW
|
||||
Props = 'FOCUS':@RM:'@PREV_ID':@RM:'@PREV_REC'
|
||||
|
||||
Vals = Get_Property(Ctrls,Props)
|
||||
|
||||
CtrlName = Vals[1,@RM]
|
||||
PrevID = Vals[COL2()+1,@RM]
|
||||
PrevRec = Vals[COL2()+1,@RM]
|
||||
|
||||
Ctrls = CtrlName:@RM:CtrlName:@RM:CtrlName
|
||||
Props = 'POS':@RM:'PART':@RM:'CONV'
|
||||
|
||||
Vals = Get_Property(Ctrls,Props)
|
||||
|
||||
Pos = Vals[1,@RM]
|
||||
Part = Vals[COL2()+1,@RM]
|
||||
Conv = Vals[COL2()+1,@RM]
|
||||
|
||||
IF Index(Pos,@SVM,1) THEN
|
||||
|
||||
* Multi-Valued control i.e. We're in an edit table
|
||||
|
||||
SelPos = Get_Property(CtrlName,'SELPOS')
|
||||
|
||||
SelCol = SelPos<COL$>
|
||||
SelRow = SelPos<ROW$>
|
||||
|
||||
ColPos = FIELD(Pos,@SVM,SelCol)
|
||||
ColConv = FIELD(Conv,@SVM,SelCol)
|
||||
|
||||
Value = PrevRec<ColPos,SelRow>
|
||||
|
||||
IF Conv NE '' THEN Value = OCONV(Value,ColConv)
|
||||
|
||||
Set_Property(CtrlName,'DEFPROP',Value,SelPos)
|
||||
Set_Property(CtrlName,'SELECTION',1,@FM:LEN(Value))
|
||||
|
||||
|
||||
END ELSE
|
||||
|
||||
* Single valued control
|
||||
|
||||
IF Pos = 0 THEN
|
||||
Value = FIELD(PrevID,'*',Part)
|
||||
END ELSE
|
||||
Value = PrevRec<Pos>
|
||||
END
|
||||
|
||||
IF Conv NE '' THEN Value = OCONV(Value,Conv)
|
||||
|
||||
Set_Property(CtrlName,'DEFPROP',Value)
|
||||
Set_Property(CtrlName,'SELECTION',1,@FM:LEN(Value))
|
||||
|
||||
END
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
ReadOnly:
|
||||
* * * * * * *
|
||||
|
||||
thisFormName = Parms[1,@RM]
|
||||
ClearFlag = Parms[COL2()+1,@RM]
|
||||
|
||||
IF thisFormName = '' THEN thisFormName = @WINDOW
|
||||
|
||||
IF ClearFlag = '' THEN ClearFlag = 0
|
||||
|
||||
* Get control map and find key controls
|
||||
* Changed from Controlling ENABLE to setting STYLE ReadOnly bit - 09/30/2005 - JCH, J.C. Henry & Co., Inc.
|
||||
|
||||
CtrlMap = Get_Property(thisFormName,'CTRLMAP')
|
||||
|
||||
CONVERT @FM TO @RM IN CtrlMap
|
||||
|
||||
PosList = Get_Property(CtrlMap,STR('POS':@RM,COUNT(CtrlMap,@RM)):'POS')
|
||||
|
||||
WindowTitle = Get_Property(thisFormName,'TEXT')
|
||||
|
||||
IF ClearFlag THEN
|
||||
SWAP ' < V i e w O n l y >' WITH '' IN WindowTitle
|
||||
END ELSE
|
||||
IF NOT(INDEX(WindowTitle,'< V i e w',1)) THEN
|
||||
WindowTitle := ' < V i e w O n l y >'
|
||||
END
|
||||
END
|
||||
|
||||
Set_Property(thisFormName,'TEXT',WindowTitle)
|
||||
|
||||
FOR I = 1 TO COUNT(PosList,@RM) + (PosList NE '')
|
||||
|
||||
Pos = FIELD(PosList,@RM,I)
|
||||
|
||||
IF Pos NE 0 THEN
|
||||
Ctrl = FIELD(CtrlMap,@RM,I)
|
||||
CtrlType = Get_Property(Ctrl,'TYPE')
|
||||
|
||||
IF ClearFlag THEN
|
||||
|
||||
IF CtrlType = 'RADIOGROUP' OR CtrlType = 'CHECKBOX' THEN
|
||||
Set_Property(Ctrl,'ENABLED',1)
|
||||
END ELSE
|
||||
Style = Get_Property(Ctrl,'STYLE')
|
||||
IF Style[1,2] _eqc "0x" THEN
|
||||
CONVERT @LOWER.CASE TO @UPPER.CASE IN Style
|
||||
Style = ICONV(Style[3,99],'MX') ;* Convert from Hex to Decimal format for BITOR operation
|
||||
END
|
||||
|
||||
Style = BITAND(Style,BITNOT(ReadOnlyStyle$)) ;* Clear ReadOnly Style Bit
|
||||
Set_Property(Ctrl,'STYLE',Style)
|
||||
|
||||
END
|
||||
END ELSE
|
||||
IF CtrlType = 'RADIOGROUP' OR CtrlType = 'CHECKBOX' THEN
|
||||
Set_Property(Ctrl,'ENABLED',0)
|
||||
END ELSE
|
||||
Style = Get_Property(Ctrl,'STYLE')
|
||||
IF Style[1,2] _eqc "0x" THEN
|
||||
CONVERT @LOWER.CASE TO @UPPER.CASE IN Style
|
||||
Style = ICONV(Style[3,99],'MX')
|
||||
END
|
||||
|
||||
Style = BITOR(Style,ReadOnlyStyle$) ;* Set ReadOnly Style Bit
|
||||
Set_Property(Ctrl,'STYLE',Style)
|
||||
|
||||
END
|
||||
|
||||
END
|
||||
|
||||
END
|
||||
NEXT I
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
LUValReturn:
|
||||
* * * * * * *
|
||||
|
||||
ValueReturned = Parms[1,@RM]
|
||||
FocusControl = Parms[COL2()+1,@RM]
|
||||
FocusPos = Parms[COL2()+1,@RM]
|
||||
SkipRecalc = Parms[COL2()+1,@RM]
|
||||
|
||||
IF NOT(ASSIGNED(SkipRecalc)) THEN SkipRecalc = 0
|
||||
|
||||
* Null values for ValueReturned are permitted
|
||||
|
||||
IF FocusControl = '' THEN
|
||||
FocusControl = Get_Property(@WINDOW,'FOCUS')
|
||||
END ELSE
|
||||
IF INDEX(FocusControl,'.',1) ELSE
|
||||
FocusControl = @WINDOW:'.':FocusControl
|
||||
END
|
||||
END
|
||||
|
||||
IF FocusPos = '' THEN
|
||||
Set_Property(FocusControl,'FOCUS',1)
|
||||
Set_Property(FocusControl,'DEFPROP',ValueReturned)
|
||||
NextControl = Get_Property(FocusControl,'NEXT')
|
||||
Send_Event(FocusControl,'LOSTFOCUS')
|
||||
Set_Property('SYSTEM','FOCUS',NextControl)
|
||||
END ELSE
|
||||
FocusCol = FocusPos[1,@FM]
|
||||
FocusRow = FocusPos[COL2()+1,@FM]
|
||||
|
||||
Set_Property(FocusControl,'SELPOS',FocusPos)
|
||||
Set_Property(FocusControl,'DEFPROP',ValueReturned,FocusPos)
|
||||
Set_Property(FocusControl,'SELPOS',FocusCol+1:@FM:FocusRow)
|
||||
IF NOT(SkipRecalc) THEN
|
||||
Send_Event(FocusControl,'CALCULATE',FocusCol+1)
|
||||
END
|
||||
END
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
LoadFormKeys:
|
||||
* * * * * * *
|
||||
|
||||
IF NOT(ASSIGNED(thisFormName)) THEN thisFormName = Parms[1,@RM]
|
||||
IF NOT(ASSIGNED(thisFormKey)) THEN thisFormKey = Parms[COL2()+1,@RM]
|
||||
|
||||
IF thisFormName = '' THEN RETURN
|
||||
|
||||
* Get control map and find key controls
|
||||
|
||||
CtrlMap = Get_Property(thisFormName,'CTRLMAP')
|
||||
|
||||
CONVERT @FM TO @RM IN CtrlMap
|
||||
|
||||
PosList = Get_Property(CtrlMap,STR('POS':@RM,COUNT(CtrlMap,@RM)):'POS')
|
||||
PartList = Get_Property(CtrlMap,STR('PART':@RM,COUNT(CtrlMap,@RM)):'PART')
|
||||
ConvList = Get_Property(CtrlMap,STR('CONV':@RM,COUNT(CtrlMap,@RM)):'CONV')
|
||||
|
||||
Ctrls = ''
|
||||
Props = ''
|
||||
Vals = ''
|
||||
NullValueControl = ''
|
||||
|
||||
PosCount = DCount(PosList, @RM)
|
||||
|
||||
FOR I = 1 TO PosCount ; //COUNT(PosList,@RM) + (PosList NE '')
|
||||
|
||||
Pos = FIELD(PosList,@RM,I)
|
||||
|
||||
IF Pos = 0 THEN
|
||||
Part = FIELD(PartList,@RM,I)
|
||||
Conv = FIELD(ConvList,@RM,I)
|
||||
Ctrl = FIELD(CtrlMap,@RM,I)
|
||||
|
||||
IF INDEX(Pos,@SVM,1) THEN
|
||||
* We're in a Multivalued control i.e. edittable - skip it
|
||||
END ELSE
|
||||
|
||||
Value = FIELD(thisFormKey,'*',Part)
|
||||
|
||||
IF Conv NE '' THEN Value = OCONV(Value,Conv)
|
||||
|
||||
IF Value = '' THEN
|
||||
NullValueControl = FIELD(CtrlMap,@RM,I)
|
||||
END ELSE
|
||||
Ctrls := FIELD(CtrlMap,@RM,I):@RM
|
||||
Props := 'DEFPROP':@RM
|
||||
Vals := Value:@RM
|
||||
END
|
||||
END
|
||||
END
|
||||
UNTIL NullValueControl NE ''
|
||||
NEXT I
|
||||
|
||||
Ctrls[-1,1] = ''
|
||||
Props[-1,1] = ''
|
||||
Vals[-1,1] = ''
|
||||
|
||||
Set_Property(Ctrls,Props,Vals)
|
||||
|
||||
LastKeyCtrl = Ctrls[-1,'B':@RM] ;*
|
||||
|
||||
IF NullValueControl = '' THEN
|
||||
* Complete key was loaded
|
||||
NextCtrl = Get_Property(LastKeyCtrl,'NEXT')
|
||||
Send_Event( LastKeyCtrl, 'LOSTFOCUS') ;* Triggers form read
|
||||
Set_Property('SYSTEM','FOCUS',NextCtrl) ;* Move to next field preserving event chain
|
||||
END ELSE
|
||||
* Partial key was loaded
|
||||
Set_Property('SYSTEM','FOCUS',NullValueControl)
|
||||
END
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
ViewNewCard:
|
||||
* * * * * * *
|
||||
|
||||
CardWindow = Parms[1,@RM]
|
||||
CardKey = Parms[COL2()+1,@RM] ;* Null values for CardKey creates new card
|
||||
NewCardCtrl = Parms[COL2()+1,@RM] ;* Name of button control to create new Card on Card window
|
||||
RecalcCtrl = Parms[COL2()+1,@RM] ;* Symbolic Control to recalculate upon return
|
||||
RecalcPos = Parms[COL2()+1,@RM] ;* Position in edit list or edit table for recalc
|
||||
RetCtrl = Parms[COL2()+1,@RM] ;* This can be called from both a window and a process
|
||||
RetPos = Parms[COL2()+1,@RM] ;* Position in edit list or edit table to return to
|
||||
|
||||
|
||||
IF CardWindow = '' THEN RETURN
|
||||
IF RetCtrl = '' THEN RetCtrl = Get_Property(@WINDOW,'FOCUS')
|
||||
IF RetPos = '' THEN RetPos = Get_Property(RetCtrl,'SELPOS')
|
||||
|
||||
thisFormName = CardWindow
|
||||
thisFormKey = CardKey
|
||||
|
||||
GOSUB AppChildWindow ;* Starts or Restores application window and gives user chance to save any changes
|
||||
|
||||
IF thisFormKey NE '' THEN
|
||||
GOSUB LoadFormKeys ;* Loads form keys and triggers READ event
|
||||
END ELSE
|
||||
IF NewCardCtrl NE '' THEN
|
||||
IF INDEX(NewCardCtrl,'.',1) THEN NewCardCtrl = FIELD(NewCardCtrl,'.',2)
|
||||
Send_Event(CardWindow:'.':NewCardCtrl,'CLICK') ;* 'Pushes' New button in card to trigger new record process
|
||||
END
|
||||
END
|
||||
|
||||
Set_Property(CardWindow,'@RETURN_CONTROL',RetCtrl)
|
||||
|
||||
IF RetPos NE '' THEN Set_Property(CardWindow,'@RETURN_POS',RetPos)
|
||||
|
||||
IF RecalcCtrl NE '' THEN Set_Property(CardWindow,'@RECALC_CONTROL',RecalcCtrl)
|
||||
IF RecalcPos NE '' THEN Set_Property(CardWindow,'@RECALC_POS',RecalcPos)
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
ViewNewDetail:
|
||||
* * * * * * *
|
||||
|
||||
DetWindow = Parms[1,@RM]
|
||||
DetKeys = Parms[COL2()+1,@RM] ;* Multipart key to detail record
|
||||
DefaultRec = Parms[COL2()+1,@RM] ;* Used to set fields in @PREV_REC for defaults
|
||||
|
||||
RetKey = Parms[COL2()+1,@RM] ;* Key to the master record
|
||||
RetPage = Parms[COL2()+1,@RM] ;* Page in master form to return to
|
||||
RetCtrl = Parms[COL2()+1,@RM] ;* Leaves focus on window upon return
|
||||
RetPos = Parms[COL2()+1,@RM] ;* Used only for edit tables or lists
|
||||
|
||||
IF DetWindow = '' THEN RETURN
|
||||
|
||||
IF RetKey = '' THEN RetKey = Get_Property(RetWin,'ID')
|
||||
IF RetPage = '' THEN RetPage = Get_Property(RetWin,'VPOSITION')
|
||||
IF RetCtrl = '' THEN RetCtrl = Get_Property(RetWin,'FOCUS')
|
||||
IF RetPos = '' THEN RetPos = Get_Property(RetCtrl,'SELPOS')
|
||||
|
||||
thisFormName = DetWindow
|
||||
thisFormKey = DetKeys
|
||||
|
||||
GOSUB AppChildWindow ;* Starts or Restores application window and gives user chance to save any changes
|
||||
|
||||
* Load Key Controls with Key Parts
|
||||
|
||||
Ctrls = DetWindow:@RM ; Props = '@PREV_ID':@RM ; Vals = DetKeys:@RM
|
||||
Ctrls := DetWindow:@RM ; Props := '@PREV_REC':@RM ; Vals := DefaultRec:@RM
|
||||
Ctrls := DetWindow:@RM ; Props := '@RETURN_KEY':@RM ; Vals := RetKey:@RM
|
||||
Ctrls := DetWindow:@RM ; Props := '@RETURN_PAGE':@RM ; Vals := RetPage:@RM
|
||||
Ctrls := DetWindow:@RM ; Props := '@RETURN_CONTROL':@RM ; Vals := RetCtrl:@RM
|
||||
Ctrls := DetWindow ; Props := '@RETURN_POS' ; Vals := RetPos
|
||||
|
||||
Set_Property(Ctrls,Props,Vals)
|
||||
|
||||
GOSUB LoadFormKeys ;* Load key into form and triggers READ event or places focus on 1st empty key field.
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
ViewRelated:
|
||||
* * * * * * *
|
||||
|
||||
RelatedWindow = Parms[1,@RM]
|
||||
RelatedKey = Parms[COL2()+1,@RM]
|
||||
RelatedParms = Parms[COL2()+1,@RM]
|
||||
|
||||
IF RelatedWindow = '' THEN RETURN ;* Master window
|
||||
IF RelatedKey = '' THEN RETURN ;* Must have at least a partial key
|
||||
|
||||
thisFormName = RelatedWindow
|
||||
thisFormKey = RelatedKey
|
||||
thisFormParms = RelatedParms
|
||||
|
||||
GOSUB AppChildWindow ;* Starts or Restores application window and gives user chance to save any changes
|
||||
|
||||
IF INDEX(RelatedKey,@VM,1) THEN
|
||||
Send_Event(RelatedWindow,'QBFINIT')
|
||||
Set_Property(RelatedWindow,'QBFLIST',RelatedKey)
|
||||
Send_Event(RelatedWindow,'QBFFIRST')
|
||||
END ELSE
|
||||
GOSUB LoadFormKeys ;* Load key into form and triggers READ event or places focus on 1st empty key field.
|
||||
END
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
|
||||
* * * * * * *
|
||||
CardReturn:
|
||||
* * * * * * *
|
||||
|
||||
CardKey = Parms[1,@RM]
|
||||
|
||||
IF NOT(ASSIGNED(CardKey)) THEN RETURN ;* Null values for CardKey are used when called from the delete event
|
||||
|
||||
ParentWindow = Get_Property(@WINDOW,'PARENT')
|
||||
|
||||
Ctrls = @WINDOW:@RM ; Props = '@RETURN_CONTROL':@RM
|
||||
Ctrls := @WINDOW:@RM ; Props := '@RETURN_POS':@RM
|
||||
Ctrls := @WINDOW:@RM ; Props := '@RECALC_CONTROL':@RM
|
||||
Ctrls := @WINDOW:@RM ; Props := '@RECALC_POS':@RM
|
||||
Ctrls := @WINDOW ; Props := '@SKIP_RETURN'
|
||||
|
||||
Vals = Get_Property(Ctrls,Props)
|
||||
|
||||
ReturnControl = Vals[1,@RM]
|
||||
ReturnPos = Vals[COL2()+1,@RM]
|
||||
RecalcControl = Vals[COL2()+1,@RM]
|
||||
RecalcPos = Vals[COL2()+1,@RM]
|
||||
SkipReturn = Vals[COL2()+1,@RM]
|
||||
|
||||
ResetVals = '':@RM:'':@RM:'':@RM:'':@RM:''
|
||||
|
||||
Set_Property(Ctrls,Props,Vals)
|
||||
|
||||
|
||||
IF SkipReturn THEN
|
||||
Set_Property(@WINDOW,'@SKIP_RETURN',0) ;* Set by routines issuing the WRITE command programmatically
|
||||
RETURN
|
||||
END
|
||||
|
||||
IF ReturnControl NE '' THEN
|
||||
Set_Property(ReturnControl,"DEFPROP",CardKey,ReturnPos)
|
||||
Set_Property(ReturnControl,'FOCUS',1)
|
||||
END
|
||||
IF RecalcControl NE '' THEN
|
||||
Post_Event(RecalcControl,'CALCULATE',RecalcPos) ;* Trigger any symbolic updates
|
||||
Post_Event(ParentWindow,'GOTFOCUS') ;* This causes Refresh
|
||||
END
|
||||
|
||||
IF ReturnControl NE '' OR RecalcControl NE '' THEN Post_Event(@WINDOW,'CLOSE')
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
DetailReturn:
|
||||
* * * * * * *
|
||||
|
||||
|
||||
Ctrls = @WINDOW:@RM ; Props = '@RETURN_KEY':@RM
|
||||
Ctrls := @WINDOW:@RM ; Props := 'PARENT':@RM
|
||||
Ctrls := @WINDOW:@RM ; Props := '@RETURN_PAGE':@RM
|
||||
Ctrls := @WINDOW:@RM ; Props := '@RETURN_CONTROL':@RM
|
||||
Ctrls := @WINDOW:@RM ; Props := '@RETURN_POS':@RM
|
||||
Ctrls := @WINDOW ; Props := '@SKIP_RETURN'
|
||||
|
||||
Vals = Get_Property(Ctrls,Props)
|
||||
|
||||
ReturnKey = Vals[1,@RM]
|
||||
ReturnWindow = Vals[COL2()+1,@RM]
|
||||
ReturnPage = Vals[COL2()+1,@RM]
|
||||
ReturnControl = Vals[COL2()+1,@RM]
|
||||
ReturnPos = Vals[COL2()+1,@RM]
|
||||
SkipReturn = Vals[COL2()+1,@RM]
|
||||
|
||||
IF SkipReturn THEN
|
||||
Set_Property(@WINDOW,'@SKIP_RETURN',0) ;* Set by routines issuing the WRITE command programmatically
|
||||
RETURN
|
||||
END
|
||||
|
||||
IF ReturnKey NE '' THEN
|
||||
thisFormName = ReturnWindow
|
||||
thisFormKey = ReturnKey
|
||||
GOSUB LoadFormKeys
|
||||
END
|
||||
|
||||
IF ReturnPage NE '' THEN
|
||||
Send_Event(ReturnWindow,'PAGE',ReturnPage)
|
||||
END
|
||||
|
||||
IF ReturnControl THEN
|
||||
Set_Property(ReturnControl,'FOCUS',1)
|
||||
IF ReturnPos THEN
|
||||
Set_Property(ReturnControl,'SELPOS',ReturnPos)
|
||||
END
|
||||
END
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
|
||||
* * * * * * *
|
||||
AppChildWindow:
|
||||
* * * * * * *
|
||||
|
||||
thisFormWindowUp = Get_Property(thisFormName,'VISIBLE') ;* Returns 0 = hidden, 1 = visible, 2 = minimized, 3 = maximized
|
||||
|
||||
IF thisFormWindowUp = '' THEN Start_Window(thisFormName,@WINDOW,thisFormParms) ;* Put up the card window - added thisFormParms 3/22/2010 JCH
|
||||
IF thisFormWindowUp = 2 THEN Set_Property(thisFormName,'VISIBLE',9) ;* Restore the window if minimized
|
||||
|
||||
IF Get_Property(thisFormName,'SAVEWARN') THEN
|
||||
Set_Property(thisFormName,'@SKIP_CARD_RETURN',1) ;* This stops the Return behavior
|
||||
Send_Event(thisFormName,'CLEAR') ;* Clear anything existing (prompts for save first)
|
||||
END
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
SetDropDowns:
|
||||
* * * * * * *
|
||||
|
||||
ComboBoxes = Utility('OBJECTLIST',@WINDOW,'COMBOBOX')
|
||||
ListBoxes = Utility('OBJECTLIST',@WINDOW,'LISTBOX')
|
||||
|
||||
ControlList = ComboBoxes:@FM:ListBoxes
|
||||
|
||||
CtrlCnt = Count(ControlList,@FM) + (ControlList NE '')
|
||||
|
||||
FOR I = 1 TO CtrlCnt
|
||||
thisControl = ControlList<I>
|
||||
UnqualCtrlName = Field(thisControl,'.',2)
|
||||
|
||||
ListData = XLATE('LISTBOX_CONFIG',UnqualCtrlName,1,'X')
|
||||
|
||||
CONVERT @VM TO @FM IN ListData
|
||||
Set_Property(thisControl,'LIST',ListData)
|
||||
NEXT I
|
||||
|
||||
RETURN
|
||||
|
||||
|
Reference in New Issue
Block a user