282 lines
7.3 KiB
Plaintext
282 lines
7.3 KiB
Plaintext
COMPILE SUBROUTINE Print_Dict(TableNames)
|
|
|
|
/*
|
|
Routine to print dictionary listing
|
|
|
|
October 12, 1998 - John C. Henry - J.C. Henry, Inc. - Copyright 1998
|
|
|
|
*/
|
|
|
|
DECLARE SUBROUTINE Utility
|
|
DECLARE FUNCTION Get_Printer, Set_Printer, RGB, Printer_Select
|
|
|
|
$INSERT DICT_EQUATES
|
|
$INSERT OIPRINT_EQUATES
|
|
$INSERT FONT_PARM
|
|
|
|
TableCnt = COUNT(TableNames,@VM) + (TableNames NE '')
|
|
|
|
|
|
* * * PRINT SETUP * * *
|
|
|
|
Title = "Dictionary Listing"
|
|
Margin = 0.50:@FM:1.0:@FM:0.50:@FM:0.7:@FM:@FM:@FM:LETTER
|
|
|
|
SWAP @VM WITH ', ' IN TableNames
|
|
|
|
PrintPath = Printer_Select()
|
|
|
|
PrintSetup = 2 ;* Preview Normal
|
|
PrintSetup<1,2> = 0 ;* Display all buttons
|
|
PrintSetup<1,5> = 1 ;* Page range dialog box
|
|
|
|
stat = Set_Printer("INIT",TableNames,Title,Margin,1,PrintSetup,PrintPath)
|
|
|
|
SWAP ', ' WITH @VM IN TableNames
|
|
|
|
IF stat < 0 THEN GOTO OIPrint_Err
|
|
|
|
FOR N = 1 TO TableCnt
|
|
|
|
TableName = TableNames<1,N>
|
|
|
|
FieldData = XLATE('DICT.':TableName,'%FIELDS%','','X') ;* Get the %FIELD% record from the dictionary
|
|
|
|
MaxFields = COUNT(FieldData<FIELDS_NAME$>,@VM) + (FieldData<FIELDS_NAME$> NE '')
|
|
PrintLines = ''
|
|
|
|
Symbolics = ''
|
|
SymSort = ''
|
|
FieldSort = ''
|
|
|
|
LineCnt = 0
|
|
FOR I = 1 TO MaxFields
|
|
|
|
FieldName = FieldData<FIELDS_NAME$,I>
|
|
|
|
IF FieldName[1,1] NE '%' THEN
|
|
DictRec = XLATE('DICT.':TableName,FieldName,'','X')
|
|
|
|
FMC = DictRec<DICT_COLUMN_NO$>
|
|
Display = DictRec<DICT_DISPLAY$>
|
|
|
|
IF Display NE '' THEN
|
|
FieldName := CRLF$:'(':Display:')'
|
|
END
|
|
|
|
Part = DictRec<DICT_PART$>
|
|
Type = DictRec<DICT_TYPE$>
|
|
Master = DictRec<DICT_MASTER_FLAG$>
|
|
S_M = DictRec<DICT_SM$>
|
|
DataType = DictRec<DICT_GENERIC_TYPE$>
|
|
Desc = DictRec<DICT_DESC$>
|
|
Conv = DictRec<DICT_CONV$>
|
|
Length = DictRec<DICT_LENGTH$>
|
|
Justification = DictRec<DICT_JUST$>
|
|
|
|
Formula = DictRec<DICT_FORMULA$>
|
|
SWAP @VM WITH CRLF$ IN Formula
|
|
|
|
Btree = DictRec<DICT_INDEX_FLAG$>
|
|
XrefField = DictRec<DICT_XREF$>
|
|
RelatedTo = DictRec<DICT_RELATIONAL$>
|
|
RelatedFrom = DictRec<DICT_RELATED$>
|
|
Protected = DictRec<DICT_PROTECT$>
|
|
CaseSensitive = DictRec<DICT_LOWERCASE$>
|
|
|
|
IndexData = ''
|
|
|
|
IF Btree = 1 THEN IndexData := 'Btree':CRLF$
|
|
IF XrefField = 1 THEN IndexData := 'Xref':CRLF$
|
|
IF CaseSensitive = 1 THEN IndexData := 'Case Sensitive':CRLF$
|
|
|
|
IF RelatedTo NE '' THEN IndexData := 'Related To: ':RelatedTo:CRLF$
|
|
IF RelatedFrom NE '' THEN IndexData := 'Related From: ':RelatedFrom:CRLF$
|
|
IF Protected = 1 THEN IndexData := 'Protected'
|
|
|
|
IF IndexData[-2,2] = CRLF$ THEN IndexData[-2,2] = ''
|
|
|
|
IF Type = 'S' THEN
|
|
SymLine = ''
|
|
SymLine<1,1> = FieldName
|
|
SymLine<1,2> = DataType
|
|
SymLine<1,3> = S_M
|
|
SymLine<1,4> = Justification
|
|
SymLine<1,5> = Length
|
|
SymLine<1,6> = Conv
|
|
SymLine<1,7> = Formula:CRLF$
|
|
SymLine<1,8> = IndexData
|
|
END
|
|
IF Type = 'F' THEN
|
|
PrintLine = ''
|
|
PrintLine<1,1> = FMC
|
|
PrintLine<1,2> = Part
|
|
PrintLine<1,3> = FieldName
|
|
PrintLine<1,4> = DataType
|
|
PrintLine<1,5> = S_M
|
|
PrintLine<1,6> = Justification
|
|
PrintLine<1,7> = Length
|
|
PrintLine<1,8> = Conv
|
|
PrintLine<1,9> = Desc:CRLF$
|
|
PrintLine<1,10> = IndexData
|
|
END
|
|
IF Type = 'G' THEN
|
|
debug
|
|
END
|
|
|
|
IF FMC NE '' THEN
|
|
IF FMC = 0 AND Part NE '' THEN FMC := '.':Part
|
|
LOCATE FMC IN FieldSort BY 'AR' USING @FM SETTING POS THEN
|
|
FieldSort = INSERT(FieldSort,POS,0,0,FMC)
|
|
END ELSE
|
|
FieldSort = INSERT(FieldSort,POS,0,0,FMC)
|
|
END
|
|
PrintLines = INSERT(PrintLines,POS,0,0,PrintLine)
|
|
|
|
END
|
|
IF Type = 'S' THEN
|
|
LOCATE FieldName IN SymSort USING @FM SETTING POS ELSE
|
|
SymSort = INSERT(SymSort,POS,0,0,FieldName)
|
|
END
|
|
Symbolics = INSERT(Symbolics,POS,0,0,SymLine)
|
|
END ;* End of sorting routine
|
|
|
|
END ; *
|
|
|
|
NEXT I
|
|
|
|
*SWAP @FM WITH @FM:@VM:@VM:@VM:@VM:@FM IN Symbolics ;* Inserts blank lines between items
|
|
|
|
|
|
***FONTS***
|
|
|
|
FONT = 'Arial'
|
|
FONT<F_POINTSIZE$> = '9'
|
|
FONT<F_JUST$> = 'L'
|
|
FONT<F_BOLD$> = FW_BOLD
|
|
|
|
stat = Set_Printer("FONTHEADFOOT", FONT)
|
|
IF stat < 0 THEN GOTO OIPrint_Err
|
|
|
|
FONT<F_BOLD$> = FW_NORMAL
|
|
FONT<F_POINTSIZE$> = '8'
|
|
spacing = '100'
|
|
stat = Set_Printer("FONT", FONT, spacing)
|
|
IF stat < 0 THEN GOTO OIPrint_Err
|
|
|
|
|
|
footer = "Page:'P' - 'D' 'T'"
|
|
colfooter = " "
|
|
|
|
colHead = '' ;colFmt = ''
|
|
colHead<1,1> = "FMC" ;colFmt<1,1> = '~>550'
|
|
colHead<1,2> = "Part" ;colFmt<1,2> = '~<500'
|
|
colHead<1,3> = "Field Name" ;colFmt<1,3> = '~<2380'
|
|
colHead<1,4> = "Data Type" ;colFmt<1,4> = '~1600'
|
|
colHead<1,5> = "S/M" ;colFmt<1,5> = '~^500'
|
|
colHead<1,6> = "Just" ;colFmt<1,6> = '~^500'
|
|
colHead<1,7> = "Lgth" ;colFmt<1,7> = '^500'
|
|
colHead<1,8> = "OConv" ;colFmt<1,8>= '<1440'
|
|
colHead<1,9> = "Description" ;colFmt<1,9> = '2880'
|
|
colHead<1,10> = "Indexes" ;colFmt<1,10> = '2880'
|
|
|
|
|
|
|
|
***HEADER & FOOTER***
|
|
|
|
header = @VM:"Dictionary Listing for ":TableName:" in Application ":@APPID<1>
|
|
header<2> = ""
|
|
|
|
stat = Set_Printer("HEADER", header,'','','')
|
|
stat = Set_Printer("FOOTER",footer,colfooter)
|
|
IF stat < 0 THEN GOTO OIPrint_Err
|
|
|
|
PageBreak = 1
|
|
|
|
FOR I = 1 TO COUNT(PrintLines,@FM) + (PrintLines NE '')
|
|
stat = Set_Printer('CALCTABLE',colFmt:@FM:PrintLines<I>)
|
|
TableSize = Get_Printer('CALCTABLE')
|
|
TableHeight = TableSize<2>
|
|
|
|
Test = Get_Printer('POS')<2>
|
|
IF Get_Printer('POS')<2> + TableHeight > 6.75 THEN
|
|
PageBreak = 1
|
|
stat = Set_Printer('PAGEBREAK')
|
|
END
|
|
|
|
IF PageBreak THEN
|
|
stat = Set_Printer('ADDTABLE',colFmt,colHead,PrintLines<I>,RGB(192,192,192),'',0,TB_ALL)
|
|
PageBreak = 0
|
|
END ELSE
|
|
stat = Set_Printer('ADDTABLE',colFmt,'',PrintLines<I>,RGB(192,192,192),'',1,TB_ALL)
|
|
END
|
|
|
|
NEXT I
|
|
|
|
IF stat < 0 THEN GOTO OIPrint_Err
|
|
|
|
stat = Set_Printer("PAGEBREAK")
|
|
|
|
colHead = "Field Name" ;colFmt = '~<2380'
|
|
colHead<1,2> = "Data Type" ;colFmt<1,2> = '~1600'
|
|
colHead<1,3> = "S/M" ;colFmt<1,3> = '~^500'
|
|
colHead<1,4> = "Just" ;colFmt<1,4> = "~^500"
|
|
colHead<1,5> = "Lgth" ;colFmt<1,5> = '^500'
|
|
colHead<1,6> = "OConv" ;colFmt<1,6> = "<1500"
|
|
colHead<1,7> = "Formula" ;colFmt<1,7> = '<4800'
|
|
colHead<1,8> = "Indexes" ;colFmt<1,8> = '2880'
|
|
|
|
|
|
header = @VM:"Symbolic Dictionary Item Listing for ":TableName:" in Application ":@APPID<1>
|
|
header<2> = ""
|
|
|
|
stat = Set_Printer("CONTROL", -1:@FM:1)
|
|
stat = Set_Printer("HEADER", header,'','','')
|
|
stat = Set_Printer("FOOTER",footer,colfooter)
|
|
IF stat < 0 THEN GOTO OIPrint_Err
|
|
|
|
PageBreak = 1
|
|
|
|
FOR I = 1 TO COUNT(Symbolics,@FM) + (Symbolics NE '')
|
|
stat = Set_Printer('CALCTABLE',colFmt:@FM:Symbolics<I>)
|
|
TableSize = Get_Printer('CALCTABLE')
|
|
TableHeight = TableSize<2>
|
|
IF Get_Printer('POS')<2> + TableHeight > 6.75 THEN
|
|
PageBreak = 1
|
|
stat = Set_Printer('PAGEBREAK')
|
|
END
|
|
|
|
IF PageBreak THEN
|
|
stat = Set_Printer('ADDTABLE',colFmt,colHead,Symbolics<I>,RGB(192,192,192),'',0,TB_ALL)
|
|
PageBreak = 0
|
|
END ELSE
|
|
stat = Set_Printer('ADDTABLE',colFmt,'',Symbolics<I>,RGB(192,192,192),'',1,TB_ALL)
|
|
END
|
|
|
|
NEXT I
|
|
|
|
IF stat < 0 THEN GOTO OIPrint_Err
|
|
|
|
NEXT N
|
|
|
|
|
|
* Terminate this printing session. *
|
|
|
|
stat = Set_Printer('TERM')
|
|
|
|
RETURN
|
|
|
|
OIPrint_Err:
|
|
|
|
UTILITY("CURSOR","A")
|
|
|
|
/* Set Error for OIPrint function and return to calling procedure */
|
|
|
|
stat = Set_Printer('TERM')
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
|