added LSL2 stored procedures
This commit is contained in:
Infineon\StieberD
289
LSL2/STPROC/PRINT_APP_INDEX.txt
Normal file
289
LSL2/STPROC/PRINT_APP_INDEX.txt
Normal file
@ -0,0 +1,289 @@
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user