92 lines
1.9 KiB
Plaintext
92 lines
1.9 KiB
Plaintext
COMPILE FUNCTION Comm_Popup_Literal( Instruction, PopupName )
|
|
|
|
/* Template support (commuter) module for FOB Window */
|
|
|
|
DECLARE SUBROUTINE Center_Window, Send_Event, Set_Property, End_Dialog, StatusLine, ErrMsg
|
|
DECLARE FUNCTION Get_Property, Dialog_Box, Popup
|
|
|
|
|
|
EQU CRLF TO \0D0A\
|
|
|
|
EQU TRUE$ TO 1
|
|
EQU FALSE$ TO 2
|
|
|
|
|
|
$INSERT APPCOLORS
|
|
|
|
Instructions = 'Create'
|
|
Instructions := @FM:'ClickUpdate'
|
|
Instructions := @FM:'ClickCancel'
|
|
|
|
RetVal = ''
|
|
|
|
LOCATE Instruction IN Instructions USING @FM SETTING Pos THEN
|
|
ON Pos GOSUB Create, ClickUpdate, ClickCancel
|
|
END
|
|
|
|
RETURN RetVal
|
|
|
|
|
|
* * * * * * *
|
|
Create:
|
|
* * * * * * *
|
|
|
|
AppName = @APPID<1>
|
|
|
|
OPEN 'SYSREPOSPOPUPS' TO PopUpTable THEN
|
|
Set_Property(@WINDOW,'@FILE_HANDLE',PopUpTable)
|
|
END ELSE
|
|
ErrMsg('Unable to open SYSREPOSPOPUPS table!')
|
|
RETURN
|
|
END
|
|
|
|
READ PopupRec FROM PopUpTable,AppName:'**':PopupName THEN
|
|
ListData = ''
|
|
FOR Line = 1 TO COUNT(PopupRec<8>,@VM) + (PopupRec<8> NE '')
|
|
FOR Col = 1 TO COUNT(PopupRec<8,Line>,@SVM) + (PopupRec<8,Line> NE '')
|
|
IF PopupRec<9,Col,5> NE '' THEN
|
|
ListData<Line,Col> = OCONV(PopupRec<8,Line,Col>,PopupRec<9,Col,5>)
|
|
END ELSE
|
|
ListData<Line,Col> = PopupRec<8,Line,Col>
|
|
END
|
|
NEXT Col
|
|
NEXT Line
|
|
END
|
|
|
|
Set_Property(@WINDOW:".TABLE",'LIST',ListData)
|
|
|
|
StatusLine(@WINDOW)
|
|
Center_Window(@WINDOW)
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
ClickUpdate:
|
|
* * * * * * *
|
|
|
|
PopupFileHandle = Get_Property(@WINDOW,'@FILE_HANDLE')
|
|
LiteralData = Get_Property(@WINDOW:'.TABLE','LIST')
|
|
PopupKey = @APPID<1>:'**':PopupName
|
|
|
|
CONVERT @VM:@FM TO @SVM:@VM IN LiteralData
|
|
|
|
IF PopupFileHandle NE '' AND PopupName NE '' THEN
|
|
WRITEV LiteralData ON PopupFileHandle,PopupKey,8 ELSE
|
|
ErrMsg("Unable to write ":QUOTE(PopupKey):" on SYSREPOSPOPUPS")
|
|
END
|
|
END
|
|
|
|
Send_Event(@WINDOW,'CLOSE')
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
ClickCancel:
|
|
* * * * * * *
|
|
|
|
Send_Event(@WINDOW,'CLOSE')
|
|
|
|
RETURN
|