Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Preview, Print and Save As for embedded IE-control (Semen's code)

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Preview, Print and Save As for embedded IE-control (Semen's code)

    ' preview, print and save as for embedded ie-control (semen's code)
    ' =================================================================
    '
    ' this is a 5th version of "simple displaying and printing of text and
    ' graphics using ie-control".
    '
    ' but this version is using the elegant super code for webbrowser without
    ' external dlls by semen matusovski, who i thank very much.
    '
    ' nb: you need to save and use the include file in the
    ' following post.
    '
    ' semens original code is at this link:
    ' http://www.powerbasic.com/support/pb...ad.php?t=24065
    ' semen's code includes preview, through which you can see and modify the
    ' page setup, print and save as. the latter is particularly interesting
    ' because you can save the code in the ie-control in various formats
    ' including the mht-format i.e. in a single file format which includes the
    ' graphics codes as an integral part of the file. all these features are
    ' utilized in this version which also provides an open (html, not mht) file option.
    '
    ' this code should work for internet explorer version 4 or higher. however,
    ' with version 4 printing of enhanced metafile graphics may result in wrong
    ' colors. this is not a problem with verison 5 or later.
    '
    ' 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.
    '
    ' 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.
    ' version 6 of ie prints the enhanced metafile graphics in correct colors.
    '
    ' good luck!
    '
    ' best regards,
    '
    ' erik christensen -------- e.chr@email.dk --------- may 17, 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 "comdlg32.inc"
    #include "comobj2.inc"
    '
    %idd_form1_labelcomboutput    = 100
    %idd_form1_labelrawtext       = 105
    %idd_form1_labelgraphic1      = 110
    %idd_form1_labelhtmltext      = 115
    %idd_form1_labelgraphwindow   = 120
    %idd_form1_butmakeoutput      = 125
    %idd_form1_butdisplcomboutp   = 130
    %idd_form1_buttonexit         = 140
    %idd_form1_texthtml           = 145
    %idd_form1_textraw            = 150
    %idd_form1_butprevfig         = 155
    %idd_form1_butnextfig         = 160
    %idd_form1_butpreview         = 165
    %idd_form1_butprint           = 170
    %idd_form1_butsaveas          = 175
    %idd_form1_butopenfile        = 180
    %id_ie1                       = 185
    '
    global hform1 as dword
    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&
    global memdc as long
    global hiect as dword
    global h&,w&
    '
    %wm_forwardmsg = &h37f ' (895)
    '
    '***************************************************************************
    '***************************************************************************
    '
    function a(byval x1 as long) as long
        function = x1 * w / 396
    end function
    '
    function b(byval y1 as long) as long
        function = y1 * h / 280
    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(7,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&,rc as rect
        hemf = getenhmetafile(bycopy currentpath+"demonstration_figure"+trim$(str$(curgrano))+".emf" )
        hgr1& = getdlgitem(hform1, %idd_form1_labelgraphwindow)
        getclientrect hgr1, rc
        hdc = getdc(hgr1)
        call playenhmetafile (hdc, hemf, rc)
        ' copy graphics onto virtual window.
        bitblt memdc,0,0, rc.nright, rc.nbottom, hdc,0,0,%srccopy
        deleteenhmetafile hemf
        releasedc hgr1, hdc
        control set text hform1, %idd_form1_labelgraphic1, "figure"+str$(curgrano)
    end sub
    '
    function openhtmfile as long
       dim pwebbrowserdata as local  webbrowserdata ptr
       pwebbrowserdata = strptr(szwebbrowserdata)
       local path   as string
       local f      as string
       local style  as dword
       local x&, ttt$
       path     = curdir$
       f        = "*.html;*htm"
       style    = %ofn_filemustexist or %ofn_hidereadonly or %ofn_longnames
       if openfiledialog(0, "open html/htm file", f, path, _
         "html/htm files|*.html;*.htm|all files|*.*", "html", style) then
          x& = freefile
          open f for binary as #x&
          get$ #x&, lof(x&), ttt$
          close #x&
          displayhtmlstring 1, ttt$
          control enable hform1, %idd_form1_butpreview
          control enable hform1, %idd_form1_butprint
          control enable hform1, %idd_form1_butsaveas
          function = 1
       end if
    end function
    
    callback function form1_dlgproc
        '
        dim pwebbrowserdata as local  webbrowserdata ptr
        local hdc&, rc as rect
        local x&, ttt$
        local ps as paintstruct, hgr&
        '
        select case cbmsg
            case %wm_paint
                hgr = getdlgitem(cbhndl, %idd_form1_labelgraphwindow)
                hdc = beginpaint(hgr, ps)
                getclientrect hgr, rc
                ' copy virtual window onto screen:
                bitblt hdc,0,0, rc.nright, rc.nbottom, memdc,0,0,%srccopy
                endpaint hgr, ps
            case %wm_destroy
                postquitmessage 0
            case %wm_command
                pwebbrowserdata = strptr(szwebbrowserdata)
                select case cbctl
                    case %idd_form1_butopenfile
                        if cbctlmsg = %bn_clicked or cbctlmsg = 1 then
                            if openhtmfile then
                            end if
                        end if
                    case %idd_form1_butmakeoutput
                        if cbctlmsg = %bn_clicked or cbctlmsg = 1 then
                            call makeoutput
                        end if
                    case %idd_form1_butdisplcomboutp
                        if cbctlmsg = %bn_clicked or cbctlmsg = 1 then
                            x& = freefile
                            open currentpath+"iecontrdemon5.html" for binary as #x&
                            get$ #x&, lof(x&), ttt$
                            close #x&
                            displayhtmlstring 1, ttt$
                            control enable hform1, %idd_form1_butpreview
                            control enable hform1, %idd_form1_butprint
                            control enable hform1, %idd_form1_butsaveas
                        end if
                    case %idd_form1_butpreview                    '
                        if cbctlmsg = %bn_clicked or cbctlmsg = 1 then
                             call dword @pwebbrowserdata[0].@piwebbrowser2.@lpvtbl.execwb using comfunction4 (byval @pwebbrowserdata[0].piwebbrowser2, byval %olecmdid_printpreview, byval 0, byval 0, byval 0)
                        end if
                    case %idd_form1_butprint
                        if cbctlmsg = %bn_clicked or cbctlmsg = 1 then
                            call dword @pwebbrowserdata[0].@piwebbrowser2.@lpvtbl.execwb using comfunction4 (byval @pwebbrowserdata[0].piwebbrowser2, byval %olecmdid_print, byval 0, byval 0, byval 0)
                        end if
                    case %idd_form1_butsaveas
                        if cbctlmsg = %bn_clicked or cbctlmsg = 1 then
                             call dword @pwebbrowserdata[0].@piwebbrowser2.@lpvtbl.execwb using comfunction4 (byval @pwebbrowserdata[0].piwebbrowser2, byval %olecmdid_saveas, byval 0, byval 0, byval 0)
                        end if
                    case %idd_form1_butnextfig
                        if cbctlmsg=%bn_clicked or cbctlmsg = 1 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 or cbctlmsg = 1 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 %idd_form1_buttonexit
                        if cbctlmsg = %bn_clicked or cbctlmsg = 1 then
                            dialog end cbhndl, 0
                        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&
        static hdcref&,iwidthmm&,iheightmm&,iwidthpels&,iheightpels&
        local hdcemf&, hemf&, hdc&, i&, kk&
        local curpath as asciiz * 255, st$, pathandfile$, res&
    
        ' get handle to graphics window
        hgr1& = getdlgitem(hform1, %idd_form1_labelgraphwindow)
        '
        if no = 1 then ' do this only the first time and remember results.
            ' 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
        end if
        '
        ' specify rectancle in 0.01 mm units for creation of metafile:
        '
        ' 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
        '
        if no = 1 then : curgrano = 1 : call showenhmetafile ' display first figure
        '
        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
    '
    sub makeoutput
        local i&, kk&, no&, graphfile$, txt$
        dim da(5) as single, gtext(5) as string, su(5) as single
        '
        ' 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$+"">" + $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$+"">" + $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$+"">" + $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$+"">" + $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$+"">" + $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+"iecontrdemon5.html" for binary as #x&
        put$ #x&, th
        seteof #x&  ' important if you use the same file name repeatedly with varying ourput.
        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 sub
    
    ' ------------------------------------------------
    function pbmain
        local umsg as tagmsg
        dim pwebbrowserdata as local  webbrowserdata ptr
        local hdc&, hbit&, rc as rect
        local style&, exstyle&, x1&, y1&, x2&, y2&
        '
        systemparametersinfo %spi_getworkarea,byval %null, byval varptr(rc),byval %null
        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 0, "simple displaying and printing of text and graphics using the ie-control - vers. 5", 0, 0,  396,  264, style&, exstyle& to hform1
        dialog pixels hform1, rc.nleft, rc.ntop to units x1, y1
        dialog pixels hform1, rc.nright, rc.nbottom to units x2, y2
        dialog set loc hform1, x1, y1
        w = x2 - x1 : h = y2 - y1
        dialog set size hform1, w, h
        control add button, hform1,  %idd_form1_butopenfile,  "&open", a(6), b(246), a(30), b(14), _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop
        control add button, hform1,  %idd_form1_butmakeoutput,  "&make output", a(42), b(246), a(56), b(14), _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop
        control add button, hform1,  %idd_form1_butdisplcomboutp,  "&show combined output", a(104), b(246), a(92), b(14), _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop or %ws_disabled
        control add button, hform1,  %idd_form1_buttonexit,  "e&xit", a(362), b(246), a(26), b(14), _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop
        control add label, hform1,  %idd_form1_labelcomboutput,  "combined text and graphics in ie-control", a(206), b(110), a(182), b(10), _
            %ws_child or %ws_visible or %ss_center
        control add label, hform1,  %idd_form1_labelrawtext,  "plain text output", a(6), b(4), a(190), b(10), _
            %ws_child or %ws_visible or %ss_center
        control add label, hform1,  %idd_form1_labelgraphic1,  ", a(196), b(28), a(42), b(10), _
            %ws_child or %ws_visible or %ss_center
        control add label, hform1,  %idd_form1_labelhtmltext,  "text output with html-tags", a(6), b(122), a(190), b(10), _
            %ws_child or %ws_visible or %ss_center
        control add label, hform1,  %idd_form1_labelgraphwindow,  ", a(238), b(6), a(150), b(98), _
            %ws_child or %ws_visible or %ws_border or %ss_whiteframe
        control add textbox, hform1,  %idd_form1_texthtml,  ", a(6), b(132), a(190), b(104), _
            %ws_child or %ws_visible or %es_readonly or %es_left or %ws_hscroll or %ws_vscroll or %ws_tabstop or %es_multiline, %ws_ex_clientedge
        control send hform1,%idd_form1_texthtml,%wm_setfont,getstockobject(%ansi_fixed_font),%true
        control add textbox, hform1,  %idd_form1_textraw,  ", a(6), b(14), a(190), b(104),_
            %ws_child or %ws_visible or %es_readonly or %es_left or %ws_hscroll or %ws_vscroll or %ws_tabstop or %es_multiline, %ws_ex_clientedge
        control send hform1,%idd_form1_textraw,%wm_setfont,getstockobject(%ansi_fixed_font),%true
        control add button, hform1,  %idd_form1_butprevfig,  "&prev.", a(200), b(42), a(34), b(14), _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop or %ws_disabled
        control add button, hform1,  %idd_form1_butnextfig,  "&next", a(200), b(62), a(34), b(14), _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop or %ws_disabled
        control add button, hform1,  %idd_form1_butpreview,  "pre&view", a(208), b(246), a(44), b(14), _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop or %ws_disabled
        control add button, hform1,  %idd_form1_butprint,  "&print", a(258), b(246), a(42), b(14), _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop or %ws_disabled
        control add button, hform1,  %idd_form1_butsaveas,  "save &as", a(306), b(246), a(44), b(14), _
            %ws_child or %ws_visible or %bs_pushbutton or %ws_tabstop or %ws_disabled
        control set color hform1,%idd_form1_labelgraphwindow ,0,rgb(255,255,255)
        control set color hform1,%idd_form1_textraw ,0,rgb(255,255,255)
        control set color hform1,%idd_form1_texthtml ,0,rgb(255,255,255)
        '
        control add label, hform1, %id_ie1, ", a(206), b(120), a(182), b(116), %ws_visible or %ws_child
        control handle hform1, %id_ie1 to hiect
        ' embed, resize and initialize ie-browser:
        if embedbrowserobject (1, hform1, %id_ie1) then
            dialog post hform1, %wm_syscommand, %sc_close, 0 : exit function
        end if
        getclientrect getdlgitem(hform1, %id_ie1), rc
        resizebrowser 1, rc.nright, rc.nbottom
        displayhtmlstring 1, "  ' "initialize"
        '
        ' create a virtual window
        getclientrect getdlgitem(hform1, %idd_form1_labelgraphwindow), rc
        hdc = getdc(getdlgitem(hform1, %idd_form1_labelgraphwindow))
        memdc = createcompatibledc(hdc)
        hbit = createcompatiblebitmap(hdc, rc.nright, rc.nbottom)
        selectobject memdc, hbit
        selectobject memdc, getstockobject(%white_brush)
        patblt memdc, 0, 0, rc.nright, rc.nbottom, %patcopy
        '
        outmade& = %false ' start with output flag set to false.
        '
        dialog show modeless hform1, call form1_dlgproc
        '
        while getmessage(umsg, %null, 0, 0)
            ' pass keyboard messages to the ancestor
            ' returns 0 if the message was not processed, nonzero if it was
            if sendmessage(hiect, %wm_forwardmsg, 0, varptr(umsg)) = 0 then
               if isdialogmessage(hform1, umsg) = %false then
                  translatemessage umsg
                  dispatchmessage umsg
               end if
            end if
        wend
        '
        deletedc memdc
        deleteobject hbit
        unembedbrowserobject 1
        '
    end function
    ------------------




    [this message has been edited by erik christensen (edited may 01, 2005).]

  • #2
    ' include file for program.
    '
    ' semen matusovski is thanked for the original code , which is at this link:
    '
    ' http://www.powerbasic.com/support/pb...ad.php?t=24065
    '
    ' save this file as "comobj2.inc"
    '
    ' this file contain declarations and functions for com interfaces.
    [CODE]
    '--- idispatch interface ---
    type idispatchvtbl
    queryinterface as dword
    addref as dword
    release as dword
    gettypeinfocount as dword
    gettypeinfo as dword
    getidsofnames as dword
    invoke as dword
    end type
    type idispatchapi
    lpvtbl as idispatchvtbl ptr
    end type

    '--- ioleobject interface ---
    $iid_ioleobject = guid$("{00000112-0000-0000-c000-000000000046}")
    type ioleobjectvtbl
    queryinterface as dword
    addref as dword
    release as dword
    setclientsite as dword
    getclientsite as dword
    sethostnames as dword
    close_ as dword
    setmoniker as dword
    getmoniker as dword
    initfromdata as dword
    getclipboarddata as dword
    doverb as dword
    enumverbs as dword
    update as dword
    isuptodate as dword
    getuserclassid as dword
    getusertype as dword
    setextent as dword
    getextent as dword
    advise as dword
    unadvise as dword
    enumadvise as dword
    getmiscstatus as dword
    setcolorscheme as dword
    end type
    type ioleobject
    lpvtbl as ioleobjectvtbl ptr
    end type
    '--- ioleclientsite inteface ---
    $iid_ioleclientsite = guid$("{00000118-0000-0000-c000-000000000046}")
    type ioleclientsitevtbl
    queryinterface as dword
    addref as dword
    release as dword
    saveobject as dword
    getmoniker as dword
    getcontainer as dword
    showobject as dword
    onshowwindow as dword
    requestnewobjectlayout as dword
    end type
    type ioleclientsite
    lpvtbl as ioleclientsitevtbl ptr
    end type
    '--- ioleinplacesite interface ---
    $iid_ioleinplacesite = guid$("{00000119-0000-0000-c000-000000000046}")
    type ioleinplacesitevtbl
    queryinterface as dword
    addref as dword
    release as dword
    getwindow as dword
    contextsensitivehelp as dword
    caninplaceactivate as dword
    oninplaceactivate as dword
    onuiactivate as dword
    getwindowcontext as dword
    scroll as dword
    onuideactivate as dword
    oninplacedeactivate as dword
    discardundostate as dword
    deactivateandundo as dword
    onposrectchange as dword
    end type
    type ioleinplacesite
    lpvtbl as ioleinplacesitevtbl ptr
    end type
    '--- ioleinplaceobject interface ---
    $iid_ioleinplaceobject = guid$("{00000113-0000-0000-c000-000000000046}")
    type ioleinplaceobjectvtbl
    queryinterface as dword
    addref as dword
    release as dword
    getwindow as dword
    contextsensitivehelp as dword
    inplacedeactivate as dword
    uideactivate as dword
    setobjectrects as dword
    reactivateandundo as dword
    end type
    type ioleinplaceobject
    lpvtbl as ioleinplaceobjectvtbl ptr
    end type
    ' --- oleiverb constants ---
    %oleiverb_primary = 0&
    %oleiverb_show = -1&
    %oleiverb_open = -2&
    %oleiverb_hide = -3&
    %oleiverb_uiactivate = -4&
    %oleiverb_inplaceactivate = -5&
    %oleiverb_discardundostate = -6&
    '--- olecmdid constants ---
    %olecmdid_open = 1
    %olecmdid_new = 2
    %olecmdid_save = 3
    %olecmdid_saveas = 4
    %olecmdid_savecopyas = 5
    %olecmdid_print = 6
    %olecmdid_printpreview = 7
    %olecmdid_pagesetup = 8
    %olecmdid_spell = 9
    %olecmdid_properties = 10
    %olecmdid_cut = 11
    %olecmdid_copy = 12
    %olecmdid_paste = 13
    %olecmdid_pastespecial = 14
    %olecmdid_undo = 15
    %olecmdid_redo = 16
    %olecmdid_selectall = 17
    %olecmdid_clearselection = 18
    %olecmdid_zoom = 19
    %olecmdid_getzoomrange = 20
    %olecmdid_updatecommands = 21
    %olecmdid_refresh = 22
    %olecmdid_stop = 23
    %olecmdid_hidetoolbars = 24
    %olecmdid_setprogressmax = 25
    %olecmdid_setprogresspos = 26
    %olecmdid_setprogresstext = 27
    %olecmdid_settitle = 28
    %olecmdid_setdownloadstate = 29
    %olecmdid_stopdownload = 30
    %olecmdid_ontoolbaractivated = 31
    %olecmdid_find = 32
    %olecmdid_delete = 33
    %olecmdid_httpequiv = 34
    %olecmdid_httpequiv_done = 35
    %olecmdid_enable_interaction = 36
    %olecmdid_onunload = 37
    %olecmdid_propertybag2 = 38
    %olecmdid_prerefresh = 39
    %olecmdid_showscripterror = 40
    %olecmdid_showmessage = 41
    %olecmdid_showfind = 42
    %olecmdid_showpagesetup = 43
    %olecmdid_showprint = 44
    %olecmdid_close = 45
    %olecmdid_allowuilesssaveas = 46
    %olecmdid_dontdownloadcss = 47
    %olecmdid_updatepagestatus = 48
    %olecmdid_print2 = 49
    %olecmdid_printpreview2 = 50
    %olecmdid_setprinttemplate = 51
    %olecmdid_getprinttemplate = 52
    '--- iconnectionpointcontainer interface ---
    $iid_iconnectionpointcontainer = guid$("{b196b284-bab4-101a-b69c-00aa00341d07}")
    type iconnectionpointcontainervtbl
    queryinterface as dword
    addref as dword
    release as dword
    enumconnectionpoints as dword
    findconnectionpoint as dword
    end type
    type iconnectionpointcontainer
    lpvtbl as iconnectionpointcontainervtbl ptr
    end type
    '--- iconnectionpoint interface ---
    type iconnectionpointvtbl
    queryinterface as dword
    addref as dword
    release as dword
    getconnectioninterface as dword
    getconnectionpointcontainer as dword
    advise as dword
    unadvise as dword
    enumconnections as dword
    end type
    type iconnectionpoint
    lpvtbl as iconnectionpointvtbl ptr
    end type
    '--- iwebbrowser2 interface ---
    $clsid_webbrowser = guid$("{8856f961-340a-11d0-a96b-00c04fd705a2}")
    $iid_iwebbrowser2 = guid$("{d30c1661-cdaf-11d0-8a3e-00c04fc9e26e}")
    type iwebbrowser2vtbl
    queryinterface as dword
    addref as dword
    release as dword
    gettypeinfocount as dword
    gettypeinfo as dword
    getidsofnames as dword
    invoke as dword
    goback as dword
    goforward as dword
    gohome as dword
    gosearch as dword
    navigate as dword
    refresh as dword
    refresh2 as dword
    stop as dword
    get_application as dword
    get_parent as dword
    get_container as dword
    get_document as dword
    get_toplevelcontainer as dword
    get_type as dword
    get_left as dword
    put_left as dword
    get_top as dword
    put_top as dword
    get_width as dword
    put_width as dword
    get_height as dword
    put_height as dword
    get_locationname as dword
    get_locationurl as dword
    get_busy as dword
    quit as dword
    clienttowindow as dword
    putproperty as dword
    getproperty as dword
    get_name as dword
    get_hwnd as dword
    get_fullname as dword
    get_path as dword
    get_visible as dword
    put_visible as dword
    get_statusbar as dword
    put_statusbar as dword
    get_statustext as dword
    put_statustext as dword
    get_toolbar as dword
    put_toolbar as dword
    get_menubar as dword
    put_menubar as dword
    get_fullscreen as dword
    put_fullscreen as dword
    navigate2 as dword
    querystatuswb as dword
    execwb as dword
    showbrowserbar as dword
    get_readystate as dword
    get_offline as dword
    put_offline as dword
    get_silent as dword
    put_silent as dword
    get_registerasbrowser as dword
    put_registerasbrowser as dword
    get_registerasdroptarget as dword
    put_registerasdroptarget as dword
    get_theatermode as dword
    put_theatermode as dword
    get_addressbar as dword
    put_addressbar as dword
    get_resizable as dword
    put_resizable as dword
    end type
    type iwebbrowser2
    lpvtbl as iwebbrowser2vtbl ptr
    end type
    '--- dwebbrowser2events ---
    $diid_dwebbrowserevents2 = guid$("{34a715a0-6587-11d0-924a-0020afc7ac4d}")
    type dwebbrowserevents2vtbl
    queryinterface as dword
    addref as dword
    release as dword
    gettypeinfocount as dword
    gettypeinfo as dword
    getidsofnames as dword
    invoke as dword
    end type
    type dwebbrowserevents2
    lpvtbl as dwebbrowserevents2vtbl ptr
    end type
    '--- dispatch ids for iexplorer dispatch events ---
    %dispid_beforenavigate = 100 ' this is sent before navigation to give a chance to abort
    %dispid_navigatecomplete = 101 ' in async, this is sent when we have enough to show
    %dispid_statustextchange = 102
    %dispid_quit = 103
    %dispid_downloadcomplete = 104
    %dispid_commandstatechange = 105
    %dispid_downloadbegin = 106
    %dispid_newwindow = 107 ' sent when a new window should be created
    %dispid_progresschange = 108 ' sent when download progress is updated
    %dispid_windowmove = 109 ' sent when main window has been moved
    %dispid_windowresize = 110 ' sent when main window has been sized
    %dispid_windowactivate = 111 ' sent when main window has been activated
    %dispid_propertychange = 112 ' sent when the putproperty method is called
    %dispid_titlechange = 113 ' sent when the document title changes
    %dispid_titleiconchange = 114 ' sent when the top level window icon may have changed.
    %dispid_framebeforenavigate = 200
    %dispid_framenavigatecomplete = 201
    %dispid_framenewwindow = 204
    %dispid_beforenavigate2 = 250 ' // hyperlink clicked on
    %dispid_newwindow2 = 251
    %dispid_navigatecomplete2 = 252 ' uiactivate new document
    %dispid_onquit = 253 '
    %dispid_onvisible = 254 ' sent when the window goes visible/hidden
    %dispid_ontoolbar = 255 ' sent when the toolbar should be shown/hidden
    %dispid_onmenubar = 256 ' sent when the menubar should be shown/hidden
    %dispid_onstatusbar = 257 ' sent when the statusbar should be shown/hidden
    %dispid_onfullscreen = 258 ' sent when kiosk mode should be on/off
    %dispid_documentcomplete = 259 ' new document goes readystate_complete
    %dispid_ontheatermode = 260 ' sent when theater mode should be on/off
    %dispid_onaddressbar = 261 ' sent when the address bar should be shown/hidden
    %dispid_windowsetresizable = 262 ' sent to set the style of the host window frame
    %dispid_windowclosing = 263 ' sent before script window.close closes the window
    %dispid_windowsetleft = 264 ' sent when the put_left method is called on the weboc
    %dispid_windowsettop = 265 ' sent when the put_top method is called on the weboc
    %dispid_windowsetwidth = 266 ' sent when the put_width method is called on the weboc
    %dispid_windowsetheight = 267 ' sent when the put_height method is called on the weboc
    %dispid_clienttohostwindow = 268 ' sent during window.open to request conversion of dimensions
    %dispid_setsecurelockicon = 269 ' sent to suggest the appropriate security icon to show
    %dispid_filedownload = 270 ' fired to indicate the file download dialog is opening
    %dispid_navigateerror = 271 ' fired to indicate the a binding error has occured
    %dispid_privacyimpactedstatechange = 272 ' fired when the user's browsing experience is impacted
    '--- clsctx constants ---
    %clsctx_inproc_server = &h00001
    %clsctx_inproc_handler = &h00002
    %clsctx_local_server = &h00004
    %clsctx_inproc_server16 = &h00008
    %clsctx_remote_server = &h00010
    %clsctx_inproc_handler16 = &h00020
    %clsctx_inproc_serverx86 = &h00040
    %clsctx_inproc_handlerx86 = &h00080
    %clsctx_eserver_handler = &h00100
    %clsctx_reserved = &h00200
    %clsctx_no_code_download = &h00400
    %clsctx_no_wx86_translation = &h00800
    %clsctx_no_custom_marshal = &h01000
    %clsctx_enable_code_download = &h02000
    %clsctx_no_failure_log = &h04000
    %clsctx_disable_aaa = &h08000
    %clsctx_enable_aaa = &h10000
    %clsctx_from_default_context = &h20000
    %clsctx_inproc = %clsctx_inproc_server or %clsctx_inproc_handler
    '------------------------------------------------------------------------------------------
    declare function comfunction0 (any) as dword
    declare function comfunction1 (any, any) as dword
    declare function comfunction2 (any, any, any) as dword
    declare function comfunction3 (any, any, any, any) as dword
    declare function comfunction4 (any, any, any, any, any) as dword
    declare function comfunction5 (any, any, any, any, any, any) as dword
    declare function comfunction6 (any, any, any, any, any, any, any) as dword

    '------------------
    %maxwebbrowsers = 3
    type webbrowserdata
    hwndparent as dword
    hwndie as dword
    pioleobject as ioleobject ptr
    piconnectionpointcontainer as iconnectionpointcontainer ptr
    piconnectionpoint as iconnectionpoint ptr
    pioleclientsite as ioleclientsite ptr
    piwebbrowser2 as iwebbrowser2 ptr
    dwcookie as dword
    msg as tagmsg
    sztmphtmlfile as asciiz * %max_path
    end type
    global szwebbrowserdata as string
    '--------------------------------------------------------------------------------
    function ioleclientsite_getvtbl(byval idwb as dword) as dword
    dim uioleclientsitevtbl(%maxwebbrowsers - 1) as static ioleclientsitevtbl
    dim uioleclientsite(%maxwebbrowsers - 1) as static ioleclientsite
    if uioleclientsite(idwb - 1).lpvtbl = 0 then
    uioleclientsite(idwb - 1).lpvtbl = varptr(uioleclientsitevtbl(idwb - 1))
    uioleclientsitevtbl(idwb - 1).addref = codeptr(ioleclientsite_addref)
    uioleclientsitevtbl(idwb - 1).release = codeptr(ioleclientsite_release)
    uioleclientsitevtbl(idwb - 1).saveobject = codeptr(ioleclientsite_saveobject)
    uioleclientsitevtbl(idwb - 1).getmoniker = codeptr(ioleclientsite_getmoniker)
    uioleclientsitevtbl(idwb - 1).getcontainer = codeptr(ioleclientsite_getcontainer)
    uioleclientsitevtbl(idwb - 1).showobject = codeptr(ioleclientsite_showobject)
    uioleclientsitevtbl(idwb - 1).onshowwindow = codeptr(ioleclientsite_onshowwindow)
    uioleclientsitevtbl(idwb - 1).requestnewobjectlayout = codeptr(ioleclientsite_requestnewobjectlayout)
    select case as long idwb
    case 1 : uioleclientsitevtbl(idwb - 1).queryinterface = codeptr(ioleclientsite_queryinterface1)
    case 2 : uioleclientsitevtbl(idwb - 1).queryinterface = codeptr(ioleclientsite_queryinterface2)
    case 3 : uioleclientsitevtbl(idwb - 1).queryinterface = codeptr(ioleclientsite_queryinterface3)
    end select
    end if
    function = varptr(uioleclientsite(idwb - 1))
    end function
    '--------------------------------------------------------------------------------
    function ioleinplacesite_getvtbl (byval idwb as dword) as dword
    dim uioleinplacesitevtbl(%maxwebbrowsers - 1) as static ioleinplacesitevtbl
    dim uioleinplacesite (%maxwebbrowsers - 1) as static ioleinplacesite
    if uioleinplacesite(idwb - 1).lpvtbl = 0 then
    uioleinplacesite(idwb - 1).lpvtbl = varptr(uioleinplacesitevtbl(idwb - 1))
    uioleinplacesitevtbl(idwb - 1).queryinterface = codeptr(ioleinplacesite_queryinterface)
    uioleinplacesitevtbl(idwb - 1).addref = codeptr(ioleinplacesite_addref)
    uioleinplacesitevtbl(idwb - 1).release = codeptr(ioleinplacesite_release)
    uioleinplacesitevtbl(idwb - 1).contextsensitivehelp = codeptr(ioleinplacesite_contextsensitivehelp)
    uioleinplacesitevtbl(idwb - 1).caninplaceactivate = codeptr(ioleinplacesite_caninplaceactivate)
    uioleinplacesitevtbl(idwb - 1).oninplaceactivate = codeptr(ioleinplacesite_oninplaceactivate)
    uioleinplacesitevtbl(idwb - 1).onuiactivate = codeptr(ioleinplacesite_onuiactivate)
    uioleinplacesitevtbl(idwb - 1).getwindowcontext = codeptr(ioleinplacesite_getwindowcontext)
    uioleinplacesitevtbl(idwb - 1).scroll = codeptr(ioleinplacesite_scroll)
    uioleinplacesitevtbl(idwb - 1).onuideactivate = codeptr(ioleinplacesite_onuideactivate)
    uioleinplacesitevtbl(idwb - 1).oninplacedeactivate = codeptr(ioleinplacesite_oninplacedeactivate)
    uioleinplacesitevtbl(idwb - 1).deactivateandundo = codeptr(ioleinplacesite_deactivateandundo)
    uioleinplacesitevtbl(idwb - 1).deactivateandundo = codeptr(ioleinplacesite_deactivateandundo)
    select case as long idwb
    case 1 : uioleinplacesitevtbl(idwb - 1).getwindow = codeptr(ioleinplacesite_getwindow1)
    uioleinplacesitevtbl(idwb - 1).onposrectchange = codeptr(ioleinplacesite_onposrectchange1)
    case 2 : uioleinplacesitevtbl(idwb - 1).getwindow = codeptr(ioleinplacesite_getwindow2)
    uioleinplacesitevtbl(idwb - 1).onposrectchange = codeptr(ioleinplacesite_onposrectchange2)
    case 3 : uioleinplacesitevtbl(idwb - 1).getwindow = codeptr(ioleinplacesite_getwindow3)
    uioleinplacesitevtbl(idwb - 1).onposrectchange = codeptr(ioleinplacesite_onposrectchange3)
    end select

    end if
    function = varptr(uioleinplacesite(idwb - 1))
    end function
    '--------------------------------------------------------------------------------
    function dwebbrowserevents2_getvtbl (byval idwb as dword) as dword
    dim udwebbrowserevents2vtbl(%maxwebbrowsers - 1) as static dwebbrowserevents2vtbl
    dim udwebbrowserevents2(%maxwebbrowsers - 1) as static dwebbrowserevents2
    if udwebbrowserevents2(idwb - 1).lpvtbl = 0 then
    udwebbrowserevents2(idwb - 1).lpvtbl = varptr(udwebbrowserevents2vtbl(idwb - 1))
    udwebbrowserevents2vtbl(idwb - 1).addref = codeptr(dwebbrowserevents2_addref)
    udwebbrowserevents2vtbl(idwb - 1).release = codeptr(dwebbrowserevents2_release)
    udwebbrowserevents2vtbl(idwb - 1).gettypeinfocount = codeptr(dwebbrowserevents2_gettypeinfocount)
    udwebbrowserevents2vtbl(idwb - 1).gettypeinfo = codeptr(dwebbrowserevents2_gettypeinfo)
    udwebbrowserevents2vtbl(idwb - 1).getidsofnames = codeptr(dwebbrowserevents2_getidsofnames)
    select case as long idwb
    case 1 : udwebbrowserevents2vtbl(idwb - 1).queryinterface = codeptr(dwebbrowserevents2_queryinterface1)
    udwebbrowserevents2vtbl(idwb - 1).invoke = codeptr(dwebbrowserevents2_invoke1)
    case 2 : udwebbrowserevents2vtbl(idwb - 1).queryinterface = codeptr(dwebbrowserevents2_queryinterface2)
    udwebbrowserevents2vtbl(idwb - 1).invoke = codeptr(dwebbrowserevents2_invoke2)
    case 3 : udwebbrowserevents2vtbl(idwb - 1).queryinterface = codeptr(dwebbrowserevents2_queryinterface3)
    udwebbrowserevents2vtbl(idwb - 1).invoke = codeptr(dwebbrowserevents2_invoke3)
    end select
    end if
    function = varptr(udwebbrowserevents2(idwb - 1))
    end function
    '--------------------------------------------------------------------------------
    function ioleinplacesite_queryinterface (byval this as dword, byref riid as guid, byref ppvobj as dword) as dword
    ppvobj = 0: function = %e_nointerface
    end function
    function ioleinplacesite_addref (byval this as dword) as dword
    function = 1
    end function
    function ioleinplacesite_release (byval this as dword) as dword
    function = 1
    end function
    function ioleinplacesite_getwindow1 (byval this as dword, byref hwnd as dword) as dword
    dim pwebbrowserdata as local webbrowserdata ptr
    pwebbrowserdata = strptr(szwebbrowserdata)
    hwnd = @pwebbrowserdata[0].hwndie
    end function
    function ioleinplacesite_getwindow2 (byval this as dword, byref hwnd as dword) as dword
    dim pwebbrowserdata as local webbrowserdata ptr
    pwebbrowserdata = strptr(szwebbrowserdata)
    hwnd = @pwebbrowserdata[1].hwndie
    end function
    function ioleinplacesite_getwindow3 (byval this as dword, byref hwnd as dword) as dword
    dim pwebbrowserdata as local webbrowserdata ptr
    pwebbrowserdata = strptr(szwebbrowserdata)
    hwnd = @pwebbrowserdata[2].hwndie
    end function
    function ioleinplacesite_contextsensitivehelp (byval this as dword, byval fentermode as long) as dword
    function = %e_notimpl
    end function
    function ioleinplacesite_caninplaceactivate (byval this as dword) as dword
    function = %s_ok
    end function
    function ioleinplacesite_oninplaceactivate (byval this as dword) as dword
    function = %s_ok
    end function
    function ioleinplacesite_onuiactivate (byval this as dword) as dword
    function = %s_ok
    end function
    function ioleinplacesite_getwindowcontext (byval this as dword, byval ppframe as dword, ppdoc as dword, rcposrect as rect, rccliprect as rect, byval lpframeinfo as dword) as dword
    function = %e_notimpl
    end function
    function ioleinplacesite_scroll (byval this as dword, byval scrollextantx as dword, byval scrollextanty as dword) as dword
    function = %e_notimpl
    end function
    function ioleinplacesite_onuideactivate (byval this as dword, byval fundoable as long) as dword
    function = %s_ok
    end function
    function ioleinplacesite_oninplacedeactivate (byval this as dword) as dword
    function = %s_ok
    end function
    function ioleinplacesite_discardundostate (byval this as dword) as dword
    function = %e_notimpl
    end function
    function ioleinplacesite_deactivateandundo (byval this as dword) as dword
    function = %e_notimpl
    end function
    function ioleinplacesite_onposrectchange1 (byval this as dword, byref rcposrect as rect) as dword
    dim pwebbrowserdata as local webbrowserdata ptr
    dim iid_ioleinplaceobject as local guid
    dim pioleinplaceobject as local ioleinplaceobject ptr
    pwebbrowserdata = strptr(szwebbrowserdata)
    iid_ioleinplaceobject = $iid_ioleinplaceobject
    call dword @pwebbrowserdata[0].@pioleobject.@lpvtbl.queryinterface using comfunction2 (byval @pwebbrowserdata[0].pioleobject, iid_ioleinplaceobject, pioleinplaceobject)
    call dword @pioleinplaceobject.@lpvtbl.setobjectrects using comfunction2 (byval pioleinplaceobject, rcposrect, rcposrect)
    call dword @pioleinplaceobject.@lpvtbl.release using comfunction0 (byval pioleinplaceobject)
    end function
    function ioleinplacesite_onposrectchange2 (byval this as dword, byref rcposrect as rect) as dword
    dim pwebbrowserdata as local webbrowserdata ptr
    dim iid_ioleinplaceobject as local guid
    dim pioleinplaceobject as local ioleinplaceobject ptr
    pwebbrowserdata = strptr(szwebbrowserdata)
    iid_ioleinplaceobject = $iid_ioleinplaceobject
    call dword @pwebbrowserdata[1].@pioleobject.@lpvtbl.queryinterface using comfunction2 (byval @pwebbrowserdata[1].pioleobject, iid_ioleinplaceobject, pioleinplaceobject)
    call dword @pioleinplaceobject.@lpvtbl.setobjectrects using comfunction2 (byval pioleinplaceobject, rcposrect, rcposrect)
    call dword @pioleinplaceobject.@lpvtbl.release using comfunction0 (byval pioleinplaceobject)
    end function
    function ioleinplacesite_onposrectchange3 (byval this as dword, byref rcposrect as rect) as dword
    dim pwebbrowserdata as local webbrowserdata ptr
    dim iid_ioleinplaceobject

    Comment

    Working...
    X