posted August 30, 2001 04:36 AM            

Regards
Peter

To run this program if %TEST = 1:
1) Compile
2) Go to explorer and run the exe-file

%TEST = 1
#if not %def(%TEST)
#compile exe "I:\Brugere\PSP\Xitami\cgi-bin\table.cgi"
#endif
 
%Console = 1
%CCWIN = 1
#include "win32api.inc"
#include "pbcgi.inc"
#include "html.inc" ' Look in next post
 
declare function PutFile(File as string, Buffer as string) as long
 
%ROW = 15
%COL = 4
 
$ProductAnnouncements = "http://www.powerbasic.com/support/forums/forumdisplay.cgi?action=topics&forum=Product+Announcements&number=1&DaysPrune=20&LastLogin="
$FAQ                  = "http://www.powerbasic.com/support/forums/forumdisplay.cgi?action=topics&forum=Frequently+Asked+Questions&number=2&DaysPrune=20&LastLogin="
$Console              = "http://www.powerbasic.com/support/forums/forumdisplay.cgi?action=topics&forum=PowerBASIC+Console+Compiler&number=5&DaysPrune=20&LastLogin="
$DOS                  = "http://www.powerbasic.com/support/forums/forumdisplay.cgi?action=topics&forum=PowerBASIC+for+DOS&number=3&DaysPrune=20&LastLogin="
$Windows              = "http://www.powerbasic.com/support/forums/forumdisplay.cgi?action=topics&forum=PowerBASIC+for+Windows&number=4&DaysPrune=20&LastLogin="
 
$off = "http://www.powerbasic.com/support/forums/off.gif"
$on  = "http://www.powerbasic.com/support/forums/on.gif"
 
%HEADING = 0
%LINE = 1
 
type FORUM_ENTRY
    LampOn as long
    nType as long   ' = %HEADING, %LINE
    Link as string*256
    LinkTxt as string*128
    Txt as string*256
    Posts as long
    LastPostDate as string*24
    LastPostTime as string*8
    Moderator as string*24
end type
 
function MakeForum(fe() as FORUM_ENTRY) as string
 
    local n as long : n  = ubound(fe())
    local i as long
 
    if n = -1 then exit function
 
    local img as HTML_IMG
    local t as HTML_TABLE, buffer as string
    dim tr(n+1) as HTML_TR
    dim td(4,n+1) as HTML_TD
    dim v(4,n+1) as string
    local col as long, row as long
    local f as HTML_FONT, f1 as HTML_FONT
 
    ' Table
    t.cellpadding = "4"
    t.cellspacing = "1"
    t.nwidth = "95%"
 
    ' 1. row
    tr(0).bgcolor = "#D5E6E1"
 
    td(2,0).nowrap = %TRUE : td(2,0).valign = "bottom" : td(2,0).align = "center"
    td(3,0).nowrap = %TRUE : td(3,0).valign = "bottom" : td(3,0).align = "center"
    td(4,0).valign = "bottom"
 
    f.face = "Verdana"
    f.nsize = "1"
    f.ncolor = "#000080"
 
    v(0,0) = Font($Space, f)
    v(1,0) = Font(Bold("Forum"), f)
    v(2,0) = Font(Bold("Posts"), f)
    v(3,0) = Font(Bold("Last Post"), f)
    v(4,0) = Font(Bold("Moderator"), f)
 
    for i = 0 to n
 
        select case fe(i).nType
        case %HEADING
            tr(i+1).bgcolor = "#F1DBD6"
 
            td(0,i+1).colspan = "5"
            td(1,i+1).StopTD = %TRUE
 
            f.nsize = "2"
            f.ncolor = "#000000"
 
            v(0,i+1) = Font(Bold(trim$(fe(i).Txt)), f)
 
        case %LINE
 
            td(0,i+1).bgcolor = "#ffffff" : td(0,i+1).valign  = "top"
            td(1,i+1).bgcolor = "#f7f7f7" : td(1,i+1).valign  = "top"
            td(2,i+1).bgcolor = "#dedfdf" : td(2,i+1).valign  = "top" : td(2,i+1).align  = "center" : td(2,i+1).nowrap = %TRUE
            td(3,i+1).bgcolor = "#f7f7f7" : td(3,i+1).valign  = "top" : td(3,i+1).align  = "center" : td(3,i+1).nowrap = %TRUE
            td(4,i+1).bgcolor = "#dedfdf" : td(4,i+1).valign  = "top"
 
            if fe(i).LampOn then
               img.src = $on
            else
               img.src = $off
            end if
            f.nsize = "2"
 
            v(0,i+1) = MakeImage(img)
            v(1,i+1) = Font(Bold(Link(trim$(fe(i).Link), trim$(fe(i).LinkTxt))), f)  + $br + Font(trim$(fe(i).Txt), f)
            v(2,i+1) = Font(format$(fe(i).Posts), f)
            f.nsize = "1" : f1 = f : f1.ncolor = "#800080"
            v(3,i+1) = Font(trim$(fe(i).LastPostDate), f) + "<br>" + Font(trim$(fe(i).LastPostTime), f1)
            f.nsize = "2" : f.ncolor = "#000000"
            v(4,i+1) = Font(trim$(fe(i).Moderator), f)
 
        end select
 
    next n
 
    function = Center(MakeTable(v(), t, tr(), td()))
 
