188 lines
3.6 KiB
Plaintext
188 lines
3.6 KiB
Plaintext
COMPILE SUBROUTINE Print_PSN_Conv(Dummy)
|
|
|
|
DECLARE FUNCTION Msg, set_property, send_event, dialog_box, Utility, get_property
|
|
DECLARE FUNCTION Set_Printer, FieldCount, Printer_Select, Get_Printer, obj_RDS2, obj_WM_In, obj_WM_Out
|
|
DECLARE SUBROUTINE RList, ErrMsg, Msg
|
|
|
|
/*
|
|
Report rewritten 07/08/2005 John C. Henry, J.C. Henry & Co., Inc.
|
|
*/
|
|
|
|
|
|
$INSERT RLIST_EQUATES
|
|
$INSERT LOGICAL
|
|
$INSERT MSG_EQUATES
|
|
$INSERT OIPRINT_EQUATES
|
|
$INSERT DICT_EQUATES
|
|
|
|
$INSERT APPCOLORS
|
|
|
|
|
|
|
|
OPEN 'DICT.PROD_SPEC' TO FileIn ELSE
|
|
GOTO Bail
|
|
END
|
|
|
|
SELECT FileIn
|
|
|
|
OrgFieldNames = ''
|
|
Destinations = ''
|
|
ColData = ''
|
|
|
|
|
|
|
|
RecCnt = 0
|
|
FixCnt = 0
|
|
Done = 0
|
|
|
|
LOOP
|
|
READNEXT DictID ELSE Done = 1
|
|
UNTIL Done
|
|
RecCnt += 1
|
|
|
|
READ DictRec FROM FileIn,DictID THEN
|
|
|
|
a = DictRec<DICT_DESC$>
|
|
|
|
|
|
IF DictRec<DICT_DESC$>[1,4] _EQC 'MOVE' THEN
|
|
Destination = DictRec<DICT_DESC$>
|
|
SWAP 'Move ' WITH '' IN Destination
|
|
LOCATE Destination IN Destinations BY 'AL' SETTING Pos THEN
|
|
OrgFieldNames = INSERT(OrgFieldNames,1,Pos,-1,DictID)
|
|
|
|
END ELSE
|
|
|
|
OrgFieldNames = INSERT(OrgFieldNames,1,Pos,0,DictID)
|
|
Destinations = INSERT(Destinations,1,Pos,0,Destination)
|
|
|
|
|
|
END
|
|
*Send_Dyn(DictID:TAB$:TAB$:TAB$:TAB$:DictRec<DICT_DESC$>)
|
|
|
|
END
|
|
END
|
|
|
|
REPEAT
|
|
|
|
SWAP @SVM WITH CRLF$ IN OrgFieldNames
|
|
|
|
ofnCnt = COUNT(OrgFieldNames,@VM) + (OrgFieldNames NE '')
|
|
|
|
FOR I = 1 TO ofnCnt
|
|
colData<I,1> = OrgFieldNames<1,I>
|
|
colData<I,2> = FIELD(Destinations<1,I>,'*',1)
|
|
colData<I,3> = FIELD(Destinations<1,I>,'*',2)
|
|
NEXT I
|
|
|
|
|
|
|
|
|
|
colHdr = '' ; colFmt = ''
|
|
colHdr<1,1> = 'PROD_SPEC field' ; colFmt<1,1> = '<+3600'
|
|
colHdr<1,2> = 'New Table' ; colFmt<1,2> = '<+3600'
|
|
colHdr<1,3> = 'New Field' ; colFmt<1,3> = '<+3600'
|
|
|
|
|
|
|
|
PrintPath = Printer_Select('',1) ;* Get default printer path
|
|
Void = Set_Printer( 'INIT', '', '', .38:@fm:.75:@fm:.38:@fm:.75, 1, 3:@vm:'':@vm:'':@vm:2:@fm:96, PrintPath )
|
|
|
|
Void = Utility( 'CURSOR', 'H' )
|
|
|
|
Font = "Courier New,8,L,1"
|
|
convert ',' to @fm in Font
|
|
TFont = font
|
|
TFont<2> = 12
|
|
Void = Set_Printer( 'FONTHEADFOOT', TFont )
|
|
|
|
SpaceOut = STR(' ',10)
|
|
|
|
Header = "Page 'P'":@VM:"'PROD_SPEC'"
|
|
Header<2> = "'D' 'T'":SpaceOut:"Conversion Report"
|
|
|
|
Void = Set_Printer( 'HEADER',Header)
|
|
|
|
TFont<2> = 8
|
|
TFont<4> = 0
|
|
Void = Set_Printer( 'FONT', TFont )
|
|
|
|
|
|
TFont<4> = 1
|
|
Void = Set_Printer( 'FONT', TFont )
|
|
|
|
FirstLine = 1
|
|
|
|
GOSUB PrintTable
|
|
|
|
Void = Utility( 'CURSOR', 'A' )
|
|
Void = Set_Printer( 'TERM', 1 )
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
|
|
|
|
|
|
* * * * * * *
|
|
Bail:
|
|
* * * * * * *
|
|
|
|
stat = Set_Printer('TERM',1)
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
OIPrintErr:
|
|
* * * * * * *
|
|
|
|
ErrMsg(ErrorTitle:@SVM:ErrorMsg)
|
|
ErrMsg(ErrorTitle:@SVM:'Set_Printer returned errorcode ':stat)
|
|
stat = Set_Printer('TERM',1)
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * *
|
|
PrintTable:
|
|
* * * * * *
|
|
|
|
stat = Set_Printer('CALCTABLE',colFmt:@FM:colData)
|
|
TableSize = Get_Printer('CALCTABLE')
|
|
TableHeight = TableSize<2>
|
|
Test = Get_Printer('POS')<2>
|
|
fontSpacing = 150
|
|
|
|
IF Get_Printer('POS')<2> + TableHeight > 7.0 OR FirstLine THEN
|
|
IF NOT(FirstLine) THEN
|
|
stat = Set_Printer('PAGEBREAK')
|
|
END
|
|
FirstLine = 0
|
|
font<2> = 8
|
|
font<4> = 1 ;* Bold
|
|
stat = Set_Printer('FONT',font,'100')
|
|
|
|
stat = Set_Printer('ADDTABLE',colFmt,colHdr,'',LTGREY$,'',0,TB_ALL)
|
|
|
|
|
|
font<4> = 0
|
|
stat = Set_Printer('FONT',font,fontSpacing)
|
|
|
|
stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',0,7)
|
|
|
|
END ELSE
|
|
font<2> = 8
|
|
font<4> = 0
|
|
stat = Set_Printer('FONT',font,fontSpacing)
|
|
stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',1,TB_ALL)
|
|
|
|
END
|
|
|
|
|
|
RETURN
|
|
|
|
|
|
|