866 lines
22 KiB
Plaintext
866 lines
22 KiB
Plaintext
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
|
|
|
|
|