end function
 
function pbmain
 
    local buffer as string
    dim fe(6) as FORUM_ENTRY
 
    fe(0).nType = %HEADING
    fe(0).Txt = "1. Announcements, Articles and Support FAQs "
 
    fe(1).nType = %LINE
    fe(1).LampOn = %FALSE
    fe(1).Link = $ProductAnnouncements
    fe(1).LinkTxt = "Product Announcements"
    fe(1).Txt = "Announcements about new products and product upgrades."
    fe(1).Posts = 10
    fe(1).LastPostDate = "September 14, 1899"
    fe(1).LastPostTime = "04:16 PM"
    fe(1).Moderator = "Sales"
 
    fe(2).nType = %LINE
    fe(2).LampOn = %TRUE
    fe(2).Link = $FAQ
    fe(2).LinkTxt = "Frequently Asked Questions"
    fe(2).Txt = "Answers to frequently asked questions about PowerBASIC products."
    fe(2).Posts = 22
    fe(2).LastPostDate = "September 20, 2001"
    fe(2).LastPostTime = "06:33 AM"
    fe(2).Moderator = "Tech<br>Support"
 
    fe(3).nType = %HEADING
    fe(3).Txt = "2. User to user Discussions "
 
    fe(4).nType = %LINE
    fe(4).LampOn = %TRUE
    fe(4).Link = $Console
    fe(4).LinkTxt = "PowerBASIC Console Compiler"
    fe(4).Txt = "User to user discussions about the PowerBASIC Console Compiler product line."
    fe(4).Posts = 7235
    fe(4).LastPostDate = "August 29, 2001"
    fe(4).LastPostTime = "04:16 PM"
    fe(4).Moderator = "Tech<br>Support"
 
    fe(5).nType = %LINE
    fe(5).LampOn = %FALSE
    fe(5).Link = $DOS
    fe(5).LinkTxt = "PowerBASIC for DOS"
    fe(5).Txt = "User to user discussion about the PowerBASIC for DOS product line. Includes discussions about PBDK, QuickPack Pro, PB/Vision, PB/Xtra, and PowerTree for DOS."
    fe(5).Posts = 2723
    fe(5).LastPostDate = "August 29, 2001"
    fe(5).LastPostTime = "04:16 PM"
    fe(5).Moderator = "Tech<br>Support"
 
    fe(6).nType = %LINE
    fe(6).LampOn = %FALSE
    fe(6).Link = $Windows
    fe(6).LinkTxt = "PowerBASIC for Windows"
    fe(6).Txt = "User to user discussions about the PB/DLL product line. Discussion topics include PowerGEN and PowerTree for Windows."
    fe(6).Posts = 22397
    fe(6).LastPostDate = "August 29, 2001"
    fe(6).LastPostTime = "06:33 AM"
    fe(6).Moderator = "Tech<br>Support"
 
    buffer = MakeForum(fe())
 
