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 IF DictRec[1,4] _EQC 'MOVE' THEN Destination = DictRec 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) END END REPEAT SWAP @SVM WITH CRLF$ IN OrgFieldNames ofnCnt = COUNT(OrgFieldNames,@VM) + (OrgFieldNames NE '') FOR I = 1 TO ofnCnt colData = OrgFieldNames<1,I> colData = FIELD(Destinations<1,I>,'*',1) colData = 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