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

Linear regression and correlation analysis - Updated for PBwin10

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

  • PBWin Linear regression and correlation analysis - Updated for PBwin10

    ' Linear regression and correlation analysis.
    '
    ' This is an updated version for PBwin10 of an old program posted previously here:
    '
    ' http://www.powerbasic.com/support/pb...ad.php?t=24134
    '
    ' If you use earlier versions of PBwin you should probably remove the marked
    ' lines 17 and 932.
    '
    ' Best regards, Erik
    Code:
    ' Linear regression and correlation analysis.
    '
    ' This is an updated version for PBwin10 of an old program posted previously here:
    '
    ' http://www.powerbasic.com/support/pb...ad.php?t=24134
    '
    ' If you use earlier versions of PBwin you should probably remove the marked
    ' lines 17 and 932.
    '
    ' Best regards, Erik
    #PBFORMS CREATED V2.01
    #COMPILE EXE
    #DIM ALL
    #DEBUG ERROR ON
    ' ************************************************************************
    #OPTION ANSIAPI ' necessary if using PBWin10 - may otherwise be excluded
    ' ************************************************************************
    '------------------------------------------------------------------------------
    '   ** Includes **
    '------------------------------------------------------------------------------
    #PBFORMS BEGIN INCLUDES
    '#RESOURCE "NoName.pbr"
    #INCLUDE ONCE "WIN32API.INC"
    #INCLUDE ONCE "COMMCTRL.INC"
    #INCLUDE ONCE "PBForms.INC"
    #PBFORMS END INCLUDES
    '------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------
    '   ** Constants **
    '------------------------------------------------------------------------------
    #PBFORMS BEGIN CONSTANTS
    %IDD_DIALOG1                          =  101
    %IDC_LISTVIEW1                        = 1001
    %IDC_SCROLLBAR2_VERTICAL              = 1002
    %IDC_SCROLLBAR1_HORIZONTAL            = 1003
    %IDC_LABEL1_DATA_TO_BE_ANAL           = 1004
    %IDC_GRAPHIC1                         = 1005
    %IDC_LABEL1_REGRESSION_PLOT           = 1006
    %IDC_TEXTBOX1                         = 1007
    %IDC_LABEL1_RESULTS                   = 1008
    %IDC_LABEL1_LOAD_DATA                 = 1009
    %IDC_LABEL1_SELECT_DEPENDENT_VAR      = 1010
    %IDC_COMBOBOX_Y                       = 1041
    %IDC_LABEL1                           = 1012
    %IDC_COMBOBOX_X                       = 1043
    %IDC_BUTTON1_DO_REGRESSION_ANAL       = 1014
    %IDC_BUTTON1_EXIT                     = 1015
    %IDR_MENU1                            =  102
    %IDM_FILE_USEDEFAULTDATA              = 1016
    %IDM_FILE_OPENDATAFILE                = 1017
    %IDM_FILE_SAVEDATAFILEAS              = 1018
    %IDM_FILE_SAVECURRENTGRAPH            = 1019
    %IDM_FILE_EXIT                        = 1020
    %IDM_EDIT_SELECTALLTEXT               = 1021
    %IDM_EDIT_COPYSELECTEDTEXTTOCLIPBOARD = 1022
    %IDM_EDIT_CUTSELECTEDTEXTTOCLIPBOARD  = 1023
    %IDM_EDIT_COPYPRESENTGRAPHTOCLIPBOARD = 1024
    %IDM_HELP_ABOUT                       = 1025
    %IDM_HELP_HELP                        = 1026
    #PBFORMS END CONSTANTS
    
    #PBFORMS DECLARATIONS
    '------------------------------------------------------------------------------
    '   ** Main Application Entry Point **
    '------------------------------------------------------------------------------
    FUNCTION PBMAIN()
        PBFormsInitComCtls (%ICC_WIN95_CLASSES OR %ICC_DATE_CLASSES OR _
            %ICC_INTERNET_CLASSES)
        ShowDIALOG1 %HWND_DESKTOP
    END FUNCTION
    '------------------------------------------------------------------------------
    SUB Help_reg_anal
        LOCAL St AS STRING
        St="Consider as an example a data base including height and weight for a number "+ _
        "of individuals. You want to see to what extent weight is associated with "+ _
        "or ""correlated"" with height. You can get an idea by plotting the set of "+ _
        "data in co-ordinate system with height on the X-axis and weight on the "+ _
        "Y-axis. It could be that the taller persons were also among the heaviest. "+ _
        "To analyze this more closely you would perform a linear regression and "+ _
        "correlation analysis."+$CRLF+ _
        "       This analysis identifies the best fitting line (i.e. the regression "+ _
        "line Y=a+b*X) to the sample of two dimensional points (X,Y) and determines "+ _
        "how closely the points lie to that line. Thus the Y variable can be "+ _
        "expressed in terms of a constant (a) and a slope (b) times the X variable. "+ _
        "The constant is also referred to as the intercept, and the slope as the "+ _
        "regression coefficient. The measure of the ""closeness"" of the points to "+ _
        "the line is known at the correlation coefficient. "+$CRLF+ _
        "       First you load your data base which should be in Tab-separated text "+ _
        "format without quotes. This file format can be specified in most spreadsheet "+ _
        "and data base programs. You can also start by using the build-in default "+ _
        "data base. The loaded data will be displayed in the listview box."+$CRLF+ _
        "       Second you should select the Y-variable (the so-called dependent variable) "+ _
        "from the upper combobox. Only numerical variables can be selected. Text "+ _
        "variables are not being displayed in the combobox."+$CRLF+ _
        "       Third you select the X-variable (the so-called independent variable) in the "+ _
        "lower combobox."+$CRLF+ _
        "       Fourth you perform the analysis by pressing the button."+$CRLF+ _
        "       The results of the calculation will be displayed in the textbox and the "+ _
        "scatter plot with the regression line will be displayed in the graphic "+ _
        "control."+$CRLF+ _
        "       You can edit and copy the text to the clipboard. The current graph can also "+ _
        "be copied to the clipboard. "+$CRLF+ _
        "       For more information about the method you may consult any textbook on "+ _
        "statistics."+$CRLF+$CRLF+"                                                            Best wishes            Erik Christensen"
        MSGBOX St,%MB_ICONINFORMATION,"Linear regression and correlation program"
    END SUB
    '
    SUB About
        LOCAL St AS STRING
        St="Linear regression and correlation program for PowerBasic for Windows 10, program version 2.0 - June 26, 2013"+$CRLF+$CRLF+ _
        "By Erik Christensen, Copenhagen, Denmark"+$CRLF+$CRLF+ _
        "The use of this Public Domain program and its consequences are your own responsibility. However, any comment you may have is welcome."+$CRLF+$CRLF+ _
        "Good Luck!"
        MSGBOX St,%MB_ICONINFORMATION,"About this program"
    END SUB
    '
    FUNCTION gammln(num AS DOUBLE) AS DOUBLE 'logGamma function
        ' Thanks to Tony Burcham who provided this fine function.
        LOCAL fl AS EXT
        LOCAL j AS LONG
        LOCAL k AS EXT
        LOCAL z AS EXT
        LOCAL zpwr AS EXT 'power of z
        LOCAL zsqr AS EXT 'z squared
        DIM cf(5) AS EXT
        cf(0) = 1## / 12##
        cf(1) = 1## / -360##
        cf(2) = 1## / 1260##
        cf(3) = 1## / -1680##
        cf(4) = 1## / 1188##
    
        FOR k = 0## TO 10##
            fl = fl - LOG(num + k )
        NEXT k
    
        z = num + 11##
        zpwr = z 'z^1
        zsqr = z * z
        FOR j = 0 TO 4
            fl = fl + ( cf(j) / zpwr)
            zpwr =  zpwr * zsqr
        NEXT j
        fl = fl + ((z - 0.5##) * LOG(z)) + 0.9189385332046727## - z
        FUNCTION = fl
       ' Gam = EXP(fl)
    END FUNCTION
    '
    SUB IncomplBeta(BYVAL X AS DOUBLE, BYVAL P AS DOUBLE, BYVAL Q AS DOUBLE, BYREF betain AS DOUBLE, BYREF ifault AS LONG)
    '
    '     Derived from FORTRAN code based on:
    '
    '     algorithm AS 63  appl. statist. (1973), vol.22, no.3
    '
    '     computes incomplete beta function ratio for arguments
    '     x between zero and one, p and q positive.
    '
          LOCAL indx&,beta##
          LOCAL zero##,one##,acu##
          LOCAL psq##,cx##,xx##,pp##,qq##,term##,ai##,ns&,rx##,temp##
    '
    '     define accuracy and initialise
    '
          zero = 0.0E0## : one = 1.0E0## : acu = 0.1E-13##
          betain=x
    '
    '     test for admissibility of arguments
    '
          ifault=1&
          IF(p <= zero OR q <= zero) THEN EXIT SUB
          ifault=2&
          IF(x < zero OR x > one) THEN EXIT SUB
          ifault=0&
          IF(x = zero OR x = one) THEN EXIT SUB
    '
    '     calculate log of complete beta
    '
          beta = gammln(p)+gammln(q)-gammln(p+q)
    '
    '     change tail if necessary and determine s
    '
          psq=p+q
          cx=one-x
          IF(p >= psq*x) GOTO 1
          xx=cx
          cx=x
          pp=q
          qq=p
          indx = 1&
          GOTO 2
        1 xx=x
          pp=p
          qq=q
          indx = 0&
        2 term=one
          ai=one
          betain=one
          ns=qq+cx*psq
    '
    '     user Soper's reduction formulae.
    '
          rx=xx/cx
        3 temp=qq-ai
          IF(ns = 0&) THEN rx=xx
        4 term=term*temp*rx/(pp+ai)
          betain=betain+term
          temp=ABS(term)
          IF(temp <= acu AND temp <= acu*betain) THEN GOTO 5
          ai=ai+one
          ns=ns-1&
          IF(ns >= 0&) THEN GOTO 3
          temp=psq
          psq=psq+one
          GOTO 4
    '
    '     calculate result
    '
        5 betain=betain*EXP(pp*LOG(xx)+(qq-one)*LOG(cx)-beta)/pp
          IF indx = 1& THEN betain=one-betain
    END SUB
    '
    FUNCTION PfromT(BYVAL T AS DOUBLE,BYVAL df AS DOUBLE) AS DOUBLE
        LOCAL ifault&,betain#
        CALL IncomplBeta(df/(df+T*T),df*.5#,.5#,betain,ifault)
        IF ifault = 0 THEN FUNCTION = betain ELSE FUNCTION = 1
    END FUNCTION
    '
    SUB MATINVSIM (BYREF X() AS DOUBLE, BYVAL M AS LONG, BYREF DET AS DOUBLE, BYREF A() AS DOUBLE, BYREF Y() AS DOUBLE)
        LOCAL PVT AS DOUBLE,T AS DOUBLE
        LOCAL J&,K&,L&,I&
        DET = 1
        FOR J& = 0 TO M
            PVT = A(J&, J&)
            DET = DET * PVT
            IF DET = 0 THEN MSGBOX "MATRIX SINGULAR - Cannot perform the analysis",%MB_ICONERROR,"Calculation Problem": EXIT SUB
            Y(J&) = Y(J&) / A(J&, J&)
            A(J&, J&) = 1
            FOR K& = 0 TO M
                A(J&, K&) = A(J&, K&) / PVT
            NEXT
            FOR K& = 0 TO M
                IF K& <> J& THEN
                    T = A(K&, J&)
                    Y(K&) = Y(K&) - T * Y(J&)
                    A(K&, J&) = 0
                    FOR L& = 0 TO M
                        A(K&, L&) = A(K&, L&) - A(J&, L&) * T
                    NEXT
                END IF
            NEXT
        NEXT
        FOR I& = 0 TO M
            FOR J& = 0 TO M
                X(I&, J&) = A(I&, J&)
            NEXT
        NEXT
    END SUB
    '
    SUB MakeAnalysis(BYVAL hDlg AS LONG, BYREF DataArray() AS STRING, BYREF NumDat() AS SINGLE, BYREF T AS STRING, _
                     BYREF Xmax AS SINGLE, BYREF Ymax AS SINGLE, BYREF Xmin AS SINGLE, BYREF Ymin AS SINGLE, _
                     BYREF AnalysisNumber AS LONG, BYREF GRAFFLAG AS LONG, BYVAL Rows AS LONG, BYREF RowsNew AS LONG, _
                     BYREF Constant AS DOUBLE, BYREF Coeff AS DOUBLE, BYVAL Columns AS LONG, BYREF Xvar AS LONG, BYREF Yvar AS LONG)
    
        LOCAL I&,J&,tt$,K&
        LOCAL Cval&,hCtl&,Length&,Cvartx$
        INCR AnalysisNumber
        ' Identify Yvar - number.
        COMBOBOX GET TEXT hDlg, %IDC_COMBOBOX_Y TO Cvartx$
        FOR I&=1 TO Columns
            IF TRIM$(Cvartx$) = TRIM$(DataArray(I&, 0)) THEN Yvar&=I&
        NEXT
        ' Identify Xvar - number.
        COMBOBOX GET TEXT hDlg, %IDC_COMBOBOX_X TO Cvartx$
        FOR I&=1 TO Columns
            IF TRIM$(Cvartx$) = TRIM$(DataArray(I&, 0)) THEN Xvar&=I&
        NEXT
        ' Transfer selected data to numerical array
        ' and find minimum and maximum values for X and Y
        REDIM NumDat(1 TO Rows,0 TO 2)
        Xmax = 1E-33: Ymax = 1E-33: Xmin = 1E+33: Ymin = 1E+33
        K&=0
        FOR J&=1 TO Rows
            ' include only complete data in the analysis
            IF TRIM$(DataArray(Xvar&,J&)) <> "" AND TRIM$(DataArray(Yvar&,J&)) <> "" THEN
                INCR K&
                NumDat(K&,0)=1
                NumDat(K&,1)=VAL(DataArray(Xvar&,J&))
                IF NumDat(K&,1)>Xmax THEN Xmax=NumDat(K&,1)
                IF NumDat(K&,1)<Xmin THEN Xmin=NumDat(K&,1)
                NumDat(K&,2)=VAL(DataArray(Yvar&,J&))
                IF NumDat(K&,2)>Ymax THEN Ymax=NumDat(K&,2)
                IF NumDat(K&,2)<Ymin THEN Ymin=NumDat(K&,2)
            END IF
        NEXT
        RowsNew=K& ' number of x,y data sets included in the analysis
        '
        DIM X(2,2) AS DOUBLE, A(2,2) AS DOUBLE, Y(2) AS DOUBLE, _
            Mean(2) AS DOUBLE, StDev(2) AS DOUBLE, T(2) AS DOUBLE, _
            B(2) AS DOUBLE, U(2,2) AS DOUBLE, R(2,2) AS DOUBLE, _
            C(2,2) AS DOUBLE, X AS DOUBLE, N AS DOUBLE, M AS LONG
        M=2
        N=RowsNew
        LOCAL L&
        LOCAL DET AS DOUBLE,SSS AS DOUBLE,TTTT AS DOUBLE, UUU AS DOUBLE
        ' calculate cross products
        FOR I& = 0 TO M
            FOR J& = 0 TO M
                X = 0
                FOR L& = 1 TO RowsNew
                    X = X + NumDat(L&,I&) * NumDat(L&,J&)
                NEXT
                X(I&,J&) = X ' sum of cross products
                C(I&,J&) = X
            NEXT
            T(I&) = X(0,I&) / X(0,0) ' Means
            B(I&) = 0
            IF I& > 0 THEN B(I&) = SQR(X(I&,I&)/(N-1)-X(0,I&)*X(0,I&)/(N*(N-1))) ' Standard Deviation (SD)
        NEXT
        '
        FOR I = 1 TO M
            Mean(I) = T(I)
            StDev(I) = B(I)
        NEXT
        T$=T$+"Analysis"+STR$(AnalysisNumber)+".   Number of individuals in analysis:"+STR$(RowsNew)+$CRLF + _
        "Y-variable: "+DataArray(Yvar&, 0) + "    Mean: "+FORMAT$(Mean(2),"######.00000")+ _
        "   SD: "+FORMAT$(StDev(2),"######.00000")+ $CRLF+ _
         "X-variable: "+DataArray(Xvar&)+"    Mean: "+FORMAT$(Mean(1),"######.00000")+ _
        "   SD: "+FORMAT$(StDev(1),"######.00000")+ $CRLF
        '
        FOR I& = 1 TO M
            FOR J& = 1 TO M
                R(I&,J&)=(N*X(I&,J&)-X(0,I&)*X(0,J&))/(N*(N - 1)*B(I&)*B(J&))
            NEXT
        NEXT
        '
        FOR I& = 1 TO M
            FOR J& = 1 TO M
                U(I&,J&) = R(I&,J&)
            NEXT
        NEXT
        LOCAL t3#,pp#,NN#,st$ : NN=RowsNew
        st = $CRLF
        IF (U(1,2)^2) < 0.999 THEN
            t3=U(1,2)*SQR((NN-2#)/(1#-U(1,2)^2)) : pp = PfromT(t3,N-2#) : st = "    t: " + FORMAT$(t3,"####.00") + "    p: "+FORMAT$(pp,"##.000000")+$CRLF
            IF pp<0.000001 THEN st$= "    t: " + FORMAT$(t3,"####.00") + "    p: <0.000001"+$CRLF
        END IF
        T$=T$+"Correlation Coefficient r: "+FORMAT$(U(1,2),"##.00000")
        T$=T$+st
        T$=T$+"Coefficient of Determination r²: "+FORMAT$(U(1,2)^2,"##.00000")+$CRLF
        FOR I& = 0 TO 1
            Y(I&) = C(I&, M)
            FOR J& = 0 TO 1
                X(I&,J&) = C(I&,J&)
            NEXT
        NEXT
        '
        CALL MATINVSIM(A(), 1, DET, X(), Y())
        IF DET=0 THEN
            T$=T$+"Cannot perform the analysis."+$CRLF+$CRLF
            GRAFFLAG = 0 ' No plot is made
            EXIT SUB
        END IF
        SSS = C(M, M)
        FOR I& = 0 TO 1
            SSS = SSS - Y(I&) * C(I&, M)
        NEXT
        TTTT = SSS / (N - M)
        UUU = SQR(TTTT)
        ' VARIANCE-COVARIANCE MATRIX
        FOR I& = 0 TO 1
            FOR J& = 0 TO 1
                A(I&, J&) = A(I&, J&) * TTTT
            NEXT
        NEXT
        Coeff=Y(1):Constant=Y(0)
        st = $CRLF
        IF ABS(A(1,1)) > ABS(y(1)) *10E-10 THEN
            t3=Y(1)/SQR(A(1,1)) : pp = PfromT(t3,N-2#) : st = "   t: " + FORMAT$(t3,"####.00") + "   p: "+FORMAT$(pp,"##.000000")+$CRLF
            IF pp<0.000001 THEN st$= "   t: " + FORMAT$(t3,"####.00") + "   p: <0.000001"+$CRLF
        END IF
        T$=T$+"Regres. Coeff.: "+FORMAT$(Y(1),"#####.00000")+"   Standard Error: "+FORMAT$(SQR(A(1,1)),"#####.00000") + st
    
        st = $CRLF
        IF ABS(A(0,0)) > ABS(y(0)) *10E-10 THEN
            t3=Y(0)/SQR(A(0,0)) : pp = PfromT(t3,N-2#) : st = "    t: "+ FORMAT$(t3,"####.00") + "    p: "+FORMAT$(pp,"##.000000")+$CRLF
            IF pp<0.000001 THEN st$= "    t: " + FORMAT$(t3,"####.00") + "    p: <0.000001"+$CRLF
        END IF
        T$=T$+"Constant: "+FORMAT$(Y(0),"#####.00000")+"    Standard Error: "+FORMAT$(SQR(A(0,0)),"#####.00000") + st
    
        I&=SGN(Y(1)) : IF I&=1 THEN tt$=" + " ELSE tt$=" - "
        T$=T$+"Regression equation: Y = "+FORMAT$(Y(0),"#####.00000")+tt$+FORMAT$(ABS(Y(1)),"#####.00000")+" * X"+$CRLF
        T$=T$+"Standard Error of Estimated Y: "+FORMAT$(UUU,"#####.00000")+$CRLF
        T$=T$+$CRLF+$CRLF
        GRAFFLAG=10
    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 Range1 AS DOUBLE,EKSP AS DOUBLE,Bbbb AS DOUBLE, III AS LONG
        Range1 = MaxVal - MinVal
        Range1 = LOG10(Range1)
        EKSP = CEIL(Range1)
        Range1 = 10 ^ (Range1 - EKSP)
        WHILE Range1 < 1
            Range1 = Range1 * 10
            EKSP = EKSP - 1
        WEND
        IF CEIL(Range1) >= 5 THEN
            Labels = CEIL(Range1) + 1
            StepSize = 1 * 10 ^ EKSP
        ELSEIF CEIL(Range1) >= 2 THEN
            Labels = CEIL(2 * Range1) + 1
            StepSize = .5 * 10 ^ EKSP
        ELSE
            Labels = CEIL(5 * Range1) + 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 PrepareAndMakeGraph (BYVAL hDlg 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 PowerX AS SINGLE, _
        BYREF PowerY AS SINGLE, BYVAL RowsNew AS LONG, BYVAL Constant AS DOUBLE, BYVAL Coeff AS DOUBLE)
        ' -
        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&,hPen AS LONG
        LOCAL Xpix AS SINGLE,Ypix AS SINGLE, Radius AS SINGLE
        LOCAL Ystart AS SINGLE,Yend AS SINGLE,PenWidth AS SINGLE
        LOCAL XPixMax&, YPixMax&
    
        GRAPHIC CLEAR
        GRAPHIC GET SIZE TO XPixMax&, YPixMax&
    
        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&/8
        RiMarg = XPixMax&/12
        UpMarg = YPixMax&/8.5
        LoMarg = YPixMax&/5.7
        XConvFac = (XPixMax& - LeMarg - RiMarg) / (Xhigh - Xlow)
        YConvFac = (YPixMax& - UpMarg - LoMarg) / (Yhigh - Ylow)
        CALL MakeXandYaxisWithText(LeMarg, LoMarg, RiMarg, UpMarg, Xlow, Xstep, Xhigh, _
             Ylow, Ystep, Yhigh, XConvFac, YConvFac, Xtxt$, Ytxt$, 0, PowerX, PowerY)
        '
        GRAPHIC WIDTH 1 'linewidth&
        GRAPHIC COLOR %RGB_BLUE
        ' Plot points
        ' ===========
        Radius=ROUND((XPixMax&/100),0)
        FOR I&=1 TO RowsNew
            Xpix=ROUND((NumDat(I&,1)-Xlow)*XConvFac+LeMarg,0)
            Ypix=ROUND(YPixMax&-((NumDat(I&,2)-Ylow)*YConvFac+LoMarg),0)
            ' Draw small circle for each point. You can change the
            ' dimensions of the circle if you like.
            GRAPHIC ELLIPSE (Xpix-Radius,Ypix-Radius) - (Xpix+Radius,Ypix+Radius)
        NEXT
        ' Draw regression line:
        ' =====================
        Ystart=Constant+Coeff*Xlow
        Yend=Constant+Coeff*Xhigh
        ' 1: Move to left starting point
        IF Ystart<=Yhigh AND Ystart>=Ylow THEN
            GRAPHIC SET POS (LeMarg,YPixMax&-((Ystart-Ylow)*YConvFac+LoMarg))
        ELSEIF Ystart>Yhigh THEN
            GRAPHIC SET POS (((Yhigh-Constant)/Coeff-Xlow)*XConvFac+LeMarg,UpMarg)
        ELSE  'Ystart<Ylow
            GRAPHIC SET POS (((Ylow-Constant)/Coeff-Xlow)*XConvFac+LeMarg,YPixMax&-LoMarg)
        END IF
        ' 2: Draw to right ending point
        IF Yend<=Yhigh AND Yend>=Ylow THEN
            GRAPHIC LINE - (XPixMax&-RiMarg,YPixMax&-((Yend-Ylow)*YConvFac+LoMarg))
        ELSEIF Yend>Yhigh THEN
            GRAPHIC LINE - (((Yhigh-Constant)/Coeff-Xlow)*XConvFac+LeMarg,UpMarg)
        ELSE  'Yend<Ylow
            GRAPHIC LINE - (((Ylow-Constant)/Coeff-Xlow)*XConvFac+LeMarg,YPixMax&-LoMarg)
        END IF
        GRAPHIC REDRAW
    END SUB
    '
    SUB MakeXandYaxisWithText (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, BYVAL PowerX AS SINGLE, BYVAL PowerY AS SINGLE)
        '-
        DIM 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 res1 AS LONG
        LOCAL SI AS SINGLE,EX$,XX1 AS SINGLE
        LOCAL YY1 AS SINGLE
        LOCAL Xval AS SINGLE,Yval AS SINGLE,PenWidth AS SINGLE
        LOCAL XPixMax&, YPixMax&
        LOCAL lpSize AS SIZEL
        LOCAL hDC AS DWORD
    
        hFont = CreateFont(16,0,0,0,400,0,0,0,0,3,2,1,82,"Arial")
        GRAPHIC GET DC TO hDC
        SelectObject hDC, hFont
        SetTextAlign hDC,%TA_LEFT
    
        GRAPHIC GET SIZE TO XPixMax&, YPixMax&
        GRAPHIC COLOR %RGB_BLACK
                                 '
        '- Draw X-axis and Y-axis
        GRAPHIC SET POS (XPixMax&-RiMarg,YPixMax&-LoMarg)
        GRAPHIC LINE - (LeMarg,YPixMax&-LoMarg)
        GRAPHIC LINE - (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)>=100 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))
    
            res1=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
            GRAPHIC SET POS (SI,YPixMax&-LoMarg)
            GRAPHIC LINE - (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&/11, 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))
            res1=GetTextExtentPoint32(hDC,lpsz,BYVAL LEN(lpsz),lpSize)
            TextOut hDC, LeMarg-XPixMax&/40, SI-lpSize.cy*0.5, lpsz, BYVAL LEN(lpsz)
            Yval = Yval + Ystep
            GRAPHIC SET POS (LeMarg, SI)
            GRAPHIC LINE - (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&/40-lpSize.cx,UpMarg-YPixMax&/10, lpsz, BYVAL LEN(lpsz)
    END SUB
    '
    SUB DefaultData(BYREF Rows AS LONG, BYREF Columns AS LONG, BYREF DataArray() AS STRING)
        LOCAL I&,J&,FL&,Y&
        LOCAL PI2 AS DOUBLE
        PI2 = ATN(1) * 8 ' two PI
    
        ' Make default test data set.
        DATA "Initials","Weight (kg)","Height (cm)","Body Mass Index (BMI)","Hemoglobin (mmol/l)","Glucose (mmol/l)","ALT  (IU/l)","Systolic Blood Pressure (mm Hg)","Diastolic Blood Pressure (mm Hg)"
        Columns=9  ' number of columns
        Rows=300   ' number of rows
        ' Two empty columns are being added.
        REDIM DataArray(0 TO Columns + 2, 0 TO Rows)
        FOR I&=1 TO Columns
            DataArray(I&, 0) = READ$(I&)
        NEXT
        DataArray(0, 0) = "Row"
        RANDOMIZE 1.5 ' The same seed ensures same data set each time you selects default data
        '
        'This function is used to create random values having a normal distribution
        'with a specified Mean and Standard Deviation (SD):
        'X = SQR(-2*LOG(RND))*COS(PI2*RND)*Standard_Deviation+Mean
        '
        FOR I&=1 TO Rows
            DataArray(0,I&)=STR$(I&)
            DataArray(1,I&)=CHR$(RND(65,90))+".  "+CHR$(RND(65,90))+".  "+CHR$(RND(65,90))+"."
            DataArray(2,I&)=LTRIM$(STR$(ROUND(SQR(-2*LOG(RND))*COS(PI2*RND)*17+84,1)))
            DataArray(3,I&)=LTRIM$(STR$(ROUND(SQR(-2*LOG(RND))*COS(PI2*RND)*18+182,1)))
            DataArray(4,I&)=LTRIM$(STR$(ROUND(VAL(DataArray(2,I&))*10000/VAL(DataArray(3,I&))^2,1)))
            DataArray(5,I&)=LTRIM$(STR$(RND(38,80)/10+ROUND(VAL(DataArray(4,I&)),0)/10))
            DataArray(6,I&)=LTRIM$(STR$(RND(19,70)/10+ROUND(VAL(DataArray(4,I&)),0)/10))
            DataArray(7,I&)=LTRIM$(STR$(ROUND(RND(-41,20)/3+VAL(DataArray(4,I&))*2.1,0)))
            DataArray(8,I&)=LTRIM$(STR$(ROUND(RND(95,160)+VAL(DataArray(4,I&)),0)))
            DataArray(9,I&)=LTRIM$(STR$(ROUND(RND(45,80)+VAL(DataArray(4,I&)),0)))
        NEXT
    END SUB
    '
    SUB CheckAndDisplayData(BYREF DataArray() AS STRING, BYREF AlphNum() AS INTEGER, BYVAL hDlg AS LONG, BYVAL Columns AS LONG, BYVAL Rows AS LONG)
       LOCAL b$,i&,j&,k&,x&,M&,N&,hCtl&,alflag&,d$,l&,res&
       LOCAL KK&,JJ&
          ' Classify ech column as alphabetic or numerical.
          REDIM AlphNum(1 TO Columns)
          FOR i&=1 TO Columns
              AlphNum(i&)=1 ' presume numerical for a start
              alflag&=1
              FOR j&=1 TO Rows
                  d$=DataArray(i&,j&)
                  k&=LEN(d$)
                  IF alflag&=1 THEN
                      FOR l&=1 TO k&
                          ' If non-numerical characters found, then alphabetical
                          IF INSTR("0123456789.,+-ED ",MID$(d$, l&, 1)) = 0 THEN
                              AlphNum(i&)=0 ' alphabetical
                              alflag&=0
                              EXIT FOR
                          END IF
                      NEXT
                  END IF
              NEXT
          NEXT
          '
          CONTROL ENABLE hDlg, %IDC_LABEL1_SELECT_DEPENDENT_VAR
          CONTROL ENABLE hDlg, %IDC_COMBOBOX_Y
    
          COMBOBOX RESET hDlg, %IDC_COMBOBOX_Y
          COMBOBOX RESET hDlg, %IDC_COMBOBOX_X
          '
          ' add variable headers to combobox Y for numerical variables only
          FOR i = 1 TO Columns
              IF Columns>=1 AND AlphNum(i)=1 THEN COMBOBOX ADD hDlg, %IDC_COMBOBOX_Y, DataArray(i, 0)
          NEXT
    END SUB
    '
    FUNCTION FilNameSave(BYVAL hDlg AS LONG, BYREF DataArray() AS STRING, BYVAL Rows AS LONG, BYVAL Columns AS LONG) AS LONG
       LOCAL hFile  AS LONG
       LOCAL i&,j&
       LOCAL filevar AS STRING, Delim AS STRING
       DISPLAY SAVEFILE hDlg, , , "Save Data As", "", CHR$("Text", 0, "*.txt", 0), _
         "", "txt", %OFN_PATHMUSTEXIST OR %OFN_CREATEPROMPT OR %OFN_ENABLESIZING TO filevar$
       hFile = FREEFILE
       OPEN filevar FOR OUTPUT AS hFile
       Delim = $TAB ' saves in TAB-delimited text format.
                    ' This format can be imported in most
                    ' spreadsheet and data base programs
                    ' like EXCEL and ACCESS.
       FOR j&=0 TO Rows
           FOR i&=1 TO Columns
               PRINT# hFile, DataArray(i&,j&);
               ' put delimiter after each field
               ' except the last
               IF i&<Columns THEN PRINT# hFile,Delim;
           NEXT
           PRINT# hFile, $CRLF; ' start a new line
       NEXT
       CLOSE hFile
       FUNCTION = 1
    END FUNCTION
    ' ------------------------------------------------
    FUNCTION FilNameOpen(BYVAL hDlg AS LONG, BYREF DataArray() AS STRING, BYREF Rows AS LONG, BYREF Columns AS LONG) AS LONG
       LOCAL filevar AS STRING, Delim AS STRING, hFile AS LONG, b AS STRING, x, i, j, k AS LONG
    igen:
        DISPLAY OPENFILE hDlg, , , "Load Data", "", CHR$("Text", 0, "*.txt", 0), _
          "", "txt", %OFN_FILEMUSTEXIST OR %OFN_PATHMUSTEXIST TO filevar$
    
          OPEN filevar FOR INPUT AS hFile
          LINE INPUT# hFile, b$
    
          ' Delimiter:
          Delim = $TAB
          ' TAB (CHR$(9)) delimited text data without quotes are
          ' assumed in this version.
          '
          ' Most spreadsheet and data base programs can export data
          ' in TAB-separated text format to be read by this program.
          ' If you so wishes you can also use other delimiters, such
          ' as comma, semicolon etc.
          '
          x& = PARSECOUNT(b$,Delim) ' Number of columns or data per row.
                                    ' Fields without quotes assumed.
          ' check file
          IF x&<1 THEN ' too few delimiters
             MSGBOX "This file cannot be read by this program!"+$CRLF+" Try again.",%MB_ICONHAND,"Problem:"
             CLOSE hFile
             GOTO igen
          END IF
          k&=0
          DO WHILE NOT (EOF(hFile) OR k&>20)
              INCR k&
              LINE INPUT# hFile, b$
              j& = PARSECOUNT(b$,Delim)
              IF j&<>x& THEN ' not the same number of fields per line
                  MSGBOX "This file cannot be read by this program!"+$CRLF+" Try again.",%MB_ICONHAND,"Problem:"
                  CLOSE hFile
                  GOTO igen
              END IF
          LOOP
          IF k&<2 THEN ' too few lines
             MSGBOX "This file cannot be read by this program!"+$CRLF+" Try again.",%MB_ICONHAND,"Problem:"
             CLOSE hFile
             GOTO igen
          END IF
          CLOSE hFile
          ' Checking OK. Now read the file from start to end.
          ' =================================================
          hFile = FREEFILE
          OPEN filevar FOR INPUT AS hFile
          Columns=x& ' number of columns
          LINE INPUT# hFile, b$
          ' Read the data in the file.
          ' If the first row contains non-numerical characters it is assumed
          ' to be column headers - if not, the program makes default column headers
          REDIM DataArray(0 TO Columns + 2, 0 TO 1)
          DataArray(0, 0) = "Row"
          LOCAL CHflag&,Cstr$ : Cstr$ = "0123456789.+-ED"+Delim+$CRLF
          CHflag = VERIFY(b$,Cstr$)
          FOR i&=1 TO Columns
              IF ISTRUE CHflag THEN
                  DataArray(i&, 0) = PARSE$(b$,Delim,i&)
              ELSE
                  DataArray(i&, 0) ="Var."+STR$(i&)
              END IF
          NEXT
          '
          Rows=0
          IF ISFALSE Chflag THEN ' include the first line as data
              INCR Rows
              REDIM PRESERVE DataArray(0 TO Columns + 2, 0 TO Rows)
              FOR i&=1 TO Columns
                  DataArray(i&, Rows)=PARSE$(b$,Delim,i&)
              NEXT
          END IF
          '
          ' read data into DataArray - one row at a time
          DO WHILE NOT EOF(hFile)
              INCR Rows ' number of rows
              LINE INPUT# hFile, b$
              REDIM PRESERVE DataArray(0 TO Columns + 2, 0 TO Rows)
              DataArray(0, Rows) = TRIM$(STR$(Rows))
              FOR i&=1 TO Columns
                  DataArray(i&, Rows)=PARSE$(b$,Delim,i&)
              NEXT
          LOOP
          CLOSE hFile
          CONTROL SET TEXT hDlg, %IDC_LABEL1_DATA_TO_BE_ANAL, "Data analyzed: " + filevar
          FUNCTION = 1
    END FUNCTION
    '
    SUB NewData(BYREF DataArray() AS STRING, BYVAL hDlg AS LONG, BYVAL Columns AS LONG, BYVAL Rows AS LONG, _
                BYREF xPos AS LONG, BYREF xPage AS LONG, BYREF xMin AS LONG, BYREF xMax AS LONG, _
                BYREF yPos AS LONG, BYREF yPage AS LONG, BYREF yMin AS LONG, BYREF yMax AS LONG)
    
                LOCAL i AS LONG
    
                FOR i = 2 TO Columns
                    LISTVIEW DELETE COLUMN hDlg, %IDC_LISTVIEW1, i
                NEXT
                CONTROL DISABLE hDlg, %IDC_BUTTON1_DO_REGRESSION_ANAL
                CONTROL DISABLE hDlg, %IDC_COMBOBOX_X
                CONTROL DISABLE hDlg, %IDC_LABEL1
    
                xPage = 3
                FOR i = 2 TO xPage + 3
                     LISTVIEW INSERT COLUMN hDlg, %IDC_LISTVIEW1, i, DataArray(i - 1, 0), 130, 0
                NEXT
    
                yMin = 1 : yMax = Rows : yPos = 1
    
                SCROLLBAR SET PAGESIZE hDlg, %IDC_SCROLLBAR2_VERTICAL, yPage
                SCROLLBAR SET RANGE hDlg, %IDC_SCROLLBAR2_VERTICAL, yMin, yMax
                SCROLLBAR SET POS hDlg, %IDC_SCROLLBAR2_VERTICAL, yPos
    
                xMin = 1 : xMax = Columns : xPos = 1
                SCROLLBAR SET PAGESIZE hDlg, %IDC_SCROLLBAR1_HORIZONTAL, xPage
                SCROLLBAR SET RANGE hDlg, %IDC_SCROLLBAR1_HORIZONTAL, xMin, xMax
                SCROLLBAR SET POS hDlg, %IDC_SCROLLBAR1_HORIZONTAL, xPos
    
                InvalidateRect hDlg, BYVAL %NULL, %FALSE
    END SUB
    
    '------------------------------------------------------------------------------
    '   ** Menus **
    '------------------------------------------------------------------------------
    FUNCTION AttachMENU1(BYVAL hDlg AS DWORD) AS DWORD
    #PBFORMS BEGIN MENU %IDR_MENU1->%IDD_DIALOG1
        LOCAL hMenu   AS DWORD
        LOCAL hPopUp1 AS DWORD
    
        MENU NEW BAR TO hMenu
        MENU NEW POPUP TO hPopUp1
        MENU ADD POPUP, hMenu, "&File", hPopUp1, %MF_ENABLED
            MENU ADD STRING, hPopUp1, "Use &Default Data", _
                %IDM_FILE_USEDEFAULTDATA, %MF_ENABLED
            MENU ADD STRING, hPopUp1, "&Open Data File", %IDM_FILE_OPENDATAFILE, _
                %MF_ENABLED
            MENU ADD STRING, hPopUp1, "&Save Data File As", _
                %IDM_FILE_SAVEDATAFILEAS, %MFS_GRAYED
            MENU ADD STRING, hPopUp1, "-", 0, 0
            MENU ADD STRING, hPopUp1, "Save Current &Graph", _
                %IDM_FILE_SAVECURRENTGRAPH, %MFS_GRAYED
            MENU ADD STRING, hPopUp1, "-", 0, 0
            MENU ADD STRING, hPopUp1, "E&xit", %IDM_FILE_EXIT, %MF_ENABLED
        MENU NEW POPUP TO hPopUp1
        MENU ADD POPUP, hMenu, "&Edit", hPopUp1, %MF_ENABLED
            MENU ADD STRING, hPopUp1, "&Select All Text", _
                %IDM_EDIT_SELECTALLTEXT, %MFS_GRAYED
            MENU ADD STRING, hPopUp1, "&Copy Selected Text To Clipboard", _
                %IDM_EDIT_COPYSELECTEDTEXTTOCLIPBOARD, %MFS_GRAYED
            MENU ADD STRING, hPopUp1, "C&ut Selected Text To Clipboard", _
                %IDM_EDIT_CUTSELECTEDTEXTTOCLIPBOARD, %MFS_GRAYED
            MENU ADD STRING, hPopUp1, "-", 0, 0
            MENU ADD STRING, hPopUp1, "Copy Present &Graph to Clipboard", _
                %IDM_EDIT_COPYPRESENTGRAPHTOCLIPBOARD, %MFS_GRAYED
        MENU NEW POPUP TO hPopUp1
        MENU ADD POPUP, hMenu, "&Help", hPopUp1, %MF_ENABLED
            MENU ADD STRING, hPopUp1, "&Help", %IDM_HELP_HELP, %MF_ENABLED
            MENU ADD STRING, hPopUp1, "-", 0, 0
            MENU ADD STRING, hPopUp1, "&About", %IDM_HELP_ABOUT, %MF_ENABLED
    
        MENU ATTACH hMenu, hDlg
    #PBFORMS END MENU
        FUNCTION = hMenu
    END FUNCTION
    '------------------------------------------------------------------------------
    '   ** CallBacks **
    '------------------------------------------------------------------------------
    CALLBACK FUNCTION ShowDIALOG1Proc()
        STATIC i AS LONG, j AS LONG, k AS LONG, st AS STRING
    
        STATIC xPos AS LONG, xPage AS LONG, xMinLV AS LONG, xMaxLV AS LONG
        STATIC yPos AS LONG, yPage AS LONG, yMinLV AS LONG, yMaxLV AS LONG
    
        STATIC AnalysisNumber AS LONG, GRAFFLAG AS LONG
        STATIC T AS STRING
        STATIC NumDat() AS SINGLE  ' numerical data array
        STATIC Xmax AS SINGLE, Xmin AS SINGLE, Ymax AS SINGLE, Ymin AS SINGLE
        STATIC Constant AS DOUBLE, Coeff AS DOUBLE
        STATIC Xvar AS LONG, Yvar AS LONG
        STATIC PowerX AS SINGLE, PowerY AS SINGLE
        STATIC hMenu AS DWORD
    
        LOCAL my_LpLvNm AS NM_LISTVIEW PTR
        LOCAL lpLVDispInfo AS LV_DISPINFO PTR
        LOCAL lplvcd AS NMLVCUSTOMDRAW PTR
        LOCAL szString AS ASCIIZ * 256
    
        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 Columns AS LONG       ' number of columns in array
    
        SELECT CASE AS LONG CB.MSG
            CASE %WM_INITDIALOG
                ' Initialization handler
                hMenu = AttachMENU1(CB.HNDL)
    
                Rows=100
                Columns=50
                '
                ' Two empty columns are being added.
                DIM DataArray(0 TO Columns + 2, 0 TO Rows) AS STATIC STRING ' Column zero and row zero are used for headers.
                DIM AlphNum(1 TO Columns) AS STATIC INTEGER
    
                LOCAL lStyle AS LONG
                LISTVIEW GET STYLEXX CB.HNDL, %IDC_LISTVIEW1 TO lStyle
                LISTVIEW SET STYLEXX CB.HNDL, %IDC_LISTVIEW1, lStyle OR %LVS_EX_FULLROWSELECT OR %LVS_EX_GRIDLINES
                LISTVIEW INSERT COLUMN CB.HNDL, %IDC_LISTVIEW1, 1, "Row", 46, 0
    
                STATIC hfont AS LONG, hFont2 AS LONG
                FONT NEW "Courier New", 9, 0, 0, 0, 0 TO hFont
                CONTROL SET FONT CB.HNDL, %IDC_TEXTBOX1, hFont
                CONTROL SET COLOR CB.HNDL, %IDC_TEXTBOX1, %RGB_BLACK, RGB(255, 255, 180)
                FONT NEW "Arial", 8, 0, 0, 0, 0 TO hFont2
                CONTROL SET FONT CB.HNDL, %IDC_LISTVIEW1, hFont2
                CONTROL SEND CB.HNDL, %IDC_LISTVIEW1, %LVM_GETCOUNTPERPAGE, 0, 0 TO yPage
                CONTROL SEND CB.HNDL,  %IDC_LISTVIEW1, %LVM_SETITEMCOUNT, yPage, %LVSICF_NOINVALIDATEALL OR %LVSICF_NOSCROLL
    
    '         ***************************************************************************************************************************************
                CONTROL SEND CB.HNDL, %IDC_LISTVIEW1, %WM_NOTIFYFORMAT, CB.HNDL, %NF_REQUERY ' necessary if using PBWin10 - may otherwise be excluded
    '         ***************************************************************************************************************************************
    
    
            CASE %WM_NCACTIVATE
                STATIC hWndSaveFocus AS DWORD
                IF ISFALSE CB.WPARAM THEN
                    ' Save control focus
                    hWndSaveFocus = GetFocus()
                ELSEIF hWndSaveFocus THEN
                    ' Restore control focus
                    SetFocus(hWndSaveFocus)
                    hWndSaveFocus = 0
                END IF
    
            CASE %WM_HSCROLL
                SELECT CASE LOWRD(CB.WPARAM)' scroll message
                    CASE %SB_LINERIGHT     : INCR xPos
                    CASE %SB_PAGERIGHT     : xPos = xPos + xPage - 1
                    CASE %SB_LINELEFT      : DECR xPos
                    CASE %SB_PAGELEFT      : xPos = xPos - xPage + 1
                    CASE %SB_THUMBPOSITION, %SB_THUMBTRACK : SCROLLBAR GET TRACKPOS CB.HNDL, %IDC_SCROLLBAR1_HORIZONTAL TO xPos
                END SELECT
                xPos = MAX&(xMinLV, MIN&(xPos, xMaxLV - xPage + 1)) ' Ensure that position is within range
                SCROLLBAR SET POS CB.HNDL, %IDC_SCROLLBAR1_HORIZONTAL, xPos
                ' update column texts
                FOR i = 2 TO xPage + 3
                    LISTVIEW SET HEADER CB.HNDL, %IDC_LISTVIEW1, i, DataArray(i + xPos - 2, 0)
                    LISTVIEW SET COLUMN CB.HNDL, %IDC_LISTVIEW1, i, 130
                NEXT
                InvalidateRect CB.HNDL, BYVAL %NULL, %FALSE
    
            CASE %WM_VSCROLL
                SELECT CASE LOWRD(CB.WPARAM)' scroll message
                    CASE %SB_LINEDOWN      : INCR yPos
                    CASE %SB_PAGEDOWN      : yPos = yPos + yPage - 1
                    CASE %SB_LINEUP        : DECR yPos
                    CASE %SB_PAGEUP        : yPos = yPos - yPage + 1
                    CASE %SB_THUMBPOSITION, %SB_THUMBTRACK : SCROLLBAR GET TRACKPOS CB.HNDL, %IDC_SCROLLBAR2_VERTICAL TO yPos
                END SELECT
                yPos = MAX&(yMinLV, MIN&(yPos, yMaxLV - yPage + 1)) ' Ensure that position is within range
                SCROLLBAR SET POS CB.HNDL, %IDC_SCROLLBAR2_VERTICAL, yPos
                InvalidateRect CB.HNDL, BYVAL %NULL, %FALSE
    
            CASE %WM_NOTIFY
                IF LOWRD(CBWPARAM)= %IDC_LISTVIEW1 THEN
                        my_LpLvNm = CBLPARAM
                        SELECT CASE @my_LpLvNm.hdr.code
                            CASE %NM_CUSTOMDRAW
                                lplvcd = CB.LPARAM
                                IF(@lplvcd.nmcd.dwDrawStage = %CDDS_PREPAINT) THEN
                                    SetWindowLong CB.HNDL,%DWL_MSGRESULT,%CDRF_NOTIFYITEMDRAW
                                    FUNCTION = 1: EXIT FUNCTION
                                END IF
                                IF(@lplvcd.nmcd.dwDrawStage = %CDDS_ITEMPREPAINT) THEN
                                    SetWindowLong CB.HNDL,%DWL_MSGRESULT,%CDRF_NOTIFYSUBITEMDRAW
                                    FUNCTION = 1: EXIT FUNCTION
                                END IF
                                IF(@lplvcd.nmcd.dwDrawStage = %CDDS_SUBITEM OR %CDDS_ITEMPREPAINT) THEN
                                    k = @lplvcd.nmcd.dwItemSpec + yPos
                                    IF @lplvcd.iSubItem = 0 THEN             ' Row header
                                        IF k MOD 2 = 1 THEN @lplvcd.clrTextBk = RGB(230, 230, 230) ELSE @lplvcd.clrTextBk = RGB(210, 210, 210)
                                        @lplvcd.clrText = %BLACK             ' text color: black
                                        ' Specify a font of your choice if you like using: SelectObject @lplvcd.nmcd.hdc, hFont
                                    ELSE                                     ' Column 1 and beyond
                                        IF k MOD 2 = 1 THEN @lplvcd.clrTextBk = %RGB_LIGHTCYAN ELSE @lplvcd.clrTextBk = %RGB_AQUAMARINE
                                        @lplvcd.clrText = %BLACK
                                        ' Specify a font of your choice if you like using: SelectObject @lplvcd.nmcd.hdc, hFont
                                    END IF
                                    SetWindowLong CB.HNDL,%DWL_MSGRESULT,(%CDRF_NEWFONT)' OR %CDRF_NOTIFYSUBITEMDRAW)
                                    FUNCTION = 1: EXIT FUNCTION
                                END IF
                            CASE %LVN_GETDISPINFO    'Virtual ListView ask for Item text
                                lpLVDispInfo = CB.LPARAM
                                IF (@lpLVDispInfo.item.mask AND %LVIF_TEXT) THEN
                                    ' Specify text to be used
                                    IF @lpLVDispInfo.item.iSubItem = 0 THEN ' row header
                                      '  msgbox "h"
                                        szString = DataArray(0 , @lpLVDispInfo.item.iItem + yPos)
                                    ELSE                                    ' column 1 and beyond
                                        szString = DataArray(@lpLVDispInfo.item.iSubItem + xPos - 1 , @lpLVDispInfo.item.iItem + yPos)
                                    END IF
                                    @lpLVDispInfo.item.pszText = VARPTR(szString)
                                    FUNCTION = 1: EXIT FUNCTION
                                END IF
                            CASE ELSE
                        END SELECT
                END IF
    
    
            CASE %WM_COMMAND
                ' Process control notifications
                SELECT CASE AS LONG CB.CTL
                    CASE %IDC_LISTVIEW1
    
                    CASE %IDC_SCROLLBAR2_VERTICAL
    
                    CASE %IDC_SCROLLBAR1_HORIZONTAL
    
                    CASE %IDC_TEXTBOX1
    
                    CASE %IDC_COMBOBOX_Y
                        IF CB.CTLMSG = %CBN_SELCHANGE THEN
                            CONTROL ENABLE CB.HNDL, %IDC_COMBOBOX_X
                            CONTROL ENABLE CB.HNDL, %IDC_LABEL1
    
                            COMBOBOX RESET CB.HNDL, %IDC_COMBOBOX_X
                            COMBOBOX GET SELECT CB.HNDL, %IDC_COMBOBOX_Y TO j
                            COMBOBOX GET COUNT CB.HNDL, %IDC_COMBOBOX_Y TO i
                            FOR k = 1 TO i
                                IF k <> j THEN
                                    COMBOBOX GET TEXT CB.HNDL, %IDC_COMBOBOX_Y, k TO st
                                    COMBOBOX ADD CB.HNDL, %IDC_COMBOBOX_X, st
                                END IF
                            NEXT
                        END IF
    
                    CASE %IDC_COMBOBOX_X
                        IF CB.CTLMSG = %CBN_SELCHANGE THEN
                            COMBOBOX GET SELCOUNT CB.HNDL, %IDC_COMBOBOX_X TO k
                            IF k = 1 THEN CONTROL ENABLE CB.HNDL, %IDC_BUTTON1_DO_REGRESSION_ANAL
                        END IF
    
                    CASE %IDC_BUTTON1_DO_REGRESSION_ANAL
                        IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                            LOCAL LineCount&, FirstVisLine&
                            ' Get the final - perhaps edited - text and place it in T$
                            CONTROL GET TEXT CB.HNDL, %IDC_TEXTBOX1 TO T$
                            CALL MakeAnalysis(CB.HNDL, DataArray(), NumDat(), T, Xmax, Ymax, Xmin, Ymin, _
                                              AnalysisNumber, GRAFFLAG, Rows, RowsNew, Constant, Coeff, Columns, Xvar, Yvar)
                            CONTROL SET TEXT CB.HNDL, %IDC_TEXTBOX1, T$
                            CONTROL SEND CB.HNDL, %IDC_TEXTBOX1, %EM_GETLINECOUNT, 0, 0 TO LineCount&
                            CONTROL SEND CB.HNDL, %IDC_TEXTBOX1, %EM_GETFIRSTVISIBLELINE, 0, 0 TO FirstVisLine&
                            ' scroll down to last analysis
                            CONTROL SEND CB.HNDL, %IDC_TEXTBOX1, %EM_LINESCROLL, 0, LineCount&-FirstVisLine&-12
    
                            CALL PrepareAndMakeGraph (CB.HNDL, 2, Rows, Xmax, Xmin, Ymax, Ymin, 1, 2, NumDat(), _
                                                      TRIM$(DataArray(Xvar&, 0)), TRIM$(DataArray(Yvar&, 0)), _
                                                      PowerX, PowerY, RowsNew, Constant, Coeff)
                            MENU SET STATE hMenu, BYCMD %IDM_FILE_SAVECURRENTGRAPH, %MFS_ENABLED
                            MENU SET STATE hMenu, BYCMD %IDM_EDIT_SELECTALLTEXT, %MFS_ENABLED
                            MENU SET STATE hMenu, BYCMD %IDM_EDIT_COPYPRESENTGRAPHTOCLIPBOARD, %MFS_ENABLED
                            MENU SET STATE hMenu, BYCMD %IDM_EDIT_SELECTALLTEXT, %MFS_ENABLED
                            MENU SET STATE hMenu, BYCMD %IDM_EDIT_COPYSELECTEDTEXTTOCLIPBOARD, %MFS_ENABLED
                            MENU SET STATE hMenu, BYCMD %IDM_EDIT_CUTSELECTEDTEXTTOCLIPBOARD, %MFS_ENABLED
                            CONTROL SET FOCUS CB.HNDL, %IDC_TEXTBOX1
                        END IF
    
                    CASE %IDC_BUTTON1_EXIT
                        IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                            LOCAL res&
                            res&=MSGBOX ("Are you sure?",%MB_YESNO OR %MB_ICONQUESTION ,"End?")
                            IF res&=%IDYES THEN DIALOG END CB.HNDL
                        END IF
    
                    CASE %IDM_FILE_USEDEFAULTDATA
                        CALL DefaultData(Rows, Columns, DataArray())
                        CALL CheckAndDisplayData(DataArray(), AlphNum(), CB.HNDL, Columns, Rows)
                        CONTROL SET TEXT CB.HNDL, %IDC_LABEL1_DATA_TO_BE_ANAL, "Data analyzed: Default Data"
                        CALL NewData(DataArray(), CB.HNDL, Columns, Rows, xPos, xPage, xMinLV, xMaxLV, _
                                    yPos, yPage, yMinLV, yMaxLV)
                        MENU SET STATE hMenu, BYCMD %IDM_FILE_SAVEDATAFILEAS, %MFS_ENABLED
    
                    CASE %IDM_FILE_OPENDATAFILE
                        FilNameOpen(CB.HNDL, DataArray(), Rows, Columns)
                        CALL CheckAndDisplayData(DataArray(), AlphNum(), CB.HNDL, Columns, Rows)
                        CALL NewData(DataArray(), CB.HNDL, Columns, Rows, xPos, xPage, xMinLV, xMaxLV, _
                                    yPos, yPage, yMinLV, yMaxLV)
                        MENU SET STATE hMenu, BYCMD %IDM_FILE_SAVEDATAFILEAS, %MFS_ENABLED
    
                    CASE %IDM_FILE_SAVEDATAFILEAS
                        FilNameSave(CB.HNDL, DataArray(), Rows, Columns)
                        CONTROL SET FOCUS CB.HNDL, %IDC_TEXTBOX1
    
                    CASE %IDM_FILE_SAVECURRENTGRAPH
                        LOCAL BmpName AS STRING
                        DISPLAY SAVEFILE CB.HNDL, , , "Save Graphic", "", CHR$("Bitmap", 0, "*.bmp", 0), _
                            "", "bmp", %OFN_PATHMUSTEXIST OR %OFN_CREATEPROMPT OR %OFN_ENABLESIZING TO BmpName
                        GRAPHIC SAVE BmpName
                        CONTROL SET FOCUS CB.HNDL, %IDC_TEXTBOX1
    
                    CASE %IDM_FILE_EXIT
                        res&=MSGBOX ("Are you sure?",%MB_YESNO OR %MB_ICONQUESTION ,"End?")
                        IF res&=%IDYES THEN DIALOG END CB.HNDL
    
                    CASE %IDM_EDIT_SELECTALLTEXT
                        CONTROL SET FOCUS CB.HNDL, %IDC_TEXTBOX1
                        CONTROL SEND CB.HNDL, %IDC_TEXTBOX1, %EM_SETSEL, 0, -1
    
                    CASE %IDM_EDIT_COPYSELECTEDTEXTTOCLIPBOARD
                        CONTROL SET FOCUS CB.HNDL, %IDC_TEXTBOX1
                        CONTROL SEND CB.HNDL, %IDC_TEXTBOX1, %WM_COPY, 0, 0
    
                    CASE %IDM_EDIT_CUTSELECTEDTEXTTOCLIPBOARD
                        CONTROL SET FOCUS CB.HNDL, %IDC_TEXTBOX1
                        CONTROL SEND CB.HNDL, %IDC_TEXTBOX1, %WM_CUT, 0, 0
    
                    CASE %IDM_EDIT_COPYPRESENTGRAPHTOCLIPBOARD
                        LOCAL hCtl AS LONG
                        CONTROL HANDLE CB.HNDL, %IDC_GRAPHIC1 TO hCtl
                        CLIPBOARD RESET
                        CLIPBOARD SET BITMAP hCtl
                        CONTROL SET FOCUS CB.HNDL, %IDC_TEXTBOX1
    
                    CASE %IDM_HELP_HELP : CALL Help_reg_anal : CONTROL SET FOCUS CB.HNDL, %IDC_TEXTBOX1
    
                    CASE %IDM_HELP_ABOUT : CALL About : CONTROL SET FOCUS CB.HNDL, %IDC_TEXTBOX1
    
                END SELECT
        END SELECT
    END FUNCTION
    '------------------------------------------------------------------------------
    '   ** Dialogs **
    '------------------------------------------------------------------------------
    FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
        LOCAL lRslt AS LONG
    #PBFORMS BEGIN DIALOG %IDD_DIALOG1->%IDR_MENU1->
        LOCAL hDlg  AS DWORD
        DIALOG NEW PIXELS, hParent, "Linear Regression Analysis", , , 800, 520, %WS_POPUP OR _
            %WS_BORDER OR %WS_DLGFRAME OR %WS_CAPTION OR %WS_SYSMENU OR _
            %WS_MINIMIZEBOX OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME _
            OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, _
            %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
            %WS_EX_RIGHTSCROLLBAR, TO hDlg
        CONTROL ADD LISTVIEW,  hDlg, %IDC_LISTVIEW1, "", 8, 16, 440, 264, _
            %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %LVS_REPORT OR _
            %LVS_SHOWSELALWAYS OR %LVS_NOSCROLL _ ' Please note the NOSCROLL style.
            OR %LVS_AUTOARRANGE OR %LVS_OWNERDATA, _
            %WS_EX_LEFT OR %WS_EX_CLIENTEDGE
        CONTROL ADD SCROLLBAR, hDlg, %IDC_SCROLLBAR2_VERTICAL, "", 448, 16, 16, _
            264, %WS_CHILD OR %WS_VISIBLE OR %SBS_VERT
        CONTROL ADD SCROLLBAR, hDlg, %IDC_SCROLLBAR1_HORIZONTAL, "", 8, 280, 440, _
            16
        CONTROL ADD LABEL,     hDlg, %IDC_LABEL1_DATA_TO_BE_ANAL, "Data " + _
            "analyzed:", 8, 1, 456, 15, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, _
            %WS_EX_LEFT OR %WS_EX_LTRREADING
        CONTROL ADD GRAPHIC,   hDlg, %IDC_GRAPHIC1, "", 472, 16, 320, 280, _
            %WS_CHILD OR %WS_VISIBLE, %WS_EX_CLIENTEDGE
        GRAPHIC ATTACH hDlg, %IDC_GRAPHIC1
        GRAPHIC COLOR -1, %WHITE
        GRAPHIC CLEAR
        CONTROL ADD LABEL,     hDlg, %IDC_LABEL1_REGRESSION_PLOT, "Regression " + _
            "plot:", 472, 1, 320, 15, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, _
            %WS_EX_LEFT OR %WS_EX_LTRREADING
        CONTROL ADD TEXTBOX,   hDlg, %IDC_TEXTBOX1, "", 8, 320, 576, 176, _
            %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_HSCROLL OR _
            %WS_VSCROLL OR %ES_LEFT OR %ES_MULTILINE OR %ES_AUTOHSCROLL, _
            %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
            %WS_EX_RIGHTSCROLLBAR
        CONTROL ADD LABEL,     hDlg, %IDC_LABEL1_RESULTS, "Results:", 8, 304, _
            576, 16, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_LEFT OR _
            %WS_EX_LTRREADING
        CONTROL ADD LABEL,     hDlg, %IDC_LABEL1_LOAD_DATA, "1. Load Data", 592, _
            304, 200, 16, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_LEFT OR _
            %WS_EX_LTRREADING
        CONTROL ADD LABEL,     hDlg, %IDC_LABEL1_SELECT_DEPENDENT_VAR, "2. Select " + _
            "Dependent Variable ( Y )", 592, 328, 200, 16, %WS_CHILD OR _
            %WS_VISIBLE OR %SS_CENTER, %WS_EX_LEFT OR %WS_EX_LTRREADING
        CONTROL DISABLE hDlg, %IDC_LABEL1_SELECT_DEPENDENT_VAR
        CONTROL ADD COMBOBOX,  hDlg, %IDC_COMBOBOX_Y, , 592, 344, 200, 200 , _
            %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %CBS_DROPDOWNLIST OR %WS_VSCROLL OR %WS_DISABLED, _
            %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
        CONTROL SEND hDlg, %IDC_COMBOBOX_Y, %CB_SETEXTENDEDUI, %TRUE, 0
        CONTROL ADD LABEL,     hDlg, %IDC_LABEL1, "3. Select Independent Variable " + _
            "( X )", 592, 376, 200, 16, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, _
            %WS_EX_LEFT OR %WS_EX_LTRREADING
        CONTROL DISABLE hDlg, %IDC_LABEL1
        CONTROL ADD COMBOBOX,  hDlg, %IDC_COMBOBOX_X, , 592, 392, 200, 200 , _
            %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %CBS_DROPDOWNLIST OR %WS_VSCROLL OR %WS_DISABLED, _
            %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
        CONTROL SEND hDlg, %IDC_COMBOBOX_X, %CB_SETEXTENDEDUI, %TRUE, 0
        CONTROL ADD BUTTON,    hDlg, %IDC_BUTTON1_DO_REGRESSION_ANAL, "4. Do " + _
            "&Regression Analysis", 592, 432, 200, 24, %BS_CENTER OR %BS_VCENTER OR %WS_TABSTOP OR %WS_DISABLED
        CONTROL ADD BUTTON,    hDlg, %IDC_BUTTON1_EXIT, "E&xit", 592, 472, 200, _
            24
    
    #PBFORMS END DIALOG
    
        DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
    
    #PBFORMS BEGIN CLEANUP %IDD_DIALOG1
    #PBFORMS END CLEANUP
    
        FUNCTION = lRslt
    END FUNCTION
    '------------------------------------------------------------------------------
    Attached Files
Working...
X