#if not %def(%TEST)
    WriteCGI buffer
#else
    kill "test.htm"
    PutFile "test.htm", buffer
    ShellExecute 0, "open", "test.htm", byval %NULL, byval %NULL, %SW_SHOWNORMAL
#endif
 
end function
 
function PutFile(File as string, Buffer as string) as long
 
    local hFile as long
 
    kill File : err = 0
    hFile = freefile
 
    open File for binary as hFile
    if err then exit function
    put$ hFile, Buffer
    close hFile
 
    function = 1
 
end function

------------------
psp@dst.dk

posted August 30, 2001 04:45 AM            

'--------------------------------------------------
' HTML.INC
' Peter Stephensen 2001
'--------------------------------------------------
#if not %def(%HTML_INC)
%HTML_INC = 1
  
$Space = " "
$br = "<br>"
  
' <TABLE> Table Elements
type HTML_TABLE
    border as string*4       'Sets the border size. <table border="0">
    cellpadding as string*4  'Pixels between the cell data and cell wall. <table cellpadding="5">
    cellspacing as string*4  'Pixels between cells. <table cellspacing="3">
    nwidth as string*4       'Width of overall Table in pixels or percent. <table width="90%">
    nheight as string*4      'Height of overall Table in pixels or percent. <table height="100">
    caption as asciiz ptr    'Places centered text just above the table. <caption>Place messge here.</caption>
    align as string*6        'Aligns the Table to the LEFT, RIGHT, or CENTER. <table align="center">
    bgcolor as string*7      'Specifies the background color of the Table.
end type
 
' <TR> Table Row Elements
type HTML_TR
    align as string*6        'Aligns the Row to the LEFT, RIGHT, or CENTER. <tr align="right">
    valign as string*8       'Vertically aligns the Row to the TOP, BOTTOM, BASELINE, or CENTER. <tr valign="top">
    bgcolor as string*7      'Specifies the background color of the Table. <tr bgcolor="black">
end type
 
' <TD> Table Cell Elements
type HTML_TD
    align as string*6        'Aligns the Cell to the LEFT, RIGHT, or CENTER. <td align="center">
    valign as string*8       'Vertically aligns the Cell to the TOP, BOTTOM, BASELINE, or CENTER. <td valign="bottom">
    nwidth as string*4       'Width of the Cell in pixels or percent. <td width="25%">
    nheight as string*4      'Height of the Cell in pixels or percent. <td height="40">
    nowrap as long           'Doesn't wrap the contents of the Cell. <td nowrap>
    bgcolor as string*7      'Specifies the background color of the Table. <td bgcolor="#00FF23">
    colspan as string*4      'Spans Cell columns. <td colspan="2">
    rowspan as string*4      'Spans Cell rows. <td rowspan="2">
    NoTD as long
    StopTD as long
end type
 
type HTML_FONT
    ncolor as string*7        'Sets font color. The color can be either a hexadecimal, red-green-blue color value or a predefined color name
    face as string*16        '="name [,name2[,name3]]" Sets the font. A list of font names can be specified. If the first font is available on the system, it will be used, otherwise the second will be tried, and so on.
                             'If none are available, a default font will be used.
    nsize as string*3        'Specifies font size between 1 and 7 (7 is largest). A plus or minus before the number indicates a size relative to the current BASEFONT setting.
                             'Relative font sizes are not cumulative, so putting two <FONT SIZE="+1"> elements in a row does not result in the font size being increased by 2
end type
 
type HTML_IMG
    src as string*64
    nheight as string*4
    nwidth as string*4
    alt as string*32
end type
 
function MakeFont(f as HTML_FONT) as string
 
    local ncolor as string   : ncolor = trim$(f.ncolor)
    local face as string     : face = trim$(f.face)
    local nsize as string    : nsize = trim$(f.nsize)
    local s as string	
 
    s = "<font"
 
    if asc(ncolor) <> 0 then
        if left$(ncolor,1) <> "#" then ncolor = "#" + ncolor
        s = s + " color='" + ncolor + "'"
    end if
 
    if asc(face) <> 0 then s = s + " face='" + face + "'"
    if asc(nsize) <> 0 then s = s + " size='" + nsize + "'"
 
    s = s + ">"
  
    function = s
 
