290 lines
6.4 KiB
Plaintext
290 lines
6.4 KiB
Plaintext
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<I>
|
|
IF Accounts<I> = 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<I>
|
|
IF Accounts<I> = Application THEN
|
|
IF Name[1,1] NE '!' AND Name[1,4] NE 'DICT' THEN
|
|
|
|
LOCATE Name IN IndexedTables USING @FM SETTING POS THEN
|
|
|
|
TableList<POS,1> = Name
|
|
TableList<POS,2> = FIELD(VolNames<I>,'*',2)
|
|
TableList<POS,3> = RealNames<I>
|
|
TableList<POS,4> = Accounts<I>
|
|
|
|
FileSystem = FileSystems<I>
|
|
SWAP @VM WITH ', ' IN FileSystem
|
|
|
|
TableList<POS,5> = 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<PDISPLAY$> = 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<FIELDS_NAME$>,@VM) + (FieldData<FIELDS_NAME$> NE '')
|
|
IndexList = ''
|
|
LineCnt = 0
|
|
BtreeFields = ''
|
|
RelatedToFields = ''
|
|
RelatedFromFields = ''
|
|
|
|
PrintFlag = 0
|
|
|
|
FOR I = 1 TO MaxFields
|
|
|
|
PrintLine = ''
|
|
|
|
FieldName = FieldData<FIELDS_NAME$,I>
|
|
AtBtree = FieldData<FIELDS_INDEX$,I>
|
|
AtXref = FieldData<FIELDS_XREF$,I>
|
|
|
|
DictRec = XLATE('DICT.':FileName,FieldName,'','X')
|
|
|
|
Btree = DictRec<DICT_INDEX_FLAG$>
|
|
XrefField = DictRec<DICT_XREF$>
|
|
Dependent = DictRec<DICT_DEPENDENT$>
|
|
RelatedTo = DictRec<DICT_RELATIONAL$>
|
|
RelatedFrom = DictRec<DICT_RELATED$>
|
|
Protected = DictRec<DICT_PROTECT$>
|
|
CaseSensitive = DictRec<DICT_LOWERCASE$>
|
|
|
|
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
|
|
|
|
|
|
|
|
|