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

Histogram example with copying to clipboard

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

  • Histogram example with copying to clipboard

    ' histogram example with copying to clipboard
    '
    ' this simple example illustrates the distribution of a continuous
    ' variable using a histogram. the program makes a random normal
    ' distribution and displays this distribution in a histogram.
    ' however, you may display other forms of distributions. the histogram
    ' will be drawn with tic marks and values on the axes as well as
    ' label texts. via the clipboard the histogram can be copied into
    ' a word document and edited there.
    ' try double clicking on the pasted graph in word and see what
    ' happens.
    '
    ' some of this code is derived from the diagram routines in the linear regression
    ' program posted previously in this link:
    'http://www.powerbasic.com/support/pb...ad.php?t=24134
    '
    ' you can rather easily convert the present code to an include file.
    '
    ' best regards,
    '
    ' erik christensen -------- july 15, 2007
    '
    ' p.s. later same day: small improvements made.
    Code:
    #compile exe
    #register none
    #dim all
    '
    #include "win32api.inc"
    
    %form1_graphcopy          = 100
    %form1_graphlabel         = 105
    ' --------------------------------------------------
    '
    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
        ' pen styles
        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 fontheight 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
    ' -----------------------
        'type logfont defines the attributes of a font.
        'see logfont in the win32 help file
        lffont.lfheight = fontheight            ' logical height of font
        lffont.lfwidth = 0                      ' logical average character width (if zero then windows sets the width using a standard aspect ratio)
        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 prepareandmakegraph (byval hdc as long, byval nv as long, byval  np as long, byval xmax as single, _
                byval xmin as single, byval ymax as single, byval ymin as single, byval iix as long, _
                byval iiy as long, byref numdat() as single, byval xtxt$,byval ytxt$, byref rct as rect, _
                byref powerx as single, byref powery as single, byref xpixmax as long, _
                byref ypixmax as long, byref logpixelsx as long, byref rowsnew as long)
        ' -
        dim start as single, stepsize as single, labels as long
        dim xstep as single, xlabels as long, xhigh as single
        dim ystep as single, ylabels as long, yhigh as single
        dim xlow as single, ylow as single
        dim lemarg as single, rimarg as single, upmarg as single, lomarg as single
        dim xconvfac as single, yconvfac as single
        local i as long, hpen as long
        local xpix as single,ypix as single, radius as single
        local ystart as single,yend as single,penwidth as single
       ' local rc as rectangle
        local hhatchedbrush as long, hrec as long
        local ytop as long, xleft as long, ybottom as long, xright as long
        '
        fillrect hdc, rct, getstockobject(%white_brush)
        hhatchedbrush = createhatchbrush(%hs_bdiagonal, %blue)
        if abs(xmax) > abs(xmin) then
            powerx = xmax
        else
            powerx = xmin
        end if
        powerx = int(log10(abs(powerx) / 10))
        if abs(ymax) > abs(ymin) then
            powery = ymax
        else
            powery = ymin
        end if
        powery = int(log10(abs(powery) / 10))
        call findaxisdimandscale(xmax, xmin, xlow, xstep, xlabels)
        call findaxisdimandscale(ymax, ymin, ylow, ystep, ylabels)
        xhigh = xlow + (xlabels - 1) * xstep
        yhigh = ylow + (ylabels - 1) * ystep
        ' define wideness of "margins" for plot
        lemarg = xpixmax/9
        rimarg = xpixmax/15
        upmarg = ypixmax/9
        lomarg = ypixmax/6.5
        xconvfac = (xpixmax - lemarg - rimarg) / (xhigh - xlow)
        yconvfac = (ypixmax - upmarg - lomarg) / (yhigh - ylow)
        '
        penwidth=logpixelsx/254*2.1
        hpen = selectobject(hdc, createpen(penstyle(0), penwidth, gcolor(1))) ' blue
        ' draw histogram
        selectobject hdc, hhatchedbrush
        for i=1 to rowsnew step 4
            xleft=round((numdat(i,1)-xlow)*xconvfac+lemarg,0)
            ybottom=round(ypixmax-((numdat(i,2)-ylow)*yconvfac+lomarg),0)
            xright=round((numdat(i+2,1)-xlow)*xconvfac+lemarg,0)
            ytop=round(ypixmax-((numdat(i+2,2)-ylow)*yconvfac+lomarg),0)
           ' hrec = rectangle(hdc, xleft, ytop, xright, ybottom)
            hrec = rectangle(hdc, xleft, ytop, xright + 1, ybottom + 1)
            ' addition of 1 to the right and bottom dimensions may give a better result on the screen.
            ' however, a print of a copy pasted to word will be best without adding anything.
        next
        deleteobject hhatchedbrush
    
        call makexandyaxiswithtext(hdc,lemarg, lomarg, rimarg, upmarg, xlow, xstep, xhigh, _
             ylow, ystep, yhigh, xconvfac, yconvfac, xtxt$, ytxt$, 0, rct, logpixelsx, _
             xpixmax, ypixmax, powerx, powery)
        '
    end sub
    '
    sub findaxisdimandscale (byval maxval as single,byval minval as single, _
            byref start as single,byref stepsize as single,byref labels as long)
        '
        local range as double, eksp as double, bbbb as double, iii as long
        range = maxval - minval
        range = log10(range)
        eksp = ceil(range)
        range = 10 ^ (range - eksp)
        while range < 1
            range = range * 10
            eksp = eksp - 1
        wend
        if ceil(range) >= 5 then
            labels = ceil(range) + 1
            stepsize = 1 * 10 ^ eksp
        elseif ceil(range) >= 2 then
            labels = ceil(2 * range) + 1
            stepsize = .5 * 10 ^ eksp
        else
            labels = ceil(5 * range) + 1
            stepsize = .2 * 10 ^ eksp
        end if
        bbbb = 0
        if maxval > 0 then
            iii = 1
            do
                iii = iii + 1
                bbbb = bbbb + stepsize
            loop until bbbb > maxval
            if (iii - labels) * stepsize > minval then labels = labels + 1
                start = (iii - labels) * stepsize
        else
            iii = 0
            do
                iii =  iii -1
                bbbb = bbbb - stepsize
            loop until bbbb < minval
            if (iii + labels - 1) * stepsize < maxval then labels = labels + 1
            start = iii * stepsize
        end if
    end sub
    '
    sub makexandyaxiswithtext (byval hdc as long, byval lemarg as single, byval lomarg as single, byval rimarg as single, _
        byval upmarg as single, byval xlow as single, byval xstep as single, byval xhigh as single, byval ylow as single, _
        byval ystep as single, byval yhigh as single, byval xconvfac as single, byval yconvfac as single, byval xtxt$, _
        byval ytxt$,byval ipat as long, byref rct as rect, byref logpixelsx as long, byref xpixmax as long, _
        byref ypixmax as long, byref powerx as single, byref powery as single)
        '-
        local lpsz as asciiz * 255
        local hpen as long, hfont as long
        local i as long, flag as long, kk as long, longtics as long
        local res as long
        local si as single, ex as string, xx1 as single
        local yy1 as single
        local xval as single, yval as single, penwidth as single
        local lpsize as sizel
        '-
        hfont=makefont(18,400,0,0,0,"arial")
        selectobject hdc, hfont
        settextalign hdc,%ta_left
    
        penwidth=logpixelsx/254*2.1
        hpen = selectobject(hdc, createpen(penstyle(0), penwidth, gcolor(0)))  ' black pen
        '
        '- draw x-axis and y-axis
        movetoex hdc, xpixmax-rimarg,ypixmax-lomarg, byval %null
        lineto hdc, lemarg,ypixmax-lomarg
        lineto hdc, lemarg,upmarg
        '
        ' check number of ciphers in tic labels on x-axis
        xval = xlow
        for si = lemarg to xpixmax - rimarg step xconvfac * xstep * .9999
            if abs(powerx)>=3 then
                xx1 = int(xval / 10 ^ powerx + .5)
            else
                xx1=round(xval,3)
            end if
            xval = xval + xstep
            if abs(xx1)>=10000 then longtics = 1
            incr kk
        next
    
        if longtics = 1 and kk >=8 then flag = 1 ' many long tic labels.
        '
        '- make tic intervals and labels on x-axis
        xval = xlow : kk = 0
        settextalign hdc,%ta_center
        for si = lemarg to xpixmax - rimarg step xconvfac * xstep * .9999
            if abs(powerx)>=3 then
                xx1 = int(xval / 10 ^ powerx + .5)
            else
                xx1=round(xval,3)
            end if
            lpsz = ltrim$(str$(xx1))
            res=gettextextentpoint32(hdc,lpsz,byval len(lpsz),lpsize)
            incr kk
            if flag = 1 then ' only show every other tic label
                if kk mod 2 = 1 then textout hdc, si, ypixmax-lomarg+ypixmax/40, lpsz, byval len(lpsz)
                if kk mod 2 = 0 then lpsize.cx = 0
            else             ' show every tic label
                textout hdc, si, ypixmax-lomarg+ypixmax/40, lpsz, byval len(lpsz)
            end if
            movetoex hdc, si,ypixmax-lomarg, byval %null
            lineto hdc, si,ypixmax-lomarg+ypixmax/50
            xval = xval + xstep
        next
        '
        '- put name of x-variable on diagram
        if powerx >=3 then ex$ = " / 10^" + mid$(str$(-powerx), 2)
        if abs(powerx)<3 then ex$ = "
        if powerx <=-3 then ex$ = " x 10^" + mid$(str$(powerx), 2)
        xtxt$ = xtxt$ + ex$
        lpsz=xtxt$
        settextalign hdc,%ta_right
        textout hdc, xpixmax-rimarg+lpsize.cx*0.5, ypixmax-lomarg+ypixmax/13, lpsz, byval len(lpsz)
        '
        '- make tic intervals and labels on y-axis
        yval = ylow
        for si = ypixmax-lomarg to upmarg step -yconvfac * ystep * .9999
            if abs(powery)>=3 then
                yy1 = int(yval / 10 ^ powery + .5)
            else
                yy1=round(yval,3)
            end if
            lpsz = ltrim$(str$(yy1))
            res=gettextextentpoint32(hdc,lpsz,byval len(lpsz),lpsize)
            textout hdc, lemarg-xpixmax/48, si-lpsize.cy*0.5, lpsz, byval len(lpsz)
            yval = yval + ystep
            movetoex hdc,lemarg, si, byval %null
            lineto hdc, lemarg-xpixmax/70,si
        next
        '-put name of y-variable on diagram
        if powery >= 3 then ex$ = " / 10^" + mid$(str$(-powery), 2)
        if abs(powery) <3 then ex$ = "
        if powery < -3 then ex$ = " x 10^" + mid$(str$(powery), 2)
        ytxt$ = ytxt$ + ex$
        lpsz=ytxt$
        settextalign hdc,%ta_left
        textout hdc, lemarg-xpixmax/48-lpsize.cx,upmarg-ypixmax/13, lpsz, byval len(lpsz)
        deleteobject hfont
    end sub
    '
    sub makecategories(byref mi() as single, byref numdat() as single, _
            byref xmax as single, byref xmin as single, byref ymax as single, byref ymin as single, byref k9 as long)
       ' categorize values in intervals
        dim xstep as single, xlabels as long, xhigh as single, sum as single
        dim xlow as single
        local i as long, k as long, j as single, kk as long, fak as single, flg as long
        '
        array sort mi() ' sorting simplifies and speeds up categorization
        '
        xmin = mi(lbound(mi)) : xmax = mi(ubound(mi))
        '
        call findaxisdimandscale(xmax, xmin, xlow, xstep, xlabels)
        xhigh = xlow + (xlabels - 1) * xstep
        '
        ' make sure that a reasonable number of intervals are being used
        fak = 2.0
        do while xlabels < 30 ' you can experiment with other values than 30
            xlabels = (xlabels - 1) * fak + 1 : xstep = xstep / fak
            fak = 4.5 - fak
        loop
        '
        ' categorize data
        dim kat(1 to xlabels - 1) as local long
        k = 1 : i = 0
        j = xlow + xstep
        do
            incr i
            do while mi(k) < j
                incr k : if k > ubound(mi) then exit do
                incr kat(i)
            loop
            decr k : j = j + xstep
            if j >= xhigh*.999999 then exit do
        loop
        '
        ' define min and max values for plot
        xmin = xlow : xmax = xhigh
        ymin = 0.0 : ymax = 0.0
        for i = 1 to xlabels - 1
            ymax = max(ymax, kat(i))
        next
        '
        ' make numeric data for plot
        reset numdat()
        k = 0 : kk = 0
        for i = 1 to xlabels - 1
            incr kk
            if kat(kk) > 0 then
                if flg = 0 then xmin = xlow + (i-1) * xstep  : flg = 1 ' adjust xmin
                '
                ' the following data allows you to draw just the outline of the bars.
                ' however, the current version of the program applies the data to draw
                ' the bars using the rectangle function with a hatched brush.
                incr k : numdat(k, 1) = xlow + (i-1) * xstep : numdat(k, 2) = 0.0
                incr k : numdat(k, 1) = xlow + (i-1) * xstep : numdat(k, 2) = kat(kk)
                incr k : numdat(k, 1) = xlow + i * xstep     : numdat(k, 2) = kat(kk)
                incr k : numdat(k, 1) = xlow + i * xstep     : numdat(k, 2) = 0
                '
                xmax = xlow + i * xstep ' adjust xmax
            end if
        next
        k9 = k
    end sub
    '
    function randomnormalvalue(mean as double, sd as double) as double
        local pi2# : pi2 = 6.2831853071796
        function = sqr(-2 * log(rnd)) * cos(pi2 * rnd) * sd + mean
    end function
    ' ---------------------------------------------------------
    callback function form1_dlgproc
        local hemf as long,lpszfile as asciiz*80
        local hdcemf as long
        local hdc as long
        local res as long
        static grafcopyflag as long
        local i#,kk&,jj#
        local hdcref as long,iwidthmm as long,iheightmm as long,iwidthpels as long,iheightpels as long
        static hform1_menu0 as long
        static hform1_menu2 as long
        static hgraph as long      ' handle for graphics window - a label (or static) control
        static brush as long
        static rows as long        ' number of rows in array
        static rowsnew as long     ' number of rows with complete x,y values in a given analysis
        static logpixelsy as long  ' pixels per inch of screen height
        static logpixelsx as long  ' pixels per inch of screen width
        static numdat() as single  ' numerical data array
        static xmax as single, xmin as single, ymax as single, ymin as single
        static powerx as single, powery as single
        static xvar as long,yvar as long
        static grflag as long
        static xdialun as long,ydialun as long,xpixmax as long,ypixmax as long
        static rct as rect
        static ps as paintstruct   ' paint structure
        static xfact as single, yfact as single
        static xtext$,ytext$
        static labelstyle as long,labelstyle2 as long
        static n as long, ct as long, r as long
        dim mi(1 to 10000) as static single
        dim kat(1 to 20) as static long
    
        '
        select case cbmsg
            '
            case %wm_initdialog
                labelstyle = %ws_child or %ws_visible or %ss_center
                xdialun = 334:ydialun = 245
                dialog units cbhndl, xdialun, ydialun to pixels xpixmax, ypixmax
                xfact=xpixmax/xdialun : yfact=ypixmax/ydialun  ' conversion factors from dialog units to pixels
                ' the graphics routines use pixels. hence this conversion.
                labelstyle2& = %ws_child or %ws_visible or %ss_grayframe or %ss_left
                ' nb: the grayframe style must be included
                control add label, cbhndl,  %form1_graphlabel,  ", 4, 2, xdialun,ydialun, labelstyle2 ',%ws_ex_clientedge
                control handle cbhndl, %form1_graphlabel to hgraph ' handle for graphics window
                menu new bar to hform1_menu0
                menu new popup to hform1_menu2
                menu add popup, hform1_menu0 ,"&copy", hform1_menu2, %mf_enabled
                menu add string, hform1_menu2, "copy present &graph to clipboard", %form1_graphcopy, %mf_enabled       ' %mf_grayed
                menu attach hform1_menu0, cbhndl
    
                brush=createsolidbrush(rgb(255,255,255)) ' white
                hdc = getdc(%hwnd_desktop)
                logpixelsy  = getdevicecaps(hdc, %logpixelsy)
                logpixelsx  = getdevicecaps(hdc, %logpixelsx)
                releasedc %hwnd_desktop, hdc
                redim numdat(1 to 5000,1 to 2)
                grflag = 10
    
                ' create random normally distributed values
                randomize 3.123 ' 2.3 ' 3.13 '2.3 '3.1
                reset mi()
                for i = 1 to 10000
                    mi(i) = randomnormalvalue(50,12.6) '  mean, sd
                next
                ' categorize values in intervals
                call makecategories(mi(), numdat(), xmax, xmin, ymax, ymin, kk)
                xtext$ = "x-value"
                ytext$ = "number of observations"
                rows = 2
                grflag = 10
                rowsnew = kk ' number of points used
    
            case %wm_paint
                beginpaint cbhndl, ps
                if grflag=10 then ' graph can be made
                    '
                    ' specify rectancle in 0.01 mm units for creation of metafile:
                    '
                    ' obtain a handle to a reference device context.
                    hdcref = getdc(cbhndl)
                    '
                    ' determine the picture frame 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 cbhndl, hdcref
    
                    ' retrieve the coordinates of the client
                    ' rectangle, in pixels.
                    getclientrect hgraph,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
                    '
                    hdcemf = createenhmetafile (%null, byval %null, rct, byval %null)
                    ' get rectangle in pixels to display diagram
                    getclientrect hgraph,rct
                    '
                    call prepareandmakegraph (hdcemf,2, rows, xmax, xmin, ymax, ymin, 1, 2, _
                        numdat(), xtext$, ytext$, rct, powerx, powery, xpixmax, ypixmax, _
                        logpixelsx, rowsnew)
                    '
                    hemf = closeenhmetafile (hdcemf) ' get handle to enhanced metafile
                    ' handle to label where the diagram is to be drawn
                    hdc = getdc(getdlgitem(cbhndl, %form1_graphlabel))
                    call playenhmetafile (hdc, hemf, rct)
                    ' "plays" the metafile in the label window,
                    ' i.e. the graphics procedures are now being performed in
                    ' that window.
                    if grafcopyflag=3 then ' copy graphic enhanced metafile to clipboard
                        ' this code is due to peter stephensen:
                        %cf_enhmetafile = 14
                        if openclipboard(%null) then
                            emptyclipboard
                            setclipboarddata %cf_enhmetafile, hemf
                            closeclipboard
                        end if
                        grafcopyflag=0
                    end if
                else
                    hdc = getdc(getdlgitem(cbhndl, %form1_graphlabel))
                    res=fillrect (hdc, rct, getstockobject(%white_brush))
                end if
                endpaint cbhndl, ps
                releasedc getdlgitem(cbhndl,%form1_graphlabel), hdc
                function = 1
            case %wm_destroy
                deleteobject brush
                postquitmessage 0
    
            case %wm_command
                select case  cbctl
                    case  %form1_graphcopy
                        ' the following causes the metafile to be copied to the clipboard.
                        grafcopyflag=3   ' see case %wm_paint above
                        res=invalidaterect(cbhndl, byval %null, %true)
                    case else
                end select
            case else
        end select
    end function
    '
    ' ------------------------------------------------
    function pbmain
        local count as long
        local style1 as long, hform1 as long
        style1 = %ws_popup or %ds_modalframe or %ws_caption or %ws_minimizebox or %ws_sysmenu or %ds_center or %ws_clipchildren
        ' nb: the clipchildren style must be included
        dialog new 0, "histogram", 0, 0,  342,  264, style1, 0 to hform1
        dialog show modeless hform1 , call form1_dlgproc
        do
            dialog doevents to count
        loop until count=0
    end function
    [this message has been edited by erik christensen (edited july 15, 2007).]

  • #2
    ' Histogram.
    '
    ' This is an updated and slightly improved version, which also works with PBwin10.
    Code:
    ' Histogram.
    '
    ' This is an updated and slightly improved version, which also works with PBwin10.
    
    #COMPILE EXE
    #REGISTER NONE
    #DIM ALL
    '
    #INCLUDE "win32api.inc"
    
    %form1_graphcopy          = 100
    %form1_graphlabel         = 105
    ' --------------------------------------------------
    '
    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
        ' pen styles
        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 fontheight 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
    ' -----------------------
        'type logfont defines the attributes of a font.
        'see logfont in the win32 help file
        lffont.lfheight = fontheight            ' logical height of font
        lffont.lfwidth = 0                      ' logical average character width (if zero then windows sets the width using a standard aspect ratio)
        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 prepareandmakegraph (BYVAL hdc AS LONG, BYVAL nv AS LONG, BYVAL  np AS LONG, BYVAL xmax AS SINGLE, _
                BYVAL xmin AS SINGLE, BYVAL ymax AS SINGLE, BYVAL ymin AS SINGLE, BYVAL iix AS LONG, _
                BYVAL iiy AS LONG, BYREF numdat() AS SINGLE, BYVAL xtxt$,BYVAL ytxt$, BYREF rct AS rect, _
                BYREF powerx AS SINGLE, BYREF powery AS SINGLE, BYREF xpixmax AS LONG, _
                BYREF ypixmax AS LONG, BYREF logpixelsx AS LONG, BYREF rowsnew AS LONG)
        ' -
        DIM start AS SINGLE, stepsize AS SINGLE, labels AS LONG
        DIM xstep AS SINGLE, xlabels AS LONG, xhigh AS SINGLE
        DIM ystep AS SINGLE, ylabels AS LONG, yhigh AS SINGLE
        DIM xlow AS SINGLE, ylow AS SINGLE
        DIM lemarg AS SINGLE, rimarg AS SINGLE, upmarg AS SINGLE, lomarg AS SINGLE
        DIM xconvfac AS SINGLE, yconvfac AS SINGLE
        LOCAL i AS LONG, hpen AS LONG
        LOCAL xpix AS SINGLE,ypix AS SINGLE, radius AS SINGLE
        LOCAL ystart AS SINGLE,yend AS SINGLE,penwidth AS SINGLE
       ' local rc as rectangle
        LOCAL hhatchedbrush AS LONG, hrec AS LONG
        LOCAL ytop AS LONG, xleft AS LONG, ybottom AS LONG, xright AS LONG
        '
        fillrect hdc, rct, getstockobject(%white_brush)
        hhatchedbrush = createhatchbrush(%hs_bdiagonal, %BLUE)
        IF ABS(xmax) > ABS(xmin) THEN
            powerx = xmax
        ELSE
            powerx = xmin
        END IF
        powerx = INT(LOG10(ABS(powerx) / 10))
        IF ABS(ymax) > ABS(ymin) THEN
            powery = ymax
        ELSE
            powery = ymin
        END IF
        powery = INT(LOG10(ABS(powery) / 10))
        CALL findaxisdimandscale(xmax, xmin, xlow, xstep, xlabels)
        CALL findaxisdimandscale(ymax, ymin, ylow, ystep, ylabels)
        xhigh = xlow + (xlabels - 1) * xstep
        yhigh = ylow + (ylabels - 1) * ystep
        ' define wideness of "margins" for plot
        lemarg = xpixmax/9
        rimarg = xpixmax/15
        upmarg = ypixmax/9
        lomarg = ypixmax/6.5
        xconvfac = (xpixmax - lemarg - rimarg) / (xhigh - xlow)
        yconvfac = (ypixmax - upmarg - lomarg) / (yhigh - ylow)
        '
        penwidth=logpixelsx/254*2.1
        hpen = selectobject(hdc, createpen(penstyle(0), penwidth, gcolor(1))) ' blue
        ' draw histogram
        selectobject hdc, hhatchedbrush
        FOR i=1 TO rowsnew STEP 4
            xleft=ROUND((numdat(i,1)-xlow)*xconvfac+lemarg,0)
            ybottom=ROUND(ypixmax-((numdat(i,2)-ylow)*yconvfac+lomarg),0)
            xright=ROUND((numdat(i+2,1)-xlow)*xconvfac+lemarg,0)
            ytop=ROUND(ypixmax-((numdat(i+2,2)-ylow)*yconvfac+lomarg),0)
           ' hrec = rectangle(hdc, xleft, ytop, xright, ybottom)
            hrec = rectangle(hdc, xleft, ytop, xright + 1, ybottom + 1)
            ' addition of 1 to the right and bottom dimensions may give a better result on the screen.
            ' however, a print of a copy pasted to word will be best without adding anything.
        NEXT
        deleteobject hhatchedbrush
    
        CALL makexandyaxiswithtext(hdc,lemarg, lomarg, rimarg, upmarg, xlow, xstep, xhigh, _
             ylow, ystep, yhigh, xconvfac, yconvfac, xtxt$, ytxt$, 0, rct, logpixelsx, _
             xpixmax, ypixmax, powerx, powery)
        '
    END SUB
    '
    SUB findaxisdimandscale (BYVAL maxval AS SINGLE,BYVAL minval AS SINGLE, _
            BYREF start AS SINGLE,BYREF stepsize AS SINGLE,BYREF labels AS LONG)
        '
        LOCAL RANGE AS DOUBLE, eksp AS DOUBLE, bbbb AS DOUBLE, iii AS LONG
        RANGE = maxval - minval
        RANGE = LOG10(RANGE)
        eksp = CEIL(RANGE)
        RANGE = 10 ^ (RANGE - eksp)
        WHILE RANGE < 1
            RANGE = RANGE * 10
            eksp = eksp - 1
        WEND
        IF CEIL(RANGE) >= 5 THEN
            labels = CEIL(RANGE) + 1
            stepsize = 1 * 10 ^ eksp
        ELSEIF CEIL(RANGE) >= 2 THEN
            labels = CEIL(2 * RANGE) + 1
            stepsize = .5 * 10 ^ eksp
        ELSE
            labels = CEIL(5 * RANGE) + 1
            stepsize = .2 * 10 ^ eksp
        END IF
        bbbb = 0
        IF maxval > 0 THEN
            iii = 1
            DO
                iii = iii + 1
                bbbb = bbbb + stepsize
            LOOP UNTIL bbbb > maxval
            IF (iii - labels) * stepsize > minval THEN labels = labels + 1
                start = (iii - labels) * stepsize
        ELSE
            iii = 0
            DO
                iii =  iii -1
                bbbb = bbbb - stepsize
            LOOP UNTIL bbbb < minval
            IF (iii + labels - 1) * stepsize < maxval THEN labels = labels + 1
            start = iii * stepsize
        END IF
    END SUB
    '
    SUB makexandyaxiswithtext (BYVAL hdc AS LONG, BYVAL lemarg AS SINGLE, BYVAL lomarg AS SINGLE, BYVAL rimarg AS SINGLE, _
        BYVAL upmarg AS SINGLE, BYVAL xlow AS SINGLE, BYVAL xstep AS SINGLE, BYVAL xhigh AS SINGLE, BYVAL ylow AS SINGLE, _
        BYVAL ystep AS SINGLE, BYVAL yhigh AS SINGLE, BYVAL xconvfac AS SINGLE, BYVAL yconvfac AS SINGLE, BYVAL xtxt$, _
        BYVAL ytxt$,BYVAL ipat AS LONG, BYREF rct AS rect, BYREF logpixelsx AS LONG, BYREF xpixmax AS LONG, _
        BYREF ypixmax AS LONG, BYREF powerx AS SINGLE, BYREF powery AS SINGLE)
        '-
        LOCAL lpsz AS ASCIIZ * 255
        LOCAL hpen AS LONG, hfont AS LONG
        LOCAL i AS LONG, flag AS LONG, kk AS LONG, longtics AS LONG
        LOCAL RES AS LONG
        LOCAL si AS SINGLE, ex AS STRING, xx1 AS SINGLE
        LOCAL yy1 AS SINGLE
        LOCAL xval AS SINGLE, yval AS SINGLE, penwidth AS SINGLE
        LOCAL lpsize AS sizel
        '-
        hfont=makefont(18,400,0,0,0,"arial")
        selectobject hdc, hfont
        settextalign hdc,%ta_left
    
        penwidth=logpixelsx/254*2.1
        hpen = selectobject(hdc, createpen(penstyle(0), penwidth, gcolor(0)))  ' black pen
        '
        '- draw x-axis and y-axis
        movetoex hdc, xpixmax-rimarg,ypixmax-lomarg, BYVAL %null
        lineto hdc, lemarg,ypixmax-lomarg
        lineto hdc, lemarg,upmarg
        '
        ' check number of ciphers in tic labels on x-axis
        xval = xlow
        FOR si = lemarg TO xpixmax - rimarg STEP xconvfac * xstep * .9999
            IF ABS(powerx)>=3 THEN
                xx1 = INT(xval / 10 ^ powerx + .5)
            ELSE
                xx1=ROUND(xval,3)
            END IF
            xval = xval + xstep
            IF ABS(xx1)>=10000 THEN longtics = 1
            INCR kk
        NEXT
    
        IF longtics = 1 AND kk >=8 THEN flag = 1 ' many long tic labels.
        '
        '- make tic intervals and labels on x-axis
        xval = xlow : kk = 0
        settextalign hdc,%ta_center
        FOR si = lemarg TO xpixmax - rimarg STEP xconvfac * xstep * .9999
            IF ABS(powerx)>=3 THEN
                xx1 = INT(xval / 10 ^ powerx + .5)
            ELSE
                xx1=ROUND(xval,3)
            END IF
            lpsz = LTRIM$(STR$(xx1))
            RES=gettextextentpoint32(hdc,lpsz,BYVAL LEN(lpsz),lpsize)
            INCR kk
            IF flag = 1 THEN ' only show every other tic label
                IF kk MOD 2 = 1 THEN textout hdc, si, ypixmax-lomarg+ypixmax/40, lpsz, BYVAL LEN(lpsz)
                IF kk MOD 2 = 0 THEN lpsize.cx = 0
            ELSE             ' show every tic label
                textout hdc, si, ypixmax-lomarg+ypixmax/40, lpsz, BYVAL LEN(lpsz)
            END IF
            movetoex hdc, si,ypixmax-lomarg, BYVAL %null
            lineto hdc, si,ypixmax-lomarg+ypixmax/50
            xval = xval + xstep
        NEXT
        '
        '- put name of x-variable on diagram
        IF powerx >=3 THEN ex$ = " / 10^" + MID$(STR$(-powerx), 2)
        IF ABS(powerx)<3 THEN ex$ = "
        IF powerx <=-3 THEN ex$ = " x 10^" + MID$(STR$(powerx), 2)
        xtxt$ = xtxt$ + ex$
        lpsz=xtxt$
        settextalign hdc,%ta_right
        textout hdc, xpixmax-rimarg+lpsize.cx*0.5, ypixmax-lomarg+ypixmax/13, lpsz, BYVAL LEN(lpsz)
        '
        '- make tic intervals and labels on y-axis
        yval = ylow
        FOR si = ypixmax-lomarg TO upmarg STEP -yconvfac * ystep * .9999
            IF ABS(powery)>=3 THEN
                yy1 = INT(yval / 10 ^ powery + .5)
            ELSE
                yy1=ROUND(yval,3)
            END IF
            lpsz = LTRIM$(STR$(yy1))
            RES=gettextextentpoint32(hdc,lpsz,BYVAL LEN(lpsz),lpsize)
            textout hdc, lemarg-xpixmax/48, si-lpsize.cy*0.5, lpsz, BYVAL LEN(lpsz)
            yval = yval + ystep
            movetoex hdc,lemarg, si, BYVAL %null
            lineto hdc, lemarg-xpixmax/70,si
        NEXT
        '-put name of y-variable on diagram
        IF powery >= 3 THEN ex$ = " / 10^" + MID$(STR$(-powery), 2)
        IF ABS(powery) <3 THEN ex$ = "
        IF powery < -3 THEN ex$ = " x 10^" + MID$(STR$(powery), 2)
        ytxt$ = ytxt$ + ex$
        lpsz=ytxt$
        settextalign hdc,%ta_left
        textout hdc, lemarg-xpixmax/48-lpsize.cx,upmarg-ypixmax/13, lpsz, BYVAL LEN(lpsz)
        deleteobject hfont
    END SUB
    '
    SUB makecategories(BYREF mi() AS SINGLE, BYREF numdat() AS SINGLE, _
            BYREF xmax AS SINGLE, BYREF xmin AS SINGLE, BYREF ymax AS SINGLE, BYREF ymin AS SINGLE, BYREF k9 AS LONG)
       ' categorize values in intervals
        DIM xstep AS SINGLE, xlabels AS LONG, xhigh AS SINGLE, sum AS SINGLE
        DIM xlow AS SINGLE
        LOCAL i AS LONG, k AS LONG, j AS SINGLE, kk AS LONG, fak AS SINGLE, flg AS LONG
        '
        ARRAY SORT mi() ' sorting simplifies and speeds up categorization
        '
        xmin = mi(LBOUND(mi)) : xmax = mi(UBOUND(mi))
        '
        CALL findaxisdimandscale(xmax, xmin, xlow, xstep, xlabels)
        xhigh = xlow + (xlabels - 1) * xstep
        '
        ' make sure that a reasonable number of intervals are being used
        fak = 2.0
        DO WHILE xlabels < 30 ' you can experiment with other values than 30
            xlabels = (xlabels - 1) * fak + 1 : xstep = xstep / fak
            fak = 4.5 - fak
        LOOP
        '
        ' categorize data
        DIM kat(1 TO xlabels - 1) AS LOCAL LONG
        k = 1 : i = 0
        j = xlow + xstep
        DO
            INCR i
            DO WHILE mi(k) < j
                INCR k : IF k > UBOUND(mi) THEN EXIT DO
                INCR kat(i)
            LOOP
            DECR k : j = j + xstep
            IF j >= xhigh*.999999 THEN EXIT DO
        LOOP
        '
        ' define min and max values for plot
        xmin = xlow : xmax = xhigh
        ymin = 0.0 : ymax = 0.0
        FOR i = 1 TO xlabels - 1
            ymax = MAX(ymax, kat(i))
        NEXT
        '
        ' make numeric data for plot
        RESET numdat()
        k = 0 : kk = 0
        FOR i = 1 TO xlabels - 1
            INCR kk
            IF kat(kk) > 0 THEN
                IF flg = 0 THEN xmin = xlow + (i-1) * xstep  : flg = 1 ' adjust xmin
                '
                ' the following data allows you to draw just the outline of the bars.
                ' however, the current version of the program applies the data to draw
                ' the bars using the rectangle function with a hatched brush.
                INCR k : numdat(k, 1) = xlow + (i-1) * xstep : numdat(k, 2) = 0.0
                INCR k : numdat(k, 1) = xlow + (i-1) * xstep : numdat(k, 2) = kat(kk)
                INCR k : numdat(k, 1) = xlow + i * xstep     : numdat(k, 2) = kat(kk)
                INCR k : numdat(k, 1) = xlow + i * xstep     : numdat(k, 2) = 0
                '
                xmax = xlow + i * xstep ' adjust xmax
            END IF
        NEXT
        k9 = k
    END SUB
    '
    FUNCTION randomnormalvalue(mean AS DOUBLE, sd AS DOUBLE) AS DOUBLE
        LOCAL pi2# : pi2 = 6.2831853071796
        FUNCTION = SQR(-2 * LOG(RND)) * COS(pi2 * RND) * sd + mean
    END FUNCTION
    ' ---------------------------------------------------------
    CALLBACK FUNCTION form1_dlgproc
        LOCAL hemf AS LONG,lpszfile AS ASCIIZ*80
        LOCAL hdcemf AS LONG
        LOCAL hdc AS LONG
        LOCAL RES AS LONG
        STATIC grafcopyflag AS LONG
        LOCAL i#,kk&,jj#
        LOCAL hdcref AS LONG,iwidthmm AS LONG,iheightmm AS LONG,iwidthpels AS LONG,iheightpels AS LONG
        STATIC hform1_menu0 AS LONG
        STATIC hform1_menu2 AS LONG
        STATIC hgraph AS LONG      ' handle for graphics window - a label (or static) control
        STATIC brush AS LONG
        STATIC rows AS LONG        ' number of rows in array
        STATIC rowsnew AS LONG     ' number of rows with complete x,y values in a given analysis
        STATIC logpixelsy AS LONG  ' pixels per inch of screen height
        STATIC logpixelsx AS LONG  ' pixels per inch of screen width
        STATIC numdat() AS SINGLE  ' numerical data array
        STATIC xmax AS SINGLE, xmin AS SINGLE, ymax AS SINGLE, ymin AS SINGLE
        STATIC powerx AS SINGLE, powery AS SINGLE
        STATIC xvar AS LONG,yvar AS LONG
        STATIC grflag AS LONG
        STATIC xdialun AS LONG,ydialun AS LONG,xpixmax AS LONG,ypixmax AS LONG
        STATIC rct AS rect
        STATIC ps AS paintstruct   ' paint structure
        STATIC xfact AS SINGLE, yfact AS SINGLE
        STATIC xtext$,ytext$
        STATIC labelstyle AS LONG,labelstyle2 AS LONG
        STATIC n AS LONG, ct AS LONG, r AS LONG
        DIM mi(1 TO 10000) AS STATIC SINGLE
        DIM kat(1 TO 20) AS STATIC LONG
    
        '
        SELECT CASE CBMSG
            '
            CASE %WM_INITDIALOG
                labelstyle = %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
                xdialun = 338*2 : ydialun = 252*2 : xpixmax = xdialun : ypixmax = ydialun
                xfact = 1.0
                yfact = 1.0
    
                labelstyle2& = %WS_CHILD OR %WS_VISIBLE OR %SS_GRAYFRAME OR %SS_LEFT
                ' nb: the grayframe style must be included
                CONTROL ADD LABEL, CBHNDL,  %form1_graphlabel,  "", 4, 2, xdialun,ydialun, labelstyle2 ',%ws_ex_clientedge
                CONTROL HANDLE CBHNDL, %form1_graphlabel TO hgraph ' handle for graphics window
                MENU NEW BAR TO hform1_menu0
                MENU NEW POPUP TO hform1_menu2
                MENU ADD POPUP, hform1_menu0 ,"&Copy", hform1_menu2, %MF_ENABLED
                MENU ADD STRING, hform1_menu2, "Copy present &graph to clipboard", %form1_graphcopy, %MF_ENABLED       ' %mf_grayed
                MENU ATTACH hform1_menu0, CBHNDL
    
                brush=createsolidbrush(RGB(255,255,255)) ' white
                hdc = getdc(%HWND_DESKTOP)
                logpixelsy  = getdevicecaps(hdc, %logpixelsy)
                logpixelsx  = getdevicecaps(hdc, %logpixelsx)
                releasedc %HWND_DESKTOP, hdc
                REDIM numdat(1 TO 5000,1 TO 2)
                grflag = 10
    
                ' create random normally distributed values
                RANDOMIZE 3.123
                RESET mi()
                FOR i = 1 TO 10000
                    mi(i) = randomnormalvalue(50,12.52) '  mean, sd
                NEXT
                ' categorize values in intervals
                CALL makecategories(mi(), numdat(), xmax, xmin, ymax, ymin, kk)
                xtext$ = "X-value"
                ytext$ = "Number of observations"
                rows = 2
                grflag = 10
                rowsnew = kk ' number of points used
    
            CASE %WM_PAINT
                beginpaint CBHNDL, ps
                IF grflag=10 THEN ' graph can be made
                    '
                    ' specify rectancle in 0.01 mm units for creation of metafile:
                    '
                    ' obtain a handle to a reference device context.
                    hdcref = getdc(CBHNDL)
                    '
                    ' determine the picture frame 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 CBHNDL, hdcref
    
                    ' retrieve the coordinates of the client
                    ' rectangle, in pixels.
                    getclientrect hgraph,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
                    '
                    hdcemf = createenhmetafile (%null, BYVAL %null, rct, BYVAL %null)
                    ' get rectangle in pixels to display diagram
                    getclientrect hgraph,rct
                    '
                    CALL prepareandmakegraph (hdcemf,2, rows, xmax, xmin, ymax, ymin, 1, 2, _
                        numdat(), xtext$, ytext$, rct, powerx, powery, xpixmax, ypixmax, _
                        logpixelsx, rowsnew)
                    '
                    hemf = closeenhmetafile (hdcemf) ' get handle to enhanced metafile
                    ' handle to label where the diagram is to be drawn
                    hdc = getdc(getdlgitem(CBHNDL, %form1_graphlabel))
                    CALL playenhmetafile (hdc, hemf, rct)
                    ' "plays" the metafile in the label window,
                    ' i.e. the graphics procedures are now being performed in
                    ' that window.
                    IF grafcopyflag=3 THEN ' copy graphic enhanced metafile to clipboard
                        ' this code is due to peter stephensen:
                       ' %cf_enhmetafile = 14
                        IF openclipboard(%null) THEN
                            emptyclipboard
                            setclipboarddata %CF_ENHMETAFILE, hemf
                            closeclipboard
                        END IF
                        grafcopyflag=0
                    END IF
                ELSE
                    hdc = getdc(getdlgitem(CBHNDL, %form1_graphlabel))
                    RES=fillrect (hdc, rct, getstockobject(%white_brush))
                END IF
                endpaint CBHNDL, ps
                releasedc getdlgitem(CBHNDL,%form1_graphlabel), hdc
                FUNCTION = 1
            CASE %WM_DESTROY
                deleteobject brush
                postquitmessage 0
    
            CASE %WM_COMMAND
                SELECT CASE  CBCTL
                    CASE  %form1_graphcopy
                        ' the following causes the metafile to be copied to the clipboard.
                        grafcopyflag=3   ' see case %wm_paint above
                        RES=invalidaterect(CBHNDL, BYVAL %null, %true)
                    CASE ELSE
                END SELECT
            CASE ELSE
        END SELECT
    END FUNCTION
    '
    ' ------------------------------------------------
    FUNCTION PBMAIN
        LOCAL COUNT AS LONG
        LOCAL style1 AS LONG, hform1 AS LONG
        style1 = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER OR %WS_CLIPCHILDREN
        ' nb: the clipchildren style must be included
        DIALOG NEW PIXELS, 0, "Histogram", 0, 0,  342*2,  264*2, style1, 0 TO hform1
        DIALOG SHOW MODELESS hform1 , CALL form1_dlgproc
        DO
            DIALOG DOEVENTS TO COUNT
        LOOP UNTIL COUNT=0
    END FUNCTION
    Attached Files

    Comment

    Working...
    X