Form S_152FA: HTML Browser Demonstration A

LANSA

Form S_152FA: HTML Browser Demonstration A
FUNCTION OPTIONS(*DIRECT)
BEGIN_COM HEIGHT(443) LAYOUTMANAGER(#SPLM_1) LEFT(265) TOP(160) WIDTH(672)
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_1)
DEFINE_COM CLASS(#PRIM_PANL) NAME(#PANL_1) DISPLAYPOSITION(2) HEIGHT(150) LEFT(512) PARENT(#PANL_2) TABPOSITION(1) TABSTOP(False) TOP(0) WIDTH(152)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_1) ATTACHMENT(Center) MANAGE(#BROWSER) PARENT(#ATLM_1)
DEFINE_COM CLASS(#PRIM_STBR) NAME(#STBR_1) DISPLAYPOSITION(1) HEIGHT(22) LEFT(0) MESSAGEPOSITION(1) PARENT(#PANL_3) TABPOSITION(2) TABSTOP(False) TOP(240) WIDTH(664)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_2) ATTACHMENT(Bottom) MANAGE(#STBR_1) PARENT(#ATLM_1)

DEFINE_COM CLASS(#S_152RHT) NAME(#DOC) DISPLAYPOSITION(3) PARENT(#COM_OWNER) VISIBLE(False)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_HTML1) CAPTION('Example 1') DISPLAYPOSITION(1) HEIGHT(29) LEFT(7) PARENT(#PANL_1) TABPOSITION(4) TOP(0) WIDTH(140)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_HTML2) CAPTION('Example 2') DISPLAYPOSITION(4) HEIGHT(29) LEFT(7) PARENT(#PANL_1) TABPOSITION(3) TOP(38) WIDTH(140)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_HTML3) CAPTION('Example 3') DISPLAYPOSITION(3) HEIGHT(29) LEFT(7) PARENT(#PANL_1) TABPOSITION(2) TOP(75) WIDTH(140)
DEFINE_COM CLASS(#PRIM_PHBN) NAME(#BTN_HTML4) CAPTION('Examples 1, 2 and 3') DISPLAYPOSITION(2) HEIGHT(29) LEFT(7) PARENT(#PANL_1) TABPOSITION(1) TOP(112) WIDTH(140)
DEFINE_COM CLASS(#PRIM_GRID) NAME(#SECLIST) COLUMNBUTTONHEIGHT(21) DISPLAYPOSITION(1) HEIGHT(150) LEFT(0) PARENT(#PANL_2) TABPOSITION(2) TOP(0) WIDTH(512)
DEFINE_COM CLASS(#PRIM_GDCL) NAME(#GDCL_1) CAPTION('Dept') CAPTIONTYPE(Caption) DISPLAYPOSITION(1) PARENT(#SECLIST) SOURCE(#DEPTMENT) TABSTOP(False) WIDTH(11)
DEFINE_COM CLASS(#PRIM_GDCL) NAME(#GDCL_2) CAPTION('Section') CAPTIONTYPE(Caption) DISPLAYPOSITION(2) PARENT(#SECLIST) SOURCE(#SECTION) TABSTOP(False) WIDTH(12)
DEFINE_COM CLASS(#PRIM_GDCL) NAME(#GDCL_3) CAPTION('Description') CAPTIONTYPE(Caption) DISPLAYPOSITION(3) PARENT(#SECLIST) SOURCE(#SECDESC) TABSTOP(False) WIDTH(31)
DEFINE_COM CLASS(#PRIM_GDCL) NAME(#GDCL_4) CAPTION('Phone') CAPTIONTYPE(Caption) DISPLAYPOSITION(4) PARENT(#SECLIST) SOURCE(#SECPHBUS) TABSTOP(False) WIDTH(18)
DEFINE_COM CLASS(#PRIM_GDCL) NAME(#GDCL_5) CAPTION('Comments ? ') CAPTIONTYPE(Caption) DISPLAYPOSITION(5) PARENT(#SECLIST) READONLY(False) SOURCE(#STD_TEXTS) WIDTH(20) WIDTHTYPE(Remainder)
DEFINE_COM CLASS(#PRIM_SPLM) NAME(#SPLM_1)
DEFINE_COM CLASS(#PRIM_PANL) NAME(#PANL_2) DISPLAYPOSITION(1) HEIGHT(150) LAYOUTMANAGER(#ATLM_2) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(2) TABSTOP(False) TOP(0) WIDTH(664)
DEFINE_COM CLASS(#PRIM_PANL) NAME(#PANL_3) DISPLAYPOSITION(2) HEIGHT(262) LAYOUTMANAGER(#ATLM_1) LEFT(0) PARENT(#COM_OWNER) TABPOSITION(3) TABSTOP(False) TOP(154) WIDTH(664)
DEFINE_COM CLASS(#PRIM_SPLI) NAME(#SPLI_1) MANAGE(#PANL_2) PARENT(#SPLM_1) WEIGHT(1)
DEFINE_COM CLASS(#PRIM_SPLI) NAME(#SPLI_2) MANAGE(#PANL_3) PARENT(#SPLM_1)
DEFINE_COM CLASS(#PRIM_ATLM) NAME(#ATLM_2)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_4) ATTACHMENT(Right) MANAGE(#PANL_1) PARENT(#ATLM_2)
DEFINE_COM CLASS(#PRIM_ATLI) NAME(#ATLI_5) ATTACHMENT(Center) MANAGE(#SECLIST) PARENT(#ATLM_2)
DEFINE_COM CLASS(#S_152RWB) NAME(#BROWSER) DISPLAYPOSITION(2) HEIGHT(240) PARENT(#PANL_3) TABSTOP(False) WIDTH(664)

Define #OutFile RefFld(#SysVar$av)
Define #TabNumber RefFld(#Std_Num)
Define #RowCount RefFld(#Std_Num)
Define #Work55 *dec Length(5) Decimals(5)
Define #UseStyle RefFld(#Std_Texts)
Define #UseStyle2 RefFld(#Std_Texts)
Define #SRetCode *Char 2
Def_Cond *SpaceOK '#SRetCode = OK'

* ===============================================================================

EVTROUTINE handling(#com_owner.Initialize)

* Set / Initialize standard variables

SET #com_owner caption(*component_desc)
Use TConcat (*Temp_Dir *Component '.htm') (#OutFile)

* Fill List view with section details

Change #Std_TextS '''Enter your comments here'''

Select *All From_File(SecTab)
Add_Entry #SecList
EndSelect

ENDROUTINE

* ================================================================================

MthRoutine DefineTable
Define_Map *Input #Std_Num #Number
Change #TabNumber #Number.Value

* Set HTML document title

Set #Doc Title(*component_desc)

Case #TabNumber



When ' = 1'


* Table 1 : Default show of department details

* Table 1 is created using default values for almost everything

Invoke #Doc.DefineTable WithName(Sec1) Order(1) WithTitle('Example 1') align(center)

Invoke #Doc.DefineTableCell InTable(Sec1) WithName(Dep) Order(1) ColHdg1('Department') ColHdg2('Code')
Invoke #Doc.DefineTableCell InTable(Sec1) WithName(Sec) Order(2) ColHdg1('Section') ColHdg2('Code')
Invoke #Doc.DefineTableCell InTable(Sec1) WithName(Dsc) Order(3) ColHdg1('Description')
Invoke #Doc.DefineTableCell InTable(Sec1) WithName(Phn) Order(4) ColHdg1('Business') ColHdg2('Phone') ColHdg3('Number')
Invoke #Doc.DefineTableCell InTable(Sec1) WithName(Com) Order(5) ColHdg1('Comments')

When ' = 2'

* Table 2 : Define the styles being used

Invoke #Doc.DefineStyle Named(HTMLPage) Size(3) Color(Blue) Face('Arial') BackColor(lightblue)
Invoke #Doc.DefineStyle Named(BigTitle) Size(6) Color(Red) Face('Arial') Bold(True) Italic(True)
Invoke #Doc.DefineStyle Named(OddCell) Size(2) Color(Blue) Face('Arial') Italic(True) BackColor(lightblue) Alignment(left)
Invoke #Doc.DefineStyle Named(EvenCell) Size(2) Color(Blue) Face('Arial') BackColor(lightyellow) Alignment(Left)
Invoke #Doc.DefineStyle Named(ColumnHeading) Size(3) Color(Black) Face('Arial') BackColor(lightgrey) Alignment(center)

* Set the style for the document

Set #Doc Style(HTMLPage)

* Table 2 uses more styles to control different options

Invoke #Doc.DefineTable WithName(Sec2) Order(2) WithTitle('Example 2') TitleStyle(BigTitle) Frame(void) Rules(none) PctWidth(100)

Invoke #Doc.DefineTableCell InTable(Sec2) WithName(A) Order(2) ColHdg1('Department') HdgStyle(ColumnHeading)
Invoke #Doc.DefineTableCell InTable(Sec2) WithName(B) Order(3) ColHdg1('Section') HdgStyle(ColumnHeading)
Invoke #Doc.DefineTableCell InTable(Sec2) WithName(C) Order(4) ColHdg1('Description') HdgStyle(ColumnHeading)
Invoke #Doc.DefineTableCell InTable(Sec2) WithName(D) Order(5) ColHdg1('Business Phone') HdgStyle(ColumnHeading)
Invoke #Doc.DefineTableCell InTable(Sec2) WithName(E) Order(1) ColHdg1('Comments') HdgStyle(ColumnHeading)

When ' = 3'

* Table 3 : Define the styles being used

Invoke #Doc.DefineStyle Named(NDepDetail) Color(Blue) Size(1) Alignment(Right) backcolor(lightblue)
Invoke #Doc.DefineStyle Named(ADepDetail) Color(Blue) Size(1) Alignment(Left) backcolor(lightblue)
Invoke #Doc.DefineStyle Named(NDepTotal) Color(Black) Size(1) Alignment(Right) backcolor(lightgrey)
Invoke #Doc.DefineStyle Named(ADepTotal) Color(Black) Size(1) Alignment(Left) backcolor(lightgrey)
Invoke #Doc.DefineStyle Named(NGrandTotal) Color(Red) Size(1) Alignment(Right) backcolor(lightpink)
Invoke #Doc.DefineStyle Named(AGrandTotal) Color(Red) Size(1) Alignment(Left) backcolor(lightpink)

* Table 3 : Summary information

Invoke #Doc.DefineTable WithName(Exam3) Order(3) Frame(void) Rules(none) cellpad(2) SpaceBef(1)

Invoke #Doc.DefineTableCell InTable(Exam3) WithName(Dep) Order(1) ColHdg1('Department') HdgStyle(ADepTotal)
Invoke #Doc.DefineTableCell InTable(Exam3) WithName(Sec) Order(2) ColHdg1('Section') HdgStyle(ADepTotal)
Invoke #Doc.DefineTableCell InTable(Exam3) WithName(Count) Order(3) ColHdg1('Head Count') HdgStyle(ADepTotal)
Invoke #Doc.DefineTableCell InTable(Exam3) WithName(Avg) Order(4) ColHdg1('Average Salary') HdgStyle(ADepTotal)
Invoke #Doc.DefineTableCell InTable(Exam3) WithName(Max) Order(5) ColHdg1('Maximum Salary') HdgStyle(ADepTotal)
Invoke #Doc.DefineTableCell InTable(Exam3) WithName(Min) Order(6) ColHdg1('Minimum Salary') HdgStyle(ADepTotal)


EndCase


EndRoutine

* ================================================================================

MthRoutine PutTable
Define_Map *Input #Std_Num #Number

Change #TabNumber #Number.Value
Change #RowCount 0

* Fill the tables with data


If '#TabNumber = 3'

Define #EmpCount RefFld(#Std_Num)
Define #AccSalary RefFld(#Salary) Length(*RefFld *Plus 2)
Define #MaxSalary RefFld(#Salary) Length(*RefFld *Plus 2)
Define #MinSalary RefFld(#Salary) Length(*RefFld *Plus 2)

Group_by #XG_Space (#Deptment #Section #EmpCount #AccSalary #MaxSalary #MinSalary)

Define #AvgSalary RefFld(#Salary)
Define #HDeptment RefFld(#Deptment)
Define #HSection RefFld(#Section)


* Define the space to be used to count totals

Use Create_Space (*component)
Use Define_Space_Cell (*component Deptment key)
Use Define_Space_Cell (*component Section key)
Use Define_Space_Cell (*component EmpCount)
Use Define_Space_Cell (*component AccSalary)
Use Define_Space_Cell (*component MaxSalary)
Use Define_Space_Cell (*component MinSalary)

* Set up the high value total markers

Change (#HDeptment #HSection) *Hival

* Calculate the values into the space

Select (#Deptment #Section #Salary) From_File(PslMst)
Execute Accumulate (#Deptment #Section #Salary)
Execute Accumulate (#Deptment #HSection #Salary)
Execute Accumulate (#HDeptment #HSection #Salary)
EndSelect

* Now read the space back and put the accumlated values into the HTML document

Use Select_In_Space (*Component) (#SRetCode #XG_Space)
DoWhile *SpaceOK
Define #LDeptment RefFld(#Deptment)


Change #RowCount '#RowCount + 1'

* Convert the codes to appropriate descriptions in #DeptDesc and #SecDesc

Change #UseStyle NDepDetail
Change #UseStyle2 ADepDetail

If '#Deptment = #HDeptment'
Change #UseStyle NGrandTotal
Change #UseStyle2 AGrandTotal
Change #DeptDesc '''Totals'''
Change #SecDesc *Null
Else
Change #DeptDesc *NAvail
Fetch (#DeptDesc) From_File(DepTab) With_Key(#Deptment) Keep_Last(50)
If '#Section = #HSection'
Change #UseStyle NDepTotal
Change #UseStyle2 ADepTotal
Change #SecDesc '''Totals'''
Change #DeptDesc *Null
Else
Change #SecDesc *NAvail
Fetch (#SecDesc) From_File(SecTab) With_Key(#Deptment #Section) Keep_Last(50)
if '#Deptment = #LDeptment'
Change #DeptDesc *Null
Endif
Change #LDeptment #Deptment
Endif
Endif

* Insert the values into the HTML table

Change #AvgSalary '#AccSalary / #EmpCount'

Invoke #Doc.SetTableCell InTable(Exam3) withName(Dep) Rownum(#RowCount) Type(alpha) AlphaValue(#DeptDesc) CellStyle(#UseStyle2)
Invoke #Doc.SetTableCell InTable(Exam3) withName(Sec) Rownum(#RowCount) Type(alpha) AlphaValue(#SecDesc) CellStyle(#UseStyle2)
Invoke #Doc.SetTableCell InTable(Exam3) withName(Count) Rownum(#RowCount) Type(Numeric) NumValue(#EmpCount) CellStyle(#UseStyle)
Invoke #Doc.SetTableCell InTable(Exam3) withName(Avg) Rownum(#RowCount) Type(Numeric) NumValue(#AvgSalary) CellStyle(#UseStyle) decimals(2)
Invoke #Doc.SetTableCell InTable(Exam3) withName(Max) Rownum(#RowCount) Type(Numeric) NumValue(#MaxSalary) CellStyle(#UseStyle) decimals(2)
Invoke #Doc.SetTableCell InTable(Exam3) withName(Min) Rownum(#RowCount) Type(Numeric) NumValue(#MinSalary) CellStyle(#UseStyle) decimals(2)


Use SelectNext_In_Space (*Component) (#SRetCode #XG_Space)
EndWhile

* Destroy the space

Use Destroy_Space (*component)


Else


SelectList #SecList
Change #RowCount '#RowCount + 1'

Case #TabNumber

When ' = 1'

* Insert to the first table

Invoke #Doc.SetTableCell InTable(Sec1) withName(Dep) Rownum(#RowCount) Type(alpha) alphavalue(#Deptment)
Invoke #Doc.SetTableCell InTable(Sec1) withName(Sec) Rownum(#RowCount) Type(alpha) alphavalue(#Section)
Invoke #Doc.SetTableCell InTable(Sec1) withName(Dsc) Rownum(#RowCount) Type(alpha) alphavalue(#SecDesc)
Invoke #Doc.SetTableCell InTable(Sec1) withName(Phn) Rownum(#RowCount) Type(alpha) alphavalue(#SecPhBus)
Invoke #Doc.SetTableCell InTable(Sec1) withName(Com) Rownum(#RowCount) Type(alpha) alphavalue(#Std_Texts)

When ' = 2'

* Insert to the second table

Change #Work55 '#RowCount / 2.0'
If '#Work55 = 0.0'
Change #UseStyle EvenCell
Else
Change #UseStyle OddCell
Endif

Invoke #Doc.SetTableCell InTable(Sec2) withName(A) Rownum(#RowCount) Type(alpha) alphavalue(#Deptment) CellStyle(#UseStyle)
Invoke #Doc.SetTableCell InTable(Sec2) withName(B) Rownum(#RowCount) Type(alpha) alphavalue(#Section) CellStyle(#UseStyle)
Invoke #Doc.SetTableCell InTable(Sec2) withName(C) Rownum(#RowCount) Type(alpha) alphavalue(#SecDesc) CellStyle(#UseStyle)
Invoke #Doc.SetTableCell InTable(Sec2) withName(D) Rownum(#RowCount) Type(alpha) alphavalue(#SecPhBus) CellStyle(#UseStyle)
Invoke #Doc.SetTableCell InTable(Sec2) withName(E) Rownum(#RowCount) Type(alpha) alphavalue(#Std_Texts) CellStyle(#UseStyle)

Endcase

EndSelect

Endif

EndRoutine

* ================================================================================

Subroutine Accumulate ((#KDeptment *Received)(#KSection *Received) (#VSalary *Received))

Define #KDeptment RefFld(#Deptment)
Define #KSection RefFld(#Section)
Define #VSalary RefFld(#Salary)


Use Fetch_in_Space (*Component #KDeptment #KSection) (#SRetCode #XG_Space)

If *SpaceOK

Change #EmpCount '#EmpCount + 1'

Change #AccSalary '#AccSalary + #VSalary'

If '#VSalary < #MinSalary'
Change #MinSalary #VSalary
Endif

If '#VSalary > #MaxSalary'
Change #MaxSalary #VSalary
Endif

Use Update_in_Space (*Component #XG_Space)

Else

Change #Deptment #KDeptment
Change #Section #KSection
Change #EmpCount 1
Change (#AccSalary #MaxSalary #MinSalary) #VSalary

Use Insert_in_Space (*Component #XG_Space)

Endif


EndRoutine

* ================================================================================

EVTROUTINE HANDLING(#BTN_HTML1.Click)

Invoke #Com_Owner.DefineTable Number(1)

Invoke #Com_Owner.PutTable Number(1)

Invoke #Doc.Save InFile(#OutFile)

Invoke #Doc.Close

Invoke #Browser.uShow URL(#OutFile)

ENDROUTINE

* ================================================================================

EVTROUTINE HANDLING(#BTN_HTML2.Click)

Invoke #Com_Owner.DefineTable Number(2)

Invoke #Com_Owner.PutTable Number(2)

Invoke #Doc.Save InFile(#OutFile)

Invoke #Doc.Close

Invoke #Browser.uShow URL(#OutFile)

ENDROUTINE

* ================================================================================

EVTROUTINE HANDLING(#BTN_HTML3.Click)

Invoke #Com_Owner.DefineTable Number(3)

Invoke #Com_Owner.PutTable Number(3)

Invoke #Doc.Save InFile(#OutFile)

Invoke #Doc.Close

Invoke #Browser.uShow URL(#OutFile)

ENDROUTINE


* ================================================================================

EVTROUTINE HANDLING(#BTN_HTML4.Click)

Invoke #Com_Owner.DefineTable Number(1)

Invoke #Com_Owner.DefineTable Number(2)

Invoke #Com_Owner.DefineTable Number(3)

Invoke #Com_Owner.PutTable Number(1)

Invoke #Com_Owner.PutTable Number(2)

Invoke #Com_Owner.PutTable Number(3)

Invoke #Doc.Save InFile(#OutFile)

Invoke #Doc.Close

Invoke #Browser.uShow URL(#OutFile)

ENDROUTINE

END_COM