Reusable Part S_152RHT: HTML Generation
* ===================================================================
*
* Component : S_152RHT
* Type : Reusable Part
* Ancestor :
*
* Description : HTML Generation Reusable Part
*
* Disclaimer : The following material is supplied as sample material
* only. No warranty concerning this material or its use
* in any way whatsoever is expressed or implied.
*
* ===================================================================
FUNCTION OPTIONS(*DIRECT)
Begin_Com Role(*EXTENDS #PRIM_PANL) Displayposition(1) Height(316) Left(0) Tabposition(1) Top(0) Width(492)
* Global Document Definition Values
Define_Com Class(#SYSVAR$AV) Name(#USE_TITLE)
Define_Com Class(#STD_TEXTS) Name(#USE_STYLE)
Define_Pty Title Set(*Auto #Use_Title)
Define_Pty Style Set(*Auto #Use_Style)
* Table definition Values
Define #Tab_Space RefFld(#Std_Texts)
Define #Tab_Order RefFld(#Tab_Space)
Define #Tax_Space RefFld(#Tab_Space)
Def_Cond *TSpace '#Tab_Space *ne *Blanks'
Def_Cond *NoTSpace '#Tab_Space = *Blanks'
* Tab_Space table (actually split into 2 twinned tables)
Define #Tab_Name RefFld(#Std_Texts) Desc('Table Name')
Define #Tab_Seqn RefFld(#Std_Num) Desc('Table Order')
Define #Tab_Title RefFld(#Sysvar$av) Desc('Table Title')
Define #Tab_TStyl RefFld(#Std_Texts) Desc('Table Style')
Define #Tab_RMax RefFld(#Std_Num) Desc('Maximum Row Inserted')
Define #Tab_ALIGN RefFld(#Std_Num) Desc('Alignment value')
Define #Tab_BORD RefFld(#Std_Num) Desc('Border value')
Define #Tab_BCOL RefFld(#Std_Num) Desc('Background color value')
Define #Tab_WIDTH RefFld(#Std_Num) Desc('Width value (percentage)')
Define #Tab_CHDG RefFld(#Std_CodeS) Desc('Column headings exist ndicator')
Define #Tab_CStyl RefFld(#Std_Texts) Desc('Cell Style')
Define #Tab_HStyl RefFld(#Std_Texts) Desc('Column Heading Style')
Define #Tab_FRAME RefFld(#Std_Num) Desc('HTML Frame Option')
Define #Tab_RULES RefFld(#Std_Num) Desc('HTML Rules option')
Define #Tab_PAD RefFld(#Std_Num) Desc('Padding Option')
Define #Tab_SPACB RefFld(#Std_Num) Desc('Space Before Value')
Define #Tab_RULEB RefFld(#Std_Num) Desc('Rule Before Value')
Define #Tab_SPACA RefFld(#Std_Num) Desc('Space After Value')
Define #Tab_RULEA RefFld(#Std_Num) Desc('Rule After Value')
Define #Tab_SubT RefFld(#Std_CodeS) Desc('Sub Table Flag')
Group_By #XG_TabGrp Fields(#Tab_Name #Tab_Seqn #Tab_Title #Tab_RMax #Tab_ALIGN #Tab_BORD #Tab_BCOL #Tab_WIDTH #Tab_CHDG #Tab_TStyl #Tab_CStyl #Tab_HStyl #Tab_FRAME #Tab_RULES #Tab_PAD #Tab_SPACB #Tab_RULEB #Tab_SPACA #Tab_RULEA)
Group_By #XG_TaxGrp Fields(#Tab_Name #Tab_SubT)
* Cell definitions
Define #Cel_Space RefFld(#Tab_Space)
Define #Cel_Order RefFld(#Tab_Space)
Def_Cond *CSpace '#Cel_Space *ne *Blanks'
Def_Cond *NoCSpace '#Cel_Space = *Blanks'
Define #Cel_Table RefFld(#Std_Texts) Desc('Table Name')
Define #Cel_Name RefFld(#Std_Texts) Desc('Cell Name')
Define #Cel_Seqn RefFld(#Std_Num) Desc('Cell Order')
Define #Cel_CH1 RefFld(#Std_TextL) Desc('Column Heading 1')
Define #Cel_CH2 RefFld(#Std_TextL) Desc('Column Heading 2')
Define #Cel_CH3 RefFld(#Std_TextL) Desc('Column Heading 3')
Define #Cel_CStyl RefFld(#Std_Texts) Desc('Cell Style')
Define #Cel_HStyl RefFld(#Std_Texts) Desc('Column Heading Style')
Define #Cel_WIDTH RefFld(#Std_Num) Desc('Cell Width (percentage)')
Group_By #XG_CelGrp Fields(#Cel_Table #Cel_Name #Cel_Seqn #Cel_CH1 #Cel_CH2 #Cel_CH3 #Cel_CStyl #Cel_HStyl #Cel_WIDTH)
* Cell Values
Define #Val_Space RefFld(#Tab_Space)
Def_Cond *VSpace '#Val_Space *ne *Blanks'
Def_Cond *NoVSpace '#Val_Space = *Blanks'
Define #Val_Table RefFld(#Std_Texts) Desc('Table Name')
Define #Val_Name RefFld(#Std_Texts) Desc('Cell Name')
Define #Val_Row RefFld(#Std_Num) Desc('Row Number')
Define #Val_Type RefFld(#Std_Codes) Desc('Cell Type')
Define #Val_AVal RefFld(#Sysvar$av) Desc('Cell Alpha Value')
Define #Val_NVal RefFld(#Std_NumL) Desc('Cell Numeric Value')
Define #Val_DecP RefFld(#Std_Num) Desc('Number of Decimals to use')
Define #Val_CStyl RefFld(#Std_Texts) Desc('Cell Style')
Define #Val_HRef RefFld(#Std_Num) Desc('HREF Hyperlink Value')
Define #Val_Image RefFld(#Std_Num) Desc('Image Value')
Group_By #XG_ValGrp Fields(#Val_Table #Val_Name #Val_Row #Val_Type #Val_AVal #Val_NVal #Val_DecP #Val_CStyl #Val_HRef #Val_Image)
* Attribute Values
Define #Atr_Space RefFld(#Tab_Space)
Def_Cond *ASpace '#Atr_Space *ne *Blanks'
Def_Cond *NoASpace '#Atr_Space = *Blanks'
Define #Atr_Ident RefFld(#Std_Num) Desc('Attribute Unique Identifer')
Define #Atr_Name RefFld(#Std_Texts) Desc('Attribute HTML Name')
Define #Atr_Type RefFld(#Std_Codes) Desc('Attribute Type')
Define #Atr_AVal RefFld(#Sysvar$av) Desc('Attribute Alpha Value')
Define #Atr_NVal RefFld(#Std_Num) Desc('Attribute Numeric Value')
Group_By #XG_AtrGrp Fields(#Atr_Ident #Atr_Name #Atr_Type #Atr_AVal #Atr_NVal)
Define #NextAID RefFld(#Std_Num)
* Style Values
Define #Sty_Space RefFld(#Tab_Space)
Def_Cond *SSpace '#Sty_Space *ne *Blanks'
Def_Cond *NoSSpace '#Sty_Space = *Blanks'
Define #Sty_Name RefFld(#Std_Texts) Desc('Style Name')
Define #Sty_Size RefFld(#Std_Num) Desc('Font Size')
Define #Sty_Face RefFld(#Std_Num) Desc('Font Face Name')
Define #Sty_Color RefFld(#Std_Num) Desc('Font Color')
Define #Sty_BCol RefFld(#Std_Num) Desc('Style Background Color')
Define #Sty_Align RefFld(#Std_Num) Desc('Alignment Option')
Define #Sty_Bold RefFld(#Std_CodeS) Desc('Bold')
Define #Sty_Under RefFld(#Std_CodeS) Desc('Underlined')
Define #Sty_Ital RefFld(#Std_CodeS) Desc('Italic')
Define #Sty_Blink RefFld(#Std_CodeS) Desc('Blinking')
Define #Sty_Strik RefFld(#Std_CodeS) Desc('Strike Out')
Group_By #XG_StyGrp Fields(#Sty_Name #Sty_Size #Sty_Face #Sty_Color #Sty_Bold #Sty_Under #Sty_Blink #Sty_Ital #Sty_Strik #Sty_BCol #Sty_Align )
* Temporary working list used for the serialization of generated HTML.
* Output of HTML is unlimited. This list is ised as a buffer of 200 lines.
Define #HTMLCount RefFld(#Std_Num)
Define #HTMLLine Reffld(#Sysvar$av)
Def_List #HTMLLines (#HTMLLine) Type(*Working) Entrys(200) Counter(#HTMLCount)
Define #OutFilNam *Char 100
* Miscellaneous Definitions
Define #BRetCode *char 2
Def_Cond *RetOkay '#BRetCode = ok'
Def_Cond *RetNOkay '#BRetCode *ne ok'
Define #SRetCode RefFld(#Std_Num)
Define #HTMLWork RefFld(#SysVar$Av)
Define #HTMLTemp RefFld(#SysVar$Av)
Define #Work00 *dec 21 0
Define #Work01 *dec 21 1
Define #Work02 *dec 21 2
Define #Work03 *dec 21 3
Define #Work04 *dec 21 4
Define #Work05 *dec 21 5
Define #Work06 *dec 21 6
Define #Work07 *dec 21 7
Define #Work08 *dec 21 8
Define #Work09 *dec 21 9
Define #Atr_Temp *Char 31
* ================================================================================
SubRoutine CrtUSpace ((#RetSpace *Returned))
Define #RetSpace RefFld(#Tab_Space)
Define #TempChar *Char 10
Define #TempNum RefFld(#Date) Length(10) Decimals(0) edit_code(4) default(0) To_Overlay(#TempChar)
* Loop around until a unique non-existent space name can be found
Begin_Loop Using(#TempNum)
Use TConcat (*Component '.' #TempChar) (#RetSpace)
Use Space_Operation (#RetSpace CheckExistence) (#BRetCode)
Leave *RetNOkay
End_Loop
* Create the uniquely named space and return the name used to the caller
Use Create_Space (#RetSpace)
EndRoutine
* ================================================================================
SubRoutine Open
* Create the basic, extended and ordered table definition storage spaces
If *NoTSpace
Execute CrtUSpace (#Tab_Space)
Use Define_Space_Cell (#Tab_Space Tab_Name 'Key NoCase')
Use Define_Space_Cell (#Tab_Space Tab_Seqn)
Use Define_Space_Cell (#Tab_Space Tab_Title)
Use Define_Space_Cell (#Tab_Space Tab_RMax)
Use Define_Space_Cell (#Tab_Space Tab_ALIGN)
Use Define_Space_Cell (#Tab_Space Tab_BORD)
Use Define_Space_Cell (#Tab_Space Tab_BCOL)
Use Define_Space_Cell (#Tab_Space Tab_WIDTH)
Use Define_Space_Cell (#Tab_Space Tab_CHDG)
Use Define_Space_Cell (#Tab_Space Tab_TStyl)
Use Define_Space_Cell (#Tab_Space Tab_CStyl)
Use Define_Space_Cell (#Tab_Space Tab_HStyl)
Use Define_Space_Cell (#Tab_Space Tab_FRAME)
Use Define_Space_Cell (#Tab_Space Tab_RULES)
Use Define_Space_Cell (#Tab_Space Tab_PAD)
Use Define_Space_Cell (#Tab_Space Tab_SPACB)
Use Define_Space_Cell (#Tab_Space Tab_RULEB)
Use Define_Space_Cell (#Tab_Space Tab_SPACA)
Use Define_Space_Cell (#Tab_Space Tab_RULEA)
Execute CrtUSpace (#Tax_Space)
Use Define_Space_Cell (#Tax_Space Tab_Name 'Key NoCase')
Use Define_Space_Cell (#Tax_Space Tab_SubT)
Execute CrtUSpace (#Tab_Order)
Use Define_Space_Cell (#Tab_Order Tab_Seqn Key)
Use Define_Space_Cell (#Tab_Order Tab_Name Key)
Endif
* Create the basic and ordered cell definition storage spaces
If *NoCSpace
Execute CrtUSpace (#Cel_Space)
Use Define_Space_Cell (#Cel_Space Cel_Table 'Key NoCase')
Use Define_Space_Cell (#Cel_Space Cel_Name 'Key NoCase')
Use Define_Space_Cell (#Cel_Space Cel_Seqn)
Use Define_Space_Cell (#Cel_Space Cel_CH1)
Use Define_Space_Cell (#Cel_Space Cel_CH2)
Use Define_Space_Cell (#Cel_Space Cel_CH3)
Use Define_Space_Cell (#Cel_Space Cel_CStyl)
Use Define_Space_Cell (#Cel_Space Cel_HStyl)
Use Define_Space_Cell (#Cel_Space Cel_WIDTH)
Execute CrtUSpace (#Cel_Order)
Use Define_Space_Cell (#Cel_Order Cel_Table 'Key NoCase')
Use Define_Space_Cell (#Cel_Order Cel_Seqn Key)
Use Define_Space_Cell (#Cel_Order Cel_Name 'Key NoCase')
Endif
* Create the cell Values storage space
If *NoVSpace
Execute CrtUSpace (#Val_Space)
Use Define_Space_Cell (#Val_Space Val_Table 'Key NoCase')
Use Define_Space_Cell (#Val_Space Val_Name 'Key NoCase')
Use Define_Space_Cell (#Val_Space Val_Row Key)
Use Define_Space_Cell (#Val_Space Val_Type)
Use Define_Space_Cell (#Val_Space Val_AVal )
Use Define_Space_Cell (#Val_Space Val_NVal )
Use Define_Space_Cell (#Val_Space Val_DecP)
Use Define_Space_Cell (#Val_Space Val_CStyl)
Use Define_Space_Cell (#Val_Space Val_HRef)
Use Define_Space_Cell (#Val_Space Val_Image)
Endif
* Create the attributes definition storage space
If *NoASpace
Execute CrtUSpace (#Atr_Space)
Use Define_Space_Cell (#Atr_Space Atr_Ident Key)
Use Define_Space_Cell (#Atr_Space Atr_Name)
Use Define_Space_Cell (#Atr_Space Atr_Type)
Use Define_Space_Cell (#Atr_Space Atr_AVal)
Use Define_Space_Cell (#Atr_Space Atr_NVal)
Endif
* Create the style definition storage space
If *NoSSpace
Execute CrtUSpace (#Sty_Space)
Use Define_Space_Cell (#Sty_Space Sty_Name 'Key NoCase')
Use Define_Space_Cell (#Sty_Space Sty_Size)
Use Define_Space_Cell (#Sty_Space Sty_Face)
Use Define_Space_Cell (#Sty_Space Sty_Color)
Use Define_Space_Cell (#Sty_Space Sty_Bold)
Use Define_Space_Cell (#Sty_Space Sty_Under)
Use Define_Space_Cell (#Sty_Space Sty_Blink)
Use Define_Space_Cell (#Sty_Space Sty_Ital)
Use Define_Space_Cell (#Sty_Space Sty_Strik)
Use Define_Space_Cell (#Sty_Space Sty_BCol)
Use Define_Space_Cell (#Sty_Space Sty_Align)
Endif
* Finished
EndRoutine
* ================================================================================
MthRoutine Close
* Destory all existing definition and data storage spaces
If *TSpace
Use Destroy_Space (#Tab_Space)
Use Destroy_Space (#Tax_Space)
Use Destroy_Space (#Tab_Order)
Change (#Tab_Space #Tab_Order #Tax_Space) *Null
Endif
If *CSpace
Use Destroy_Space (#Cel_Space)
Use Destroy_Space (#Cel_Order)
Change (#Cel_Space #Cel_Order) *Null
Endif
If *VSpace
Use Destroy_Space (#Val_Space)
Change #Val_Space *Null
Endif
If *ASpace
Use Destroy_Space (#Atr_Space)
Change #Atr_Space *Null
Endif
If *SSpace
Use Destroy_Space (#Sty_Space)
Change (#Sty_Space #NextAID) *Null
Endif
* (Re)Initialize this component as it it were just being created
Execute Initialize
EndRoutine
* ================================================================================
EvtRoutine Handling(#Com_Owner.CreateInstance)
* Handle creation of an instance of this component
Execute Initialize
EndRoutine
* ================================================================================
SubRoutine Initialize
* Genrically initialize this component definition
Set #Com_Owner Style(DEFAULT)
Set #Com_Owner Title(' ')
Invoke #Com_Owner.DefineStyle Named(DEFAULT) Size(2) Color('Blue') Face('Arial')
EndRoutine
* ================================================================================
MthRoutine Save
* Seralize the component definitions as HTML into the specified file
Define_Map *input #SysVar$AV #InFile Desc('Name of file that HTML is to be saved in')
* Set up the output file name
Change #OutFilNam #InFile.Value
* Perform any opening logic
Execute Open
* Clear the HTML lines buffer
Clr_List #HTMLLines
* Now generate the HTML
Execute InsertHTML ('<HTML>' Y)
Execute InsertHTML ('<HEAD>' Y)
If '#Use_Title.Value *ne *blanks'
Execute InsertHTML ('<TITLE>' N)
Execute InsertHTML (#Use_Title.Value N)
Execute InsertHTML ('</TITLE>' N)
Endif
Execute InsertHTML ('</HEAD>' Y)
Change #HTMLWork '<BODY'
Execute InsertBGA (#Use_Style #HTMLWork Y N)
Use BConcat (#HTMLWork '>') (#HTMLWork)
Execute InsertHTML (#HTMLWork Y)
Execute StartStyle (#Use_Style.Value)
* Now generate all the tables
Use Select_In_Space (#Tab_Order) (#BRetCode #Tab_Seqn #Tab_Name)
DoWhile *RetOkay
* Get the Full table details
Use Fetch_In_Space (#Tab_Space #Tab_Name) (#bRetCode #XG_TabGrp)
Use Fetch_In_Space (#Tax_Space #Tab_Name) (#bRetCode #XG_TaxGrp)
* Only process this table if it is not flagged as a sub table
If '#Tab_SubT = N'
Invoke #Com_Owner.OutputTable Named(#Tab_Name)
Endif
* Move on to next table definition
Use SelectNext_In_Space (#Tab_Order) (#BRetCode #Tab_Seqn #Tab_Name)
EndWhile
* Finish up the HTML
Execute EndStyle (#Use_Style.Value)
Execute InsertHTML ('</BODY>' Y)
Execute InsertHTML ('</HTML>' Y)
* Save the last final list buffer of HTML to disk and close output file
Use Transform_List (#HTMLLines #OutFilNam C I T '.' Y) (#BRetCode)
* Finished
EndRoutine
* ================================================================================
MthRoutine OutputTable
* Serialize the named table definition as HTML
* NOTE: This routine may be used recursively
Define_Map *Input #Std_Texts #Named
Define #TempStyle RefFld(#Std_TextS)
Define #Cur_Row RefFld(#Std_Num) length(*RefFld *Plus 1)
DEFINE_COM CLASS(#STD_TEXTS) NAME(#STAB_NAME)
DEFINE_COM CLASS(#STD_NUM) NAME(#STAB_SEQN)
DEFINE_COM CLASS(#STD_TEXTS) NAME(#SCEL_TABLE)
DEFINE_COM CLASS(#STD_TEXTS) NAME(#SCEL_NAME)
DEFINE_COM CLASS(#STD_NUM) NAME(#SCEL_SEQN)
DEFINE_COM CLASS(#STD_TEXTS) NAME(#SVAL_TABLE)
DEFINE_COM CLASS(#STD_TEXTS) NAME(#SVAL_NAME)
DEFINE_COM CLASS(#STD_NUM) NAME(#SVAL_ROW)
DEFINE_COM CLASS(#STD_NUM) NAME(#SCUR_ROW)
DEFINE_COM CLASS(#STD_TEXTS) NAME(#STEMPSTYLE)
* Get the definition details of the table to be serialized
Change #Tab_Name #Named.Value
Use Fetch_In_Space (#Tab_Space #Tab_Name) (#BRetCode #XG_TabGrp)
Use Fetch_In_Space (#Tax_Space #Tab_Name) (#BRetCode #XG_TaxGrp)
if *RetNOkay
Return
Endif
* Put out any leading space and rule details
Begin_Loop from(1) to(#Tab_RULEB)
Execute InsertHTML ('<HR>' N)
End_Loop
Begin_Loop from(1) to(#Tab_SPACB)
Execute InsertHTML ('<BR>' N)
End_Loop
* Build the table start
Change #HTMLWork '<TABLE'
Execute Attrib (#Tab_BORD #HTMLWork)
Execute Attrib (#Tab_ALIGN #HTMLWork)
Execute Attrib (#Tab_WIDTH #HTMLWork)
Execute Attrib (#Tab_BCOL #HTMLWork)
Execute Attrib (#Tab_FRAME #HTMLWork)
Execute Attrib (#Tab_RULES #HTMLWork)
Execute Attrib (#Tab_PAD #HTMLWork)
Execute InsertBGA (#Tab_TStyl #HTMLWork Y N)
Use TConcat (#HTMLWork '>') (#HTMLWork)
Execute InsertHTML (#HTMLWork Y)
If '#Tab_Title *ne *blanks'
Execute InsertHTML ('<CAPTION>' N)
Execute StartStyle (#Tab_TStyl)
Execute InsertHTML (#Tab_Title N)
Execute EndStyle (#Tab_TStyl)
Execute InsertHTML ('</CAPTION>' N)
Endif
* Do the <TH> headers if any cell definition has column headings
If '#Tab_CHDG = Y'
Execute InsertHTML ('<THEAD>' Y)
Change #HTMLWork '<TR'
Execute InsertBGA (#Tab_HStyl #HTMLWork Y Y)
Use BConcat (#HTMLWork '>' ) (#HTMLWork)
Execute InsertHTML (#HTMLWork N)
Use Select_In_Space (#Cel_Order #Tab_Name) (#BRetCode #Cel_Table #Cel_Seqn #Cel_Name)
DoWhile *RetOkay
* Get the cell definition
Use Fetch_In_Space (#Cel_Space #Tab_Name #Cel_Name) (#BRetCode #XG_CelGrp)
If_Null #Cel_HStyl
Change #TempStyle #Tab_HStyl
Else
Change #TempStyle #Cel_HStyl
Endif
* Start the header
Change #HTMLWork '<TH'
Execute Attrib (#Cel_Width #HTMLWork)
Execute InsertBGA (#TempStyle #HTMLWork Y Y)
Use BConcat (#HTMLWork '>' ) (#HTMLWork)
Execute InsertHTML (#HTMLWork N)
* Insert the column Headings
Execute StartStyle (#TempStyle)
Change #HTMLWork #Cel_CH1
If '(#Cel_CH2 *Ne *Blanks) or (#Cel_CH3 *ne *Blanks)'
Use TConcat (#HTMLWork '<BR>' #Cel_CH2) (#HTMLWork)
If '#Cel_CH3 *ne *Blanks'
Use TConcat (#HTMLWork '<BR>' #Cel_CH3) (#HTMLWork)
Endif
Endif
Execute InsertHTML (#HTMLWork N)
Execute EndStyle (#TempStyle)
* End the header
Execute InsertHTML ('</TH>' N)
Use SelectNext_In_Space (#Cel_Order #Tab_Name) (#BRetCode #Cel_Table #Cel_Seqn #Cel_Name)
EndWhile
Execute InsertHTML ('</TR>' N)
Execute InsertHTML ('</THEAD>' Y)
Endif
* Start the table body
Execute InsertHTML ('<TBODY>' Y)
* Do the <TD> Rows
Begin_Loop from(1) to(#Tab_RMax) Using(#Cur_Row)
Execute InsertHTML ('<TR>' N)
* For each cell ( in sequence number order)
Use Select_In_Space (#Cel_Order #Tab_Name) (#BRetCode #Cel_Table #Cel_Seqn #Cel_Name)
DoWhile *RetOkay
* Get the cell definition
Use Fetch_In_Space (#Cel_Space #Tab_Name #Cel_Name) (#BRetCode #XG_CelGrp)
* Get the cell value in this row
Use Fetch_In_Space (#Val_Space #Tab_Name #Cel_Name #Cur_Row) (#BRetCode #XG_ValGrp)
* If value not found, create a default one
If *RetNOkay
Change #Val_Table #Tab_Name
Change #Val_Name #Cel_Name
Change #Val_Row #Cur_Row
Change #Val_Type A
Change (#Val_AVal #Val_NVal #Val_DecP #Val_HRef #Val_Image #Val_CStyl) *Null
Endif
* Now output the values as required
If_Null #Val_CStyl
If_Null #Cel_CStyl
Change #TempStyle #Tab_CStyl
Else
Change #TempStyle #Cel_CStyl
Endif
Else
Change #TempStyle #Val_CStyl
Endif
* Start the data cell with a <TD>
Change #HTMLWork '<TD'
Execute Attrib (#Cel_Width #HTMLWork)
Execute InsertBGA (#TempStyle #HTMLWork Y Y)
Use BConcat (#HTMLWork '>' ) (#HTMLWork)
Execute InsertHTML (#HTMLWork N)
* Insert any style details
Execute StartStyle (#TempStyle)
* Insert any HREF
If '#Val_HRef *ne 0'
Change #HTMLWork '<A'
Execute Attrib (#Val_HRef #HTMLWork)
Use TConcat (#HTMLWork '>') (#HTMLWork)
Execute InsertHTML ( #HTMLWork N)
Endif
* Insert any IMG
If '#Val_Image *ne 0'
Change #HTMLWork '<IMG'
Execute Attrib (#Val_Image #HTMLWork)
Use BConcat (#HTMLWork 'ALT="" ALIGN="left">') (#HTMLWork)
Execute InsertHTML (#HTMLWork N)
Endif
* Insert the cell value itself
Case #Val_Type
* Handle an ALPHA cell
When '= A'
Execute InsertHTML (#Val_AVal N)
* Handle an NUMERIC cell
When '= N'
Case #Val_DecP
When '= 0'
Change #Work00 #Val_NVal
use Numeric_String (#Work00) (#Atr_Temp)
When '= 1'
Change #Work01 #Val_NVal
use Numeric_String (#Work01) (#Atr_Temp)
When '= 2'
Change #Work02 #Val_NVal
use Numeric_String (#Work02) (#Atr_Temp)
When '= 3'
Change #Work03 #Val_NVal
use Numeric_String (#Work03) (#Atr_Temp)
When '= 4'
Change #Work04 #Val_NVal
use Numeric_String (#Work04) (#Atr_Temp)
When '= 5'
Change #Work05 #Val_NVal
use Numeric_String (#Work05) (#Atr_Temp)
When '= 6'
Change #Work06 #Val_NVal
use Numeric_String (#Work06) (#Atr_Temp)
When '= 7'
Change #Work07 #Val_NVal
use Numeric_String (#Work07) (#Atr_Temp)
When '= 8'
Change #Work08 #Val_NVal
use Numeric_String (#Work08) (#Atr_Temp)
Otherwise
Change #Work09 #Val_NVal
use Numeric_String (#Work09) (#Atr_Temp)
EndCase
Execute InsertHTML (#Atr_Temp N)
* Handle an TABLE cell (ie: a table within a table)
When '= T'
* Stack the current Values
Set #STab_Name Value(#Tab_Name)
Set #STab_Seqn Value(#Tab_Seqn)
Set #SCel_Table Value(#Cel_Table)
Set #SCel_Seqn Value(#Cel_Seqn)
Set #SCel_Name Value(#Cel_Name)
Set #SVal_Table Value(#Val_Table)
Set #SVal_Name Value(#Val_Name)
Set #SVal_Row Value(#Val_Row)
Set #SCur_Row Value(#Cur_Row)
Set #STempStyle Value(#TempStyle)
* Recursively invoke this routine
Invoke #Com_Owner.OutputTable Named(#Val_AVal )
* Unstack the values and reset the space positions
Change #Tab_Name #STab_Name.Value
Change #Tab_Seqn #STab_Seqn.Value
Change #Cel_Table #SCel_Table.Value
Change #Cel_Seqn #SCel_Seqn.Value
Change #Cel_Name #SCel_Name.Value
Change #Val_Table #SVal_Table.Value
Change #Val_Name #SVal_Name.Value
Change #Val_Row #SVal_Row.Value
Change #Cur_Row #SCur_Row.Value
Change #TempStyle #STempStyle.Value
Use Fetch_In_Space (#Tab_Space #Tab_Name) (#BRetCode #XG_TabGrp)
Use Fetch_In_Space (#Tax_Space #Tab_Name) (#BRetCode #XG_TaxGrp)
Use Fetch_In_Space (#Cel_Order #Cel_Table #Cel_Seqn #Cel_Name) (#BRetCode #Cel_Table #Cel_Seqn #Cel_Name)
Use Fetch_In_Space (#Cel_Space #Cel_Table #Cel_Name) (#BRetCode #XG_CelGrp)
Use Fetch_In_Space (#Val_Space #Val_Table #Val_Name #Cur_Row) (#BRetCode #XG_ValGrp)
EndCase
* End off any HREF
If '#Val_HRef *ne 0'
Execute InsertHTML ('</A>' N)
Endif
* End off the style
Execute EndStyle (#TempStyle)
* End the data cell
Execute InsertHTML ('</TD>' N)
* Move on to the next cell definition (in sequence order)
Use SelectNext_In_Space (#Cel_Order #Tab_Name) (#BRetCode #Cel_Table #Cel_Seqn #Cel_Name)
EndWhile
Execute InsertHTML ('</TR>' N)
End_loop
* The Table Body is finished
Execute InsertHTML ('</TBODY>' Y)
* The Table is finished
Execute InsertHTML ('</TABLE>' Y)
* Put out trailing spaces and rules
Begin_Loop from(1) to(#Tab_RULEA)
Execute InsertHTML ('<HR>' N)
End_Loop
Begin_Loop from(1) to(#Tab_SPACA)
Execute InsertHTML ('<BR>' N)
End_Loop
* Finished
EndRoutine
* ================================================================================
MthRoutine Show
* Show the specified file via the standard Windows shell interface for the file type
Define_Map *input #SysVar$AV #InFile Desc('Name of file that HTML is to be saved in')
Use System_Command (H #InFile.Value) (#SRetCode)
If '#SRetCode *Ne 0'
Use Message_Box_Show with_args(ok ok error *component 'Attempt to show output file failed.')
Endif
EndRoutine
* ================================================================================
SubRoutine InsertHTML ((#xxLine *Received)(#xxFLush *Received))
* Insert a line of HTML into the buffer list
Define #xxLine RefFld(#SysVar$Av)
Define #xxFlush RefFld(#Std_CodeS)
Define #OutBuffer RefFld(#SysVar$Av)
Define #TmpBuffer RefFld(#SysVar$av)
Define #OutLength RefFld(#Std_Num)
* If the output list is full, flush it to disk but keep the output file open
* Note the 199 limit. This is because following code may add 2 lines the list.
If '#HTMLCount >= 199'
Use Transform_List (#HTMLLines #OutFilNam C I T '.' N) (#BRetCode)
Clr_List #HTMLLines
Endif
* Handle a forced flush request
If '#xxFlush *eq Y'
If '#OutBuffer *ne *blanks'
Change #HTMLLine #OutBuffer
Add_Entry #HTMLLines
Change #OutBuffer *Null
Endif
Change #HTMLLine #xxLine
Add_Entry #HTMLLines
Else
* See if this stuff will fit in the buffer and act accordingly
Use TConcat (#OutBuffer #xxLine) (#TmpBuffer #OutLength)
If '#OutLength >= 250'
Change #HTMLLine #OutBuffer
Add_Entry #HTMLLines
Change #OutBuffer #xxLine
Else
Change #OutBuffer #TmpBuffer
Endif
Endif
EndRoutine
* ================================================================================
SubRoutine StorAttrib ((#Atr_Ident *Returned)(#Atr_Name *Received)(#Atr_Type *Received)(#Atr_AVal *Received)(#Atr_NVal *Received) )
* Assign a unique identifier to an attribute and store its details in the storage space
Change #NextAID '#NextAID + 1'
Change #Atr_Ident #NextAID
Use Insert_In_Space (#Atr_Space #XG_AtrGrp)
EndRoutine
* ================================================================================
SubRoutine Attrib ((#UseAID *Received)(#HTMLOut *Both))
* Get details of an attribute (where the caller supplies its unqiue identifer)
* If found and if not a default/non-existent value, assemble it into its HTML
* form and then concatenate this reuslt onto the end of the string specified
* in parameter 2.
Define #UseAID RefFld(#Std_Num)
Define #HTMLOut RefFld(#SysVar$Av)
* Get details
Use Fetch_In_Space (#Atr_Space #UseAID) (#BRetCode #XG_AtrGrp)
* Handle not found
if *RetNOkay
Return
Endif
* Handle default value according to attribute type
Case #Atr_Type
When '= S'
If_Null #Atr_AVal
Return
Endif
When ('= N' '= P')
If '#Atr_NVal = -999999'
Return
Endif
EndCase
* Add HTML attribute name to end of supplied string
Use BConcat (#HTMLOut #Atr_Name) (#HTMLOut)
Use TConcat (#HTMLOut '=') (#HTMLOut)
* Add HTML value to the end of the supplied string.
* Note that S = quoted string, N = quoted number, P = quoted percentage
* Note that only integral numeric values are handled as #Atr_NVAL is based on #STD_NUM
Case #Atr_Type
When '= S'
Use TConcat (#HTMLOut '"' #Atr_AVal '"') (#HTMLOut)
When '= N'
Use Numeric_String (#Atr_NVal) (#Atr_Temp)
Use TConcat (#HTMLOut '"' #Atr_Temp '"') (#HTMLOut)
When '= P'
Use Numeric_String (#Atr_NVal) (#Atr_Temp)
Use TConcat (#HTMLOut '"' #Atr_Temp '%"') (#HTMLOut)
EndCase
EndRoutine
* ================================================================================
Subroutine InsertBGA ((#Sty_Name *Received)(#xxLine *Both)(#RetBG *Received)(#RetAlign *Received) )
* This routine is just a specialized version of prveious routine Attrib
* that simplifies the constant serialization of background and aligment
* attributes
Define #RetBG RefFld(#Std_CodeS)
Define #RetAlign RefFld(#Std_CodeS)
If_Null #Sty_Name
Return
Endif
Use Fetch_In_Space (#Sty_Space #Sty_Name) (#BRetCode #XG_StyGrp)
if *RetNOkay
Return
Endif
If '#RetBG = Y'
Execute Attrib (#Sty_BCol #xxLine)
Endif
If '#RetAlign = Y'
Execute Attrib (#Sty_Align #xxLine)
Endif
EndRoutine
* ================================================================================
Subroutine StartStyle ((#Sty_Name *Received))
* Start the serialization of a specified style into HTML form
* Handle non existent name
If_Null #Sty_Name
Return
Endif
* Get the style definition
Use Fetch_In_Space (#Sty_Space #Sty_Name) (#BRetCode #XG_StyGrp)
* Handle not found
if *RetNOkay
Return
Endif
* Insert the font details
Change #HTMLWork '<FONT'
Execute Attrib (#Sty_Size #HTMLWork)
Execute Attrib (#Sty_Face #HTMLWork)
Execute Attrib (#Sty_Color #HTMLWork)
Use TConcat (#HTMLWork '>') (#HTMLWork)
Execute InsertHTML (#HTMLWork N)
* Insert other formatting details
If '#Sty_Bold = T'
Execute InsertHTML ('<B>' N)
Endif
If '#Sty_Under = T'
Execute InsertHTML ('<U>' N)
Endif
If '#Sty_Blink = T'
Execute InsertHTML ('<BLINK>' N)
Endif
If '#Sty_Ital = T'
Execute InsertHTML ('<I>' N)
Endif
If '#Sty_Strik = T'
Execute InsertHTML ('<S>' N)
Endif
* Finished
EndRoutine
* ================================================================================
SubRoutine EndStyle ((#Sty_Name *Received))
* End the serialization of a specified style into HTML form
If_Null #Sty_Name
Return
Endif
* Handle non existent name
Use Fetch_In_Space (#Sty_Space #Sty_Name) (#BRetCode #XG_StyGrp)
* Handle not found
if *RetNOkay
Return
Endif
* Close any formatiing blcoks that are part of this style (see subroutine StartStyle)
If '#Sty_Strik = T'
Execute InsertHTML ('</S>' N)
Endif
If '#Sty_Ital = T'
Execute InsertHTML ('</I>' N)
Endif
If '#Sty_Blink = T'
Execute InsertHTML ('</BLINK>' N)
Endif
If '#Sty_Under = T'
Execute InsertHTML ('</U>' N)
Endif
If '#Sty_Bold = T'
Execute InsertHTML ('</B>' N)
Endif
* Close off the font
Execute InsertHTML ('</FONT>' N)
* Finished
EndRoutine
* ================================================================================
* ====================
* Method : DefineTable
* ====================
* WithName : Symbolic name of the table
* Order : Presentation order of table relative to other tables
* WithTitle : Title of Table
* TitleStyle : Name of style to be used for title
* Align : Alignment option for table. Use center, left or right.
* Border : Border thickness in pixels. Zero means no border.
* PctWidth : Percentage width of table as a percentage of the display window. range 0 -> 100.
* CellStyle : Default style to use for table cells.
* HdgStyle : Default style to use for Column headings.
* BorderCol : Border color
* Frame : Specifies which sides of the framing border should be drawn. Use above, below, box, hsides, lhs, rhs, void or vsides. Equates to HTML attribute FRAME=
* Rules : Specifies which cell dividing lines should be drawn within the table. Use all, cols, groups, none or rows. Equates to HTML attribute RULES=.
* CellPad : Specifies the space (in pixels) to leave around the edges of each cell.
* SpaceBef : Number of spaces (<BR>) to generate before the table
* RuleBef : Number of horizontal rules (<HR>) to generate before the table
* SpaceAft : Number of spaces (<BR>) to generate after the table
* RuleAft : Number of horizontal rules (<HR>) to generate after the table
MthRoutine DefineTable
* Store details of a table
Define_Map *Input #Std_Texts #WithName
Define_Map *Input #Std_Num #Order
Define_Map *Input #SysVar$Av #WithTitle Mandatory(' ')
Define_Map *Input #Std_Texts #TitleStyle Mandatory('DEFAULT')
Define_Map *Input #Std_Texts #Align Mandatory(' ')
Define_Map *Input #Std_Num #Border Mandatory(-999999)
Define_Map *Input #Std_Num #PctWidth Mandatory(-999999)
Define_Map *Input #Std_Texts #CellStyle Mandatory('DEFAULT')
Define_Map *Input #Std_Texts #HdgStyle Mandatory('DEFAULT')
Define_Map *Input #Std_Texts #BorderCol Mandatory('blue')
Define_Map *Input #Std_Texts #Frame Mandatory('box')
Define_Map *Input #Std_Texts #Rules Mandatory('all')
Define_Map *Input #Std_Num #CellPad Mandatory(1)
Define_Map *Input #Std_Num #SpaceBef Mandatory(0)
Define_Map *Input #Std_Num #RuleBef Mandatory(0)
Define_Map *Input #Std_Num #SpaceAft Mandatory(0)
Define_Map *Input #Std_Num #RuleAft Mandatory(0)
* Open up required resources
Execute Open
* Map values into table space storage areas
Change #Tab_Name #WithName.Value
Change #Tab_Seqn #Order.Value
Change #Tab_Title #WithTitle.Value
Change #Tab_RMax 0
Change #Tab_CHDG N
Change #Tab_SubT N
Change #Tab_TStyl #TitleStyle.Value
Change #Tab_CStyl #CellStyle.Value
Change #Tab_HStyl #HdgStyle.Value
Change #Tab_SPACB #SpaceBef.Value
Change #Tab_RULEB #RuleBef.Value
Change #Tab_SPACA #SpaceAft.Value
Change #Tab_RULEA #RuleAft.Value
* Convert and store attributes
Execute StorAttrib (#Tab_ALIGN ALIGN S #Align.Value 0)
Execute StorAttrib (#Tab_BORD BORDER N ' ' #Border.Value)
Execute StorAttrib (#Tab_WIDTH WIDTH P ' ' #PctWidth.Value)
Execute StorAttrib (#Tab_BCOL BORDERCOLOR S #BorderCol.Value 0)
Execute StorAttrib (#Tab_FRAME FRAME S #Frame.Value 0)
Execute StorAttrib (#Tab_RULES RULES S #Rules.Value 0)
Execute StorAttrib (#Tab_PAD CELLPADDING N ' ' #CellPad.Value)
* Store table definition details (basic, extended and in order)
Use Insert_In_Space (#Tab_Space #XG_TabGrp)
Use Insert_In_Space (#Tax_Space #XG_TaxGrp)
Use Insert_In_Space (#Tab_Order #Tab_Seqn #Tab_Name)
EndRoutine
* ========================
* Method : DefineTableCell
* ========================
* InTable : Symbolic name of the table. Must have been previously defined with DefineTable.
* WithName : Symbolic name of the table cell.
* Order : Presentation order of the cell relative to other cells in the same table.
* ColHdg1 : Cell column heading 1
* ColHdg2 : Cell column heading 2
* ColHdg3 : Cell column heading 3
* CellStyle : Default style to use for table cells.
* HdgStyle : Default style to use for Column headings.
* PctWidth : Percentage width of the cell as a percentage of table width. Range 0 -> 100.
MthRoutine DefineTableCell
* Store details of a cell
Define_Map *Input #Std_Texts #InTable
Define_Map *Input #Std_Texts #WithName
Define_Map *Input #Std_Num #Order
Define_Map *Input #Std_TextL #ColHdg1 Mandatory(' ')
Define_Map *Input #Std_TextL #ColHdg2 Mandatory(' ')
Define_Map *Input #Std_TextL #ColHdg3 Mandatory(' ')
Define_Map *Input #Std_Texts #CellStyle Mandatory(' ')
Define_Map *Input #Std_Texts #HdgStyle Mandatory(' ')
Define_Map *Input #Std_Num #PctWidth Mandatory(-999999)
* Open up required resources
Execute Open
* Map values into table space storage areas
Change #Cel_Table #InTable.Value
Change #Cel_Name #WithName.Value
Change #Cel_Seqn #Order.Value
Change #Cel_CH1 #ColHdg1.Value
Change #Cel_CH2 #ColHdg2.Value
Change #Cel_CH3 #ColHdg3.Value
Change #Cel_CStyl #CellStyle.Value
Change #Cel_HStyl #HdgStyle.Value
* Convert and store attributes
Execute StorAttrib (#Cel_WIDTH WIDTH P ' ' #PctWidth.Value)
* Store details (Basic and in order)
Use Insert_In_Space (#Cel_Space #XG_CelGrp)
Use Insert_In_Space (#Cel_Order #Cel_Table #Cel_Seqn #Cel_Name)
* Fetch the table header details and update column heading existence flag
Use Fetch_In_Space (#Tab_Space #Cel_Table) (#bRetCode #XG_TabGrp)
Use Fetch_In_Space (#Tax_Space #Cel_Table) (#bRetCode #XG_TaxGrp)
if *RetNOkay
Abort 'Referenced table does not exist. Define the table before referencing it.'
Endif
If '(#Cel_CH1 *ne *blanks) or (#Cel_CH2 *ne *blanks) or (#Cel_CH3 *ne *blanks)'
Change #Tab_CHDG Y
Endif
Use Update_In_Space (#Tab_Space #XG_TabGrp)
Use Update_In_Space (#Tax_Space #XG_TaxGrp)
* Finished
EndRoutine
* ================================================================================
* =====================
* Method : SetTableCell
* =====================
* InTable : Symbolic name of the table. Must have been previously defined with DefineTable.
* WithName : Symbolic name of the table cell.
* RowNum : Row number of this cell within the table.
* Type : Cell content type. Must be alpha, numeric or table.
* AlphaValue : Alphanumeric value to be placed into the cell.
* NumValue : Numeric value to be placed into the cell (note 15,5 maximum).
* Decimals : Number of decimals to use when displaying. Range 0 -> 9.
* CellStyle : Cell style to be used.
* HRef : Hyperlink reference to be associated with cell contents.
* Image : Image to be associated with cell contents.
MthRoutine SetTableCell
* Store details of a specific table cell value
Define_Map *Input #Std_Texts #InTable
Define_Map *Input #Std_Texts #WithName
Define_Map *Input #Std_Num #RowNum
Define_Map *Input #Std_Texts #Type Mandatory(ALPHA)
Define_Map *Input #SysVar$av #AlphaValue Mandatory(' ')
Define_Map *Input #Std_NumL #NumValue Mandatory(0.0)
Define_Map *Input #Std_Num #Decimals Mandatory(0)
Define_Map *Input #Std_Texts #CellStyle Mandatory(' ')
Define_Map *Input #SysVar$Av #HRef Mandatory(' ')
Define_Map *Input #SysVar$Av #Image Mandatory(' ')
* Perform opening logic if not already done
Execute Open
* Map the cell values
Change #Val_Table #InTable.Value
Change #Val_Name #WithName.Value
Change #Val_Row #RowNum.Value
* Check out the type
Use UpperCase (#Type) (#Std_Texts)
Case #Std_Texts
When '= alpha'
Change #Val_Type A
When '= numeric'
Change #Val_Type N
When '= table'
Change #Val_Type T
OtherWise
Abort 'Invalid valid specified for Type argument in SetTableCell method'
EndCase
* Map some more values
Change #Val_CStyl #CellStyle.Value
Change #Val_AVal #AlphaValue.Value
Change #Val_NVal #NumValue.Value
Change #Val_DecP #Decimals.Value
* Store HREF and Image values (if present)
If '#HRef.Value = *Blanks'
Change #Val_HRef 0
Else
Execute StorAttrib (#Val_HRef HREF S #HRef.Value 0)
Endif
If '#Image.Value = *Blanks'
Change #Val_Image 0
Else
Execute StorAttrib (#Val_Image SRC S #Image.Value 0)
Endif
* Update or create the cell
Use Update_In_Space (#Val_Space #XG_ValGrp) (#BRetCode)
if *RetNOkay
Use Insert_In_Space (#Val_Space #XG_ValGrp)
Endif
* Update the header details with the highest row number encountered so far
Change #Tab_RMax *Hival
Use Fetch_In_Space (#Tab_Space #Val_Table) (#bRetCode #XG_TabGrp)
Use Fetch_In_Space (#Tax_Space #Val_Table) (#bRetCode #XG_TaxGrp)
If '#Val_Row > #Tab_RMax'
Change #Tab_RMax #Val_Row
Use Update_In_Space (#Tab_Space #XG_TabGrp)
Use Update_In_Space (#Tax_Space #XG_TaxGrp)
Endif
* If the reference is to a table locate the table and update it's
* special Tab_SubT flag to indicate that it is a sub table
If '#Val_Type = T'
Use Fetch_In_Space (#Tab_Space #Val_AVal) (#bRetCode #XG_TabGrp)
Use Fetch_In_Space (#Tax_Space #Val_AVal) (#bRetCode #XG_TaxGrp)
if *RetNOkay
Abort 'Referenced table does not exist. Define the table before referencing it.'
Endif
Change #Tab_SubT Y
Use Update_In_Space (#Tab_Space #XG_TabGrp)
Use Update_In_Space (#Tax_Space #XG_TaxGrp)
Endif
* Finished
EndRoutine
* ================================================================================
* ====================
* Method : DefineStyle
* ====================
* Named : Symbolic name of the style.
* Size : Size of the font sued with the style. Range 1 -> 7.
* Color : Font color. See color listings following the HTML_DEMA sample.
* Face : Face name of the font to be used (eg: Arial)
* Bold : Use bolding
* Underline : Use underlining
* Blink : Use the <BLINK> attribute
* Italic : Use Italic
* StrikeOut : Use strikout
* BackColor : Background color for this style
* Alignment : Alignment for this style (use left, center or right)
MthRoutine DefineStyle
* Store details of a style
Define_Map *Input #Std_Texts #Named
Define_Map *Input #Std_Num #Size mandatory(2)
Define_Map *Input #Std_Texts #Color mandatory('blue')
Define_Map *Input #Std_Texts #Face mandatory('Arial')
Define_Map *Input #Std_Bool #Bold mandatory(FALSE)
Define_Map *Input #Std_Bool #UnderLine mandatory(FALSE)
Define_Map *Input #Std_Bool #Blink mandatory(FALSE)
Define_Map *Input #Std_Bool #Italic mandatory(FALSE)
Define_Map *Input #Std_Bool #StrikeOut mandatory(FALSE)
Define_Map *Input #Std_Texts #BackColor mandatory('white')
Define_Map *Input #Std_Texts #Alignment mandatory('left')
* Open if not already opened
Execute Open
* Do the Mappings
Change #Sty_Name #Named.Value
Execute StorAttrib (#Sty_Size SIZE N *blanks #Size.Value)
Execute StorAttrib (#Sty_Face FACE S #Face.Value 0)
Execute StorAttrib (#Sty_Color COLOR S #Color.Value 0)
Execute StorAttrib (#Sty_BCol BGCOLOR S #BackColor.Value 0)
Execute StorAttrib (#Sty_Align ALIGN S #Alignment.Value 0)
Change #Sty_Bold #Bold.Value
Change #Sty_Under #Underline.Value
Change #Sty_Blink #Blink.Value
Change #Sty_Ital #Italic.Value
Change #Sty_Strik #StrikeOut.Value
Use UpperCase (#Sty_Bold) (#Sty_Bold)
Use UpperCase (#Sty_Under) (#Sty_Under)
Use UpperCase (#Sty_Blink) (#Sty_Blink)
Use UpperCase (#Sty_Ital) (#Sty_Ital)
Use UpperCase (#Sty_Strik) (#Sty_Strik)
* Update or create the style
Use Update_In_Space (#Sty_Space #XG_StyGrp) (#BRetCode)
if *RetNOkay
Use Insert_In_Space (#Sty_Space #XG_StyGrp)
Endif
EndRoutine
END_COM
* ===================================================================
*
* Component : S_152RHT
* Type : Reusable Part
* Ancestor :
*
* Description : HTML Generation Reusable Part
*
* Disclaimer : The following material is supplied as sample material
* only. No warranty concerning this material or its use
* in any way whatsoever is expressed or implied.
*
* ===================================================================
FUNCTION OPTIONS(*DIRECT)
Begin_Com Role(*EXTENDS #PRIM_PANL) Displayposition(1) Height(316) Left(0) Tabposition(1) Top(0) Width(492)
* Global Document Definition Values
Define_Com Class(#SYSVAR$AV) Name(#USE_TITLE)
Define_Com Class(#STD_TEXTS) Name(#USE_STYLE)
Define_Pty Title Set(*Auto #Use_Title)
Define_Pty Style Set(*Auto #Use_Style)
* Table definition Values
Define #Tab_Space RefFld(#Std_Texts)
Define #Tab_Order RefFld(#Tab_Space)
Define #Tax_Space RefFld(#Tab_Space)
Def_Cond *TSpace '#Tab_Space *ne *Blanks'
Def_Cond *NoTSpace '#Tab_Space = *Blanks'
* Tab_Space table (actually split into 2 twinned tables)
Define #Tab_Name RefFld(#Std_Texts) Desc('Table Name')
Define #Tab_Seqn RefFld(#Std_Num) Desc('Table Order')
Define #Tab_Title RefFld(#Sysvar$av) Desc('Table Title')
Define #Tab_TStyl RefFld(#Std_Texts) Desc('Table Style')
Define #Tab_RMax RefFld(#Std_Num) Desc('Maximum Row Inserted')
Define #Tab_ALIGN RefFld(#Std_Num) Desc('Alignment value')
Define #Tab_BORD RefFld(#Std_Num) Desc('Border value')
Define #Tab_BCOL RefFld(#Std_Num) Desc('Background color value')
Define #Tab_WIDTH RefFld(#Std_Num) Desc('Width value (percentage)')
Define #Tab_CHDG RefFld(#Std_CodeS) Desc('Column headings exist ndicator')
Define #Tab_CStyl RefFld(#Std_Texts) Desc('Cell Style')
Define #Tab_HStyl RefFld(#Std_Texts) Desc('Column Heading Style')
Define #Tab_FRAME RefFld(#Std_Num) Desc('HTML Frame Option')
Define #Tab_RULES RefFld(#Std_Num) Desc('HTML Rules option')
Define #Tab_PAD RefFld(#Std_Num) Desc('Padding Option')
Define #Tab_SPACB RefFld(#Std_Num) Desc('Space Before Value')
Define #Tab_RULEB RefFld(#Std_Num) Desc('Rule Before Value')
Define #Tab_SPACA RefFld(#Std_Num) Desc('Space After Value')
Define #Tab_RULEA RefFld(#Std_Num) Desc('Rule After Value')
Define #Tab_SubT RefFld(#Std_CodeS) Desc('Sub Table Flag')
Group_By #XG_TabGrp Fields(#Tab_Name #Tab_Seqn #Tab_Title #Tab_RMax #Tab_ALIGN #Tab_BORD #Tab_BCOL #Tab_WIDTH #Tab_CHDG #Tab_TStyl #Tab_CStyl #Tab_HStyl #Tab_FRAME #Tab_RULES #Tab_PAD #Tab_SPACB #Tab_RULEB #Tab_SPACA #Tab_RULEA)
Group_By #XG_TaxGrp Fields(#Tab_Name #Tab_SubT)
* Cell definitions
Define #Cel_Space RefFld(#Tab_Space)
Define #Cel_Order RefFld(#Tab_Space)
Def_Cond *CSpace '#Cel_Space *ne *Blanks'
Def_Cond *NoCSpace '#Cel_Space = *Blanks'
Define #Cel_Table RefFld(#Std_Texts) Desc('Table Name')
Define #Cel_Name RefFld(#Std_Texts) Desc('Cell Name')
Define #Cel_Seqn RefFld(#Std_Num) Desc('Cell Order')
Define #Cel_CH1 RefFld(#Std_TextL) Desc('Column Heading 1')
Define #Cel_CH2 RefFld(#Std_TextL) Desc('Column Heading 2')
Define #Cel_CH3 RefFld(#Std_TextL) Desc('Column Heading 3')
Define #Cel_CStyl RefFld(#Std_Texts) Desc('Cell Style')
Define #Cel_HStyl RefFld(#Std_Texts) Desc('Column Heading Style')
Define #Cel_WIDTH RefFld(#Std_Num) Desc('Cell Width (percentage)')
Group_By #XG_CelGrp Fields(#Cel_Table #Cel_Name #Cel_Seqn #Cel_CH1 #Cel_CH2 #Cel_CH3 #Cel_CStyl #Cel_HStyl #Cel_WIDTH)
* Cell Values
Define #Val_Space RefFld(#Tab_Space)
Def_Cond *VSpace '#Val_Space *ne *Blanks'
Def_Cond *NoVSpace '#Val_Space = *Blanks'
Define #Val_Table RefFld(#Std_Texts) Desc('Table Name')
Define #Val_Name RefFld(#Std_Texts) Desc('Cell Name')
Define #Val_Row RefFld(#Std_Num) Desc('Row Number')
Define #Val_Type RefFld(#Std_Codes) Desc('Cell Type')
Define #Val_AVal RefFld(#Sysvar$av) Desc('Cell Alpha Value')
Define #Val_NVal RefFld(#Std_NumL) Desc('Cell Numeric Value')
Define #Val_DecP RefFld(#Std_Num) Desc('Number of Decimals to use')
Define #Val_CStyl RefFld(#Std_Texts) Desc('Cell Style')
Define #Val_HRef RefFld(#Std_Num) Desc('HREF Hyperlink Value')
Define #Val_Image RefFld(#Std_Num) Desc('Image Value')
Group_By #XG_ValGrp Fields(#Val_Table #Val_Name #Val_Row #Val_Type #Val_AVal #Val_NVal #Val_DecP #Val_CStyl #Val_HRef #Val_Image)
* Attribute Values
Define #Atr_Space RefFld(#Tab_Space)
Def_Cond *ASpace '#Atr_Space *ne *Blanks'
Def_Cond *NoASpace '#Atr_Space = *Blanks'
Define #Atr_Ident RefFld(#Std_Num) Desc('Attribute Unique Identifer')
Define #Atr_Name RefFld(#Std_Texts) Desc('Attribute HTML Name')
Define #Atr_Type RefFld(#Std_Codes) Desc('Attribute Type')
Define #Atr_AVal RefFld(#Sysvar$av) Desc('Attribute Alpha Value')
Define #Atr_NVal RefFld(#Std_Num) Desc('Attribute Numeric Value')
Group_By #XG_AtrGrp Fields(#Atr_Ident #Atr_Name #Atr_Type #Atr_AVal #Atr_NVal)
Define #NextAID RefFld(#Std_Num)
* Style Values
Define #Sty_Space RefFld(#Tab_Space)
Def_Cond *SSpace '#Sty_Space *ne *Blanks'
Def_Cond *NoSSpace '#Sty_Space = *Blanks'
Define #Sty_Name RefFld(#Std_Texts) Desc('Style Name')
Define #Sty_Size RefFld(#Std_Num) Desc('Font Size')
Define #Sty_Face RefFld(#Std_Num) Desc('Font Face Name')
Define #Sty_Color RefFld(#Std_Num) Desc('Font Color')
Define #Sty_BCol RefFld(#Std_Num) Desc('Style Background Color')
Define #Sty_Align RefFld(#Std_Num) Desc('Alignment Option')
Define #Sty_Bold RefFld(#Std_CodeS) Desc('Bold')
Define #Sty_Under RefFld(#Std_CodeS) Desc('Underlined')
Define #Sty_Ital RefFld(#Std_CodeS) Desc('Italic')
Define #Sty_Blink RefFld(#Std_CodeS) Desc('Blinking')
Define #Sty_Strik RefFld(#Std_CodeS) Desc('Strike Out')
Group_By #XG_StyGrp Fields(#Sty_Name #Sty_Size #Sty_Face #Sty_Color #Sty_Bold #Sty_Under #Sty_Blink #Sty_Ital #Sty_Strik #Sty_BCol #Sty_Align )
* Temporary working list used for the serialization of generated HTML.
* Output of HTML is unlimited. This list is ised as a buffer of 200 lines.
Define #HTMLCount RefFld(#Std_Num)
Define #HTMLLine Reffld(#Sysvar$av)
Def_List #HTMLLines (#HTMLLine) Type(*Working) Entrys(200) Counter(#HTMLCount)
Define #OutFilNam *Char 100
* Miscellaneous Definitions
Define #BRetCode *char 2
Def_Cond *RetOkay '#BRetCode = ok'
Def_Cond *RetNOkay '#BRetCode *ne ok'
Define #SRetCode RefFld(#Std_Num)
Define #HTMLWork RefFld(#SysVar$Av)
Define #HTMLTemp RefFld(#SysVar$Av)
Define #Work00 *dec 21 0
Define #Work01 *dec 21 1
Define #Work02 *dec 21 2
Define #Work03 *dec 21 3
Define #Work04 *dec 21 4
Define #Work05 *dec 21 5
Define #Work06 *dec 21 6
Define #Work07 *dec 21 7
Define #Work08 *dec 21 8
Define #Work09 *dec 21 9
Define #Atr_Temp *Char 31
* ================================================================================
SubRoutine CrtUSpace ((#RetSpace *Returned))
Define #RetSpace RefFld(#Tab_Space)
Define #TempChar *Char 10
Define #TempNum RefFld(#Date) Length(10) Decimals(0) edit_code(4) default(0) To_Overlay(#TempChar)
* Loop around until a unique non-existent space name can be found
Begin_Loop Using(#TempNum)
Use TConcat (*Component '.' #TempChar) (#RetSpace)
Use Space_Operation (#RetSpace CheckExistence) (#BRetCode)
Leave *RetNOkay
End_Loop
* Create the uniquely named space and return the name used to the caller
Use Create_Space (#RetSpace)
EndRoutine
* ================================================================================
SubRoutine Open
* Create the basic, extended and ordered table definition storage spaces
If *NoTSpace
Execute CrtUSpace (#Tab_Space)
Use Define_Space_Cell (#Tab_Space Tab_Name 'Key NoCase')
Use Define_Space_Cell (#Tab_Space Tab_Seqn)
Use Define_Space_Cell (#Tab_Space Tab_Title)
Use Define_Space_Cell (#Tab_Space Tab_RMax)
Use Define_Space_Cell (#Tab_Space Tab_ALIGN)
Use Define_Space_Cell (#Tab_Space Tab_BORD)
Use Define_Space_Cell (#Tab_Space Tab_BCOL)
Use Define_Space_Cell (#Tab_Space Tab_WIDTH)
Use Define_Space_Cell (#Tab_Space Tab_CHDG)
Use Define_Space_Cell (#Tab_Space Tab_TStyl)
Use Define_Space_Cell (#Tab_Space Tab_CStyl)
Use Define_Space_Cell (#Tab_Space Tab_HStyl)
Use Define_Space_Cell (#Tab_Space Tab_FRAME)
Use Define_Space_Cell (#Tab_Space Tab_RULES)
Use Define_Space_Cell (#Tab_Space Tab_PAD)
Use Define_Space_Cell (#Tab_Space Tab_SPACB)
Use Define_Space_Cell (#Tab_Space Tab_RULEB)
Use Define_Space_Cell (#Tab_Space Tab_SPACA)
Use Define_Space_Cell (#Tab_Space Tab_RULEA)
Execute CrtUSpace (#Tax_Space)
Use Define_Space_Cell (#Tax_Space Tab_Name 'Key NoCase')
Use Define_Space_Cell (#Tax_Space Tab_SubT)
Execute CrtUSpace (#Tab_Order)
Use Define_Space_Cell (#Tab_Order Tab_Seqn Key)
Use Define_Space_Cell (#Tab_Order Tab_Name Key)
Endif
* Create the basic and ordered cell definition storage spaces
If *NoCSpace
Execute CrtUSpace (#Cel_Space)
Use Define_Space_Cell (#Cel_Space Cel_Table 'Key NoCase')
Use Define_Space_Cell (#Cel_Space Cel_Name 'Key NoCase')
Use Define_Space_Cell (#Cel_Space Cel_Seqn)
Use Define_Space_Cell (#Cel_Space Cel_CH1)
Use Define_Space_Cell (#Cel_Space Cel_CH2)
Use Define_Space_Cell (#Cel_Space Cel_CH3)
Use Define_Space_Cell (#Cel_Space Cel_CStyl)
Use Define_Space_Cell (#Cel_Space Cel_HStyl)
Use Define_Space_Cell (#Cel_Space Cel_WIDTH)
Execute CrtUSpace (#Cel_Order)
Use Define_Space_Cell (#Cel_Order Cel_Table 'Key NoCase')
Use Define_Space_Cell (#Cel_Order Cel_Seqn Key)
Use Define_Space_Cell (#Cel_Order Cel_Name 'Key NoCase')
Endif
* Create the cell Values storage space
If *NoVSpace
Execute CrtUSpace (#Val_Space)
Use Define_Space_Cell (#Val_Space Val_Table 'Key NoCase')
Use Define_Space_Cell (#Val_Space Val_Name 'Key NoCase')
Use Define_Space_Cell (#Val_Space Val_Row Key)
Use Define_Space_Cell (#Val_Space Val_Type)
Use Define_Space_Cell (#Val_Space Val_AVal )
Use Define_Space_Cell (#Val_Space Val_NVal )
Use Define_Space_Cell (#Val_Space Val_DecP)
Use Define_Space_Cell (#Val_Space Val_CStyl)
Use Define_Space_Cell (#Val_Space Val_HRef)
Use Define_Space_Cell (#Val_Space Val_Image)
Endif
* Create the attributes definition storage space
If *NoASpace
Execute CrtUSpace (#Atr_Space)
Use Define_Space_Cell (#Atr_Space Atr_Ident Key)
Use Define_Space_Cell (#Atr_Space Atr_Name)
Use Define_Space_Cell (#Atr_Space Atr_Type)
Use Define_Space_Cell (#Atr_Space Atr_AVal)
Use Define_Space_Cell (#Atr_Space Atr_NVal)
Endif
* Create the style definition storage space
If *NoSSpace
Execute CrtUSpace (#Sty_Space)
Use Define_Space_Cell (#Sty_Space Sty_Name 'Key NoCase')
Use Define_Space_Cell (#Sty_Space Sty_Size)
Use Define_Space_Cell (#Sty_Space Sty_Face)
Use Define_Space_Cell (#Sty_Space Sty_Color)
Use Define_Space_Cell (#Sty_Space Sty_Bold)
Use Define_Space_Cell (#Sty_Space Sty_Under)
Use Define_Space_Cell (#Sty_Space Sty_Blink)
Use Define_Space_Cell (#Sty_Space Sty_Ital)
Use Define_Space_Cell (#Sty_Space Sty_Strik)
Use Define_Space_Cell (#Sty_Space Sty_BCol)
Use Define_Space_Cell (#Sty_Space Sty_Align)
Endif
* Finished
EndRoutine
* ================================================================================
MthRoutine Close
* Destory all existing definition and data storage spaces
If *TSpace
Use Destroy_Space (#Tab_Space)
Use Destroy_Space (#Tax_Space)
Use Destroy_Space (#Tab_Order)
Change (#Tab_Space #Tab_Order #Tax_Space) *Null
Endif
If *CSpace
Use Destroy_Space (#Cel_Space)
Use Destroy_Space (#Cel_Order)
Change (#Cel_Space #Cel_Order) *Null
Endif
If *VSpace
Use Destroy_Space (#Val_Space)
Change #Val_Space *Null
Endif
If *ASpace
Use Destroy_Space (#Atr_Space)
Change #Atr_Space *Null
Endif
If *SSpace
Use Destroy_Space (#Sty_Space)
Change (#Sty_Space #NextAID) *Null
Endif
* (Re)Initialize this component as it it were just being created
Execute Initialize
EndRoutine
* ================================================================================
EvtRoutine Handling(#Com_Owner.CreateInstance)
* Handle creation of an instance of this component
Execute Initialize
EndRoutine
* ================================================================================
SubRoutine Initialize
* Genrically initialize this component definition
Set #Com_Owner Style(DEFAULT)
Set #Com_Owner Title(' ')
Invoke #Com_Owner.DefineStyle Named(DEFAULT) Size(2) Color('Blue') Face('Arial')
EndRoutine
* ================================================================================
MthRoutine Save
* Seralize the component definitions as HTML into the specified file
Define_Map *input #SysVar$AV #InFile Desc('Name of file that HTML is to be saved in')
* Set up the output file name
Change #OutFilNam #InFile.Value
* Perform any opening logic
Execute Open
* Clear the HTML lines buffer
Clr_List #HTMLLines
* Now generate the HTML
Execute InsertHTML ('<HTML>' Y)
Execute InsertHTML ('<HEAD>' Y)
If '#Use_Title.Value *ne *blanks'
Execute InsertHTML ('<TITLE>' N)
Execute InsertHTML (#Use_Title.Value N)
Execute InsertHTML ('</TITLE>' N)
Endif
Execute InsertHTML ('</HEAD>' Y)
Change #HTMLWork '<BODY'
Execute InsertBGA (#Use_Style #HTMLWork Y N)
Use BConcat (#HTMLWork '>') (#HTMLWork)
Execute InsertHTML (#HTMLWork Y)
Execute StartStyle (#Use_Style.Value)
* Now generate all the tables
Use Select_In_Space (#Tab_Order) (#BRetCode #Tab_Seqn #Tab_Name)
DoWhile *RetOkay
* Get the Full table details
Use Fetch_In_Space (#Tab_Space #Tab_Name) (#bRetCode #XG_TabGrp)
Use Fetch_In_Space (#Tax_Space #Tab_Name) (#bRetCode #XG_TaxGrp)
* Only process this table if it is not flagged as a sub table
If '#Tab_SubT = N'
Invoke #Com_Owner.OutputTable Named(#Tab_Name)
Endif
* Move on to next table definition
Use SelectNext_In_Space (#Tab_Order) (#BRetCode #Tab_Seqn #Tab_Name)
EndWhile
* Finish up the HTML
Execute EndStyle (#Use_Style.Value)
Execute InsertHTML ('</BODY>' Y)
Execute InsertHTML ('</HTML>' Y)
* Save the last final list buffer of HTML to disk and close output file
Use Transform_List (#HTMLLines #OutFilNam C I T '.' Y) (#BRetCode)
* Finished
EndRoutine
* ================================================================================
MthRoutine OutputTable
* Serialize the named table definition as HTML
* NOTE: This routine may be used recursively
Define_Map *Input #Std_Texts #Named
Define #TempStyle RefFld(#Std_TextS)
Define #Cur_Row RefFld(#Std_Num) length(*RefFld *Plus 1)
DEFINE_COM CLASS(#STD_TEXTS) NAME(#STAB_NAME)
DEFINE_COM CLASS(#STD_NUM) NAME(#STAB_SEQN)
DEFINE_COM CLASS(#STD_TEXTS) NAME(#SCEL_TABLE)
DEFINE_COM CLASS(#STD_TEXTS) NAME(#SCEL_NAME)
DEFINE_COM CLASS(#STD_NUM) NAME(#SCEL_SEQN)
DEFINE_COM CLASS(#STD_TEXTS) NAME(#SVAL_TABLE)
DEFINE_COM CLASS(#STD_TEXTS) NAME(#SVAL_NAME)
DEFINE_COM CLASS(#STD_NUM) NAME(#SVAL_ROW)
DEFINE_COM CLASS(#STD_NUM) NAME(#SCUR_ROW)
DEFINE_COM CLASS(#STD_TEXTS) NAME(#STEMPSTYLE)
* Get the definition details of the table to be serialized
Change #Tab_Name #Named.Value
Use Fetch_In_Space (#Tab_Space #Tab_Name) (#BRetCode #XG_TabGrp)
Use Fetch_In_Space (#Tax_Space #Tab_Name) (#BRetCode #XG_TaxGrp)
if *RetNOkay
Return
Endif
* Put out any leading space and rule details
Begin_Loop from(1) to(#Tab_RULEB)
Execute InsertHTML ('<HR>' N)
End_Loop
Begin_Loop from(1) to(#Tab_SPACB)
Execute InsertHTML ('<BR>' N)
End_Loop
* Build the table start
Change #HTMLWork '<TABLE'
Execute Attrib (#Tab_BORD #HTMLWork)
Execute Attrib (#Tab_ALIGN #HTMLWork)
Execute Attrib (#Tab_WIDTH #HTMLWork)
Execute Attrib (#Tab_BCOL #HTMLWork)
Execute Attrib (#Tab_FRAME #HTMLWork)
Execute Attrib (#Tab_RULES #HTMLWork)
Execute Attrib (#Tab_PAD #HTMLWork)
Execute InsertBGA (#Tab_TStyl #HTMLWork Y N)
Use TConcat (#HTMLWork '>') (#HTMLWork)
Execute InsertHTML (#HTMLWork Y)
If '#Tab_Title *ne *blanks'
Execute InsertHTML ('<CAPTION>' N)
Execute StartStyle (#Tab_TStyl)
Execute InsertHTML (#Tab_Title N)
Execute EndStyle (#Tab_TStyl)
Execute InsertHTML ('</CAPTION>' N)
Endif
* Do the <TH> headers if any cell definition has column headings
If '#Tab_CHDG = Y'
Execute InsertHTML ('<THEAD>' Y)
Change #HTMLWork '<TR'
Execute InsertBGA (#Tab_HStyl #HTMLWork Y Y)
Use BConcat (#HTMLWork '>' ) (#HTMLWork)
Execute InsertHTML (#HTMLWork N)
Use Select_In_Space (#Cel_Order #Tab_Name) (#BRetCode #Cel_Table #Cel_Seqn #Cel_Name)
DoWhile *RetOkay
* Get the cell definition
Use Fetch_In_Space (#Cel_Space #Tab_Name #Cel_Name) (#BRetCode #XG_CelGrp)
If_Null #Cel_HStyl
Change #TempStyle #Tab_HStyl
Else
Change #TempStyle #Cel_HStyl
Endif
* Start the header
Change #HTMLWork '<TH'
Execute Attrib (#Cel_Width #HTMLWork)
Execute InsertBGA (#TempStyle #HTMLWork Y Y)
Use BConcat (#HTMLWork '>' ) (#HTMLWork)
Execute InsertHTML (#HTMLWork N)
* Insert the column Headings
Execute StartStyle (#TempStyle)
Change #HTMLWork #Cel_CH1
If '(#Cel_CH2 *Ne *Blanks) or (#Cel_CH3 *ne *Blanks)'
Use TConcat (#HTMLWork '<BR>' #Cel_CH2) (#HTMLWork)
If '#Cel_CH3 *ne *Blanks'
Use TConcat (#HTMLWork '<BR>' #Cel_CH3) (#HTMLWork)
Endif
Endif
Execute InsertHTML (#HTMLWork N)
Execute EndStyle (#TempStyle)
* End the header
Execute InsertHTML ('</TH>' N)
Use SelectNext_In_Space (#Cel_Order #Tab_Name) (#BRetCode #Cel_Table #Cel_Seqn #Cel_Name)
EndWhile
Execute InsertHTML ('</TR>' N)
Execute InsertHTML ('</THEAD>' Y)
Endif
* Start the table body
Execute InsertHTML ('<TBODY>' Y)
* Do the <TD> Rows
Begin_Loop from(1) to(#Tab_RMax) Using(#Cur_Row)
Execute InsertHTML ('<TR>' N)
* For each cell ( in sequence number order)
Use Select_In_Space (#Cel_Order #Tab_Name) (#BRetCode #Cel_Table #Cel_Seqn #Cel_Name)
DoWhile *RetOkay
* Get the cell definition
Use Fetch_In_Space (#Cel_Space #Tab_Name #Cel_Name) (#BRetCode #XG_CelGrp)
* Get the cell value in this row
Use Fetch_In_Space (#Val_Space #Tab_Name #Cel_Name #Cur_Row) (#BRetCode #XG_ValGrp)
* If value not found, create a default one
If *RetNOkay
Change #Val_Table #Tab_Name
Change #Val_Name #Cel_Name
Change #Val_Row #Cur_Row
Change #Val_Type A
Change (#Val_AVal #Val_NVal #Val_DecP #Val_HRef #Val_Image #Val_CStyl) *Null
Endif
* Now output the values as required
If_Null #Val_CStyl
If_Null #Cel_CStyl
Change #TempStyle #Tab_CStyl
Else
Change #TempStyle #Cel_CStyl
Endif
Else
Change #TempStyle #Val_CStyl
Endif
* Start the data cell with a <TD>
Change #HTMLWork '<TD'
Execute Attrib (#Cel_Width #HTMLWork)
Execute InsertBGA (#TempStyle #HTMLWork Y Y)
Use BConcat (#HTMLWork '>' ) (#HTMLWork)
Execute InsertHTML (#HTMLWork N)
* Insert any style details
Execute StartStyle (#TempStyle)
* Insert any HREF
If '#Val_HRef *ne 0'
Change #HTMLWork '<A'
Execute Attrib (#Val_HRef #HTMLWork)
Use TConcat (#HTMLWork '>') (#HTMLWork)
Execute InsertHTML ( #HTMLWork N)
Endif
* Insert any IMG
If '#Val_Image *ne 0'
Change #HTMLWork '<IMG'
Execute Attrib (#Val_Image #HTMLWork)
Use BConcat (#HTMLWork 'ALT="" ALIGN="left">') (#HTMLWork)
Execute InsertHTML (#HTMLWork N)
Endif
* Insert the cell value itself
Case #Val_Type
* Handle an ALPHA cell
When '= A'
Execute InsertHTML (#Val_AVal N)
* Handle an NUMERIC cell
When '= N'
Case #Val_DecP
When '= 0'
Change #Work00 #Val_NVal
use Numeric_String (#Work00) (#Atr_Temp)
When '= 1'
Change #Work01 #Val_NVal
use Numeric_String (#Work01) (#Atr_Temp)
When '= 2'
Change #Work02 #Val_NVal
use Numeric_String (#Work02) (#Atr_Temp)
When '= 3'
Change #Work03 #Val_NVal
use Numeric_String (#Work03) (#Atr_Temp)
When '= 4'
Change #Work04 #Val_NVal
use Numeric_String (#Work04) (#Atr_Temp)
When '= 5'
Change #Work05 #Val_NVal
use Numeric_String (#Work05) (#Atr_Temp)
When '= 6'
Change #Work06 #Val_NVal
use Numeric_String (#Work06) (#Atr_Temp)
When '= 7'
Change #Work07 #Val_NVal
use Numeric_String (#Work07) (#Atr_Temp)
When '= 8'
Change #Work08 #Val_NVal
use Numeric_String (#Work08) (#Atr_Temp)
Otherwise
Change #Work09 #Val_NVal
use Numeric_String (#Work09) (#Atr_Temp)
EndCase
Execute InsertHTML (#Atr_Temp N)
* Handle an TABLE cell (ie: a table within a table)
When '= T'
* Stack the current Values
Set #STab_Name Value(#Tab_Name)
Set #STab_Seqn Value(#Tab_Seqn)
Set #SCel_Table Value(#Cel_Table)
Set #SCel_Seqn Value(#Cel_Seqn)
Set #SCel_Name Value(#Cel_Name)
Set #SVal_Table Value(#Val_Table)
Set #SVal_Name Value(#Val_Name)
Set #SVal_Row Value(#Val_Row)
Set #SCur_Row Value(#Cur_Row)
Set #STempStyle Value(#TempStyle)
* Recursively invoke this routine
Invoke #Com_Owner.OutputTable Named(#Val_AVal )
* Unstack the values and reset the space positions
Change #Tab_Name #STab_Name.Value
Change #Tab_Seqn #STab_Seqn.Value
Change #Cel_Table #SCel_Table.Value
Change #Cel_Seqn #SCel_Seqn.Value
Change #Cel_Name #SCel_Name.Value
Change #Val_Table #SVal_Table.Value
Change #Val_Name #SVal_Name.Value
Change #Val_Row #SVal_Row.Value
Change #Cur_Row #SCur_Row.Value
Change #TempStyle #STempStyle.Value
Use Fetch_In_Space (#Tab_Space #Tab_Name) (#BRetCode #XG_TabGrp)
Use Fetch_In_Space (#Tax_Space #Tab_Name) (#BRetCode #XG_TaxGrp)
Use Fetch_In_Space (#Cel_Order #Cel_Table #Cel_Seqn #Cel_Name) (#BRetCode #Cel_Table #Cel_Seqn #Cel_Name)
Use Fetch_In_Space (#Cel_Space #Cel_Table #Cel_Name) (#BRetCode #XG_CelGrp)
Use Fetch_In_Space (#Val_Space #Val_Table #Val_Name #Cur_Row) (#BRetCode #XG_ValGrp)
EndCase
* End off any HREF
If '#Val_HRef *ne 0'
Execute InsertHTML ('</A>' N)
Endif
* End off the style
Execute EndStyle (#TempStyle)
* End the data cell
Execute InsertHTML ('</TD>' N)
* Move on to the next cell definition (in sequence order)
Use SelectNext_In_Space (#Cel_Order #Tab_Name) (#BRetCode #Cel_Table #Cel_Seqn #Cel_Name)
EndWhile
Execute InsertHTML ('</TR>' N)
End_loop
* The Table Body is finished
Execute InsertHTML ('</TBODY>' Y)
* The Table is finished
Execute InsertHTML ('</TABLE>' Y)
* Put out trailing spaces and rules
Begin_Loop from(1) to(#Tab_RULEA)
Execute InsertHTML ('<HR>' N)
End_Loop
Begin_Loop from(1) to(#Tab_SPACA)
Execute InsertHTML ('<BR>' N)
End_Loop
* Finished
EndRoutine
* ================================================================================
MthRoutine Show
* Show the specified file via the standard Windows shell interface for the file type
Define_Map *input #SysVar$AV #InFile Desc('Name of file that HTML is to be saved in')
Use System_Command (H #InFile.Value) (#SRetCode)
If '#SRetCode *Ne 0'
Use Message_Box_Show with_args(ok ok error *component 'Attempt to show output file failed.')
Endif
EndRoutine
* ================================================================================
SubRoutine InsertHTML ((#xxLine *Received)(#xxFLush *Received))
* Insert a line of HTML into the buffer list
Define #xxLine RefFld(#SysVar$Av)
Define #xxFlush RefFld(#Std_CodeS)
Define #OutBuffer RefFld(#SysVar$Av)
Define #TmpBuffer RefFld(#SysVar$av)
Define #OutLength RefFld(#Std_Num)
* If the output list is full, flush it to disk but keep the output file open
* Note the 199 limit. This is because following code may add 2 lines the list.
If '#HTMLCount >= 199'
Use Transform_List (#HTMLLines #OutFilNam C I T '.' N) (#BRetCode)
Clr_List #HTMLLines
Endif
* Handle a forced flush request
If '#xxFlush *eq Y'
If '#OutBuffer *ne *blanks'
Change #HTMLLine #OutBuffer
Add_Entry #HTMLLines
Change #OutBuffer *Null
Endif
Change #HTMLLine #xxLine
Add_Entry #HTMLLines
Else
* See if this stuff will fit in the buffer and act accordingly
Use TConcat (#OutBuffer #xxLine) (#TmpBuffer #OutLength)
If '#OutLength >= 250'
Change #HTMLLine #OutBuffer
Add_Entry #HTMLLines
Change #OutBuffer #xxLine
Else
Change #OutBuffer #TmpBuffer
Endif
Endif
EndRoutine
* ================================================================================
SubRoutine StorAttrib ((#Atr_Ident *Returned)(#Atr_Name *Received)(#Atr_Type *Received)(#Atr_AVal *Received)(#Atr_NVal *Received) )
* Assign a unique identifier to an attribute and store its details in the storage space
Change #NextAID '#NextAID + 1'
Change #Atr_Ident #NextAID
Use Insert_In_Space (#Atr_Space #XG_AtrGrp)
EndRoutine
* ================================================================================
SubRoutine Attrib ((#UseAID *Received)(#HTMLOut *Both))
* Get details of an attribute (where the caller supplies its unqiue identifer)
* If found and if not a default/non-existent value, assemble it into its HTML
* form and then concatenate this reuslt onto the end of the string specified
* in parameter 2.
Define #UseAID RefFld(#Std_Num)
Define #HTMLOut RefFld(#SysVar$Av)
* Get details
Use Fetch_In_Space (#Atr_Space #UseAID) (#BRetCode #XG_AtrGrp)
* Handle not found
if *RetNOkay
Return
Endif
* Handle default value according to attribute type
Case #Atr_Type
When '= S'
If_Null #Atr_AVal
Return
Endif
When ('= N' '= P')
If '#Atr_NVal = -999999'
Return
Endif
EndCase
* Add HTML attribute name to end of supplied string
Use BConcat (#HTMLOut #Atr_Name) (#HTMLOut)
Use TConcat (#HTMLOut '=') (#HTMLOut)
* Add HTML value to the end of the supplied string.
* Note that S = quoted string, N = quoted number, P = quoted percentage
* Note that only integral numeric values are handled as #Atr_NVAL is based on #STD_NUM
Case #Atr_Type
When '= S'
Use TConcat (#HTMLOut '"' #Atr_AVal '"') (#HTMLOut)
When '= N'
Use Numeric_String (#Atr_NVal) (#Atr_Temp)
Use TConcat (#HTMLOut '"' #Atr_Temp '"') (#HTMLOut)
When '= P'
Use Numeric_String (#Atr_NVal) (#Atr_Temp)
Use TConcat (#HTMLOut '"' #Atr_Temp '%"') (#HTMLOut)
EndCase
EndRoutine
* ================================================================================
Subroutine InsertBGA ((#Sty_Name *Received)(#xxLine *Both)(#RetBG *Received)(#RetAlign *Received) )
* This routine is just a specialized version of prveious routine Attrib
* that simplifies the constant serialization of background and aligment
* attributes
Define #RetBG RefFld(#Std_CodeS)
Define #RetAlign RefFld(#Std_CodeS)
If_Null #Sty_Name
Return
Endif
Use Fetch_In_Space (#Sty_Space #Sty_Name) (#BRetCode #XG_StyGrp)
if *RetNOkay
Return
Endif
If '#RetBG = Y'
Execute Attrib (#Sty_BCol #xxLine)
Endif
If '#RetAlign = Y'
Execute Attrib (#Sty_Align #xxLine)
Endif
EndRoutine
* ================================================================================
Subroutine StartStyle ((#Sty_Name *Received))
* Start the serialization of a specified style into HTML form
* Handle non existent name
If_Null #Sty_Name
Return
Endif
* Get the style definition
Use Fetch_In_Space (#Sty_Space #Sty_Name) (#BRetCode #XG_StyGrp)
* Handle not found
if *RetNOkay
Return
Endif
* Insert the font details
Change #HTMLWork '<FONT'
Execute Attrib (#Sty_Size #HTMLWork)
Execute Attrib (#Sty_Face #HTMLWork)
Execute Attrib (#Sty_Color #HTMLWork)
Use TConcat (#HTMLWork '>') (#HTMLWork)
Execute InsertHTML (#HTMLWork N)
* Insert other formatting details
If '#Sty_Bold = T'
Execute InsertHTML ('<B>' N)
Endif
If '#Sty_Under = T'
Execute InsertHTML ('<U>' N)
Endif
If '#Sty_Blink = T'
Execute InsertHTML ('<BLINK>' N)
Endif
If '#Sty_Ital = T'
Execute InsertHTML ('<I>' N)
Endif
If '#Sty_Strik = T'
Execute InsertHTML ('<S>' N)
Endif
* Finished
EndRoutine
* ================================================================================
SubRoutine EndStyle ((#Sty_Name *Received))
* End the serialization of a specified style into HTML form
If_Null #Sty_Name
Return
Endif
* Handle non existent name
Use Fetch_In_Space (#Sty_Space #Sty_Name) (#BRetCode #XG_StyGrp)
* Handle not found
if *RetNOkay
Return
Endif
* Close any formatiing blcoks that are part of this style (see subroutine StartStyle)
If '#Sty_Strik = T'
Execute InsertHTML ('</S>' N)
Endif
If '#Sty_Ital = T'
Execute InsertHTML ('</I>' N)
Endif
If '#Sty_Blink = T'
Execute InsertHTML ('</BLINK>' N)
Endif
If '#Sty_Under = T'
Execute InsertHTML ('</U>' N)
Endif
If '#Sty_Bold = T'
Execute InsertHTML ('</B>' N)
Endif
* Close off the font
Execute InsertHTML ('</FONT>' N)
* Finished
EndRoutine
* ================================================================================
* ====================
* Method : DefineTable
* ====================
* WithName : Symbolic name of the table
* Order : Presentation order of table relative to other tables
* WithTitle : Title of Table
* TitleStyle : Name of style to be used for title
* Align : Alignment option for table. Use center, left or right.
* Border : Border thickness in pixels. Zero means no border.
* PctWidth : Percentage width of table as a percentage of the display window. range 0 -> 100.
* CellStyle : Default style to use for table cells.
* HdgStyle : Default style to use for Column headings.
* BorderCol : Border color
* Frame : Specifies which sides of the framing border should be drawn. Use above, below, box, hsides, lhs, rhs, void or vsides. Equates to HTML attribute FRAME=
* Rules : Specifies which cell dividing lines should be drawn within the table. Use all, cols, groups, none or rows. Equates to HTML attribute RULES=.
* CellPad : Specifies the space (in pixels) to leave around the edges of each cell.
* SpaceBef : Number of spaces (<BR>) to generate before the table
* RuleBef : Number of horizontal rules (<HR>) to generate before the table
* SpaceAft : Number of spaces (<BR>) to generate after the table
* RuleAft : Number of horizontal rules (<HR>) to generate after the table
MthRoutine DefineTable
* Store details of a table
Define_Map *Input #Std_Texts #WithName
Define_Map *Input #Std_Num #Order
Define_Map *Input #SysVar$Av #WithTitle Mandatory(' ')
Define_Map *Input #Std_Texts #TitleStyle Mandatory('DEFAULT')
Define_Map *Input #Std_Texts #Align Mandatory(' ')
Define_Map *Input #Std_Num #Border Mandatory(-999999)
Define_Map *Input #Std_Num #PctWidth Mandatory(-999999)
Define_Map *Input #Std_Texts #CellStyle Mandatory('DEFAULT')
Define_Map *Input #Std_Texts #HdgStyle Mandatory('DEFAULT')
Define_Map *Input #Std_Texts #BorderCol Mandatory('blue')
Define_Map *Input #Std_Texts #Frame Mandatory('box')
Define_Map *Input #Std_Texts #Rules Mandatory('all')
Define_Map *Input #Std_Num #CellPad Mandatory(1)
Define_Map *Input #Std_Num #SpaceBef Mandatory(0)
Define_Map *Input #Std_Num #RuleBef Mandatory(0)
Define_Map *Input #Std_Num #SpaceAft Mandatory(0)
Define_Map *Input #Std_Num #RuleAft Mandatory(0)
* Open up required resources
Execute Open
* Map values into table space storage areas
Change #Tab_Name #WithName.Value
Change #Tab_Seqn #Order.Value
Change #Tab_Title #WithTitle.Value
Change #Tab_RMax 0
Change #Tab_CHDG N
Change #Tab_SubT N
Change #Tab_TStyl #TitleStyle.Value
Change #Tab_CStyl #CellStyle.Value
Change #Tab_HStyl #HdgStyle.Value
Change #Tab_SPACB #SpaceBef.Value
Change #Tab_RULEB #RuleBef.Value
Change #Tab_SPACA #SpaceAft.Value
Change #Tab_RULEA #RuleAft.Value
* Convert and store attributes
Execute StorAttrib (#Tab_ALIGN ALIGN S #Align.Value 0)
Execute StorAttrib (#Tab_BORD BORDER N ' ' #Border.Value)
Execute StorAttrib (#Tab_WIDTH WIDTH P ' ' #PctWidth.Value)
Execute StorAttrib (#Tab_BCOL BORDERCOLOR S #BorderCol.Value 0)
Execute StorAttrib (#Tab_FRAME FRAME S #Frame.Value 0)
Execute StorAttrib (#Tab_RULES RULES S #Rules.Value 0)
Execute StorAttrib (#Tab_PAD CELLPADDING N ' ' #CellPad.Value)
* Store table definition details (basic, extended and in order)
Use Insert_In_Space (#Tab_Space #XG_TabGrp)
Use Insert_In_Space (#Tax_Space #XG_TaxGrp)
Use Insert_In_Space (#Tab_Order #Tab_Seqn #Tab_Name)
EndRoutine
* ========================
* Method : DefineTableCell
* ========================
* InTable : Symbolic name of the table. Must have been previously defined with DefineTable.
* WithName : Symbolic name of the table cell.
* Order : Presentation order of the cell relative to other cells in the same table.
* ColHdg1 : Cell column heading 1
* ColHdg2 : Cell column heading 2
* ColHdg3 : Cell column heading 3
* CellStyle : Default style to use for table cells.
* HdgStyle : Default style to use for Column headings.
* PctWidth : Percentage width of the cell as a percentage of table width. Range 0 -> 100.
MthRoutine DefineTableCell
* Store details of a cell
Define_Map *Input #Std_Texts #InTable
Define_Map *Input #Std_Texts #WithName
Define_Map *Input #Std_Num #Order
Define_Map *Input #Std_TextL #ColHdg1 Mandatory(' ')
Define_Map *Input #Std_TextL #ColHdg2 Mandatory(' ')
Define_Map *Input #Std_TextL #ColHdg3 Mandatory(' ')
Define_Map *Input #Std_Texts #CellStyle Mandatory(' ')
Define_Map *Input #Std_Texts #HdgStyle Mandatory(' ')
Define_Map *Input #Std_Num #PctWidth Mandatory(-999999)
* Open up required resources
Execute Open
* Map values into table space storage areas
Change #Cel_Table #InTable.Value
Change #Cel_Name #WithName.Value
Change #Cel_Seqn #Order.Value
Change #Cel_CH1 #ColHdg1.Value
Change #Cel_CH2 #ColHdg2.Value
Change #Cel_CH3 #ColHdg3.Value
Change #Cel_CStyl #CellStyle.Value
Change #Cel_HStyl #HdgStyle.Value
* Convert and store attributes
Execute StorAttrib (#Cel_WIDTH WIDTH P ' ' #PctWidth.Value)
* Store details (Basic and in order)
Use Insert_In_Space (#Cel_Space #XG_CelGrp)
Use Insert_In_Space (#Cel_Order #Cel_Table #Cel_Seqn #Cel_Name)
* Fetch the table header details and update column heading existence flag
Use Fetch_In_Space (#Tab_Space #Cel_Table) (#bRetCode #XG_TabGrp)
Use Fetch_In_Space (#Tax_Space #Cel_Table) (#bRetCode #XG_TaxGrp)
if *RetNOkay
Abort 'Referenced table does not exist. Define the table before referencing it.'
Endif
If '(#Cel_CH1 *ne *blanks) or (#Cel_CH2 *ne *blanks) or (#Cel_CH3 *ne *blanks)'
Change #Tab_CHDG Y
Endif
Use Update_In_Space (#Tab_Space #XG_TabGrp)
Use Update_In_Space (#Tax_Space #XG_TaxGrp)
* Finished
EndRoutine
* ================================================================================
* =====================
* Method : SetTableCell
* =====================
* InTable : Symbolic name of the table. Must have been previously defined with DefineTable.
* WithName : Symbolic name of the table cell.
* RowNum : Row number of this cell within the table.
* Type : Cell content type. Must be alpha, numeric or table.
* AlphaValue : Alphanumeric value to be placed into the cell.
* NumValue : Numeric value to be placed into the cell (note 15,5 maximum).
* Decimals : Number of decimals to use when displaying. Range 0 -> 9.
* CellStyle : Cell style to be used.
* HRef : Hyperlink reference to be associated with cell contents.
* Image : Image to be associated with cell contents.
MthRoutine SetTableCell
* Store details of a specific table cell value
Define_Map *Input #Std_Texts #InTable
Define_Map *Input #Std_Texts #WithName
Define_Map *Input #Std_Num #RowNum
Define_Map *Input #Std_Texts #Type Mandatory(ALPHA)
Define_Map *Input #SysVar$av #AlphaValue Mandatory(' ')
Define_Map *Input #Std_NumL #NumValue Mandatory(0.0)
Define_Map *Input #Std_Num #Decimals Mandatory(0)
Define_Map *Input #Std_Texts #CellStyle Mandatory(' ')
Define_Map *Input #SysVar$Av #HRef Mandatory(' ')
Define_Map *Input #SysVar$Av #Image Mandatory(' ')
* Perform opening logic if not already done
Execute Open
* Map the cell values
Change #Val_Table #InTable.Value
Change #Val_Name #WithName.Value
Change #Val_Row #RowNum.Value
* Check out the type
Use UpperCase (#Type) (#Std_Texts)
Case #Std_Texts
When '= alpha'
Change #Val_Type A
When '= numeric'
Change #Val_Type N
When '= table'
Change #Val_Type T
OtherWise
Abort 'Invalid valid specified for Type argument in SetTableCell method'
EndCase
* Map some more values
Change #Val_CStyl #CellStyle.Value
Change #Val_AVal #AlphaValue.Value
Change #Val_NVal #NumValue.Value
Change #Val_DecP #Decimals.Value
* Store HREF and Image values (if present)
If '#HRef.Value = *Blanks'
Change #Val_HRef 0
Else
Execute StorAttrib (#Val_HRef HREF S #HRef.Value 0)
Endif
If '#Image.Value = *Blanks'
Change #Val_Image 0
Else
Execute StorAttrib (#Val_Image SRC S #Image.Value 0)
Endif
* Update or create the cell
Use Update_In_Space (#Val_Space #XG_ValGrp) (#BRetCode)
if *RetNOkay
Use Insert_In_Space (#Val_Space #XG_ValGrp)
Endif
* Update the header details with the highest row number encountered so far
Change #Tab_RMax *Hival
Use Fetch_In_Space (#Tab_Space #Val_Table) (#bRetCode #XG_TabGrp)
Use Fetch_In_Space (#Tax_Space #Val_Table) (#bRetCode #XG_TaxGrp)
If '#Val_Row > #Tab_RMax'
Change #Tab_RMax #Val_Row
Use Update_In_Space (#Tab_Space #XG_TabGrp)
Use Update_In_Space (#Tax_Space #XG_TaxGrp)
Endif
* If the reference is to a table locate the table and update it's
* special Tab_SubT flag to indicate that it is a sub table
If '#Val_Type = T'
Use Fetch_In_Space (#Tab_Space #Val_AVal) (#bRetCode #XG_TabGrp)
Use Fetch_In_Space (#Tax_Space #Val_AVal) (#bRetCode #XG_TaxGrp)
if *RetNOkay
Abort 'Referenced table does not exist. Define the table before referencing it.'
Endif
Change #Tab_SubT Y
Use Update_In_Space (#Tab_Space #XG_TabGrp)
Use Update_In_Space (#Tax_Space #XG_TaxGrp)
Endif
* Finished
EndRoutine
* ================================================================================
* ====================
* Method : DefineStyle
* ====================
* Named : Symbolic name of the style.
* Size : Size of the font sued with the style. Range 1 -> 7.
* Color : Font color. See color listings following the HTML_DEMA sample.
* Face : Face name of the font to be used (eg: Arial)
* Bold : Use bolding
* Underline : Use underlining
* Blink : Use the <BLINK> attribute
* Italic : Use Italic
* StrikeOut : Use strikout
* BackColor : Background color for this style
* Alignment : Alignment for this style (use left, center or right)
MthRoutine DefineStyle
* Store details of a style
Define_Map *Input #Std_Texts #Named
Define_Map *Input #Std_Num #Size mandatory(2)
Define_Map *Input #Std_Texts #Color mandatory('blue')
Define_Map *Input #Std_Texts #Face mandatory('Arial')
Define_Map *Input #Std_Bool #Bold mandatory(FALSE)
Define_Map *Input #Std_Bool #UnderLine mandatory(FALSE)
Define_Map *Input #Std_Bool #Blink mandatory(FALSE)
Define_Map *Input #Std_Bool #Italic mandatory(FALSE)
Define_Map *Input #Std_Bool #StrikeOut mandatory(FALSE)
Define_Map *Input #Std_Texts #BackColor mandatory('white')
Define_Map *Input #Std_Texts #Alignment mandatory('left')
* Open if not already opened
Execute Open
* Do the Mappings
Change #Sty_Name #Named.Value
Execute StorAttrib (#Sty_Size SIZE N *blanks #Size.Value)
Execute StorAttrib (#Sty_Face FACE S #Face.Value 0)
Execute StorAttrib (#Sty_Color COLOR S #Color.Value 0)
Execute StorAttrib (#Sty_BCol BGCOLOR S #BackColor.Value 0)
Execute StorAttrib (#Sty_Align ALIGN S #Alignment.Value 0)
Change #Sty_Bold #Bold.Value
Change #Sty_Under #Underline.Value
Change #Sty_Blink #Blink.Value
Change #Sty_Ital #Italic.Value
Change #Sty_Strik #StrikeOut.Value
Use UpperCase (#Sty_Bold) (#Sty_Bold)
Use UpperCase (#Sty_Under) (#Sty_Under)
Use UpperCase (#Sty_Blink) (#Sty_Blink)
Use UpperCase (#Sty_Ital) (#Sty_Ital)
Use UpperCase (#Sty_Strik) (#Sty_Strik)
* Update or create the style
Use Update_In_Space (#Sty_Space #XG_StyGrp) (#BRetCode)
if *RetNOkay
Use Insert_In_Space (#Sty_Space #XG_StyGrp)
Endif
EndRoutine
END_COM