COMPILE SUBROUTINE Print_App_Index( Application ) /* Print Application Indexes J.C. Henry, Inc. - John C. Henry */ DECLARE SUBROUTINE Set_Property,End_Dialog, Send_Event, ErrMsg, Print_Dict, DictToAcad, Send_Message, Utility Declare Subroutine Msg DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, PopUp, Set_Printer, Get_Printer, Printer_Select, Utility EQU COL$NAME TO 1 EQU COL$VOLUME TO 2 EQU COL$REAL_NAME TO 3 EQU COL$ACCOUNT TO 4 EQU COL$FILE_SYS TO 5 EQU IXCOL$FNAME TO 1 EQU IXCOL$AT_BTREE TO 2 EQU IXCOL$AT_XREF TO 3 EQU IXCOL$BTREE TO 4 EQU IXCOL$XREF TO 5 EQU IXCOL$RELATED_TO TO 6 EQU IXCOL$RELATED_FROM TO 7 EQU IXCOL$DEPENDENT TO 8 EQU IXCOL$CASE_SENS TO 9 $INSERT DICT_EQUATES $INSERT POPUP_EQUATES $INSERT OIPRINT_EQUATES TableList = '' IndexedTables = '' Names = @TABLES(0) VolNames = @TABLES(1) RealNames = @TABLES(2) Accounts = @TABLES(3) FileSystems = @TABLES(4) Handles = @TABLES(5) SortedNames = '' nCnt = COUNT(Names,@FM) + (Names NE '') FOR I = 1 TO nCnt Name = Names IF Accounts = Application THEN IF Name[1,1] = '!' THEN IName = Name[2,99] LOCATE IName IN IndexedTables BY 'AL' USING @FM SETTING POS ELSE IndexedTables = INSERT(IndexedTables,POS,0,0,IName) END END END NEXT I FOR I = 1 TO nCnt Name = Names IF Accounts = Application THEN IF Name[1,1] NE '!' AND Name[1,4] NE 'DICT' THEN LOCATE Name IN IndexedTables USING @FM SETTING POS THEN TableList = Name TableList = FIELD(VolNames,'*',2) TableList = RealNames TableList = Accounts FileSystem = FileSystems SWAP @VM WITH ', ' IN FileSystem TableList = FileSystem END END ;* End of check for Bang file END ;* End of check for application NEXT I CONVERT @VM TO @SVM IN TableList CONVERT @FM TO @VM IN TableList TypeOver = '' TypeOver = TableList TableNames = Popup(@WINDOW,TypeOver,'INDEXED_TABLES') IF Get_Status(errCode) THEN CALL ErrMsg(errCode) End Today = OCONV(Date(),'D4/') **START PRINTING PROCESS** FileName = 'Print Application Index Report':@VM:'6' Title = 'Printing Application Index':@VM:'Report' TopMargin = 0.5 BottomMargin = 0.5 LeftMargin = 0.25 RightMargin = 0.25 Margins = LeftMargin:@FM:TopMargin:@FM:RightMargin:@FM:BottomMargin PageSetup = '1' ;* LandScape PrintSetup = '2' ;* Preview Normal PrintSetup<1,2> = '5' ;* Print & PDF buttons PrintSetup<1,5> = '1' ;* Page Range PrintSetup<1,6> = 7 ;* full mouse and keyboard support PrintPath = Printer_Select('',1) ;* Get Default printer path stat = Set_Printer("INIT",FileName,Title,Margins,PageSetup,PrintSetup,PrintPath) IF stat < 0 THEN GOTO OIPrint_Err Header = @VM:'Application Index Report' Header<2> = '' font = 'Arial' font<2> = '10' font<4> = 1 ;* Bold stat = Set_Printer("FONTHEADFOOT", font) stat = Set_Printer("HEADER",Header) * Footer * Footer = " 'D' 'T'":@VM:@VM:" Page: 'P'" ColFooter = " " stat = Set_Printer("FOOTER",Footer,ColFooter) FirstLine = 1 tCnt = COUNT(TableNames,@VM) + (TableNames NE '') IF tCnt <= 0 THEN Return colHeader = 'Table Name' ; colFmt = '^2880' colHeader<1,2> = 'Field Name' ; colFmt<1,2> = '<2880' colHeader<1,3> = 'Related To' ; colFmt<1,3> = '<4320' colHeader<1,4> = 'Related From' ; colFmt<1,4> = '<4320' PrintLineNo = 0 PrintLines = '' FOR T = 1 TO tCnt FileName = TableNames<1,T> FieldData = XLATE('DICT.':FileName,'%FIELDS%','','X') ;* Get the %FIELD% record from the dictionary MaxFields = COUNT(FieldData,@VM) + (FieldData NE '') IndexList = '' LineCnt = 0 BtreeFields = '' RelatedToFields = '' RelatedFromFields = '' PrintFlag = 0 FOR I = 1 TO MaxFields PrintLine = '' FieldName = FieldData AtBtree = FieldData AtXref = FieldData DictRec = XLATE('DICT.':FileName,FieldName,'','X') Btree = DictRec XrefField = DictRec Dependent = DictRec RelatedTo = DictRec RelatedFrom = DictRec Protected = DictRec CaseSensitive = DictRec IF AtBtree = 0 THEN AtBtree = '' IF AtXref = 0 THEN AtXref = '' IF Btree = 0 THEN Btree = '' IF XrefField = 0 THEN XrefField = '' IF CaseSensitive = 0 THEN CaseSensitive = '' If AtBtree NE '' Then BtreeFields = Insert(BtreeFields,1,1,0,FieldName) BtreeFields = Insert(BtreeFields,2,1,0,'') End If RelatedTo NE '' Then PrintLine = FileName:@VM:FieldName:@VM:RelatedTo:@VM End If RelatedFrom NE '' Then PrintLine = FileName:@VM:FieldName:@VM:@VM:RelatedFrom End If PrintLine NE '' THEN colData = PrintLine fontSpacing = 100 Gosub PrintTable END NEXT I NEXT T Goto Bail * * * * * * Bail: * * * * * * stat = Set_Printer("TERM") ;* Terminiate this printing session IF stat < 0 THEN GOTO OIPrint_Err Utility('CURSOR','A') RETURN * * * * * * * OIPrint_Err: * * * * * * * *Set Error for OIPrint function and return to calling procedure Msg('',stat) Error_Msg = 'Set_Printer Returned Error Status: ':QUOTE(stat) IF Get_Status(errCode) THEN Stat = Set_Status(-1,'STPROC',ErrorTitle:@SVM:Error_Msg) END ELSE Stat = Set_Status(1,'STPROC',ErrorTitle:@SVM:Error_Msg) END 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> IF Get_Printer('POS')<2> + TableHeight > 7.00 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,colHeader,'',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