end function
 
function MakeImage(i as HTML_IMG) as string
 
    local src as string      : src = trim$(i.src)
    local nheight as string  : nheight = trim$(i.nheight)
    local nwidth as string   : nwidth = trim$(i.nwidth)
    local alt as string      : alt = trim$(i.alt)
    local s as string	
 
    s = "<img"
 
    if asc(src) <> 0 then s = s + " src='" + src + "'"
    if asc(nheight) <> 0 then s = s + " height='" + nheight + "'"
    if asc(nwidth) <> 0 then s = s + " width='" + nwidth + "'"
    if asc(alt) <> 0 then s = s + " alt='" + alt + "'"
 
    function = s
 
end function
 
function Link(byval href as string, byval txt as string) as string
    function = "<a href='" + href + "'>" + txt + "</a>"
end function
 
function MakeTable(v() as string, t as HTML_TABLE, tr() as HTML_TR, td() as HTML_TD) as string
 
    local border as string       : border       = trim$(t.border)
    local cellpadding as string  : cellpadding  = trim$(t.cellpadding)
    local cellspacing as string  : cellspacing  = trim$(t.cellspacing)
    local nwidth as string       : nwidth       = trim$(t.nwidth)
    local nheight as string      : nheight       = trim$(t.nheight)
    local align as string        : align        = trim$(t.align)
    local bgcolor as string      : bgcolor      = trim$(t.bgcolor)
    local valign as string
    local colspan as string
    local rowspan as string
 
    local s as string, s_tr as string, s_td as string
    local nRow as long, nCol as long
    local row as long, col as long
 
    nCol = ubound(v(1)) : if nCol = -1 then exit function
    nRow = ubound(v(2)) : if nRow = -1 then exit function
 
    if ubound(tr()) <> nRow then exit function
 
    if ubound(td(1)) <> nCol then exit function
    if ubound(td(2)) <> nRow then exit function
 
    if t.caption then s = "<caption>" + t.@caption + "</caption>" + $CRLF
 
    s = s + "<table"
 
    if asc(border) = 0 then border = "0"
    s = s + " border='" + border + "'"
 
    if asc(cellpadding) <> 0 then s = s + " cellpadding='" + cellpadding + "'"
    if asc(cellspacing) <> 0 then s = s + " cellspacing='" + cellspacing + "'"
    if asc(nwidth) <> 0 then s = s + " width='" + nwidth + "'"
    if asc(nheight) <> 0 then s = s + " height='" + nheight + "'"
    if asc(align) <> 0 then s = s + " align='" + align + "'"
 
    if asc(bgcolor) <> 0 then
        if left$(bgcolor,1) <> "#" then bgcolor = "#" + bgcolor
        s = s + " bgcolor='" + bgcolor + "'"
    end if
 
    s = s + ">" + $CRLF
 
    for row = 0 to nRow
        s_tr = "    <tr"
        align = trim$(tr(row).align)
        if asc(align) <> 0 then s_tr = s_tr + " align='" + align + "'"
 
        valign = trim$(tr(row).valign)
        if asc(valign) <> 0 then s_tr = s_tr + " valign='" + valign + "'"
 
        bgcolor = trim$(tr(row).bgcolor)
        if asc(bgcolor) <> 0 then
            if left$(bgcolor,1) <> "#" then bgcolor = "#" + bgcolor
            s_tr = s_tr + " bgcolor='" + bgcolor + "'"
        end if
 
        s_tr = s_tr + ">"
 
        s = s + s_tr + $CRLF
        for col = 0 to nCol
	    if td(col,row).StopTD = %TRUE then exit for
	    if td(col,row).NoTD = 0 then
	        s_td = "        <td"
  
	        align = trim$(td(col,row).align)
	        if asc(align) <> 0 then s_td = s_td + " align='" + align + "'"
 
	        valign = trim$(td(col,row).valign)
	        if asc(valign) <> 0 then s_td = s_td + " valign='" + valign + "'"
 
	        bgcolor = trim$(td(col,row).bgcolor)
	        if asc(bgcolor) <> 0 then
	            if left$(bgcolor,1) <> "#" then bgcolor = "#" + bgcolor
	            s_td = s_td + " bgcolor='" + bgcolor + "'"
                end if
 
                nwidth = trim$(td(col,row).nwidth)
                if asc(nwidth) <> 0 then s_td = s_td + " width='" + nwidth + "'"
 
                nheight = trim$(td(col,row).nheight)
                if asc(nheight) <> 0 then s_td = s_td + " height='" + nheight + "'"
 
                colspan = trim$(td(col,row).colspan)
                if asc(colspan) <> 0 then s_td = s_td + " colspan='" + colspan + "'"
 
                rowspan = trim$(td(col,row).rowspan)
                if asc(rowspan) <> 0 then s_td = s_td + " rowspan='" + rowspan + "'"
 
	        if td(col,row).nowrap then  s_td = s_td + " nowrap"
 
	        s_td = s_td + ">"
	        s = s + s_td + v(col,row) + "</td>" + $CRLF
	    end if
        next col
        s = s + "    </tr>" + $CRLF
    next row
 
    s = s + "</table>" + $CRLF
 
    function = s
 
