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 (updated version)

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

  • Linear regression and correlation (updated version)

    ' First version presented: August 2001
    '
    ' Re-updated version of a program previously presented in the forum.
    '
    ' This version also runs using PB for Windows version 7. To avoid conflict
    ' with the new DIALOG FONT statement, the name of the font variable has been
    ' changed to Fontt&.
    '
    ' June 24, 2002: Some graphics problems identified by Lance Edmonds have been
    ' dealt with - satisfactorily I hope. Many thanks for the invaluable feed-back
    ' from Lance and other members of the PB Forum.
    '
    ' NB: Enhanced metafile dimensions adjusted January 16, 2004.
    ' P-values are also calculated now. Added January 18, 2004.
    ' January 21, 2004: Further corrections made to allow first
    ' data line of a read file to be data and not column headers.

    '
    ' Original name:
    '
    ' Linear regression and correlation for beginners like me.
    ' --------------------------------------------------------
    '
    ' This program for PB for Windows 6 and 7 illustrates many useful techniques
    ' including: open and save files, combobox, listview, listbox as a simulated
    ' row header, textbox, label control for graphics, enhanced metafiles and
    ' copying of any produced text and graphics to the clipboard to be used
    ' instantly in other programs like word processors.
    '
    ' 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.
    '
    ' 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.
    '
    ' You start by loading 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.
    '
    ' Then 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.
    '
    ' Then you select the X-variable (the so-called independent variable) in the
    ' lower combobox.
    '
    ' Now you can perform the analysis by pressing the button.
    '
    ' 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
    ' label control.
    '
    ' You can edit and copy the text to the clipboard. The current graph can also
    ' be copied to the clipboard using the enhanced metafiles technique. If you
    ' copy the graph to a word processor you would even be able to edit the graph
    ' because of the enhanced metafiles format.
    '
    ' For more information about the method you may consult any textbook on
    ' statistics.

    ' The initial code skeleton was generated by EZGUI Freeware Dialog Designer
    ' by Christopher R. Boss. See web site at EZGUI.COM. Unused code has
    ' been removed to improve clarity.
    '
    ' The listview part was inspired by ideas and code provided to the
    ' PowerBasic FORUM by Peter Redei, David L Morris, Semen Matusovski,
    ' Jules Marchildon and Borje Hagsten.
    '
    ' A label control is used as the graphics window. This was inspired
    ' by Forum notes by Lance Edmonds.
    '
    ' Comments and suggestions are welcome
    '
    ' Best Wishes,
    ' Erik Christensen, Copenhagen, Denmark. ---- e.chr@email.dk
    Code:
    #COMPILE EXE
    #REGISTER NONE
    #DIM ALL
    #DEBUG ERROR ON
    %NOANIMATE    = 1
    %NODRAGLIST   = 1
    %NOHEADER     = 1
    %NOIMAGELIST  = 1
    %NOSTATUSBAR  = 1
    %NOTABCONTROL = 1
    %NOTOOLBAR    = 1
    %NOTOOLTIPS   = 1
    %NOTRACKBAR   = 1
    %NOTREEVIEW   = 1
    %NOUPDOWN     = 1
    #INCLUDE "win32api.inc"   ' Must come first before other include files !
    #INCLUDE "commctrl.inc"   ' The Common Controls include file !
    #INCLUDE "COMDLG32.INC"
    ' ----------------------------------------------------------
    %Form1_FILE                                     = 500
    ' ----------------------------------------------------------
    %Form1_DEFAULT                                  = 505
    %Form1_OPENFILE                                 = 510
    %Form1_SAVEAS                                   = 515
    %Form1_SEPARATOR_520                            = 520
    %Form1_SAVE_CUR_GRAPH                           = 522
    %Form1_SEPARATOR_524                            = 524
    %Form1_EXIT                                     = 525
    ' ----------------------------------------------------------
    %Form1_EDIT                                     = 600
    ' ----------------------------------------------------------
    %Form1_UNDO                                     = 601
    %Form1_SEPARATOR_602                            = 602
    %Form1_CUT                                      = 603
    %Form1_PASTE                                    = 606
    %Form1_SEPARATOR_604                            = 604
    %Form1_TEXTCOPY                                 = 605
    %Form1_GRAPHCOPY                                = 610
    %Form1_SELECTALL                                = 615
    ' ----------------------------------------------------------
    %Form1_HELP                                     = 700
    ' ----------------------------------------------------------
    %Form1_HELP1                                    = 705
    %Form1_ABOUT                                    = 710
    %FORM1_LABELRESULTS       = 100
    %FORM1_LABELFORGRAPH      = 102
    %FORM1_GRAPHLABEL         = 105
    %FORM1_LABELROW           = 110
    %FORM1_LABELDATA          = 112
    %FORM1_LABELLOADDATA      = 115
    %FORM1_PROCEDUREFRAME     = 117
    
    %FORM1_LABELSELECTX       = 120
    %FORM1_LABELSELECTY       = 125
    %FORM1_TEXTRESULTS        = 127
    %FORM1_COMBOBOXY          = 130
    %FORM1_COMBOBOXX          = 135
    %FORM1_BUTTONDOANALYSIS   = 140
    %FORM1_BUTTONEXIT         = 145
    %FORM1_LISTVIEWBOX1       = 150
    %FORM1_LISTBOXROWHEAD     = 155
    ' --------------------------------------------------
    DECLARE SUB ShowDialog_Form1(BYVAL hParent&)
    DECLARE CALLBACK FUNCTION Form1_DLGPROC
    ' --------------------------------------------------
    ' ------------------------------------------------
    DECLARE SUB Form1_DEFAULT_Select()
    DECLARE SUB Form1_OPENFILE_Select()
    DECLARE SUB Form1_SAVEAS_Select()
    DECLARE SUB Form1_EXIT_Select()
    DECLARE SUB Form1_TEXTCOPY_Select()
    DECLARE SUB Form1_GRAPHCOPY_Select()
    DECLARE SUB Form1_HELP1_Select()
    DECLARE SUB Form1_ABOUT_Select()
    DECLARE CALLBACK FUNCTION CBF_FORM1_COMBOBOXY()
    DECLARE CALLBACK FUNCTION CBF_FORM1_COMBOBOXX()
    DECLARE CALLBACK FUNCTION CBF_FORM1_BUTTONDOANALYSIS()
    DECLARE CALLBACK FUNCTION CBF_FORM1_BUTTONEXIT()
    '
    DECLARE FUNCTION MakeFont(BYVAL FontTypeSize AS LONG,BYVAL FontWeight AS LONG, _
        BYVAL Italic AS LONG, BYVAL Underline AS LONG,BYVAL StrikeOut AS LONG, _
        BYVAL FaceName AS STRING) AS LONG
    DECLARE FUNCTION FilNameOpen() AS LONG
    DECLARE FUNCTION FilNameSave() AS LONG
    DECLARE FUNCTION FilNameSaveEMF() AS LONG
    DECLARE FUNCTION FilePath(BYVAL Src AS STRING) AS STRING
    DECLARE FUNCTION FileNam(BYVAL Src AS STRING) AS STRING
    DECLARE SUB MATINVSIM (BYREF X() AS DOUBLE, BYVAL M AS LONG, BYREF DET AS DOUBLE, BYREF A() AS DOUBLE, BYREF Y() AS DOUBLE)
    DECLARE 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$)
    DECLARE SUB FindAxisDimAndScale (BYVAL MaxVal AS SINGLE,BYVAL MinVal AS SINGLE,BYREF Start AS SINGLE,BYREF StepSize AS SINGLE,BYREF Labels AS LONG)
    DECLARE 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)
    DECLARE FUNCTION gColor(BYVAL I AS LONG) AS LONG
    DECLARE FUNCTION PenStyle(BYVAL I AS LONG) AS LONG
    
    ' *************************************************************
    GLOBAL hForm1&    ' Dialog handle
    ' Global Handles for menus
    GLOBAL hForm1_Menu0&
    GLOBAL hForm1_Menu1&
    GLOBAL hForm1_Menu2&
    GLOBAL hForm1_Menu3&
    GLOBAL hGraph AS LONG ' Handle for graphics window - a label (or static) control
    '
    GLOBAL Brush&
    GLOBAL PAFU AS STRING     ' path and file for input
    GLOBAL PAFUout AS STRING  ' path and file for output
    GLOBAL PAFUemf AS STRING  ' path and file for enhanced metafile format graph
    GLOBAL DAT() AS STRING    ' ARRAY TO HOLD THE DATA in listbox 1
    GLOBAL head() AS STRING   ' array to hold the headers in listbox 1
    GLOBAL MaxLen() AS INTEGER ' (1:Columns)
    GLOBAL AlphNum() AS INTEGER ' (1:Columns)
    GLOBAL Rows AS LONG          ' number of rows in array
    GLOBAL Columns AS LONG       ' number of columns in array
    GLOBAL RowsNew AS LONG       ' number of rows with complete X,Y values in a given analysis
    GLOBAL HorizBaseU AS LONG
    GLOBAL VertBaseU AS LONG
    GLOBAL Delim AS STRING    ' Delimiter for saving and loading files
                              ' Set to $TAB (=CHR$(9)) in this program.
                              ' You may change this.
    GLOBAL COMBOBOXX_List() AS STRING
    GLOBAL COMBOBOXY_List() AS STRING
    GLOBAL LISTBOXROWHEAD_list() AS STRING
    GLOBAL lfFont AS lOGFONT   ' Logfont structure
    GLOBAL LogPixelsY AS LONG 'pixels per inch of screen height
    GLOBAL LogPixelsX AS LONG 'pixels per inch of screen width
    GLOBAL AnalysisNumber AS LONG
    GLOBAL T$
    GLOBAL NumDat() AS SINGLE  ' numerical data array
    GLOBAL Xmax AS SINGLE, Xmin AS SINGLE, Ymax AS SINGLE, Ymin AS SINGLE
    GLOBAL PowerX AS SINGLE, PowerY AS SINGLE
    GLOBAL Xvar&,Yvar&
    GLOBAL GRAFFLAG AS LONG
    GLOBAL XDialUn&,YDialUn&,XPixMax&,YPixMax&
    GLOBAL Rct AS RECT
    GLOBAL Ps AS PAINTSTRUCT   ' Paint structure
    GLOBAL Xfact AS SINGLE, Yfact AS SINGLE
    GLOBAL lpSize AS SIZEL
    GLOBAL Constant AS DOUBLE,Coeff AS DOUBLE
    GLOBAL RowHeadCorrect AS LONG
    '
    ' *************************************************************
    '
    FUNCTION PBMAIN
        LOCAL Count&
        LOCAL hDC AS LONG
        LOCAL CC1 AS INIT_COMMON_CONTROLSEX
        CC1.dwSize=SIZEOF(CC1)
        CC1.dwICC=%ICC_WIN95_CLASSES
        InitCommonControlsEX CC1
        Brush&=CreateSolidBrush(RGB(255,255,255)) ' white
        'Retrieves a handle of a display device context (DC) for the
        'client area of the specified window (here the desktop).
        hDC = GetDC(%HWND_DESKTOP)
        '
        'Retrieves device-specific information about the number
        'of pixels per logical inch along the screen height
        '(depends on screen resolution setting).
        'This is important to define appropriate font sizes.
        LogPixelsY  = GetDeviceCaps(hDC, %LOGPIXELSY)
        LogPixelsX  = GetDeviceCaps(hDC, %LOGPIXELSX)
        '
        ReleaseDC %HWND_DESKTOP, hDC
        ShowDialog_Form1 0
        DO
            DIALOG DOEVENTS TO Count&
        LOOP UNTIL Count&=0
        DeleteObject Brush&
    END FUNCTION
    '
    '                    Application Dialogs
    ' *************************************************************
    SUB ShowDialog_Form1(BYVAL hParent&)
        LOCAL Style&, ExStyle& ,hCtl&
        LOCAL ComboStyle&, LabelStyle&,LabelStyle2&
        LOCAL N&, CT&, r&, Fontt&,res&
        LOCAL hListView AS LONG
        LOCAL lStyle AS LONG
        LOCAL result AS LONG
        ' hParent& = 0 if no parent Dialog
        Style& = %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
        ExStyle& = 0
        DIALOG NEW hParent&, "Linear Regression Analysis", 0, 0,  392,  260, Style&, ExStyle& TO hForm1&
        LabelStyle& = %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
        XDialUn&=168:YDialUn&=130
        DIALOG UNITS hForm1&, 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, hForm1&,  %FORM1_GRAPHLABEL,  "", 220, 9, XDialUn&,YDialUn&, LabelStyle2& ',%WS_EX_CLIENTEDGE
        CONTROL HANDLE hForm1&, %FORM1_GRAPHLABEL TO hGraph ' handle for graphics window
        ' ---------------------------
        MENU NEW BAR TO hForm1_Menu0&
        ' ---------------------------
        MENU NEW POPUP TO hForm1_Menu1&
        MENU ADD POPUP, hForm1_Menu0& ,"&File", hForm1_Menu1&, %MF_ENABLED
        ' - - - - - - - - - - - - - -
        MENU ADD STRING, hForm1_Menu1&, "Use &Default data",  %Form1_DEFAULT, %MF_ENABLED
        MENU ADD STRING, hForm1_Menu1&, "&Open Data File",  %Form1_OPENFILE, %MF_ENABLED
        MENU ADD STRING, hForm1_Menu1&, "Save Data File &As",  %Form1_SAVEAS, %MF_GRAYED
        MENU ADD STRING, hForm1_Menu1&, "-",  %Form1_SEPARATOR_520, %MF_ENABLED
        MENU ADD STRING, hForm1_Menu1&, "Save Current &Graph", %Form1_SAVE_CUR_GRAPH, %MF_GRAYED
        MENU ADD STRING, hForm1_Menu1&, "-",  %Form1_SEPARATOR_524, %MF_ENABLED
        MENU ADD STRING, hForm1_Menu1&, "E&xit",  %Form1_EXIT, %MF_ENABLED
        MENU NEW POPUP TO hForm1_Menu2&
        MENU ADD POPUP, hForm1_Menu0& ,"&Edit", hForm1_Menu2&, %MF_ENABLED
        ' - - - - - - - - - - - - - -
        MENU ADD STRING, hForm1_Menu2&, "&Undo",  %Form1_UNDO, %MF_ENABLED
        MENU ADD STRING, hForm1_Menu2&, "-",  %Form1_SEPARATOR_602, %MF_ENABLED
        MENU ADD STRING, hForm1_Menu2&, "Cu&t Selected Text to Clipboard",  %Form1_CUT, %MF_ENABLED
        MENU ADD STRING, hForm1_Menu2&, "&Paste text from Clipboard",  %Form1_PASTE, %MF_ENABLED
        MENU ADD STRING, hForm1_Menu2&, "&Copy Selected Text to Clipboard", %Form1_TEXTCOPY, %MF_ENABLED
        MENU ADD STRING, hForm1_Menu2&, "Select &All Text",  %Form1_SELECTALL, %MF_ENABLED
        MENU ADD STRING, hForm1_Menu2&, "-",  %Form1_SEPARATOR_604, %MF_ENABLED
        MENU ADD STRING, hForm1_Menu2&, "Copy Present &Graph to Clipboard", %Form1_GRAPHCOPY, %MF_GRAYED
        MENU NEW POPUP TO hForm1_Menu3&
        MENU ADD POPUP, hForm1_Menu0& ,"&Help", hForm1_Menu3&, %MF_ENABLED
        ' - - - - - - - - - - - - - -
        MENU ADD STRING, hForm1_Menu3&, "&Description of program",  %Form1_HELP1, %MF_ENABLED
        MENU ADD STRING, hForm1_Menu3&, "&About",  %Form1_ABOUT, %MF_ENABLED
        MENU ATTACH hForm1_Menu0&, hForm1&
        CONTROL ADD LABEL, hForm1&,  %FORM1_LABELFORGRAPH,  "Regression Plot:", 234, 0, 142, 8, LabelStyle&
        CONTROL ADD LABEL, hForm1&,  %FORM1_LABELROW,  "Row:", 4, 10, 20, 8, LabelStyle&
        CONTROL ADD LABEL, hForm1&,  %FORM1_LABELSELECTX,  "3. Select Independent Variable ( X )", 257, 183, 124, 10, LabelStyle&
        CONTROL ADD LABEL, hForm1&,  %FORM1_LABELDATA,  "Data to be analyzed:", 25, 0, 180, 8, LabelStyle&
        CONTROL ADD LABEL, hForm1&,  %FORM1_LABELSELECTY,  "2. Select Dependent Variable ( Y )", 259, 158, 122, 10, LabelStyle&
        CONTROL ADD LABEL, hForm1&,  %FORM1_LABELLOADDATA,  "1. Load Data", 259, 147, 122, 10, LabelStyle&
        CONTROL ADD LABEL, hForm1&,  %FORM1_LABELRESULTS,  "Results:", 41, 136, 150, 8, LabelStyle&
        ' - - - - - - - - - - - - - - - - - - - - - - - - -
        CONTROL ADD "Button", hForm1&,  %FORM1_BUTTONDOANALYSIS,  "4. Do Linear &Regression Analysis", 259, 210, 124, 12, _
            %WS_CHILD OR %WS_VISIBLE OR %WS_DISABLED OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_BUTTONDOANALYSIS
        CONTROL ADD "Button", hForm1&,  %FORM1_BUTTONEXIT,  "E&xit", 259, 228, 124, 12, _
            %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FORM1_BUTTONEXIT
        CONTROL ADD TEXTBOX, hForm1&,  %FORM1_TEXTRESULTS,  "", 2, 144, 245, 101, _
          %WS_CHILD OR %WS_VISIBLE OR %ES_MULTILINE OR %ES_WANTRETURN OR _
            %ES_LEFT OR %WS_VSCROLL OR %ES_NOHIDESEL OR %ES_AUTOVSCROLL OR %WS_TABSTOP, _
            %WS_EX_CLIENTEDGE
        ' an attempt to accomodate both large and small Windows font setting
        IF Xfact>1.75 THEN ' large font
            Fontt&=MakeFont(8,400,0,0,0,"Arial")
            RowHeadCorrect = 0
        ELSE               ' small font
            Fontt&=MakeFont(7,400,0,0,0,"Arial")
            RowHeadCorrect = 2
        END IF
        CONTROL SEND hForm1&, %FORM1_TEXTRESULTS, %WM_SETFONT, Fontt&, %TRUE
        ' - - - - - - - - - - - - - - - - - - - - - - - - -
        CONTROL ADD "SysListView32", hForm1&, %FORM1_LISTVIEWBOX1,"",26, 8, 190, 126+RowHeadCorrect, _
          %WS_border OR %WS_Child OR %WS_TABSTOP OR %LVS_Report , %WS_EX_CLIENTEDGE
        CONTROL HANDLE hForm1&,%FORM1_LISTVIEWBOX1 TO hListView
        lStyle = SendMessage(hListView, _
               %LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0)
        lStyle = lStyle OR %LVS_EX_GRIDLINES
        CALL SendMessage(hListView, %LVM_SETEXTENDEDLISTVIEWSTYLE, _
           0, BYVAL lStyle)
        r& = ShowWindow(hListView,%SW_SHOW)
        result = GetDialogBaseUnits
        'Horizontal dialog box base unit
        'This is equal to the average width, in pixels, of the characters
        'in the system font.
        HorizBaseU = LOWRD(result)
        'Vertical dialog box base unit
        'This is equal to the height, in pixels, of the font.
        VertBaseU = HIWRD(result)
        ' - - - - - - - - - - - - - - - - - - - - - - - - -
        CONTROL ADD LISTBOX, hForm1&,  %FORM1_LISTBOXROWHEAD, LISTBOXROWHEAD_List(), 2, 19+RowHeadCorrect, 24, 114, _
            %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %LBS_NOINTEGRALHEIGHT, _
            %WS_EX_CLIENTEDGE
        ' The font below gives the same vertical spacing as in the listview box
        ' The left listbox works as a simulated row header which scrolls
        ' in parallel with the listview box
        '
        ' An attempt to accomodate both large and small Windows font setting
        IF Xfact>1.75 THEN ' large font
            Fontt&=MakeFont(9,300,0,1,0,"Arial")
        ELSE               ' small font
            Fontt&=MakeFont(8,300,0,1,0,"Arial")
        END IF
    
        CONTROL SEND hForm1&, %FORM1_LISTBOXROWHEAD, %WM_SETFONT, Fontt&, %TRUE
        ComboStyle&=%WS_CHILD OR %WS_VISIBLE OR %CBS_DROPDOWNLIST OR %WS_VSCROLL OR %CBS_NOINTEGRALHEIGHT OR %WS_TABSTOP
        CONTROL ADD COMBOBOX, hForm1&,  %FORM1_COMBOBOXY, COMBOBOXY_List(), 259, 167, 124, 48, ComboStyle&  CALL CBF_FORM1_COMBOBOXY
        CONTROL ADD COMBOBOX, hForm1&,  %FORM1_COMBOBOXX, COMBOBOXX_List(), 259, 192, 124, 48, ComboStyle& CALL CBF_FORM1_COMBOBOXX
        CONTROL SET FOCUS hForm1&,  %FORM1_TEXTRESULTS
        CONTROL SEND hForm1&,  %FORM1_TEXTRESULTS,%EM_SETSEL,0,-1
        ' Get co-ordinates for graphics label window rectangle
        GetClientRect hGraph,Rct
        DIALOG SHOW MODELESS hForm1& , CALL Form1_DLGPROC
    END SUB
    ' ---------------------------------------------------------
    CALLBACK FUNCTION Form1_DLGPROC
        LOCAL hemf AS LONG,lpszFile AS ASCIIZ*80
        LOCAL hdcEMF AS LONG
        LOCAL hDC AS LONG
        LOCAL hCtl AS LONG,hEdit AS LONG
        LOCAL lpStart AS LONG, lpEnd AS LONG
        LOCAL res AS LONG
        STATIC GrafCopyFlag AS LONG
        STATIC TopLV AS LONG
        STATIC TopRH AS LONG
        CONTROL HANDLE hForm1&,%FORM1_TEXTRESULTS TO hEdit
        ' Get first and last position of the selection if any
        SendMessage hEdit, %EM_GETSEL, VARPTR(lpStart), VARPTR(lpEnd)
        IF lpStart=lpEnd THEN ' No text selection. Disable cut and copy
            EnableMenuItem hForm1_Menu2&, %Form1_CUT, %MF_BYCOMMAND OR %MF_GRAYED
            EnableMenuItem hForm1_Menu2&, %Form1_TEXTCOPY, %MF_BYCOMMAND OR %MF_GRAYED
        ELSE                  ' Text selection. Enable cut and copy
            EnableMenuItem hForm1_Menu2&, %Form1_CUT, %MF_BYCOMMAND OR %MF_ENABLED
            EnableMenuItem hForm1_Menu2&, %Form1_TEXTCOPY, %MF_BYCOMMAND OR %MF_ENABLED
        END IF
        IF SendMessage (hEdit, %EM_CANUNDO, 0, 0) THEN ' Undo valid
            EnableMenuItem hForm1_Menu2&, %Form1_UNDO, %MF_BYCOMMAND OR %MF_ENABLED
        ELSE                                           ' Undo not valid
            EnableMenuItem hForm1_Menu2&, %Form1_UNDO, %MF_BYCOMMAND OR %MF_GRAYED
        END IF
        SELECT CASE CBMSG
            ' Common Windows Messages you may want to process
            ' -----------------------------------------------
            ' these two lines are due to feedback from Borje Hagsten
            CASE %WM_NCACTIVATE
                IF CBWPARAM THEN CONTROL SET FOCUS CBHNDL, %FORM1_TEXTRESULTS
            CASE %WM_PAINT
                BeginPaint CBHNDL, Ps
                IF GRAFFLAG=10 THEN ' graph can be made
                    '
                    ' SPECIFY RECTANCLE IN 0.01 MM UNITS FOR CREATION OF METAFILE:
                    LOCAL hdcRef&,iWidthMM&,iHeightMM&,iWidthPels&,iHeightPels&
                    '
                    ' 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) ' Rct
                    ' Get rectangle in pixels to display diagram
                    GetClientRect hGraph,Rct
                    CALL PrepareAndMakeGraph (hdcEMF,2, Rows, Xmax, Xmin, Ymax, Ymin, 1, 2, NumDat(), head(Xvar&), head(Yvar&))
                    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.
    
                    EnableMenuItem hForm1_Menu1&,%Form1_SAVE_CUR_GRAPH, %MF_BYCOMMAND OR %MF_ENABLED
                    IF GrafCopyFlag=5 THEN
                        lpszFile = PAFUemf
                        Res& = CopyEnhMetaFile(hemf,lpszFile)
                        GrafCopyFlag=0
                    END IF
    
                    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_CTLCOLORMSGBOX , %WM_CTLCOLORBTN, %WM_CTLCOLOREDIT,_
                 %WM_CTLCOLORSTATIC, %WM_CTLCOLORSCROLLBAR, %WM_CTLCOLORLISTBOX
                ' Control colors
                SELECT CASE GetDlgCtrlID(CBLPARAM)
                    CASE  %FORM1_LISTBOXROWHEAD
                        SetTextColor CBWPARAM, RGB(145,145,145)
                        SetBkColor   CBWPARAM, RGB(255,255,255)
                        FUNCTION=Brush&
                    CASE ELSE
                        FUNCTION=0
                END SELECT
            CASE %WM_NOTIFY
                ' This code ensures parallel scrolling of the "Row header"
                ' This idea behind this code was Borje Hagsten's
                CONTROL SEND hForm1&,%FORM1_LISTVIEWBOX1,%LVM_GETTOPINDEX,0,0 TO TopLV
                IF TopLV<>TopRH THEN
                    CONTROL SEND hForm1&,%FORM1_LISTBOXROWHEAD,%LB_SETTOPINDEX,TopLV,0
                    TopRH=TopLV
                END IF
            CASE %WM_COMMAND
                ' Process Messages to Controls that have no Callback Function
                ' and Process Messages to Menu Items
                SELECT CASE CBCTL
                    CASE  %Form1_DEFAULT
                        Form1_DEFAULT_Select
                    CASE  %Form1_OPENFILE
                        Form1_OPENFILE_Select
                    CASE  %Form1_SAVEAS
                        Form1_SAVEAS_Select
                    CASE  %Form1_SAVE_CUR_GRAPH
                        IF FilNameSaveEMF() THEN
                        END IF
                        ' The following causes the metafile to be saved on disk.
                        GrafCopyFlag=5   ' see CASE %WM_PAINT above
                        res&=InvalidateRect(hForm1&,BYVAL %NULL,%TRUE)
                    CASE  %Form1_EXIT
                        Form1_EXIT_Select
                    CASE  %Form1_UNDO
                        'Send a WM_UNDO message to the edit control to
                        'undo the last operation. When this message is
                        'sent to the edit control, the previously deleted
                        'text is restored or the previously added text
                        'is deleted.
                        SendMessage hEdit, %EM_UNDO, 0, 0
                    CASE  %Form1_CUT
                        'Send a %WM_CUT message to the edit control to
                        'delete (cut) the current selection, if any, in
                        'the edit control and copy the deleted text to
                        'the clipboard in CF_TEXT format.
                        SendMessage hEdit, %WM_CUT, 0, 0
                    CASE  %Form1_PASTE
                        'Sends a %WM_PASTE message to the edit control to
                        'copy the current content of the clipboard to
                        'the edit control at the current caret position.
                        'Data is inserted only if the clipboard contains
                        'data in CF_TEXT format.
                        SendMessage hEdit, %WM_PASTE, %CF_TEXT, 0
                    CASE  %Form1_TEXTCOPY
                        'Send a %WM_COPY message to the edit control to
                        'copy the current selection to the clipboard
                        'in CF_TEXT format.
                        SendMessage hEdit, %WM_COPY, 0, 0
                    CASE  %Form1_GRAPHCOPY
                        ' The following causes the metafile to be copied to the clipboard.
                        GrafCopyFlag=3   ' see CASE %WM_PAINT above
                        res&=InvalidateRect(hForm1&,BYVAL %NULL,%TRUE)
                    CASE  %Form1_SELECTALL
                        'Send an %EM_SETSEL message to select a range of
                        'characters in the edit control.
                        'If the nStart parameter is 0 and the nEnd
                        'parameter is -1, all the text in the edit
                        'control is selected.
                         SendMessage hEdit, %EM_SETSEL,0,-1
                    CASE  %Form1_HELP1
                        Form1_HELP1_Select
                    CASE %Form1_ABOUT
                        Form1_ABOUT_Select
                    CASE ELSE
                END SELECT
            CASE ELSE
        END SELECT
    END FUNCTION
    ' ------------------------------------------------
    SUB Form1_DEFAULT_Select()
        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
        REDIM head(1:Rows)
        REDIM DAT(1:Columns,1:Rows)
        FOR I&=1 TO Columns
            head(I&)=READ$(I&)
        NEXT
        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
            DAT(1,I&)=CHR$(RND(65,90))+".  "+CHR$(RND(65,90))+".  "+CHR$(RND(65,90))+"."
            DAT(2,I&)=LTRIM$(STR$(ROUND(SQR(-2*LOG(RND))*COS(PI2*RND)*17+84,1)))
            DAT(3,I&)=LTRIM$(STR$(ROUND(SQR(-2*LOG(RND))*COS(PI2*RND)*18+182,1)))
            DAT(4,I&)=LTRIM$(STR$(ROUND(VAL(DAT(2,I&))*10000/VAL(DAT(3,I&))^2,1)))
            DAT(5,I&)=LTRIM$(STR$(RND(38,80)/10+ROUND(VAL(DAT(4,I&)),0)/10))
            DAT(6,I&)=LTRIM$(STR$(RND(19,70)/10+ROUND(VAL(DAT(4,I&)),0)/10))
            DAT(7,I&)=LTRIM$(STR$(ROUND(RND(-41,20)/3+VAL(DAT(4,I&))*2.1,0)))
            DAT(8,I&)=LTRIM$(STR$(ROUND(RND(95,160)+VAL(DAT(4,I&)),0)))
            DAT(9,I&)=LTRIM$(STR$(ROUND(RND(45,80)+VAL(DAT(4,I&)),0)))
        NEXT
        CALL CheckAndDisplayData()
        MSGBOX "This random data base is artificial and any similarity to any known person is completely accidental !",%MB_ICONINFORMATION,"Random default data"
        EnableMenuItem hForm1_Menu1&, %Form1_SAVEAS, %MF_BYCOMMAND OR %MF_ENABLED
    END SUB
    ' ------------------------------------------------
    SUB Form1_OPENFILE_Select()
        IF FilNameOpen() THEN
            IF Rows>=2 THEN
                CALL CheckAndDisplayData()
                EnableMenuItem hForm1_Menu1&, %Form1_SAVEAS, %MF_BYCOMMAND OR %MF_ENABLED
            END IF
        END IF
    END SUB
    ' ------------------------------------------------
    SUB Form1_SAVEAS_Select()
        IF FilNameSave() THEN
        END IF
    END SUB
    ' ------------------------------------------------
    SUB Form1_EXIT_Select()
        LOCAL res&
        res&=MSGBOX ("Are you sure?",%MB_YESNO OR %MB_ICONQUESTION ,"End?")
        IF res&=%IDYES THEN DIALOG END hForm1&
    END SUB
    ' ------------------------------------------------
    SUB Form1_HELP1_Select()
        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 "+ _
        "label control."+$CRLF+ _
        "       You can edit and copy the text to the clipboard. The current graph can also "+ _
        "be copied to the clipboard using the enhanced metafiles technique. If you "+ _
        "copy the graph to a word processor you would even be able to edit the graph "+ _
        "because of the enhanced metafiles format."+$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 Form1_ABOUT_Select
        LOCAL St AS STRING
        St="Linear regression and correlation program for PB for Windows 6 or 7. Program version 1.4 - January 22, 2004"+$CRLF+$CRLF+ _
        "By Erik Christensen, Copenhagen, Denmark       e.chr@email.dk"+$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
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_FORM1_BUTTONDOANALYSIS
        LOCAL hCtl&,LineCount&,FirstVisLine&,Res&
        ' Get the final - perhaps edited - text and place it in T$
        CONTROL GET TEXT hForm1&, %FORM1_TEXTRESULTS TO T$
        EnableMenuItem hForm1_Menu2&, %Form1_GRAPHCOPY, %MF_BYCOMMAND OR %MF_GRAYED
        CALL MakeAnalysis
        CONTROL SET TEXT hForm1&,%FORM1_TEXTRESULTS,T$
        CONTROL HANDLE hForm1&, %FORM1_TEXTRESULTS TO hCtl&
        LineCount&=Edit_GetLineCount(hCtl&)
        FirstVisLine&=Edit_GetFirstVisibleLine(hCtl&)
        ' scroll down to last analysis
        Res&=Edit_LineScroll(hCtl&,0,LineCount&-FirstVisLine&-13)
        CONTROL SET FOCUS hForm1&,%FORM1_TEXTRESULTS
        res&=InvalidateRect(hForm1&,BYVAL %NULL,%TRUE)
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_FORM1_COMBOBOXY
        LOCAL CVal&,hCtl&,i&,res&,txt$,NoY&
        ' Return Current Selection in CVal&
        CONTROL SEND CBHNDL , CBCTL, %CB_GETCURSEL, 0,0 TO CVal&
        IF (CBCTLMSG=%CBN_SELCHANGE) OR  (CBCTLMSG=%CBN_EDITCHANGE) OR (CBCTLMSG=%CBN_EDITUPDATE) THEN
            ' empty combobox X
            COMBOBOX RESET hForm1&, %FORM1_COMBOBOXX
            ' put all numerical variables minus the selected Y-variable in combobox X
            CONTROL HANDLE hForm1&, %FORM1_COMBOBOXY TO hCtl&
            NoY&=SendMessage (hCtl&,%CB_GETCOUNT,0,0)
            FOR i&=0 TO NoY&-1
                CONTROL HANDLE hForm1&, %FORM1_COMBOBOXY TO hCtl&
                res&=SendMessage (hCtl&,%CB_GETLBTEXTLEN,i&,0)
                txt$=Combo_GetLbText(hCtl&,i&)
                txt$=LEFT$(txt$,res&)
                IF i&<>CVal& THEN
                    CONTROL HANDLE hForm1&, %FORM1_COMBOBOXX TO hCtl&
                    res&=Combo_AddString(hCtl&,txt$)
                END IF
            NEXT
            CONTROL DISABLE hForm1&, %FORM1_BUTTONDOANALYSIS
        END IF
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_FORM1_COMBOBOXX
        LOCAL CVal&
        ' Return Current Selection in CVal&
        CVal&=-1
        CONTROL SEND CBHNDL , CBCTL, %CB_GETCURSEL, 0,0 TO CVal&
        IF CVal& > -1 THEN ' valid selection
            CONTROL ENABLE hForm1&, %FORM1_BUTTONDOANALYSIS
        END IF
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_FORM1_BUTTONEXIT
        LOCAL res&
        res&=MSGBOX ("Are you sure?",%MB_YESNO OR %MB_ICONQUESTION ,"End?")
        IF res&=%IDYES THEN DIALOG END hForm1&
    END FUNCTION
    ' ------------------------------------------------
    '
    FUNCTION MakeFont(BYVAL FontTypeSize AS LONG,BYVAL FontWeight AS LONG, _
        BYVAL Italic AS LONG, BYVAL Underline AS LONG,BYVAL StrikeOut AS LONG, _
        BYVAL FaceName AS STRING) AS LONG
    ' -----------------------
        'TYPE LOGFONT defines the attributes of a font.
        'See LOGFONT in the Win32 help file
        lfFont.lfHeight = -MulDiv(FontTypeSize,LogPixelsY,72) ' better than: -(FontTypeSize * LogPixelsY) \ 72
                                                ' logical height of font
        lfFont.lfWidth = 0                      ' logical average character width
        lfFont.lfEscapement = 0                 ' angle of escapement
        lfFont.lfOrientation = 0                ' base-line orientation angle
        lfFont.lfWeight = FontWeight            ' font weight
        lfFont.lfItalic = Italic                ' italic attribute flag    (0,1)
        lfFont.lfUnderline = Underline          ' underline attribute flag (0,1)
        lfFont.lfStrikeOut = StrikeOut          ' strikeout attribute flag (0,1)
        lfFont.lfCharSet = %ANSI_CHARSET        ' character set identifier
        lfFont.lfOutPrecision = %OUT_TT_PRECIS  ' output precision
        lfFont.lfClipPrecision = %CLIP_DEFAULT_PRECIS  ' clipping precision
        lfFont.lfQuality = %DEFAULT_QUALITY     ' output quality
        lfFont.lfPitchAndFamily = %FF_DONTCARE  ' pitch and family
        lfFont.lfFaceName = FaceName            ' typeface name string
    ' -----------------------
        ' Make font according to specifications
        FUNCTION = CreateFontIndirect (lfFont)
    END FUNCTION
    ' ------------------------------------------------
    '
    SUB CheckAndDisplayData()
       LOCAL b$,i&,j&,k&,x&,M&,N&,hCtl&,alflag&,d$,l&,res&
       LOCAL KK&,JJ&
       LOCAL hListView AS LONG
          ' Find maximum string length for each column.
          ' Classify column as alphabetic or numerical.
          REDIM MaxLen(Columns)
          REDIM AlphNum(Columns)
          FOR i&=1 TO Columns
              MaxLen(i&)=LEN(head(i&)) ' start with header text length
              AlphNum(i&)=1 ' presume numerical for a start
              alflag&=1
              FOR j&=1 TO Rows
                  d$=DAT(i&,j&)
                  k&=LEN(d$)
                  IF k&>MaxLen(i&) THEN MaxLen(i&)=k&
                  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
          '
          ' Display data using the listview control
          ' ***************************************
          LOCAL LVC AS LV_COLUMN
          LOCAL LVI AS LV_ITEM
          LOCAL zText AS ASCIIZ * 255
          LOCAL lstyle AS LONG
          lvC.mask = %LVCF_FMT OR %LVCF_WIDTH OR %LVCF_TEXT OR %LVCF_SUBITEM
          LVC.cchTextMax = 255
          ' Kill previous listview box. An easy way of clearing!
          CONTROL KILL hForm1&,%FORM1_LISTVIEWBOX1
          '
          LISTBOX RESET hForm1&, %FORM1_LISTBOXROWHEAD ' empty listbox
          '
          ' recreate listview box
          CONTROL ADD "SysListView32", hForm1&, %FORM1_LISTVIEWBOX1,"",26, 8, 190, 126+RowHeadCorrect, _
            %WS_border OR %WS_Child OR %WS_TABSTOP OR %LVS_Report , %WS_EX_CLIENTEDGE
          CONTROL HANDLE hForm1&,%FORM1_LISTVIEWBOX1 TO hListView
          lStyle = SendMessage(hListView, _
                 %LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0)
          lStyle = lStyle OR %LVS_EX_GRIDLINES
          CALL SendMessage(hListView, %LVM_SETEXTENDEDLISTVIEWSTYLE, _
           0, BYVAL lStyle)
          res& = ShowWindow(hListView,%SW_SHOW)
          '
          'By using the ListView_SetItemCount macro or the LVM_SETITEMCOUNT
          'message  before adding a large number of items, you enable a list
          'view control to reallocate its internal data structures only once
          'rather than every time you add an item.
           ListView_SetItemCount hListView, Rows
          '
          ' Display new data
          ' First make column headers
          FOR KK& = 1 TO Columns
              ' calculate width of each column
              lvC.cx = MaxLen(KK&)*HorizBaseU + 10
              IF AlphNum(KK&)=0 THEN
                   lvC.fmt = %LVCFMT_LEFT ' left justify if alphabetical
              ELSE          '%LVCFMT_CENTER is another available style
                   lvC.fmt = %LVCFMT_RIGHT ' right justify if numerical
              END IF
              ' column header text
              zText = head(KK&)
              LVC.pszText = VARPTR(zText)
              CONTROL SEND hForm1&,%FORM1_LISTVIEWBOX1,%LVM_INSERTCOLUMN, KK&, VARPTR(lvc)
          NEXT
          ' Then fill row and column grid with data - one row at a time
          DIM Rec(Columns-1) AS STRING
          CONTROL HANDLE hForm1&,%FORM1_LISTVIEWBOX1 TO hListView
          FOR JJ&=1 TO Rows
              FOR KK& = 1 TO Columns
                  rec(KK&-1)=DAT(KK&,JJ&)
              NEXT
              '
              ' Put number of row in this lefthand listbox
              ' to simulate a row header
              LISTBOX ADD hForm1&, %FORM1_LISTBOXROWHEAD, RIGHT$("00000"+LTRIM$(STR$(JJ&)) ,5)
              '
              ' Append each set of row data to the listview control
              CALL AppendListView (hListView, Rec())
          NEXT
          ' The reason for this line becomes clear when
          ' you see the display with and without the horizontal scroll bar.
          LISTBOX ADD hForm1&, %FORM1_LISTBOXROWHEAD, RIGHT$("00000"+LTRIM$(STR$(Rows+1)) ,5)
          ' empty comboboxes
          COMBOBOX RESET hForm1&, %FORM1_COMBOBOXY
          COMBOBOX RESET hForm1&, %FORM1_COMBOBOXX
          '
          ' add variable headers to combobox Y for numerical variables only
          FOR i&=0 TO Columns-1
              IF Columns>=1 AND AlphNum(i&+1)=1 THEN COMBOBOX ADD hForm1&, %FORM1_COMBOBOXY, head(i&+1)
          NEXT
    END SUB
    '
    '
    SUB AppendListView (hList AS LONG, Rec() AS STRING )
      DIM z AS INTEGER
      DIM iStatus AS INTEGER
      DIM szStr AS ASCIIZ * 300
      DIM lvi AS LV_ITEM
      LOCAL x AS LONG
      'this will be the next record
      lvi.iItem = ListView_GetItemCount(hList)
      'The ListView_GetItemCount macro retrieves the number of items
      'in a list view control. You can use this macro or explicitly
      'send the LVM_GETITEMCOUNT message.
      '
      lvi.mask = %LVIF_TEXT
      lvi.stateMask = 0 '%LVIS_FOCUSED '%LVIS_SELECTED
      lvi.pszText = VARPTR(szStr)
      FOR z = 0 TO UBOUND(Rec)
        szStr = Rec(z)
        lvi.iSubItem = z
        lvi.lParam = lvi.iItem
        IF z = 0 THEN
          lvi.mask = %LVIF_TEXT 'OR %LVIF_PARAM OR %LVIF_STATE
          iStatus = ListView_InsertItem (hList, lvi)
          'The ListView_InsertItem macro inserts a new item in a list view control.
          'The iItem member specifies the index of the new item.
          'You cannot use ListView_InsertItem to insert subitems;
          'the iSubItem member of the LV_ITEM structure must be zero.
        ELSE
          lvi.mask = %LVIF_TEXT 'OR %LVIF_PARAM OR %LVIF_STATE
          iStatus = ListView_SetItem (hList, lvi)
          'The ListView_SetItem macro sets some or all of a list view item's attributes.
        END IF
      NEXT
    END SUB
    ' ------------------------------------------------
    FUNCTION FilNameSaveEMF() AS LONG
       LOCAL Path   AS STRING
       LOCAL f      AS STRING
       LOCAL Style  AS DWORD
    igen:
       PAFUemf=""
       Path=FilePath(PAFU)
       f=""
       Style = %OFN_HIDEREADONLY OR %OFN_LONGNAMES
       IF SaveFileDialog(0, "Save Current Graph", f, Path, _
           "Enhanced Metafiles|*.emf|All Files|*.*", "emf", Style) THEN
           PAFUemf=f
           FUNCTION = 1
       END IF
    END FUNCTION
    ' ------------------------------------------------
    FUNCTION FilNameSave() AS LONG
       LOCAL Path   AS STRING
       LOCAL f      AS STRING
       LOCAL Style  AS DWORD
       LOCAL hFile  AS LONG
       LOCAL i&,j&,res&,fl&
    igen:
       PAFUout=""
       Path=FilePath(PAFU)
       f=""
       Style = %OFN_HIDEREADONLY OR %OFN_LONGNAMES
       IF SaveFileDialog(0, "Save File", f, Path, _
           "Text Files|*.txt|All Files|*.*", "txt", Style) THEN
           '
           PAFUout=f
           IF PAFU=PAFUout THEN
               res& = MSGBOX ("Output file name the same as input file name. Do you want this ?",%MB_ICONHAND OR %MB_YESNO, "Problem:")
               IF res&=%IDNO THEN GOTO igen
           END IF
           hFile = FREEFILE
           OPEN PAFUout 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.
           ' First save the column header line
           FOR i&=1 TO Columns
               PRINT# hFile, head(i&);
               ' put delimiter after each column header
               ' except the last
               IF i&<Columns THEN  PRINT# hFile,Delim;
           NEXT
           PRINT# hFile, $CRLF; ' start a new line
           ' Then save the data - one row at a time
           FOR j&=1 TO Rows
               FOR i&=1 TO Columns
                   PRINT# hFile, DAT(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 IF
    END FUNCTION
    ' ------------------------------------------------
    FUNCTION FilNameOpen() AS LONG
       LOCAL Path   AS STRING
       LOCAL f      AS STRING
       LOCAL Style  AS DWORD
       LOCAL A$
       LOCAL hFile  AS LONG
       LOCAL b$,i&,j&,k&,x&,M&,N&,hCtl&,alflag&,d$,l&
       LOCAL KK&,JJ&
       LOCAL hListView AS LONG
       Path     = CURDIR$
    igen:
       f        = "*.TXT"
       Style    = %OFN_FILEMUSTEXIST OR %OFN_HIDEREADONLY OR %OFN_LONGNAMES
       IF OpenFileDialog(0, "Open File", f, Path, _
         "Text Files|*.txt|All Files|*.*", "txt", Style) THEN
          PAFU=f
          Rows = 0
          hFile = FREEFILE
          OPEN PAFU 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 PAFU 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 head(1:Columns)
          LOCAL CHflag&,Cstr$ : Cstr$ = "0123456789.+-ED"+Delim+$CRLF
          CHflag = VERIFY(b$,Cstr$)
          FOR i&=1 TO Columns
              IF ISTRUE CHflag THEN
                  head(i&)=PARSE$(b$,Delim,i&)
              ELSE
                  head(i&)="Var."+STR$(i&)
              END IF
          NEXT
          '
          ' Redimension DAT array. Important to set the right number of columns
          ' prior to using REDIM PRESERVE
          REDIM DAT(1:Columns,1:1)
    
          Rows=0
          IF ISFALSE Chflag THEN ' include the first line as data
              INCR Rows
              REDIM PRESERVE DAT(1:Columns,1:Rows)
              FOR i&=1 TO Columns
                  DAT(i&,Rows)=PARSE$(b$,Delim,i&)
              NEXT
          END IF
          '
          ' read data into DAT array - one row at a time
          DO WHILE NOT EOF(hFile)
              INCR Rows ' number of rows
              LINE INPUT# hFile, b$
              REDIM PRESERVE DAT(1:Columns,1:Rows)
              FOR i&=1 TO Columns
                  DAT(i&,Rows)=PARSE$(b$,Delim,i&)
              NEXT
          LOOP
          CLOSE hFile
          FUNCTION = 1
       END IF
    END FUNCTION
    ' ------------------------------------------------
    FUNCTION FileNam(BYVAL Src AS STRING) AS STRING
      LOCAL x AS LONG
      FOR x = LEN(Src) TO 1 STEP -1
        IF (ASC(Src, x) = 92) OR (ASC(Src, x) = 58) THEN EXIT FOR
      NEXT x
      FUNCTION = MID$(Src, x + 1)
    END FUNCTION
    ' ------------------------------------------------
    FUNCTION FilePath(BYVAL Src AS STRING) AS STRING
      LOCAL x AS LONG
      FOR x = LEN(Src) TO 1 STEP -1
        IF (ASC(Src, x) = 92) OR (ASC(Src, x) = 58) THEN EXIT FOR
      NEXT x
      FUNCTION = LEFT$(Src, x)
    END FUNCTION
    '
    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 MakeAnalysis
        LOCAL I&,J&,tt$,K&
        LOCAL Cval&,hCtl&,Length&,Cvartx$
        INCR AnalysisNumber
        ' Identify Yvar - number.
        CONTROL HANDLE hForm1&, %FORM1_COMBOBOXY TO hCtl&
        Cval&=Combo_GetCurSel(hCtl&) ' get current selection index
        Length&=SendMessage (hCtl&,%CB_GETLBTEXTLEN,CVal&,0)
        ' get selected text without extra spaces
        Cvartx$=LEFT$(Combo_GetLbText(hCtl&,CVal&),Length&)
        FOR I&=1 TO Columns
            IF Cvartx$ = head(I&) THEN Yvar&=I&
        NEXT
        ' Identify Xvar - number.
        CONTROL HANDLE hForm1&, %FORM1_COMBOBOXX TO hCtl&
        Cval&=Combo_GetCurSel(hCtl&) ' get current selection index
        Length&=SendMessage (hCtl&,%CB_GETLBTEXTLEN,CVal&,0)
        ' get selected text without extra spaces
        Cvartx$=LEFT$(Combo_GetLbText(hCtl&,CVal&),Length&)
        FOR I&=1 TO Columns
            IF Cvartx$ = head(I&) THEN Xvar&=I&
        NEXT
        ' Transfer selected data to numerical array
        ' and find minimum and maximum values for X and Y
        REDIM NumDat(1:Rows,0: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$(DAT(Xvar&,J&))<>"" AND TRIM$(DAT(Yvar&,J&))<>"" THEN
                INCR K&
                NumDat(K&,0)=1
                NumDat(K&,1)=VAL(DAT(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(DAT(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: "+head(Yvar&)+"         Mean:"+FORMAT$(Mean(2),"######.#####")+ _
        "          SD:"+FORMAT$(StDev(2),"######.#####")+ $CRLF+ _
        "X-variable: "+head(Xvar&)+"         Mean:"+FORMAT$(Mean(1),"######.#####")+ _
        "          SD:"+FORMAT$(StDev(1),"######.#####")+ $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,"####.##") + "    p: "+FORMAT$(pp,"##.######")+$CRLF
            IF pp<0.000001 THEN st$= "    t: " + FORMAT$(t3,"####.##") + "    p: <0.000001"+$CRLF
        END IF
        T$=T$+"Correlation Coefficient r:  "+FORMAT$(U(1,2),"##.#####")
        T$=T$+st
        T$=T$+"Coefficient of Determination r²:  "+FORMAT$(U(1,2)^2,"##.#####")+$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,"####.##") + "    p: "+FORMAT$(pp,"##.######")+$CRLF
            IF pp<0.000001 THEN st$= "    t: " + FORMAT$(t3,"####.##") + "    p: <0.000001"+$CRLF
        END IF
        T$=T$+"Regres. Coeff.: "+FORMAT$(Y(1),"#####.#####")+"    Standard Error: "+FORMAT$(SQR(A(1,1)),"#####.#####") + 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,"####.##") + "    p: "+FORMAT$(pp,"##.######")+$CRLF
            IF pp<0.000001 THEN st$= "    t: " + FORMAT$(t3,"####.##") + "    p: <0.000001"+$CRLF
        END IF
        T$=T$+"Constant:       "+FORMAT$(Y(0),"#####.#####")+"    Standard Error: "+FORMAT$(SQR(A(0,0)),"#####.#####") + st
    
        I&=SGN(Y(1)) : IF I&=1 THEN tt$="  +" ELSE tt$="  -"
        T$=T$+"Regression equation: Y ="+FORMAT$(Y(0),"#####.#####")+tt$+FORMAT$(ABS(Y(1)),"#####.#####")+" * X"+$CRLF
        T$=T$+"Standard Error of Estimated Y: "+FORMAT$(UUU,"#####.#####")+$CRLF
        T$=T$+$CRLF+$CRLF
        GRAFFLAG=10
        EnableMenuItem hForm1_Menu2&, %Form1_GRAPHCOPY, %MF_BYCOMMAND OR %MF_ENABLED
    END SUB
    '
    '
    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 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$)
        ' -
        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
        '
        FillRect hDC, Rct, GetStockObject(%WHITE_BRUSH)
        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
        LoMarg = YPixMax&/6
        XConvFac = (XPixMax& - LeMarg - RiMarg) / (Xhigh - Xlow)
        YConvFac = (YPixMax& - UpMarg - LoMarg) / (Yhigh - Ylow)
        CALL MakeXandYaxisWithText(hDC,LeMarg, LoMarg, RiMarg, UpMarg, Xlow, Xstep, Xhigh, _
             Ylow, Ystep, Yhigh, XConvFac, YConvFac, Xtxt$, Ytxt$, 0)
        '
        PenWidth=LogPixelsX/254*2.1
        hPen = SelectObject(hDC, CreatePen(PenStyle(0), PenWidth, gColor(1))) ' 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.
            Ellipse hDC, 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
            MoveToEx hDC, LeMarg,YPixMax&-((Ystart-Ylow)*YConvFac+LoMarg), BYVAL %NULL
        ELSEIF Ystart>Yhigh THEN
            MoveToEx hDC,((Yhigh-Constant)/Coeff-Xlow)*XConvFac+LeMarg,UpMarg,BYVAL %NULL
        ELSE  'Ystart<Ylow
            MoveToEx hDC,((Ylow-Constant)/Coeff-Xlow)*XConvFac+LeMarg,YPixMax&-LoMarg,BYVAL %NULL
        END IF
        ' 2: Draw to right ending point
        IF Yend<=Yhigh AND Yend>=Ylow THEN
            LineTo hDC, XPixMax&-RiMarg,YPixMax&-((Yend-Ylow)*YConvFac+LoMarg)
        ELSEIF Yend>Yhigh THEN
            LineTo hDC,((Yhigh-Constant)/Coeff-Xlow)*XConvFac+LeMarg,UpMarg
        ELSE  'Yend<Ylow
            LineTo hDC,((Ylow-Constant)/Coeff-Xlow)*XConvFac+LeMarg,YPixMax&-LoMarg
        END IF
    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)
        '-
        DIM lpsz AS ASCIIZ * 255
        LOCAL hPen AS LONG,Fontt&
        LOCAL I AS LONG, flag AS LONG, KK AS LONG, LongTics AS LONG
        LOCAL res AS LONG
        LOCAL SI AS SINGLE,EX$,XX1 AS SINGLE
        LOCAL YY1 AS SINGLE
        LOCAL Xval AS SINGLE,Yval AS SINGLE,PenWidth AS SINGLE
        '-
        res=FillRect(hDC, Rct, GetStockObject(%WHITE_BRUSH))
        '
        ' An attempt to accomodate both large and small Windows font setting.
        IF Xfact>1.75 THEN ' large font
            Fontt&=MakeFont(8,400,0,0,0,"Arial")
        ELSE               ' small font
            Fontt&=MakeFont(7,400,0,0,0,"Arial")
        END IF
        SelectObject hDC, Fontt&
        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)>=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))
            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&/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))
            res=GetTextExtentPoint32(hDC,lpsz,BYVAL LEN(lpsz),lpSize)
            TextOut hDC, LeMarg-XPixMax&/40, 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&/40-lpSize.cx,UpMarg-YPixMax&/10, lpsz, BYVAL LEN(lpsz)
    END SUB
    '
    '
    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 = 0 '%PS_SOLID       _______
        CASE 1 :   FUNCTION = 1 '%PS_DASH        -------
        CASE 2 :   FUNCTION = 2 '%PS_DOT         .......
        CASE 3 :   FUNCTION = 3 '%PS_DASHDOT     _._._._
        CASE 4 :   FUNCTION = 4 '%PS_DASHDOTDOT  _.._.._
        CASE ELSE: FUNCTION = 0 '%PS_SOLID
      END SELECT
    END FUNCTION


    [This message has been edited by Erik Christensen (edited January 23, 2004).]

  • #2
    FYI: The program has been adjusted after valuable feed-back from
    Andrew Lindsay who identified problems in display of diagram due
    to ambiguous enhanced metafile dimension. Thanks for this
    feed-back.

    Best regards,

    Erik

    ------------------

    Comment


    • #3
      erik,

      perhaps it's useful to additionally provide p-values for slope,
      constant and coefficient of correlation in order to test the
      respective 0-hypothesis ho(slope=0) etc. (the first and third
      p-value should have the same value, if i remember well.) recently,
      with respect to student's t, a guy named erik christensen posted
      all the code you need at
      http://www.powerbasic.com/support/pb...ad.php?t=23858

      regards and thanks, hanns.


      ------------------


      [this message has been edited by hanns ackermann (edited january 17, 2004).]

      Comment


      • #4
        Hanns, you are right. I may do it some time soon.

        ------------------

        Comment


        • #5
          Hanns,

          Thanks for the suggestion. Now you have got it. See above.

          Best regards,

          Erik

          ------------------

          Comment


          • #6
            Erik,

            Found one compilation error on line 1242. There is a smiley and
            I think in place of the smiley should be ':' and the following
            'p' should 'pp'.
            Am I correct. Your program compiled afterwards without any
            problems.

            Regards,


            ------------------
            Regards
            Haitham
            Regards
            Haitham

            Comment


            • #7
              Erik,

              When loading a data file, the first point is not shown in the
              spreadsheet-like 'Data to be analyzed' section of your program.

              When running the regression, I got the following (so many digits!)

              Analysis 5. Number of individuals in analysis: 9
              Y-variable: 1 Mean:6. SD:2.73861
              X-variable: 2 Mean:7. SD:2.73861
              Correlation Coefficient r: 1. t: 999999999999999999900000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000. p: <0.000001
              Coefficient of Determination r²: 1.
              Regres. Coeff.: 1. Standard Error: 0. t: 999999999999999999900000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000. p: <0.000001
              Constant: -1. Standard Error: 0. t: -99999999999999999990000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000. p: <0.000001
              Regression equation: Y =-1. +1. * X
              Standard Error of Estimated Y: 0.

              Regards,




              ------------------
              Regards
              Haitham
              Regards
              Haitham

              Comment


              • #8
                Haitham,

                Thanks for your feedback. The smiley problem, which Hanns also
                found, is now avoided by insertion of an extra space character.

                The t-overflow problem was caused by division by zero. This is
                now avoided by specific checking.

                The original program assumed the first data line of a file being
                read to be column headers. This caused your problem. The program
                has now been changed to check for non-numerical characters in
                the first line. If none are found, these data are included for
                analysis and default header labels are being inserted instead.

                I hope these changes are working satisfactorily.

                Regards,

                Erik



                [This message has been edited by Erik Christensen (edited January 21, 2004).]

                Comment


                • #9
                  For your information an updated version of the program for PBwin10 is here:

                  http://www.powerbasic.com/support/pb...ad.php?t=53149

                  Comment

                  Working...
                  X