' simple displaying and printing of text and graphics using ie-control
' ====================================================================
'
' comment here please:
http://www.powerbasic.com/support/pb...ad.php?t=10177
'
' many thanks to terry reese for his original ie-control code at this link:
http://www.powerbasic.com/support/pb...ead.php?t=8184
' i could not have made this program without his code.
'
' march 27th 2004: some improvements have been made. if you have ie-6,
' enhanced metafile graphics are printed in correct colors.
'
' march 31st 2004: a small problem with repainting has been
' corrected thanks to brad byrne, who provided the necessary
' inspiration.
'
' using the ie-control you can display and print text and graphics output
' from your pb-programs in a simple and easy way. this program demonstrates
' how. the formating of the output is made using the standard html-tags.
' the most common of these tags are shown below. normally you would only
' need very few as demonstrated in this program.
'
' the text output from your program should be presented to the ie-control
' in condensed form as a single text-string with html-tags inserted where
' specific formatting features are needed. by letting your program insert
' the relevant html-tags, you can format your text as you wish. normally
' you would only need to use very few of them. it is important, however,
' that you supply the html-tagged text with a standardized starting and
' ending sequence like those shown in this program.
'
' graphics output from pb programs can be saved in enhanced metafiles, which
' can be inserted anywhere in the output text-string by placing a html
' image tag with an url referring to the graphics file in question. (by the
' way, image files in other formats can also be inserted.)
'
' by clicking the right mouse button you can obtain a shortcut menu (slightly
' different if you click over a picture or over the text) by which you can
' copy to the clipboard or print the content via the printer dialog box. my
' version of ie (vers. 5) cannot print the enhanced metafile graphics in
' correct colors. i wonder if later versions have solved that problem?
' if you copy to word and print from there, the colors are ok. so it seems
' to be a problem caused in - at least earlier versions of - the ie printer
' driver.
'
' good luck!
'
' best regards,
'
' erik christensen -------- [email protected] --------- march 23, 2004
[CODE]
'****************************************************************************
' some common html-tags:
'****************************************************************************
' basic elements
' document type <html></html> (beginning and end of file)
' title <title></title> (must be in header)
' header <head></head> (descriptive info, such as title)
' body <body></body> (bulk of the page)
'
' structural definition
' heading <h?></h?> (the spec. defines 6 levels)
' align heading <h? align=left|center|right></h?>
' code <code></code> (for source code listings)
' large font size <big></big>
' small font size <small></small>
'
' presentation formatting
' bold <b></b>
' italic <i></i>
' underline <u></u>
' subscript <sub></sub>
' superscript <sup></sup>
' preformatted <pre></pre> (display text spacing as-is)
' center <center></center> (for both text and images)
' font size <font size=?></font> (ranges from 1-7)
' change font size <font size="+|-?"></font>
' font color <font color="#$$$$$$"></font> (order is red/green/blue)
' select font <font face="***"></font>
' point size <font point-size=?></font>
' weight <font weight=?></font>
' base font size <basefont size=?> (from 1-7; default is 3)
' marquee <marquee></marquee>
'
' positioning
' spacer <spacer>
' size <spacer size=?>
'
' graphics
' display image <img src="url">
' alignment <img src="url" align=top|bottom|middle|left|right>
' alignment <img src="url" align=texttop|absmiddle|baseline|absbottom>
' dimensions <img src="url" width=? height=?> (in pixels)
' <img src="url" width=% height=%> (as percentage of page width/height)
' border <img src="url" border=?> (in pixels)
' runaround space <img src="url" hspace=? vspace=?> (in pixels)
' embed object <embed src="url"> (insert object into page)
' object size <embed src="url" width=? height=?>
'
' dividers
' paragraph <p></p> (closing tag often unnecessary)
' align text <p align=left|center|right></p>
' justify text <p align=justify></p>
' line break <br> (a single carriage return)
' clear textwrap <br clear=left|right|all>
' no break <nobr></nobr> (prevents line breaks)
' word break <wbr> (where to break a line if needed)
'
' backgrounds and colors
' tiled bkground <body background="url">
' watermark <body bgproperties="fixed">
' bkground color <body bgcolor="#$$$$$$"> (order is red/green/blue)
' text color <body text="#$$$$$$">
'
' miscellaneous
' url of this file <base href="url"> (must be in header)
' base window name <base target="***"> (must be in header)
'
'****************************************************************************
#compile exe
#register none
#dim all
'
#include "win32api.inc"
#include "commctrl.inc"
'
%idd_form1_labelrawtext = 100
%idd_form1_labelgraphic1 = 105
%idd_form1_labelhtmltext = 110
%idd_form1_labelgraphwindow = 115
%idd_form1_butmakeoutput = 120
%idd_form1_butdisplcomboutp = 125
%idd_form1_buttonexit = 135
%idd_form1_texthtml = 140
%idd_form1_textraw = 145
%idd_form1_butprevfig = 150
%idd_form1_butnextfig = 155
'
global hform1&
global gerror as long ' stores the error variable
global curgrano as long
global totalgrano as long
global currentpath as string
global th$, tt$ ' th is for html-tagged text, tt is for plain text.
global outmade&
'
'=======================================================================
' the following 7 functions are due to terry reese - thanks
'=======================================================================
' function/sub: createie
' description: creates an instance of ie and sets the window properties
' of the new session.
' variables:
' vobj_ie: reference to a variant in the calling code --
' this will be the object that you will use in
' subsequent calls.
'=======================================================================
' this is a simplified version of terry's original function.
' see above link for original version.
function createie(byref vobj_ie as variant) as long
local obj_ie as dispatch
local vtoolbar as variant ' not used - set to zero
local vmenu as variant ' not used - set to zero
local vaddressbar as variant ' not used - set to zero
local vresizable as variant ' not used - set to zero
local vstatusbar as variant ' not used - set to zero
local lerror as long
'
set obj_ie = new dispatch in "internetexplorer.application"
if isfalse isobject (obj_ie) then
function = %false
else:
try
object let obj_ie.toolbar = vtoolbar
object let obj_ie.menubar = vmenu
object let obj_ie.addressbar = vaddressbar
object let obj_ie.resizable = vresizable
object let obj_ie.statusbar = vstatusbar
set vobj_ie = obj_ie
set obj_ie = nothing
function = %true
catch
function = %false
set obj_ie = nothing
lerror = err
end try
end if
gerror = lerror
end function
'=======================================================================
' function/sub: navigateto
' description: use this function to navigate to a url or file.
' this works just like typing into the ie addressbar
' variables:
' vobj_ie: this is a reference to a valid object
' surl: this is the url/file to load
'=======================================================================
function navigateto(vobj_ie as variant, byval surl as string) as long
local obj_ie as dispatch
local vurl as variant
local lerror as long
set obj_ie = vobj_ie
let vurl = surl
try
object call obj_ie.navigate(vurl)
function = %true
catch
function = %false
lerror = err
end try
gerror = lerror
end function
'=======================================================================
' function/sub: isbusy
' description: queries ie to see if the object has finished loading
' the current url/file
' variables:
' vobj_ie: this is a reference to a valid object
' lbusy: return value. 0 = not busy 1 = busy
'=======================================================================
function isbusy(vobj_ie as variant, lbusy as long) as long
local obj_ie as dispatch
local vvariant as variant
local lerror as long
set obj_ie = vobj_ie
try
object get obj_ie.busy to vvariant
lbusy = variant#(vvariant)
function = %true
catch
function = %false
lerror = err
end try
gerror = lerror
end function
'=======================================================================
' function/sub: setheight
' description: accesses the ie height property (window)
' variables:
' vobj_ie: this is a reference to a valid object
' lheight: height of the window
'=======================================================================
function setheight(vobj_ie as variant, byval lheight as long) as long
local obj_ie as dispatch
local tvariant as variant
local lerror as long
set obj_ie = vobj_ie
try
let tvariant = lheight
object let obj_ie.height = tvariant
function = %true
catch
function = %false
lerror = err
end try
gerror = lerror
end function
'=======================================================================
' function/sub: setwidth
' description: accesses the ie width property (window)
' variables:
' vobj_ie: this is a reference to a valid object
' lwidth: width of the window
'=======================================================================
function setwidth(vobj_ie as variant, byval lwidth as long) as long
local obj_ie as dispatch
local tvariant as variant
local lerror as long
set obj_ie = vobj_ie
try
let tvariant = lwidth
object let obj_ie.width = tvariant
function = %true
catch
function = %false
lerror = err
end try
gerror = lerror
end function
'=======================================================================
' function/sub: setcoordinates
' description: sets the left and top coordinates of a window. uses the
' same screen measurements as returned by getsystemmetrics
' variables:
' vobj_ie: this is a reference to a valid object
' lleft: left position of the window
' ltop: top position of the window
'=======================================================================
function setcoordinates(vobj_ie as variant, _
byval lleft as long, _
byval ltop as long) as long
local obj_ie as dispatch
local vleft as variant
local vtop as variant
local lerror as long
set obj_ie = vobj_ie
try
let vleft = lleft
let vtop = ltop
object let obj_ie.left = vleft
object let obj_ie.top = vtop
function = %true
catch
function = %false
lerror = err
end try
gerror = lerror
end function
'=======================================================================
' function/sub: visible
' description: sets the window's visiblity
' variables:
' vobj_ie: this is a reference to a valid object
' bool_visible: 0: window will not be visible
' 1: window will be visible
'=======================================================================
function visible(vobj_ie as variant, _
byval bool_visible as long) as long
local obj_ie as dispatch
local vvariant as variant
local lerror as long
set obj_ie = vobj_ie
select case as long bool_visible
case %false
let vvariant = 0
case %true
let vvariant = 1
case else:
let vvariant = 1
end select
try
object let obj_ie.visible = vvariant
function = %true
catch
function = %false
lerror = err
end try
gerror = lerror
end function
'***************************************************************************
'***************************************************************************
'***************************************************************************
function gcolor(byval i as long) as long
select case i
' common rgb colors:
case 0 : function = &h000000??? '%black - same as rgb(0,0,0)
case 1 : function = &hff0000??? '%blue
case 2 : function = &h00ff00??? '%green
case 3 : function = &hffff00??? '%cyan
case 4 : function = &h0000ff??? '%red
case 5 : function = &hff00ff??? '%magenta
case 6 : function = &h00ffff??? '%yellow
case 7 : function = &hffffff??? '%white - same as rgb(255,255,255)
case 8 : function = &h808080??? '%gray
case 9 : function = &hc0c0c0??? '%ltgray
' additional colors can be added e.g. using the rgb function,
' e.g. case 10: function = rgb(164,164,164)
' and so on.
case else : function = &h000000??? '%black
end select
end function
' ------------------------------------------------
function penstyle(byval i as long) as long
select case i
case 0 : function = %ps_solid ' _______
case 1 : function = %ps_dash ' -------
case 2 : function = %ps_dot ' .......
case 3 : function = %ps_dashdot ' _._._._
case 4 : function = %ps_dashdotdot ' _.._.._
case else: function = %ps_solid
end select
end function
' ------------------------------------------------
function makefont(byval fonttypesize as long,byval fontweight as long, _
byval italic as long, byval underline as long,byval strikeout as long, _
byval facename as string) as long
local lffont as logfont ' logfont structure
local hdc&,logpixelsy&
hdc = getdc(%hwnd_desktop)
'retrieves device-specific information about the number
'of pixels per logical inch along the screen height
'(depends on screen resolution setting).
'this is important to define appropriate font sizes.
logpixelsy = getdevicecaps(hdc, %logpixelsy)
releasedc %hwnd_desktop, hdc
'type logfont defines the attributes of a font.
'see logfont in the win32 help file
lffont.lfheight = -muldiv(fonttypesize,logpixelsy,72) ' better than: -(fonttypesize * logpixelsy) \ 72
' logical height of font
lffont.lfwidth = 0 ' logical average character width
lffont.lfescapement = 0 ' angle of escapement
lffont.lforientation = 0 ' base-line orientation angle
lffont.lfweight = fontweight ' font weight
lffont.lfitalic = italic ' italic attribute flag (0,1)
lffont.lfunderline = underline ' underline attribute flag (0,1)
lffont.lfstrikeout = strikeout ' strikeout attribute flag (0,1)
lffont.lfcharset = %ansi_charset ' character set identifier
lffont.lfoutprecision = %out_tt_precis ' output precision
lffont.lfclipprecision = %clip_default_precis ' clipping precision
lffont.lfquality = %default_quality ' output quality
lffont.lfpitchandfamily = %ff_dontcare ' pitch and family
lffont.lffacename = facename ' typeface name string
' make font according to specifications
function = createfontindirect (lffont)
end function
' ------------------------------------------------
sub makegraph(byval hdc as long,rct as rect,byref da() as single, _
byref gtext() as string, byval nm as long)
local hpen as long
local gtex as asciiz * 200
local i as long
local total as single
local cumul as single
local pi2 as single
local pct as long, radius as long
local recstart as long
local rc as rect
local hfont as long
local xleft as long, ytop as long, xright as long, ybottom as long
local xstart as long, ystart as long, xend as long, yend as long
local xtext as long, ytext as long, korr as long
local x1&,y1&, hbrush&
x1&=rct.nright
y1&=rct.nbottom
fillrect hdc, rct, getstockobject(%white_brush)
radius = y1&/3.6
xleft = x1&/2 - radius : xright = x1&/2 + radius
ytop = y1&/2 - radius : ybottom = y1&/2 + radius
total=0! : for i=1 to nm : total = total + da(i) : next
local tc$ : tc$ = "
for i=1 to nm
tc = tc + left$(gtext(i)+space$(12),13)+using$("######.## ##.##%",da(i),da(i)*100!/total)+$crlf
next
tc = tc + $crlf
tt = tt + tc : th = th + tc
'
hfont = makefont(8,400,0,0,0,"arial") : selectobject hdc, hfont
'
pi2=8!*atn(1#) : cumul=0!
korr=-9 ' empiric correction for height of characters. this may be improved.
for i=1 to nm
cumul = cumul + da(i) : pct=fix(100*da(i)/total+0.5)
xtext = int(x1&/2+(radius-korr)*cos(pi2 * (cumul - da(i)/2) / total)+0.5)
ytext = int(y1&/2-(radius-korr)*sin(pi2 * (cumul - da(i)/2) / total)+0.5)
if cos(pi2 * (cumul - da(i)/2) / total) >= 0 then
settextalign hdc,%ta_left ' text on right side of diagram
else
settextalign hdc,%ta_right ' text on left side of diagram
end if
gtex=gtext(i)+" ("+ltrim$(str$(pct))+"%)"
textout hdc, xtext, ytext+korr, gtex, byval len(gtex)
next
deleteobject hfont
'
xstart=x1&/2+radius: ystart=y1&/2 ' select starting point for pie pieces
cumul=0!
for i=1 to nm
cumul = cumul + da(i)
xend = int(x1&/2+radius*cos(pi2 * cumul / total)+0.5)
yend = int(y1&/2-radius*sin(pi2 * cumul / total)+0.5)
hpen = createpen(penstyle(0), 0, gcolor(i)) : selectobject hdc, hpen
hbrush = createsolidbrush(gcolor(i)) : selectobject hdc, hbrush
pie hdc, xleft,ytop,xright,ybottom, xstart, ystart, xend, yend
deleteobject hpen : deleteobject hbrush
xstart=xend: ystart=yend
next
end sub
'
sub showenhmetafile
local hemf&,hgr1&,hdc&,rct as rect
hemf = getenhmetafile(bycopy currentpath+"demonstration_figure"+trim$(str$(curgrano))+".emf" )
hgr1& = getdlgitem(hform1&, %idd_form1_labelgraphwindow)
getclientrect hgr1, rct
hdc = getdc(hgr1)
call playenhmetafile (hdc, hemf, rct)
deleteenhmetafile hemf
releasedc hgr1, hdc
control set text hform1&, %idd_form1_labelgraphic1, "figure"+str$(curgrano)
end sub
'
callback function form1_dlgproc
static vobj_ie as variant
static lret as long
static ltmp as long
select case cbmsg
case %wm_paint
local hdc&, ps as paintstruct, rc as rect
beginpaint cbhndl, ps
if istrue outmade& then
call showenhmetafile
else
getclientrect getdlgitem(cbhndl, %idd_form1_labelgraphwindow), rc
hdc = getdc(getdlgitem(cbhndl, %idd_form1_labelgraphwindow))
fillrect hdc, rc, getstockobject(%white_brush)
releasedc cbhndl, hdc
end if
endpaint cbhndl, ps
case %wm_command
select case cbctl
case %idd_form1_butdisplcomboutp
if cbctlmsg=%bn_clicked then
if createie(vobj_ie) = 0 then
error gerror
msgbox error$,%mb_iconerror,"error in creating ie-dialog"
end if
lret = setwidth(vobj_ie, getsystemmetrics (%sm_cxscreen)*0.6)
lret = setheight(vobj_ie, getsystemmetrics (%sm_cyscreen)*0.6)
lret = setcoordinates(vobj_ie, getsystemmetrics (%sm_cxscreen)*0.2, getsystemmetrics (%sm_cyscreen)*0.2)
lret = navigateto(vobj_ie, currentpath+"iecontrdemon.html")
lret = visible(vobj_ie, 1)
ltmp = 1
while ltmp > 0
lret = isbusy(vobj_ie, ltmp)
sleep 200 'unless you need to be doing something else
'its is best to just go to sleep for small
'periods so that ie can do what it needs
'to do without constantly being queried by
'this thread.
wend
end if
'
case %idd_form1_butnextfig
if cbctlmsg=%bn_clicked then
incr curgrano
if curgrano > totalgrano then curgrano = totalgrano : exit if
call showenhmetafile
end if
if curgrano > 1 then control enable hform1&, %idd_form1_butprevfig
if curgrano = totalgrano then
control disable hform1&, %idd_form1_butnextfig
control set focus hform1&, %idd_form1_butprevfig
end if
'
case %idd_form1_butprevfig
if cbctlmsg=%bn_clicked then
decr curgrano
if curgrano < 1 then curgrano = 1 : exit if
call showenhmetafile
end if
if curgrano < totalgrano then control enable hform1&, %idd_form1_butnextfig
if curgrano = 1 then
control disable hform1&, %idd_form1_butprevfig
control set focus hform1&, %idd_form1_butnextfig
end if
case else
end select
case else
end select
end function
'
function graphics(byval no as long,byref da() as single, _
byref gtext() as string, byval nm as long) as string
local rct as rect, hgr1&
local hdcref&,iwidthmm&,iheightmm&,iwidthpels&,iheightpels&
local hdcemf&, hemf&, hdc&, i&, kk&
' get handle to graphics window
hgr1& = getdlgitem(hform1&, %idd_form1_labelgraphwindow)
'
' specify rectancle in 0.01 mm units for creation of metafile:
'
' obtain a handle to a reference device context.
hdcref = getdc(hform1&)
'
' determine the full display dimensions.
' iwidthmm is the display width in millimeters.
' iheightmm is the display height in millimeters.
' iwidthpels is the display width in pixels.
' iheightpels is the display height in pixels
iwidthmm = getdevicecaps(hdcref, %horzsize)
iheightmm = getdevicecaps(hdcref, %vertsize)
iwidthpels = getdevicecaps(hdcref, %horzres)
iheightpels = getdevicecaps(hdcref, %vertres)
'
releasedc hform1&, hdcref
'
' retrieve the coordinates of the client rectangle, in pixels.
getclientrect hgr1,rct
' convert client coordinates to .01-mm units.
' use iwidthmm, iwidthpels, iheightmm, and
' iheightpels to determine the number of
' .01-millimeter units per pixel in the x- and y-directions.
rct.nleft = (rct.nleft * iwidthmm * 100)/iwidthpels
rct.ntop = (rct.ntop * iheightmm * 100)/iheightpels
rct.nright = (rct.nright * iwidthmm * 100)/iwidthpels
rct.nbottom = (rct.nbottom * iheightmm * 100)/iheightpels
'
' create enhanced metafile
hdcemf = createenhmetafile (%null, byval %null, rct, byval %null)
' get rectangle in pixels to display diagram
getclientrect hgr1, rct
call makegraph(hdcemf,rct,da(),gtext(),nm)
hemf = closeenhmetafile (hdcemf) ' get handle to enhanced metafile
'
' handle to device context of label where the diagram is to be drawn
hdc = getdc(hgr1)
' play enhanced metafile in the label window,
' i.e. the graphics procedures are now being performed in that window.
if no = 1 then
call playenhmetafile (hdc, hemf, rct)
control set text hform1&, %idd_form1_labelgraphic1, "figure"+str$(no)
end if
releasedc hgr1, hdc
'
local curpath as asciiz * 255, st$, pathandfile$, res&
'
getmodulefilename getmodulehandle("), curpath, 255 'get current path & exe
'
st$=curpath
'
currentpath=left$(st$,instr(-1, st$, any ":\/"))
pathandfile$=currentpath+"demonstration_figure"+trim$(str$(no))+".emf"
'
res& = copyenhmetafile(hemf,bycopy pathandfile$) ' save to disk
deleteenhmetafile hemf
function = pathandfile$
end function
callback function cbf_form1_butmakeoutput
local i&, kk&, no&, graphfile$, txt$
dim da(5) as single, gtext(5) as string, su(5) as single
if cbctlmsg=%bn_clicked then
' th is the html text string to be used for the ie control
' ***************************
' first the html text header:
' ***************************
th = "<html>"+$crlf ' start of html-document
th = th +"<head>"+$crlf ' start of header
th = th +"<meta http-equiv="content-type" content="text/html; charset=iso-8859-1">"+$crlf ' technical specification
txt = "ie display and print demonstration" ' title text
th = th +"<title>"+txt+"</title>"+$crlf ' title
th = th +"</head>"+$crlf ' end of header
th = th +"<body>"+$crlf ' start of body of content
th = th +"<pre>"+$crlf ' preformatted text
th = th +"<font face="courier new" color="#0000ff">"+$crlf ' font type and color ' font color
' ****************************
'
' tt is the plain text for a textbox
tt = txt + $crlf + $crlf
'
th = th + txt + $crlf + $crlf
'
kk = 0
' data are completely imaginary
' they are only for illustration
data food, house, clothes, leisure, travel
for i=1 to 5 : incr kk : gtext(kk)=read$(kk) : next
'
data 452.92, 665.40, 87.76, 186.54
' expenses period 1
for i=1 to 4 : incr kk : da(i) = val(read$(kk)) : su(i) = su(i) + da(i) : next
no = 1
tt = tt + " period"+str$(no)+$crlf
th = th + " <b><i><u>period"+str$(no)+"</b></i></u>"+$crlf
curgrano = 1
graphfile$ = graphics(no, da(), gtext(), 4)
' include this graph in the html-tagged text file.
tt = tt + " figure"+str$(no)+$crlf+$crlf
th = th + " figure"+str$(no)
th = th + $crlf + "<img src=""+graphfile$+"" border=1>" + $crlf + $crlf
'
data 438.39, 666.24, 130.65, 230.54
' expenses period 2
for i=1 to 4 : incr kk : da(i) = val(read$(kk)) : su(i) = su(i) + da(i) : next
incr no
tt = tt + " period"+str$(no)+$crlf
th = th + " <b><i><u>period"+str$(no)+"</b></i></u>"+$crlf
graphfile$ = graphics(no, da(), gtext(), 4)
' include this graph in the html-tagged text file.
tt = tt + " figure"+str$(no)+$crlf+$crlf
th = th + " figure"+str$(no)
th = th + $crlf + "<img src=""+graphfile$+"" border=1>" + $crlf + $crlf
'
data 410.67, 766.56, 200.65, 250.23, 698.54
' expenses period 3
for i=1 to 5 : incr kk : da(i) = val(read$(kk)) : su(i) = su(i) + da(i) : next
incr no
tt = tt + " period"+str$(no)+$crlf
th = th + " <b><i><u>period"+str$(no)+"</b></i></u>"+$crlf
graphfile$ = graphics(no, da(), gtext(), 5)
' include this graph in the html-tagged text file.
tt = tt + " figure"+str$(no)+$crlf+$crlf
th = th + " figure"+str$(no)
th = th + $crlf + "<img src=""+graphfile$+"" border=1>" + $crlf + $crlf
'
data 502.37, 685.23, 41.65, 146.87
' ' expenses period 4
for i=1 to 4 : incr kk : da(i) = val(read$(kk)) : su(i) = su(i) + da(i) : next
incr no
tt = tt + " period"+str$(no)+$crlf
th = th + " <b><i><u>period"+str$(no)+"</b></i></u>"+$crlf
graphfile$ = graphics(no, da(), gtext(), 4)
' include this graph in the html-tagged text file.
tt = tt + " figure"+str$(no)+$crlf+$crlf
th = th + " figure"+str$(no)
th = th + $crlf + "<img src=""+graphfile$+"" border=1>" + $crlf + $crlf
'
local total!
for i = 1 to 5 : total = total + su(i) : next
incr no
tt = tt + " results for all 4 periods"+$crlf
th = th + " <b><i><u>results for all 4 periods</b></i></u>"+$crlf
graphfile$ = graphics(no, su(), gtext(), 5)
' include this graph in the html-tagged text file.
tt = tt + " figure"+str$(no)+$crlf+$crlf
th = th + " figure"+str$(no)
th = th + $crlf + "<img src=""+graphfile$+"" border=1>" + $crlf + $crlf
'
tt = tt + " - - - - -"+$crlf
th = th + " - - - - -"+$crlf
' **********************
' end tags of html text:
' **********************
th = th +"</font>"+$crlf
th = th +"</pre>"+$crlf
th = th +"</body>"+$crlf
th = th +"</html>"+$crlf
' ***************************
totalgrano = no
control set text hform1&, %idd_form1_texthtml, th
control set text hform1&, %idd_form1_textraw, tt
'
' save html-string as a html-file
local x& : x& = freefile
open currentpath+"iecontrdemon.html" for binary as #x&
put$ #x&, th
seteof #x& ' important if you have used the same file name before.
close #x&
'
control disable hform1&, %idd_form1_butprevfig
control enable hform1&, %idd_form1_butnextfig
control enable hform1&, %idd_form1_butdisplcomboutp
outmade& = %true ' output flag set to true
end if
end function
' ------------------------------------------------
callback function cbf_form1_buttonexit
if cbctlmsg=%bn_clicked then dialog end hform1&
end function
' ------------------------------------------------
sub showdialog_form1(byval hparent&)
local style&, exstyle&
style& = %ws_popup or %ds_modalframe or %ws_caption or %ws_minimizebox or %ws_sysmenu or %ds_center or %ws_clipchildren
exstyle& = 0
dialog new hparent&, "simple displaying and printing of text and
' ====================================================================
'
' comment here please:
http://www.powerbasic.com/support/pb...ad.php?t=10177
'
' many thanks to terry reese for his original ie-control code at this link:
http://www.powerbasic.com/support/pb...ead.php?t=8184
' i could not have made this program without his code.
'
' march 27th 2004: some improvements have been made. if you have ie-6,
' enhanced metafile graphics are printed in correct colors.
'
' march 31st 2004: a small problem with repainting has been
' corrected thanks to brad byrne, who provided the necessary
' inspiration.
'
' using the ie-control you can display and print text and graphics output
' from your pb-programs in a simple and easy way. this program demonstrates
' how. the formating of the output is made using the standard html-tags.
' the most common of these tags are shown below. normally you would only
' need very few as demonstrated in this program.
'
' the text output from your program should be presented to the ie-control
' in condensed form as a single text-string with html-tags inserted where
' specific formatting features are needed. by letting your program insert
' the relevant html-tags, you can format your text as you wish. normally
' you would only need to use very few of them. it is important, however,
' that you supply the html-tagged text with a standardized starting and
' ending sequence like those shown in this program.
'
' graphics output from pb programs can be saved in enhanced metafiles, which
' can be inserted anywhere in the output text-string by placing a html
' image tag with an url referring to the graphics file in question. (by the
' way, image files in other formats can also be inserted.)
'
' by clicking the right mouse button you can obtain a shortcut menu (slightly
' different if you click over a picture or over the text) by which you can
' copy to the clipboard or print the content via the printer dialog box. my
' version of ie (vers. 5) cannot print the enhanced metafile graphics in
' correct colors. i wonder if later versions have solved that problem?
' if you copy to word and print from there, the colors are ok. so it seems
' to be a problem caused in - at least earlier versions of - the ie printer
' driver.
'
' good luck!
'
' best regards,
'
' erik christensen -------- [email protected] --------- march 23, 2004
[CODE]
'****************************************************************************
' some common html-tags:
'****************************************************************************
' basic elements
' document type <html></html> (beginning and end of file)
' title <title></title> (must be in header)
' header <head></head> (descriptive info, such as title)
' body <body></body> (bulk of the page)
'
' structural definition
' heading <h?></h?> (the spec. defines 6 levels)
' align heading <h? align=left|center|right></h?>
' code <code></code> (for source code listings)
' large font size <big></big>
' small font size <small></small>
'
' presentation formatting
' bold <b></b>
' italic <i></i>
' underline <u></u>
' subscript <sub></sub>
' superscript <sup></sup>
' preformatted <pre></pre> (display text spacing as-is)
' center <center></center> (for both text and images)
' font size <font size=?></font> (ranges from 1-7)
' change font size <font size="+|-?"></font>
' font color <font color="#$$$$$$"></font> (order is red/green/blue)
' select font <font face="***"></font>
' point size <font point-size=?></font>
' weight <font weight=?></font>
' base font size <basefont size=?> (from 1-7; default is 3)
' marquee <marquee></marquee>
'
' positioning
' spacer <spacer>
' size <spacer size=?>
'
' graphics
' display image <img src="url">
' alignment <img src="url" align=top|bottom|middle|left|right>
' alignment <img src="url" align=texttop|absmiddle|baseline|absbottom>
' dimensions <img src="url" width=? height=?> (in pixels)
' <img src="url" width=% height=%> (as percentage of page width/height)
' border <img src="url" border=?> (in pixels)
' runaround space <img src="url" hspace=? vspace=?> (in pixels)
' embed object <embed src="url"> (insert object into page)
' object size <embed src="url" width=? height=?>
'
' dividers
' paragraph <p></p> (closing tag often unnecessary)
' align text <p align=left|center|right></p>
' justify text <p align=justify></p>
' line break <br> (a single carriage return)
' clear textwrap <br clear=left|right|all>
' no break <nobr></nobr> (prevents line breaks)
' word break <wbr> (where to break a line if needed)
'
' backgrounds and colors
' tiled bkground <body background="url">
' watermark <body bgproperties="fixed">
' bkground color <body bgcolor="#$$$$$$"> (order is red/green/blue)
' text color <body text="#$$$$$$">
'
' miscellaneous
' url of this file <base href="url"> (must be in header)
' base window name <base target="***"> (must be in header)
'
'****************************************************************************
#compile exe
#register none
#dim all
'
#include "win32api.inc"
#include "commctrl.inc"
'
%idd_form1_labelrawtext = 100
%idd_form1_labelgraphic1 = 105
%idd_form1_labelhtmltext = 110
%idd_form1_labelgraphwindow = 115
%idd_form1_butmakeoutput = 120
%idd_form1_butdisplcomboutp = 125
%idd_form1_buttonexit = 135
%idd_form1_texthtml = 140
%idd_form1_textraw = 145
%idd_form1_butprevfig = 150
%idd_form1_butnextfig = 155
'
global hform1&
global gerror as long ' stores the error variable
global curgrano as long
global totalgrano as long
global currentpath as string
global th$, tt$ ' th is for html-tagged text, tt is for plain text.
global outmade&
'
'=======================================================================
' the following 7 functions are due to terry reese - thanks
'=======================================================================
' function/sub: createie
' description: creates an instance of ie and sets the window properties
' of the new session.
' variables:
' vobj_ie: reference to a variant in the calling code --
' this will be the object that you will use in
' subsequent calls.
'=======================================================================
' this is a simplified version of terry's original function.
' see above link for original version.
function createie(byref vobj_ie as variant) as long
local obj_ie as dispatch
local vtoolbar as variant ' not used - set to zero
local vmenu as variant ' not used - set to zero
local vaddressbar as variant ' not used - set to zero
local vresizable as variant ' not used - set to zero
local vstatusbar as variant ' not used - set to zero
local lerror as long
'
set obj_ie = new dispatch in "internetexplorer.application"
if isfalse isobject (obj_ie) then
function = %false
else:
try
object let obj_ie.toolbar = vtoolbar
object let obj_ie.menubar = vmenu
object let obj_ie.addressbar = vaddressbar
object let obj_ie.resizable = vresizable
object let obj_ie.statusbar = vstatusbar
set vobj_ie = obj_ie
set obj_ie = nothing
function = %true
catch
function = %false
set obj_ie = nothing
lerror = err
end try
end if
gerror = lerror
end function
'=======================================================================
' function/sub: navigateto
' description: use this function to navigate to a url or file.
' this works just like typing into the ie addressbar
' variables:
' vobj_ie: this is a reference to a valid object
' surl: this is the url/file to load
'=======================================================================
function navigateto(vobj_ie as variant, byval surl as string) as long
local obj_ie as dispatch
local vurl as variant
local lerror as long
set obj_ie = vobj_ie
let vurl = surl
try
object call obj_ie.navigate(vurl)
function = %true
catch
function = %false
lerror = err
end try
gerror = lerror
end function
'=======================================================================
' function/sub: isbusy
' description: queries ie to see if the object has finished loading
' the current url/file
' variables:
' vobj_ie: this is a reference to a valid object
' lbusy: return value. 0 = not busy 1 = busy
'=======================================================================
function isbusy(vobj_ie as variant, lbusy as long) as long
local obj_ie as dispatch
local vvariant as variant
local lerror as long
set obj_ie = vobj_ie
try
object get obj_ie.busy to vvariant
lbusy = variant#(vvariant)
function = %true
catch
function = %false
lerror = err
end try
gerror = lerror
end function
'=======================================================================
' function/sub: setheight
' description: accesses the ie height property (window)
' variables:
' vobj_ie: this is a reference to a valid object
' lheight: height of the window
'=======================================================================
function setheight(vobj_ie as variant, byval lheight as long) as long
local obj_ie as dispatch
local tvariant as variant
local lerror as long
set obj_ie = vobj_ie
try
let tvariant = lheight
object let obj_ie.height = tvariant
function = %true
catch
function = %false
lerror = err
end try
gerror = lerror
end function
'=======================================================================
' function/sub: setwidth
' description: accesses the ie width property (window)
' variables:
' vobj_ie: this is a reference to a valid object
' lwidth: width of the window
'=======================================================================
function setwidth(vobj_ie as variant, byval lwidth as long) as long
local obj_ie as dispatch
local tvariant as variant
local lerror as long
set obj_ie = vobj_ie
try
let tvariant = lwidth
object let obj_ie.width = tvariant
function = %true
catch
function = %false
lerror = err
end try
gerror = lerror
end function
'=======================================================================
' function/sub: setcoordinates
' description: sets the left and top coordinates of a window. uses the
' same screen measurements as returned by getsystemmetrics
' variables:
' vobj_ie: this is a reference to a valid object
' lleft: left position of the window
' ltop: top position of the window
'=======================================================================
function setcoordinates(vobj_ie as variant, _
byval lleft as long, _
byval ltop as long) as long
local obj_ie as dispatch
local vleft as variant
local vtop as variant
local lerror as long
set obj_ie = vobj_ie
try
let vleft = lleft
let vtop = ltop
object let obj_ie.left = vleft
object let obj_ie.top = vtop
function = %true
catch
function = %false
lerror = err
end try
gerror = lerror
end function
'=======================================================================
' function/sub: visible
' description: sets the window's visiblity
' variables:
' vobj_ie: this is a reference to a valid object
' bool_visible: 0: window will not be visible
' 1: window will be visible
'=======================================================================
function visible(vobj_ie as variant, _
byval bool_visible as long) as long
local obj_ie as dispatch
local vvariant as variant
local lerror as long
set obj_ie = vobj_ie
select case as long bool_visible
case %false
let vvariant = 0
case %true
let vvariant = 1
case else:
let vvariant = 1
end select
try
object let obj_ie.visible = vvariant
function = %true
catch
function = %false
lerror = err
end try
gerror = lerror
end function
'***************************************************************************
'***************************************************************************
'***************************************************************************
function gcolor(byval i as long) as long
select case i
' common rgb colors:
case 0 : function = &h000000??? '%black - same as rgb(0,0,0)
case 1 : function = &hff0000??? '%blue
case 2 : function = &h00ff00??? '%green
case 3 : function = &hffff00??? '%cyan
case 4 : function = &h0000ff??? '%red
case 5 : function = &hff00ff??? '%magenta
case 6 : function = &h00ffff??? '%yellow
case 7 : function = &hffffff??? '%white - same as rgb(255,255,255)
case 8 : function = &h808080??? '%gray
case 9 : function = &hc0c0c0??? '%ltgray
' additional colors can be added e.g. using the rgb function,
' e.g. case 10: function = rgb(164,164,164)
' and so on.
case else : function = &h000000??? '%black
end select
end function
' ------------------------------------------------
function penstyle(byval i as long) as long
select case i
case 0 : function = %ps_solid ' _______
case 1 : function = %ps_dash ' -------
case 2 : function = %ps_dot ' .......
case 3 : function = %ps_dashdot ' _._._._
case 4 : function = %ps_dashdotdot ' _.._.._
case else: function = %ps_solid
end select
end function
' ------------------------------------------------
function makefont(byval fonttypesize as long,byval fontweight as long, _
byval italic as long, byval underline as long,byval strikeout as long, _
byval facename as string) as long
local lffont as logfont ' logfont structure
local hdc&,logpixelsy&
hdc = getdc(%hwnd_desktop)
'retrieves device-specific information about the number
'of pixels per logical inch along the screen height
'(depends on screen resolution setting).
'this is important to define appropriate font sizes.
logpixelsy = getdevicecaps(hdc, %logpixelsy)
releasedc %hwnd_desktop, hdc
'type logfont defines the attributes of a font.
'see logfont in the win32 help file
lffont.lfheight = -muldiv(fonttypesize,logpixelsy,72) ' better than: -(fonttypesize * logpixelsy) \ 72
' logical height of font
lffont.lfwidth = 0 ' logical average character width
lffont.lfescapement = 0 ' angle of escapement
lffont.lforientation = 0 ' base-line orientation angle
lffont.lfweight = fontweight ' font weight
lffont.lfitalic = italic ' italic attribute flag (0,1)
lffont.lfunderline = underline ' underline attribute flag (0,1)
lffont.lfstrikeout = strikeout ' strikeout attribute flag (0,1)
lffont.lfcharset = %ansi_charset ' character set identifier
lffont.lfoutprecision = %out_tt_precis ' output precision
lffont.lfclipprecision = %clip_default_precis ' clipping precision
lffont.lfquality = %default_quality ' output quality
lffont.lfpitchandfamily = %ff_dontcare ' pitch and family
lffont.lffacename = facename ' typeface name string
' make font according to specifications
function = createfontindirect (lffont)
end function
' ------------------------------------------------
sub makegraph(byval hdc as long,rct as rect,byref da() as single, _
byref gtext() as string, byval nm as long)
local hpen as long
local gtex as asciiz * 200
local i as long
local total as single
local cumul as single
local pi2 as single
local pct as long, radius as long
local recstart as long
local rc as rect
local hfont as long
local xleft as long, ytop as long, xright as long, ybottom as long
local xstart as long, ystart as long, xend as long, yend as long
local xtext as long, ytext as long, korr as long
local x1&,y1&, hbrush&
x1&=rct.nright
y1&=rct.nbottom
fillrect hdc, rct, getstockobject(%white_brush)
radius = y1&/3.6
xleft = x1&/2 - radius : xright = x1&/2 + radius
ytop = y1&/2 - radius : ybottom = y1&/2 + radius
total=0! : for i=1 to nm : total = total + da(i) : next
local tc$ : tc$ = "
for i=1 to nm
tc = tc + left$(gtext(i)+space$(12),13)+using$("######.## ##.##%",da(i),da(i)*100!/total)+$crlf
next
tc = tc + $crlf
tt = tt + tc : th = th + tc
'
hfont = makefont(8,400,0,0,0,"arial") : selectobject hdc, hfont
'
pi2=8!*atn(1#) : cumul=0!
korr=-9 ' empiric correction for height of characters. this may be improved.
for i=1 to nm
cumul = cumul + da(i) : pct=fix(100*da(i)/total+0.5)
xtext = int(x1&/2+(radius-korr)*cos(pi2 * (cumul - da(i)/2) / total)+0.5)
ytext = int(y1&/2-(radius-korr)*sin(pi2 * (cumul - da(i)/2) / total)+0.5)
if cos(pi2 * (cumul - da(i)/2) / total) >= 0 then
settextalign hdc,%ta_left ' text on right side of diagram
else
settextalign hdc,%ta_right ' text on left side of diagram
end if
gtex=gtext(i)+" ("+ltrim$(str$(pct))+"%)"
textout hdc, xtext, ytext+korr, gtex, byval len(gtex)
next
deleteobject hfont
'
xstart=x1&/2+radius: ystart=y1&/2 ' select starting point for pie pieces
cumul=0!
for i=1 to nm
cumul = cumul + da(i)
xend = int(x1&/2+radius*cos(pi2 * cumul / total)+0.5)
yend = int(y1&/2-radius*sin(pi2 * cumul / total)+0.5)
hpen = createpen(penstyle(0), 0, gcolor(i)) : selectobject hdc, hpen
hbrush = createsolidbrush(gcolor(i)) : selectobject hdc, hbrush
pie hdc, xleft,ytop,xright,ybottom, xstart, ystart, xend, yend
deleteobject hpen : deleteobject hbrush
xstart=xend: ystart=yend
next
end sub
'
sub showenhmetafile
local hemf&,hgr1&,hdc&,rct as rect
hemf = getenhmetafile(bycopy currentpath+"demonstration_figure"+trim$(str$(curgrano))+".emf" )
hgr1& = getdlgitem(hform1&, %idd_form1_labelgraphwindow)
getclientrect hgr1, rct
hdc = getdc(hgr1)
call playenhmetafile (hdc, hemf, rct)
deleteenhmetafile hemf
releasedc hgr1, hdc
control set text hform1&, %idd_form1_labelgraphic1, "figure"+str$(curgrano)
end sub
'
callback function form1_dlgproc
static vobj_ie as variant
static lret as long
static ltmp as long
select case cbmsg
case %wm_paint
local hdc&, ps as paintstruct, rc as rect
beginpaint cbhndl, ps
if istrue outmade& then
call showenhmetafile
else
getclientrect getdlgitem(cbhndl, %idd_form1_labelgraphwindow), rc
hdc = getdc(getdlgitem(cbhndl, %idd_form1_labelgraphwindow))
fillrect hdc, rc, getstockobject(%white_brush)
releasedc cbhndl, hdc
end if
endpaint cbhndl, ps
case %wm_command
select case cbctl
case %idd_form1_butdisplcomboutp
if cbctlmsg=%bn_clicked then
if createie(vobj_ie) = 0 then
error gerror
msgbox error$,%mb_iconerror,"error in creating ie-dialog"
end if
lret = setwidth(vobj_ie, getsystemmetrics (%sm_cxscreen)*0.6)
lret = setheight(vobj_ie, getsystemmetrics (%sm_cyscreen)*0.6)
lret = setcoordinates(vobj_ie, getsystemmetrics (%sm_cxscreen)*0.2, getsystemmetrics (%sm_cyscreen)*0.2)
lret = navigateto(vobj_ie, currentpath+"iecontrdemon.html")
lret = visible(vobj_ie, 1)
ltmp = 1
while ltmp > 0
lret = isbusy(vobj_ie, ltmp)
sleep 200 'unless you need to be doing something else
'its is best to just go to sleep for small
'periods so that ie can do what it needs
'to do without constantly being queried by
'this thread.
wend
end if
'
case %idd_form1_butnextfig
if cbctlmsg=%bn_clicked then
incr curgrano
if curgrano > totalgrano then curgrano = totalgrano : exit if
call showenhmetafile
end if
if curgrano > 1 then control enable hform1&, %idd_form1_butprevfig
if curgrano = totalgrano then
control disable hform1&, %idd_form1_butnextfig
control set focus hform1&, %idd_form1_butprevfig
end if
'
case %idd_form1_butprevfig
if cbctlmsg=%bn_clicked then
decr curgrano
if curgrano < 1 then curgrano = 1 : exit if
call showenhmetafile
end if
if curgrano < totalgrano then control enable hform1&, %idd_form1_butnextfig
if curgrano = 1 then
control disable hform1&, %idd_form1_butprevfig
control set focus hform1&, %idd_form1_butnextfig
end if
case else
end select
case else
end select
end function
'
function graphics(byval no as long,byref da() as single, _
byref gtext() as string, byval nm as long) as string
local rct as rect, hgr1&
local hdcref&,iwidthmm&,iheightmm&,iwidthpels&,iheightpels&
local hdcemf&, hemf&, hdc&, i&, kk&
' get handle to graphics window
hgr1& = getdlgitem(hform1&, %idd_form1_labelgraphwindow)
'
' specify rectancle in 0.01 mm units for creation of metafile:
'
' obtain a handle to a reference device context.
hdcref = getdc(hform1&)
'
' determine the full display dimensions.
' iwidthmm is the display width in millimeters.
' iheightmm is the display height in millimeters.
' iwidthpels is the display width in pixels.
' iheightpels is the display height in pixels
iwidthmm = getdevicecaps(hdcref, %horzsize)
iheightmm = getdevicecaps(hdcref, %vertsize)
iwidthpels = getdevicecaps(hdcref, %horzres)
iheightpels = getdevicecaps(hdcref, %vertres)
'
releasedc hform1&, hdcref
'
' retrieve the coordinates of the client rectangle, in pixels.
getclientrect hgr1,rct
' convert client coordinates to .01-mm units.
' use iwidthmm, iwidthpels, iheightmm, and
' iheightpels to determine the number of
' .01-millimeter units per pixel in the x- and y-directions.
rct.nleft = (rct.nleft * iwidthmm * 100)/iwidthpels
rct.ntop = (rct.ntop * iheightmm * 100)/iheightpels
rct.nright = (rct.nright * iwidthmm * 100)/iwidthpels
rct.nbottom = (rct.nbottom * iheightmm * 100)/iheightpels
'
' create enhanced metafile
hdcemf = createenhmetafile (%null, byval %null, rct, byval %null)
' get rectangle in pixels to display diagram
getclientrect hgr1, rct
call makegraph(hdcemf,rct,da(),gtext(),nm)
hemf = closeenhmetafile (hdcemf) ' get handle to enhanced metafile
'
' handle to device context of label where the diagram is to be drawn
hdc = getdc(hgr1)
' play enhanced metafile in the label window,
' i.e. the graphics procedures are now being performed in that window.
if no = 1 then
call playenhmetafile (hdc, hemf, rct)
control set text hform1&, %idd_form1_labelgraphic1, "figure"+str$(no)
end if
releasedc hgr1, hdc
'
local curpath as asciiz * 255, st$, pathandfile$, res&
'
getmodulefilename getmodulehandle("), curpath, 255 'get current path & exe
'
st$=curpath
'
currentpath=left$(st$,instr(-1, st$, any ":\/"))
pathandfile$=currentpath+"demonstration_figure"+trim$(str$(no))+".emf"
'
res& = copyenhmetafile(hemf,bycopy pathandfile$) ' save to disk
deleteenhmetafile hemf
function = pathandfile$
end function
callback function cbf_form1_butmakeoutput
local i&, kk&, no&, graphfile$, txt$
dim da(5) as single, gtext(5) as string, su(5) as single
if cbctlmsg=%bn_clicked then
' th is the html text string to be used for the ie control
' ***************************
' first the html text header:
' ***************************
th = "<html>"+$crlf ' start of html-document
th = th +"<head>"+$crlf ' start of header
th = th +"<meta http-equiv="content-type" content="text/html; charset=iso-8859-1">"+$crlf ' technical specification
txt = "ie display and print demonstration" ' title text
th = th +"<title>"+txt+"</title>"+$crlf ' title
th = th +"</head>"+$crlf ' end of header
th = th +"<body>"+$crlf ' start of body of content
th = th +"<pre>"+$crlf ' preformatted text
th = th +"<font face="courier new" color="#0000ff">"+$crlf ' font type and color ' font color
' ****************************
'
' tt is the plain text for a textbox
tt = txt + $crlf + $crlf
'
th = th + txt + $crlf + $crlf
'
kk = 0
' data are completely imaginary
' they are only for illustration
data food, house, clothes, leisure, travel
for i=1 to 5 : incr kk : gtext(kk)=read$(kk) : next
'
data 452.92, 665.40, 87.76, 186.54
' expenses period 1
for i=1 to 4 : incr kk : da(i) = val(read$(kk)) : su(i) = su(i) + da(i) : next
no = 1
tt = tt + " period"+str$(no)+$crlf
th = th + " <b><i><u>period"+str$(no)+"</b></i></u>"+$crlf
curgrano = 1
graphfile$ = graphics(no, da(), gtext(), 4)
' include this graph in the html-tagged text file.
tt = tt + " figure"+str$(no)+$crlf+$crlf
th = th + " figure"+str$(no)
th = th + $crlf + "<img src=""+graphfile$+"" border=1>" + $crlf + $crlf
'
data 438.39, 666.24, 130.65, 230.54
' expenses period 2
for i=1 to 4 : incr kk : da(i) = val(read$(kk)) : su(i) = su(i) + da(i) : next
incr no
tt = tt + " period"+str$(no)+$crlf
th = th + " <b><i><u>period"+str$(no)+"</b></i></u>"+$crlf
graphfile$ = graphics(no, da(), gtext(), 4)
' include this graph in the html-tagged text file.
tt = tt + " figure"+str$(no)+$crlf+$crlf
th = th + " figure"+str$(no)
th = th + $crlf + "<img src=""+graphfile$+"" border=1>" + $crlf + $crlf
'
data 410.67, 766.56, 200.65, 250.23, 698.54
' expenses period 3
for i=1 to 5 : incr kk : da(i) = val(read$(kk)) : su(i) = su(i) + da(i) : next
incr no
tt = tt + " period"+str$(no)+$crlf
th = th + " <b><i><u>period"+str$(no)+"</b></i></u>"+$crlf
graphfile$ = graphics(no, da(), gtext(), 5)
' include this graph in the html-tagged text file.
tt = tt + " figure"+str$(no)+$crlf+$crlf
th = th + " figure"+str$(no)
th = th + $crlf + "<img src=""+graphfile$+"" border=1>" + $crlf + $crlf
'
data 502.37, 685.23, 41.65, 146.87
' ' expenses period 4
for i=1 to 4 : incr kk : da(i) = val(read$(kk)) : su(i) = su(i) + da(i) : next
incr no
tt = tt + " period"+str$(no)+$crlf
th = th + " <b><i><u>period"+str$(no)+"</b></i></u>"+$crlf
graphfile$ = graphics(no, da(), gtext(), 4)
' include this graph in the html-tagged text file.
tt = tt + " figure"+str$(no)+$crlf+$crlf
th = th + " figure"+str$(no)
th = th + $crlf + "<img src=""+graphfile$+"" border=1>" + $crlf + $crlf
'
local total!
for i = 1 to 5 : total = total + su(i) : next
incr no
tt = tt + " results for all 4 periods"+$crlf
th = th + " <b><i><u>results for all 4 periods</b></i></u>"+$crlf
graphfile$ = graphics(no, su(), gtext(), 5)
' include this graph in the html-tagged text file.
tt = tt + " figure"+str$(no)+$crlf+$crlf
th = th + " figure"+str$(no)
th = th + $crlf + "<img src=""+graphfile$+"" border=1>" + $crlf + $crlf
'
tt = tt + " - - - - -"+$crlf
th = th + " - - - - -"+$crlf
' **********************
' end tags of html text:
' **********************
th = th +"</font>"+$crlf
th = th +"</pre>"+$crlf
th = th +"</body>"+$crlf
th = th +"</html>"+$crlf
' ***************************
totalgrano = no
control set text hform1&, %idd_form1_texthtml, th
control set text hform1&, %idd_form1_textraw, tt
'
' save html-string as a html-file
local x& : x& = freefile
open currentpath+"iecontrdemon.html" for binary as #x&
put$ #x&, th
seteof #x& ' important if you have used the same file name before.
close #x&
'
control disable hform1&, %idd_form1_butprevfig
control enable hform1&, %idd_form1_butnextfig
control enable hform1&, %idd_form1_butdisplcomboutp
outmade& = %true ' output flag set to true
end if
end function
' ------------------------------------------------
callback function cbf_form1_buttonexit
if cbctlmsg=%bn_clicked then dialog end hform1&
end function
' ------------------------------------------------
sub showdialog_form1(byval hparent&)
local style&, exstyle&
style& = %ws_popup or %ds_modalframe or %ws_caption or %ws_minimizebox or %ws_sysmenu or %ds_center or %ws_clipchildren
exstyle& = 0
dialog new hparent&, "simple displaying and printing of text and
Comment