end function
 
function rgb_$(byval r as long, byval g as long, byval b as long) as string
    function = hex$(rgb(b,g,r))
end function
function Bold(byval s as string) as string
    function = "<b>" + s + "</b>"
end function
function Center(byval s as string) as string
    function = "<center>" + s + "</center>"
end function

function Italic(byval s as string) as string
    function = "<i>" + s + "</i>"
end function
function Font(byval s as string, f as HTML_FONT) as string
    function = MakeFont(f) + s + "</font>"
end function
#endif

------------------
psp@dst.dk

posted August 30, 2001 06:04 AM            

%CCWIN = 1
#include "win32api.inc"
#include "pbcgi.inc"
#include "html.inc"
 
declare function PutFile(File as string, Buffer as string) as long
 
%ROW = 25
%COL = 12
 
function pbmain
 
    local t as HTML_TABLE, buffer as string
    dim tr(%ROW) as HTML_TR
    dim td(%COL,%ROW) as HTML_TD
    dim v(%COL,%ROW) as string
    local col as long, row as long
 
    randomize timer
 
    for row = 0 to %ROW
        for col = 0 to %COL
            v(col,row) = $Space
            td(col,row).bgcolor = rgb_$(255*rnd, 255*rnd, 255*rnd)
        next col
    next row
 
    t.align = "center"
    t.nwidth = "100%"
    t.bgcolor = rgb_$(0, 100, 200)
    t.cellspacing = "4"
    t.cellpadding = "10"
 
    tr(1).align = "center"
    tr(2).valign = "top"
 
    buffer = MakeTable(v(), t, tr(), td())
 
    PutFile "test.htm", buffer
    ShellExecute 0, "open", "test.htm", byval %NULL, byval %NULL, %SW_SHOWNORMAL
 
end function
 
function PutFile(File as string, Buffer as string) as long
  
    local hFile as long
  
    kill File : err = 0
    hFile = freefile
  
    open File for binary as hFile
    if err then exit function
    put$ hFile, Buffer
    close hFile
  
    function = 1
  
end function

posted August 31, 2001 12:22 AM            

2 problems:

A. To run my first example if %TEST = 1, you have to
   1) Compile
   2) Go to explorer and run exe-file

B. In the file html.inc I have the line

   $Space = "#nbsp;"

   $Space = " "

Regards
Peter

------------------
psp@dst.dk

posted August 31, 2001 08:15 AM            

In the meantime, you can still do it manually. Think & instead.
Your browser will convert the &amp to a simple & and it'll look fine.
Try not to edit the post afterwards, though, or you'll need to restore all
the &s!