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

Header based virtual grid control with cell editing

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

  • Header based virtual grid control with cell editing

    ' Header based virtual grid control with cell editing for PBWin 7.0
    '
    ' This version of the header based virtual grid control enables you to
    ' edit individual cells as well as column and row headers. Like in
    ' Excel new text is placed in the selected cell just by typing the text
    ' on the keyboard. You end entering new text by pressing ENTER, TAB, by
    ' moving the selected cell or by scrolling. Before ending you may
    ' retrieve the old text by pressing ESCAPE. In harmony with Excel you
    ' can perform full editing of a cell by pressing function key 2 (F2).
    ' When editing is started in this way you can insert and delete
    ' characters in any position.
    '
    ' Editing of column and row headers is started by a mouse click. Full
    ' editing is always possible and editing needs to be ended by pressing
    ' ENTER or TAB. This arrangement makes it more difficult to
    ' accidentally change the headers.
    '
    ' In this version you can import files from Excel and other similar
    ' programs if the files have been saved in TAB-separated text format.
    ' You can also save the data in the grid control in TAB-separated text
    ' format, which can be imported in Excel and most other programs.
    '
    ' Thanks to the PowerBasic Forum for great inspiration. If you find
    ' any blunders or have comments, please let me know.
    '
    ' Good luck!
    '
    ' Erik Christensen ---- e.chr@email.dk
    Code:
    '------------------------------------------------------------------------------
    #COMPILE EXE
    #REGISTER NONE
    #DIM ALL
    '------------------------------------------------------------------------------
    ' Initial Declares - eliminate unnecessary macros in COMMCTRL.INC
    '------------------------------------------------------------------------------
    %NOANIMATE         = 1  ' Animate contro l
    %NOBUTTON          = 1  ' Button
    %NOCOMBO           = 1  ' Combo box
    %NOCOMBOEX         = 1  ' ComboBoxEx
    %NODATETIMEPICK    = 1  ' Date/time picker
    %NODRAGLIST        = 1  ' Drag list control
    %NOEDIT            = 1  ' Edit control
    %NOFLATSBAPIS      = 1  ' Flat scroll bar
    '  %NOHEADER          = 1  ' Header control
    %NOHOTKEY          = 1  ' HotKey control
    %NOIMAGELIST       = 1  ' Image APIs
    %NOIPADDRESS       = 1  ' IP Address edit control
    %NOLIST            = 1  ' List box control
    %NOLISTVIEW        = 1  ' ListView control
    %NOMENUHELP        = 1  ' Menu help
    %NOMONTHCAL        = 1  ' MonthCal
    %NOMUI             = 1  ' MUI
    %NONATIVEFONTCTL   = 1  ' Native Font control
    %NOPAGESCROLLER    = 1  ' Pager
    %NOPROGRESS        = 1  ' Progress control
    %NOREBAR           = 1  ' Rebar control
    '  %NOSTATUSBAR       = 1  ' Status bar
    %NOTABCONTROL      = 1  ' Tab control
    %NOTOOLBAR         = 1  ' Tool bar
    %NOTOOLTIPS        = 1  ' Tool tips
    %NOTRACKBAR        = 1  ' Track bar
    %NOTRACKMOUSEEVENT = 1  ' Track Mouse Event
    %NOTREEVIEW        = 1  ' TreeView
    %NOUPDOWN          = 1  ' Up Down arrow control
    ' ----------------------------------------------------------
    #INCLUDE  "WIN32API.INC"
    #INCLUDE  "COMMCTRL.INC"
    #INCLUDE  "INITCTRL.INC"
    #INCLUDE  "COMDLG32.INC"
    
    '******************************************************************************
    '** Potential Include File Part ***********************************************
    '******************************************************************************
    '------------------------------------------------------------------------
    %FORM1_HEADER             = 130
    %FORM1_GRID               = 135
    %ID_EDITCHILD             = 140
    '
    GLOBAL hGrid&                ' Handle of grid control
    GLOBAL hHead&                ' Handle of header control of grid control
    GLOBAL hEdit&                ' Handle of edit control in grid
    GLOBAL Rows AS LONG          ' Total number of rows in array
    GLOBAL Columns AS LONG       ' Total number of columns in array
    GLOBAL DataArray() AS STRING ' Two dimensional text array to be displayed
    GLOBAL ColWidth() AS LONG    ' Array to hold the column widths
    GLOBAL HeaderHeight AS LONG  ' Height of header control
    GLOBAL LineHeight AS LONG    ' Height of one line in grid control
    GLOBAL gOldSubClassEdit&
    GLOBAL SelectCol AS LONG
    GLOBAL SelectRow AS LONG
    GLOBAL VScrollNotify AS WORD
    GLOBAL HScrollNotify AS WORD
    GLOBAL EditFlag AS LONG
    GLOBAL CorrectFlag AS LONG
    GLOBAL HeadEditFlag AS LONG
    GLOBAL RowHeaderEditFlag AS LONG
    GLOBAL HeadCol AS LONG
    GLOBAL EditRow AS LONG
    GLOBAL hFont AS LONG
    GLOBAL siX AS SCROLLINFO
    '------------------------------------------------------------------------------
    FUNCTION MakeFont(BYVAL FontTypeSize AS LONG,BYVAL FontWeight AS LONG, _
        BYVAL Italic AS LONG, BYVAL Underline AS LONG,BYVAL StrikeOut AS LONG, _
        BYVAL FaceName AS STRING) AS LONG
        LOCAL hDC&,LogPixelsY&
        LOCAL lfFont AS lOGFONT   ' Logfont structure
        hDC = GetDC(%HWND_DESKTOP)
        '
        'Retrieves device-specific information about the number
        'of pixels per logical inch along the screen height
        '(depends on screen resolution setting).
        'This is important to define appropriate font sizes.
        LogPixelsY  = GetDeviceCaps(hDC, %LOGPIXELSY)
        '
        ReleaseDC %HWND_DESKTOP, hDC
        'TYPE LOGFONT defines the attributes of a font.
        'See LOGFONT in the Win32 help file
        lfFont.lfHeight = -MulDiv(FontTypeSize,LogPixelsY,72) ' better than: -(FontTypeSize * LogPixelsY) \ 72
                                                ' logical height of font
        lfFont.lfWidth = 0                      ' logical average character width
        lfFont.lfEscapement = 0                 ' angle of escapement
        lfFont.lfOrientation = 0                ' base-line orientation angle
        lfFont.lfWeight = FontWeight            ' font weight
        lfFont.lfItalic = Italic                ' italic attribute flag    (0,1)
        lfFont.lfUnderline = Underline          ' underline attribute flag (0,1)
        lfFont.lfStrikeOut = StrikeOut          ' strikeout attribute flag (0,1)
        lfFont.lfCharSet = %ANSI_CHARSET        ' character set identifier
        lfFont.lfOutPrecision = %OUT_TT_PRECIS  ' output precision
        lfFont.lfClipPrecision = %CLIP_DEFAULT_PRECIS  ' clipping precision
        lfFont.lfQuality = %DEFAULT_QUALITY     ' output quality
        lfFont.lfPitchAndFamily = %FF_DONTCARE  ' pitch and family
        lfFont.lfFaceName = FaceName            ' typeface name string
        ' Make font according to specifications
        FUNCTION = CreateFontIndirect (lfFont)
    END FUNCTION
    '******************************************************************************
    FUNCTION InitHeaderGridCtrl() AS LONG
        LOCAL wc          AS WNDCLASS
        LOCAL szClassName AS ASCIIZ * 11
        szClassName      = "HEADERGRID"
        wc.style         = %CS_HREDRAW OR %CS_VREDRAW OR %CS_DBLCLKS OR %CS_GLOBALCLASS
        wc.lpfnWndProc   = CODEPTR(GridCallBack)
        wc.cbClsExtra    = 0
        wc.cbWndExtra    = 0
        wc.hInstance     = GetModuleHandle(BYVAL %NULL)
        wc.hIcon         = %NULL
        wc.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
        wc.hbrBackground = GetStockObject(%WHITE_BRUSH)
        wc.lpszMenuName  = %NULL
        wc.lpszClassName = VARPTR(szClassName)
        FUNCTION = RegisterClass(wc)
    END FUNCTION
    '******************************************************************************
    CALLBACK FUNCTION GridCallBack
        ' Callback Handle CBHNDL is: hGrid&
        LOCAL szString AS ASCIIZ * 256
        LOCAL layout AS HDLAYOUT
        LOCAL winpos AS WINDOWPOS
        STATIC headitem AS HD_ITEM
        STATIC hCtr&,Res&,s AS ASCIIZ * 250
        LOCAL hdnptr AS HD_NOTIFY PTR
        LOCAL hdiptr AS HD_ITEM PTR
        LOCAL MinWidth AS LONG : MinWidth = 40
        LOCAL rc AS RECT ,i&,j&,hdc&,k&,chrs&,idx&,M&
        LOCAL rc2 AS RECT
        LOCAL hDCgr AS LONG
        LOCAL ColStart AS LONG
        STATIC TextHeight AS LONG
        LOCAL lpSize AS SIZEL
        LOCAL Spacing AS LONG : Spacing = 6
        LOCAL ps AS PAINTSTRUCT
        LOCAL tm AS TEXTMETRIC
        STATIC hFontBold AS LONG , hFatPen AS LONG
        STATIC hGrayPen AS LONG, hLightGrayPen AS LONG
        STATIC memDCgr AS LONG, hBitGr AS LONG
        STATIC siY AS SCROLLINFO
        STATIC ptsCursor AS POINTAPI
        STATIC PageRows AS LONG      ' Number of rows on a page
        STATIC PageColumns AS LONG   ' Number of columns on a page
        STATIC CellFlag&, ColFlag&, RowFlag&
        STATIC x1&,y1&,x2&,y2&
        '
        SELECT CASE CBMSG
            CASE %WM_CREATE
                '
                ' Create Header and set its font.
                IF ISFALSE hHead& THEN
                    hHead& = CreateWindow("SysHeader32",BYVAL 0, %WS_CHILD OR %WS_BORDER _
                         OR %HDS_BUTTONS,0,0,0,0,CBHNDL,%FORM1_HEADER, _
                         GetModuleHandle(BYVAL %NULL), BYVAL %NULL)
                    hFontBold = MakeFont(8,%FW_BOLD,0,0,0,"MS Sans Serif")
                    SendMessage hHead&,%WM_SETFONT,hFontBold,MAKLNG(%TRUE,0)
                    hFont = MakeFont(8,%FW_NORMAL,0,0,0,"MS Sans Serif")
                    hGrayPen = CreatePen(%PS_SOLID, 0, %GRAY)
                    hLightGrayPen = CreatePen(%PS_SOLID, 0, %LTGRAY)
                    hFatPen = CreatePen(%PS_SOLID, 3, %BLACK)
                    '
                    ' Insert items into the header
                    headitem.mask = %HDI_FORMAT OR %HDI_WIDTH OR %HDI_TEXT
                    headitem.fmt = %HDF_STRING OR %HDF_LEFT
    
                    FOR i& = 0 TO MIN(20, Columns)
                        s="" : IF i>0 THEN s = FORMAT$(i&)+"   "
                        IF i&<Columns THEN s = s + DataArray(i&,0)
                        headitem.pszText = VARPTR(s)
                        headitem.cchTextMax = LEN(headitem.pszText)
                        headitem.cxy = ColWidth(i&)
                        Header_InsertItem hHead&, i&, VARPTR(headitem)
                    NEXT
                    ShowWindow hHead&, %SW_SHOW
                ELSE
                    ' Update header
                    FOR i& = 0 TO MIN(20, Columns)
                        IF i&>=Columns THEN
                            s ="  "
                            headitem.cxy = 2000 ' set very wide extra column
                        ELSE
                            s="" : IF i>0 THEN s = FORMAT$(i&)+"   "
                            s = s + DataArray(i&,0)
                            headitem.cxy = ColWidth(i&)
                        END IF
                        headitem.pszText = VARPTR(s)
                        headitem.cchTextMax = LEN(headitem.pszText)
                        SendMessage hHead&, %HDM_SETITEM, i&, VARPTR(headitem)
                    NEXT
                END IF
                '
                IF ISFALSE memDCgr THEN
                    ' Create a virtual window for grid
                    hDCgr = GetDC(CBHNDL)
                    memDCgr = CreateCompatibleDC(hDCgr)
                    hBitGr = CreateCompatibleBitmap(hDCgr,Rc.nRight,Rc.nBottom)
                    SelectObject memDCgr, hBitGr
                    SelectObject memDCgr, hFont
                    GetTextMetrics memDCgr, tm
                    LineHeight = tm.tmHeight + tm.tmInternalLeading
                    Res& = PatBlt(memDCgr, 0, 0, Rc.nRight, Rc.nBottom, %PATCOPY)
                END IF
                '
                IF ISFALSE hEdit THEN
                    ' Create edit control
                    hEdit = CreateWindow("EDIT",BYVAL %NULL,%WS_CHILD OR %ES_AUTOHSCROLL, _
                        0, 0, 0, 0,CBHNDL,%ID_EDITCHILD, _
                        GetWindowLong(CBHNDL,%GWL_HINSTANCE),BYVAL %NULL)
                    SendMessage hEdit&,%WM_SETFONT,hFont,MAKLNG(%TRUE,0)
                    ' Subclass Edit Control
                    gOldSubClassEdit& = SetWindowLong(hEdit&, %GWL_WNDPROC, CODEPTR(SubClassEditKeys))
                END IF
                '
                SelectRow = 1 : SelectCol = 1  ' Initial position of selection rectangle.
                '
                ' Define vertical scrollbar
                siY.cbSize = SIZEOF(siY)
                siY.fMask  = %SIF_ALL  ' = %SIF_RANGE OR %SIF_PAGE OR %SIF_POS OR %SIF_TRACKPOS
                siY.nMin   = 1
                siY.nMax   = Rows
                siY.nPage  = PageRows
                siY.nPos   = 1
                Res& = SetScrollInfo(CBHNDL, %SB_VERT, siY, %TRUE)
                '
                ' Define horizontal scrollbar
                siX.cbSize = SIZEOF(siX)
                siX.fMask  = %SIF_ALL
                siX.nMin   = 0
                siX.nMax   = Columns
                siX.nPage  = PageColumns
                siX.nPos   = 0
                Res& = SetScrollInfo(CBHNDL, %SB_HORZ, siX, %TRUE)
                '
                SetFocus CBHNDL
                InvalidateRect CBHNDL, BYVAL %NULL , %FALSE
                '
            CASE %WM_VSCROLL
                SetFocus CBHNDL
                IF ISTRUE EditFlag THEN CALL FinishEdit
                HeadEditFlag = %FALSE
    
                SELECT CASE LOWRD(CBWPARAM)
                    CASE %SB_TOP : siY.nPos = siY.nMin : IF VScrollNotify = %SB_TOP THEN SelectRow = siY.nMin
                    CASE %SB_BOTTOM : siY.nPos = siY.nMax : IF VScrollNotify = %SB_BOTTOM THEN SelectRow = siY.nMax
                    CASE %SB_LINEDOWN
                        IF VScrollNotify = %SB_LINEDOWN THEN ' Down key pressed
                            IF SelectRow < Rows THEN INCR SelectRow
                            IF SelectRow > siY.nPos + siY.nPage - 1 THEN INCR siY.nPos
                        ELSE                       ' Scroll bar clicked
                            INCR siY.nPos
                        END IF
                    CASE %SB_LINEUP
                        IF VScrollNotify = %SB_LINEUP THEN ' Up key pressed
                            IF SelectRow > 1 THEN DECR SelectRow
                            IF SelectRow < siY.nPos THEN DECR siY.nPos
                        ELSE                       ' Scroll bar clicked
                            DECR siY.nPos
                        END IF
                    CASE %SB_PAGEDOWN
                         IF VScrollNotify = %SB_PAGEDOWN THEN ' Page Down key pressed
                             IF SelectRow = siY.nPos + siY.nPage - 1 THEN ' On the last visible line
                                 siY.nPos = siY.nPos + siY.nPage - 1
                                 SelectRow = siY.nPos + siY.nPage - 1
                             END IF
                             ' Not on the last display line: then move to that.
                             IF SelectRow < siY.nPos + siY.nPage - 1 THEN SelectRow = siY.nPos + siY.nPage - 1
                             SelectRow = MIN(SelectRow, siY.nMax)
                         ELSE                                 ' Scroll bar clicked
                             siY.nPos = siY.nPos + siY.nPage - 1
                         END IF
                    CASE %SB_PAGEUP
                         IF VScrollNotify = %SB_PAGEUP THEN ' Page Up key pressed
                             IF SelectRow = siY.nPos THEN   ' On the first visible line
                                 siY.nPos = siY.nPos - siY.nPage + 1
                                 SelectRow = siY.nPos
                             END IF
                             ' Not on the first display line: then move to that.
                             IF SelectRow > siY.nPos THEN SelectRow = siY.nPos
                             SelectRow = MAX(SelectRow, siY.nMin)
                         ELSE                               ' Scroll bar clicked
                             siY.nPos = siY.nPos - siY.nPage + 1
                         END IF
                    CASE %SB_THUMBTRACK
                        Res& = GetScrollInfo(CBHNDL, %SB_VERT, siY)
                        siY.nPos   = siY.nTrackPos
                    CASE ELSE              : EXIT FUNCTION
                END SELECT
                VScrollNotify = -1
                ' Ensure that position is within range
                siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
                ' Update vertical scroll bar
                Res& = SetScrollInfo(CBHNDL, %SB_VERT, siY, %TRUE)
                GetClientRect CBHNDL, rc : Rc.nTop = HeaderHeight
                InvalidateRect CBHNDL, rc , %FALSE
                EXIT FUNCTION
                '
            CASE %WM_HSCROLL
                SetFocus CBHNDL
                IF ISTRUE EditFlag THEN CALL FinishEdit
                HeadEditFlag = %FALSE
    
                SELECT CASE LOWRD(CBWPARAM)
                    CASE %SB_LEFT : siX.nPos = siX.nMin :IF HScrollNotify = %SB_LEFT THEN SelectCol = siX.nMin +1 ' Home
                    CASE %SB_RIGHT : siX.nPos = siX.nMax : siX.nPage = 3 : IF HScrollNotify = %SB_RIGHT THEN SelectCol = siX.nMax - 1' End
                    CASE %SB_LINELEFT
                        IF HScrollNotify = %SB_LINELEFT THEN ' Left key pressed
                            IF SelectCol > 1 THEN DECR SelectCol
                            IF SelectCol < siX.nPos + 1 THEN DECR siX.nPos
                        ELSE                       ' Scroll bar clicked
                            DECR siX.nPos
                        END IF
                    CASE %SB_LINERIGHT
                        IF HScrollNotify = %SB_LINERIGHT THEN ' Right key pressed
                            IF SelectCol < Columns-1 THEN INCR SelectCol
                            IF SelectCol > siX.nPos + siX.nPage - 2 THEN INCR siX.nPos
                        ELSE                       ' Scroll bar clicked
                            INCR siX.nPos
                        END IF
                    CASE %SB_PAGELEFT      : siX.nPos = MIN(siX.nPos - siX.nPage + 2 , siX.nPos - 1)
                    CASE %SB_PAGERIGHT     : siX.nPos = MAX(siX.nPos + siX.nPage - 2 , siX.nPos + 1)
                    CASE %SB_THUMBTRACK
                        Res& = GetScrollInfo(CBHNDL, %SB_HORZ, siX)
                        siX.nPos   = siX.nTrackPos
                    CASE ELSE              : EXIT FUNCTION
                END SELECT
                HScrollNotify = -1
                ' Ensure that position is within range
                siX.nPos = MAX&(siX.nMin, MIN&(siX.nPos, siX.nMax - siX.nPage + 1))
                ' Update horizontal scroll bar
                Res& = SetScrollInfo(CBHNDL, %SB_HORZ, siX, %TRUE)
                InvalidateRect CBHNDL, BYVAL %NULL, %FALSE
                UpdateWindow CBHNDL
                EXIT FUNCTION
                '
            CASE %WM_CHAR ' Any character key at time of pressing
                          ' This is the starting signal for editing a cell.
                ' Before starting: End any previous editing.
                SetFocus CBHNDL
                IF ISTRUE EditFlag THEN CALL FinishEdit
                HeadEditFlag = %FALSE
    
                SELECT CASE CBWPARAM
                    ' Exit if character is not relevant.
                    CASE %VK_TAB,%VK_LINEFEED, %VK_RETURN, 32 TO 255
                    CASE ELSE : FUNCTION = 0 : EXIT FUNCTION
                END SELECT
                ' First: If selected cell not in view, then scroll it into view.
                IF ISFALSE ColFlag OR ISFALSE RowFlag THEN
                    IF ISFALSE ColFlag THEN
                        siX.nPos = SelectCol - 1
                        siX.nPos = MAX&(siX.nMin, MIN&(siX.nPos, siX.nMax - siX.nPage + 1))
                        Res& = SetScrollInfo(CBHNDL, %SB_HORZ, siX, %TRUE)
                    END IF
                    IF ISFALSE RowFlag THEN
                        siY.nPos = SelectRow
                        siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
                        Res& = SetScrollInfo(CBHNDL, %SB_VERT, siY, %TRUE)
                    END IF
                    InvalidateRect CBHNDL, BYVAL %NULL, %FALSE
                    UpdateWindow CBHNDL
                END IF
                '
                ' Identify character and perform relevant action.
                SELECT CASE CBWPARAM
                    CASE %VK_TAB
                        HScrollNotify = %SB_LINERIGHT
                        SendMessage CBHNDL,%WM_HSCROLL,MAKLNG(HScrollNotify,0),0
                        FUNCTION = 0 : EXIT FUNCTION
                    CASE %VK_LINEFEED, %VK_RETURN
                        VScrollNotify = %SB_LINEDOWN
                        SendMessage CBHNDL,%WM_VSCROLL,MAKLNG(VScrollNotify,0),0
                        FUNCTION = 0 : EXIT FUNCTION
                    CASE 32 TO 255 ' Character codes
                        ' Move edit window to selected cell and display it there.
                        MoveWindow hEdit&,x1+6,y1+2,x2-x1-9,y2-y1-3,1
                        ShowWindow hEdit&, %SW_SHOW
                        SetFocus hEdit&
                        ' Set current character as the first in the edit control.
                        CONTROL SET TEXT CBHNDL,%ID_EDITCHILD,CHR$(CBWPARAM)
                        SendMessage hEdit,%EM_SETSEL,0,-1 ' Set caret
                        SendMessage hEdit,%EM_SETSEL,-1,1 ' to end of string.
                        EditFlag = %TRUE
                END SELECT
                FUNCTION = 0 : EXIT FUNCTION
                '
            CASE %WM_KEYDOWN
                SetFocus CBHNDL
                IF ISTRUE EditFlag THEN CALL FinishEdit
                HeadEditFlag = %FALSE
    
                ' Process arrow keys etc. for grid. hGrid& needs to have focus.
                VScrollNotify = -1 : HScrollNotify = -1
                SELECT CASE CBWPARAM
                    CASE %VK_UP    : VScrollNotify = %SB_LINEUP
                    CASE %VK_DOWN  : VScrollNotify = %SB_LINEDOWN
                    CASE %VK_LEFT  : HScrollNotify = %SB_LINELEFT
                    CASE %VK_RIGHT : HScrollNotify = %SB_LINERIGHT
                    CASE %VK_PRIOR : VScrollNotify = %SB_PAGEUP
                    CASE %VK_NEXT  : VScrollNotify = %SB_PAGEDOWN
                    CASE %VK_HOME  : VScrollNotify = %SB_TOP    : HScrollNotify = %SB_LEFT
                    CASE %VK_END   : VScrollNotify = %SB_BOTTOM : HScrollNotify = %SB_RIGHT
                    '
                    CASE %VK_F2    ' Function key F2: Activate a cell for editing
                        ' If selected cell not in view then scroll it into view
                        IF ISFALSE ColFlag OR ISFALSE RowFlag THEN
                            IF ISFALSE ColFlag THEN
                                siX.nPos = SelectCol - 1
                                siX.nPos = MAX&(siX.nMin, MIN&(siX.nPos, siX.nMax - siX.nPage + 1))
                                Res& = SetScrollInfo(CBHNDL, %SB_HORZ, siX, %TRUE)
                            END IF
                            IF ISFALSE RowFlag THEN
                                siY.nPos = SelectRow
                                siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
                                Res& = SetScrollInfo(CBHNDL, %SB_VERT, siY, %TRUE)
                            END IF
                            InvalidateRect CBHNDL, BYVAL %NULL, %FALSE
                            UpdateWindow CBHNDL
                        END IF
                        '
                        ' Move edit window to selected cell and display it there.
                        MoveWindow hEdit&,x1+6,y1+2,x2-x1-9,y2-y1-3,1
                        ShowWindow hEdit&, %SW_SHOW
                        SetFocus hEdit&
                        ' Set current cell text in the edit control.
                        SetWindowText hEdit, BYVAL STRPTR(DataArray(SelectCol,SelectRow))
                        SendMessage hEdit,%EM_SETSEL,0,-1 ' Set caret
                        SendMessage hEdit,%EM_SETSEL,-1,1 ' to end of string.
                        EditFlag = %TRUE
                        CorrectFlag = %TRUE
                        FUNCTION = 0 : EXIT FUNCTION
                    CASE ELSE      : FUNCTION = 0 : EXIT FUNCTION
                END SELECT
                '
                IF VScrollNotify > -1 THEN SendMessage CBHNDL,%WM_VSCROLL,MAKLNG(VScrollNotify,0),0
                IF HScrollNotify > -1 THEN SendMessage CBHNDL,%WM_HSCROLL,MAKLNG(HScrollNotify,0),0
                '
            CASE %WM_LBUTTONDBLCLK ' Not used
            CASE %WM_LBUTTONDOWN   ' Click to place selected cell at click position
                '
                SetFocus CBHNDL
                IF ISTRUE EditFlag THEN CALL FinishEdit
                HeadEditFlag = %FALSE
                '
                ' Get cursor position in client area.
                ptsCursor.x = LOWRD(CBLPARAM) : ptsCursor.y = HIWRD(CBLPARAM)
                '
                ' Get column index for cell corresponding to this point.
                IF ptsCursor.x < Colwidth(0) THEN ' Row header column
                    ' Prepare for editing of row header column cell.
                    SendMessage hEdit&,%WM_SETFONT,hFontBold,MAKLNG(%TRUE,0)
                    EditRow = siY.nPos + (ptsCursor.y - HeaderHeight) \ LineHeight
                    ' Move edit window to selected cell and display it there.
                    MoveWindow hEdit&,3,HeaderHeight+(EditRow-siY.nPos)*LineHeight+1,Colwidth(0)-6,LineHeight-3,1
                    ShowWindow hEdit&, %SW_SHOW
                    SetFocus hEdit&
                    ' Set current cell text in the edit control.
                    SetWindowText hEdit, BYVAL STRPTR(DataArray(0,EditRow))
                    SendMessage hEdit,%EM_SETSEL,0,-1 ' Set caret
                    SendMessage hEdit,%EM_SETSEL,-1,1 ' to end of string.
                    RowHeaderEditFlag = %TRUE
                    EditFlag = %TRUE
                    CorrectFlag = %TRUE
                    FUNCTION = 0 : EXIT FUNCTION
                ELSE                              ' Column one and beyond
                    LOCAL kk&,jj& : kk=Colwidth(0) : jj = siX.nPos + 1
                    DO WHILE kk < ptsCursor.x AND jj < Columns
                        kk = kk + Colwidth(jj) : INCR jj
                    LOOP
                    SelectCol = jj - 1
                END IF
                '
                ' Get row index for cell corresponding to this point.
                SelectRow = siY.nPos + (ptsCursor.y - HeaderHeight) \ LineHeight
                '
                InvalidateRect CBHNDL, BYVAL %NULL, %FALSE
                '
            CASE %WM_PAINT
                '
                ' Draw grid
                STATIC PrevX AS LONG
                IF siX.nPos <> PrevX OR ISTRUE HeadEditFlag THEN ' Horizontal scrolling has taken place
                    ' Then update header items
                    FOR i& = 0 TO MIN(siX.nPage + 20, Columns)
                        IF i = 0 THEN idx = 0 ELSE idx = siX.nPos
                        IF i + idx >= Columns THEN
                            s ="  "
                            headitem.cxy = 2000 ' set very wide extra column
                        ELSE
                            s = FORMAT$(i+idx)+"   "+DataArray(i+idx,0)
                            IF i = 0 THEN s = DataArray(i+idx,0)
                            headitem.cxy = ColWidth(i+idx)
                        END IF
                        headitem.pszText = VARPTR(s)
                        headitem.cchTextMax = LEN(headitem.pszText)
                        SendMessage hHead&, %HDM_SETITEM, i&, VARPTR(headitem)
                    NEXT
                END IF
                PrevX = siX.nPos
                '
                GetClientRect CBHNDL,rc
                rc.nTop = HeaderHeight
                Res&=FillRect(memDCgr, rc, GetStockObject(%WHITE_BRUSH))
                GetClientRect CBHNDL,rc2
                rc2.nTop = HeaderHeight
                TextHeight = 0 : j = 0
                CellFlag = %FALSE : RowFlag = %FALSE : ColFlag = %FALSE
                '
                ' Row loop
                DO WHILE (TextHeight < rc.nBottom - rc.nTop) AND (j + siY.nPos <= Rows)
                    '
                    INCR j : TextHeight = TextHeight + LineHeight
                    ColStart = 0 : i = 0
                    '
                    ' Column loop
                    DO WHILE (ColStart < rc.nRight) AND (i + siX.nPos <= Columns)
    
                        LOCAL cowi&
                        IF i = 0 THEN idx = 0 ELSE idx = siX.nPos
                        cowi = ColWidth(i + idx) : k = 2
                        IF ColStart + cowi > rc.nRight THEN cowi =  rc.nRight - ColStart
                        IF cowi <= 0 THEN EXIT DO
                        '
                        ' Paint row header column and draw vertical lines
                        IF j = 1 THEN         ' First line
                            IF i = 0 THEN     ' Row header column: Paint it light gray
                                rc2.nRight = cowi
                                Res&=FillRect(memDCgr, rc2, GetStockObject(%LTGRAY_BRUSH))
                            ELSE              ' Other columns: Draw vertical lines
                                IF i = 1 THEN ' Select black pen for row header column's right side
                                    SelectObject memDCgr, GetStockObject(%BLACK_PEN)
                                ELSE          ' Select grey pen for other columns
                                    SelectObject memDCgr, hGrayPen
                                END IF
                                MoveToEx memDCgr, ColStart, HeaderHeight, BYVAL %NULL
                                LineTo memDCgr, Colstart, rc.nBottom
                            END IF
                        END IF
                        '
                        ' Get array indices, select font and colors for text and background.
                        LOCAL xx&,yy&
                        IF i = 0 THEN ' Row header column
                            ' Get indices for cell
                            xx = 0 : yy = j + siY.nPos - 1
                            ' Get text from array
                            s = FORMAT$(yy)+"   "+DataArray(xx,yy)
                            SelectObject memDCgr, hFontBold
                            SetBkColor memDCgr,%LTGRAY
                            ' Make button appearance of row headers
                            SelectObject memDCgr, GetStockObject(%WHITE_PEN)
                            MoveToEx memDCgr, 1, HeaderHeight+j*LineHeight-2, BYVAL %NULL
                            LineTo memDCgr, 1, HeaderHeight+(j-1)*LineHeight
                            LineTo memDCgr, cowi-1, HeaderHeight+(j-1)*LineHeight
                            SelectObject memDCgr, hGrayPen
                            LineTo memDCgr, cowi-1, HeaderHeight+j*LineHeight-2
                            LineTo memDCgr, 0, HeaderHeight+j*LineHeight-2
                        ELSE          ' Other columns
                            ' Get indices for cell
                            xx = i + siX.nPos : yy = j + siY.nPos - 1
                            ' Selected column in display
                            IF xx = SelectCol THEN ColFlag = %TRUE
                            ' Get text from array
                            s = DataArray(xx,yy)
                            SelectObject memDCgr, hFont
                            SetBkColor memDCgr,%WHITE
                        END IF
                        '
                        ' Determine if selected item is here. If so determine its rectangle.
                        IF yy = SelectRow THEN     ' Selected row in display
                            RowFlag = %TRUE
                            IF xx = SelectCol THEN ' Selected cell in display
                                x1 = MAX(1,Colstart) : x2 = MIN(Colstart + Cowi, rc.nRight-2)
                                y1 = HeaderHeight+(j-1)*LineHeight-1
                                y2 = MIN(HeaderHeight+j*LineHeight-1,rc.nBottom-2)
                                CellFlag = %TRUE
                            END IF
                        END IF
                        '
                        ' Add "..." to truncated entries
                        GetTextMetrics memDCgr, tm
                        GetTextExtentPoint32 memDCgr, s, LEN(s), lpSize
                        LOCAL Space AS LONG
                        Space = cowi - Spacing - 3
                        DO WHILE Space < lpSize.cx
                            chrs = cowi / tm.tmAveCharWidth
                            IF k>=chrs THEN s = "..." : EXIT DO
                            s = LEFT$(s,chrs-k)+"..."
                            GetTextExtentPoint32 memDCgr, s, BYVAL LEN(s), lpSize
                            INCR k
                        LOOP
                        '
                        ' Write cell text
                        TextOut memDCgr, (ColStart+Spacing), _
                        (HeaderHeight+1+(j-1)*LineHeight), s, BYVAL LEN(s)
                        '
                        ' Prepare to draw next column
                        ColStart = ColStart + ColWidth(i + idx)
                        INCR i
                        '
                    LOOP ' End of column loop
                    '
                    ' Finished with row: Draw horizontal line
                    ' Row header part: black
                    SelectObject memDCgr, GetStockObject(%BLACK_PEN)
                    MoveToEx memDCgr, 0, HeaderHeight+j*LineHeight-1, BYVAL %NULL
                    LineTo memDCgr, rc2.nRight, HeaderHeight+j*LineHeight-1
                    ' Remaining part: gray
                    SelectObject memDCgr, hGrayPen
                    LineTo memDCgr, rc.nRight, HeaderHeight+j*LineHeight-1
                    '
                LOOP ' End of row loop
                '
                ' If selected item is in display window, then show it.
                IF CellFlag THEN
                    SelectObject memDCgr, hFatPen
                    MoveToEx memDCgr,x1,y1,BYVAL %NULL : LineTo memDCgr,x2,y1
                    LineTo memDCgr,x2,y2 : LineTo memDCgr,x1,y2 : LineTo memDCgr,x1,y1
                END IF
                '
                IF i <= Columns THEN
                    ' Update number of columns in a displayed page
                    PageColumns = i
                    ' Update horizontal scroll bar accordingly
                    siX.nPage  = PageColumns
                    siX.nPos = MAX&(siX.nMin, MIN&(siX.nPos, siX.nMax - siX.nPage + 1))
                    SetScrollInfo CBHNDL, %SB_HORZ, siX, %TRUE
                END IF
                '
                hDCgr = BeginPaint(CBHNDL, Ps)
                '
                ' Copy virtual grid window onto screen.
                Res& = BitBlt(hDCgr,0,HeaderHeight,Rc.nRight,Rc.nBottom,memDCgr,0,HeaderHeight,%SRCCOPY)
                '
                EndPaint CBHNDL, Ps
                '
            CASE %WM_NOTIFY
                IF LOWRD(CBWPARAM) = %FORM1_HEADER THEN
                    hdnptr = CBLPARAM
                    hdiptr = @hdnptr.pitem
                    SELECT CASE @hdnptr.hdr.code
                        CASE %HDN_TRACK ' May be replaced by %HDN_ENDTRACK
                            IF ISTRUE EditFlag THEN CALL FinishEdit
                            GetClientRect CBHNDL,Rc
                            @hdiptr.cxy = MAX(MinWidth,@hdiptr.cxy)
                            IF @hdnptr.iItem = 0 THEN idx = 0 ELSE idx = siX.nPos
                            ColWidth(@hdnptr.iItem + idx) = @hdiptr.cxy
                            rc.nTop = HeaderHeight
                            InvalidateRect CBHNDL, rc, %FALSE
                            '
                        CASE %HDN_ITEMCLICK ' Column header clicked: Edit column header cell.
                            IF ISTRUE EditFlag THEN CALL FinishEdit
                            IF @hdnptr.iItem = 0 THEN idx = 0 ELSE idx = siX.nPos + 1
                            y1 = 0 : y2 = HeaderHeight
                            IF idx = 0 THEN
                                x1 = 0 : x2 = ColWidth(0)
                            ELSE
                                i& = ColWidth(0)
                                FOR j& = idx TO @hdnptr.iItem + idx - 1
                                    i& = i& + ColWidth(j&)
                                NEXT
                                x2 = i& : x1 = i& - ColWidth(@hdnptr.iItem + idx-1)
                            END IF
                            SendMessage hEdit&,%WM_SETFONT,hFontBold,MAKLNG(%TRUE,0)
                            ' Move edit window to selected column header and display it there.
                            MoveWindow hEdit&,x1+4,y1+1,x2-x1-7,y2-y1-4,1
                            ShowWindow hEdit&, %SW_SHOW
                            SetFocus hEdit&
                            ' Set column header text in the edit control.
                            idx = MAX(1,idx) : HeadCol = @hdnptr.iItem + idx-1
                            SetWindowText hEdit, BYVAL STRPTR(DataArray(HeadCol,0))
                            SendMessage hEdit,%EM_SETSEL,0,-1 ' Set caret
                            SendMessage hEdit,%EM_SETSEL,-1,1 ' to end of string.
                            EditFlag = %TRUE
                            CorrectFlag = %TRUE
                            HeadEditFlag = %TRUE
                        CASE %HDN_ITEMDBLCLICK ' not used
                        CASE ELSE
                    END SELECT
                END IF
                '
            CASE %WM_SIZE
                '
                SetFocus CBHNDL
                IF ISTRUE EditFlag THEN CALL FinishEdit
                GetClientRect CBHNDL, rc
                ' Get new estimates of size variables for grid display
                PageRows = (Rc.nBottom - HeaderHeight) \ LineHeight
                PageColumns = Rc.nRight \ Colwidth(Columns-1) + 1
                '
                ' Update scroll bars
                siY.nPage = PageRows
                siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
                SetScrollInfo CBHNDL, %SB_VERT, siY, %TRUE
                siX.nPage = PageColumns
                siX.nPos = MAX&(siX.nMin, MIN&(siX.nPos, siX.nMax - siX.nPage + 1))
                SetScrollInfo CBHNDL, %SB_HORZ, siX, %TRUE
                '
                ' (re)size header according to dimensions of grid window
                layout.prc = VARPTR(rc)
                layout.pwpos = VARPTR(winpos)
                Res& = Header_Layout(hHead&, layout) ' make header layout
                HeaderHeight = winpos.cy             ' save height of header
                MoveWindow hHead&, winpos.x, winpos.y-1,winpos.cx, winpos.cy+1, 1
                '
                ' (re)create the virtual window
                IF memDCgr THEN DeleteDC memDCgr
                IF hBitGr  THEN DeleteObject hBitGr
                hDCgr = GetDC(CBHNDL)
                memDCgr = CreateCompatibleDC(hDCgr)
                hBitGr = CreateCompatibleBitmap(hDCgr,Rc.nRight,Rc.nBottom)
                SelectObject memDCgr, hBitGr
                SelectObject memDCgr, hFont
                Res& = PatBlt(memDCgr, 0, 0, Rc.nRight, Rc.nBottom, %PATCOPY)
                InvalidateRect CBHNDL, rc, %FALSE
                '
            CASE %WM_DESTROY
                '
                IF ISTRUE EditFlag THEN CALL FinishEdit
                IF hGrayPen THEN DeleteObject hGrayPen
                IF hLightGrayPen THEN DeleteObject hLightGrayPen
                IF hFatPen THEN DeleteObject hFatPen
                IF hFont THEN DeleteObject hFont
                IF hFontBold THEN DeleteObject hFontBold
                IF memDCgr THEN DeleteDC memDCgr
                IF hBitGr  THEN DeleteObject hBitGr
                ' Important! Remove the subclassing
                SetWindowLong hEdit&, %GWL_WNDPROC, gOldSubClassEdit&
                '
        END SELECT
        ' Pass unprocessed messages on to the default handler
        FUNCTION = DefWindowProc(CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
        '
    END FUNCTION
    '
    CALLBACK FUNCTION SubClassEditKeys
        ' Subclass callback function for processing key messages for edit control.
        LOCAL res AS DWORD, i&,j&,k&,t$
        '
        SELECT CASE CBMSG
            '
            CASE %WM_CHAR
                SELECT CASE CBWPARAM ' Holds the code.
                    ' Specify what action should be taken.
                    CASE %VK_RETURN,%VK_LINEFEED ' End editing of cell and move one cell down
                        CALL FinishEdit
                        IF ISFALSE HeadEditFlag AND RowHeaderEditFlag <> 2 THEN
                            RowHeaderEditFlag = %FALSE
                            VScrollNotify = %SB_LINEDOWN
                            SendMessage hGrid&,%WM_VSCROLL,MAKLNG(VScrollNotify,0),0
                        END IF
                        HeadEditFlag = %FALSE : RowHeaderEditFlag = %FALSE : EXIT FUNCTION
                    CASE %VK_TAB                 ' End editing of cell and move one cell right
                        CALL FinishEdit
                        IF ISFALSE HeadEditFlag AND RowHeaderEditFlag <> 2 THEN
                            RowHeaderEditFlag = %FALSE
                            HScrollNotify = %SB_LINERIGHT
                            SendMessage hGrid&,%WM_HSCROLL,MAKLNG(HScrollNotify,0),0
                        END IF
                        HeadEditFlag = %FALSE : RowHeaderEditFlag = %FALSE : EXIT FUNCTION
                    CASE %VK_ESCAPE              ' Cancel edit: leave original cell text unchanged
                        EditFlag = %FALSE : CorrectFlag = %FALSE : HeadEditFlag = %FALSE : RowHeaderEditFlag = %FALSE
                        ShowWindow hEdit&, %SW_HIDE
                        SetFocus hGrid&
                        InvalidateRect hGrid&,BYVAL %NULL, %FALSE
                        EXIT FUNCTION
                    CASE ELSE ' No action to be taken here for characters. They are being taken care of within the edit control.
                END SELECT
                '
            CASE %WM_KEYDOWN
                SELECT CASE CBWPARAM
                    CASE %VK_DELETE,%VK_LEFT,%VK_RIGHT
                    CASE ELSE
                        IF ISTRUE HeadEditFlag OR RowHeaderEditFlag = 1 THEN FUNCTION = 0 : EXIT FUNCTION
                END SELECT
                VScrollNotify = -1 : HScrollNotify = -1
                SELECT CASE CBWPARAM
                    CASE %VK_DELETE
                        IF ISTRUE CorrectFlag THEN ' Remove character right of caret
                            res = SendMessage(hEdit, %EM_GETSEL, 0, 0)
                            j = HIWRD(res)                     ' Caret position
                            CONTROL GET TEXT hGrid&,%ID_EDITCHILD TO t
                            t = LEFT$(t,j)+MID$(t,j+2)
                            CONTROL SET TEXT hGrid&,%ID_EDITCHILD,t
                            SendMessage hEdit, %EM_SETSEL, j,j ' Reset caret
                            FUNCTION = 0 : EXIT FUNCTION
                        END IF
                    CASE %VK_UP    : VScrollNotify = %SB_LINEUP
                    CASE %VK_DOWN  : VScrollNotify = %SB_LINEDOWN
                    CASE %VK_LEFT
                        IF ISTRUE CorrectFlag THEN ' Move caret left
                            res = SendMessage(hEdit, %EM_GETSEL, 0, 0)
                            j = MAX(HIWRD(res)-1,0) ' Caret is at the (upper limit of the) selection
                            SendMessage hEdit, %EM_SETSEL, j,j  ' Set caret at new position
                            FUNCTION = 0 : EXIT FUNCTION
                        ELSE                       ' Move to next cell to the left
                            HScrollNotify = %SB_LINELEFT
                        END IF
                    CASE %VK_RIGHT
                        IF ISTRUE CorrectFlag THEN ' Move caret right
                            k = SendMessage(hEdit, %EM_LINELENGTH, 0, 0)
                            res = SendMessage(hEdit, %EM_GETSEL, 0, 0)
                            j = MIN(HIWRD(res)+1,k)
                            SendMessage hEdit, %EM_SETSEL, j,j
                            FUNCTION = 0 : EXIT FUNCTION
                        ELSE                       ' Move to next cell to the right
                            HScrollNotify = %SB_LINERIGHT
                        END IF
                    CASE %VK_PRIOR : VScrollNotify = %SB_PAGEUP
                    CASE %VK_NEXT  : VScrollNotify = %SB_PAGEDOWN
                    CASE %VK_HOME  : VScrollNotify = %SB_TOP    : HScrollNotify = %SB_LEFT
                    CASE %VK_END   : VScrollNotify = %SB_BOTTOM : HScrollNotify = %SB_RIGHT
                    CASE ELSE      : FUNCTION = 0 : EXIT FUNCTION
                END SELECT
                '
                IF VScrollNotify > -1 THEN SendMessage hGrid&,%WM_VSCROLL,MAKLNG(VScrollNotify,0),0
                IF HScrollNotify > -1 THEN SendMessage hGrid&,%WM_HSCROLL,MAKLNG(HScrollNotify,0),0
                '
        END SELECT
        ' Pass the message on to the original window procedure.
        FUNCTION = CallWindowProc(gOldSubClassEdit&, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
    END FUNCTION
    '
    SUB FinishEdit
        LOCAL HScrollNotify AS LONG
        IF ISTRUE HeadEditFlag THEN
            CONTROL GET TEXT hGrid&,%ID_EDITCHILD TO DataArray(HeadCol,0)
        ELSEIF RowHeaderEditFlag = 1 THEN
            CONTROL GET TEXT hGrid&,%ID_EDITCHILD TO DataArray(0,EditRow)
            RowHeaderEditFlag = 2
        ELSE
            CONTROL GET TEXT hGrid&,%ID_EDITCHILD TO DataArray(SelectCol,SelectRow)
        END IF
        EditFlag = %FALSE
        CorrectFlag = %FALSE
        SendMessage hEdit&,%WM_SETFONT,hFont,MAKLNG(%TRUE,0) ' normal font (default)
        ShowWindow hEdit&, %SW_HIDE
        SetFocus hGrid&
        InvalidateRect hGrid&,BYVAL %NULL, %FALSE
        UpdateWindow hGrid&
    END SUB
    '
    '******************************************************************************
    '** Program Main Part *********************************************************
    '******************************************************************************
    ' ----------------------------------------------------------
    %Form1_FILE                                     = 500
    ' ----------------------------------------------------------
    %Form1_DEFAULT                                  = 505
    %Form1_OPENFILE                                 = 510
    %Form1_SAVEAS                                   = 515
    %Form1_SEPARATOR_524                            = 524
    %Form1_EXIT                                     = 525
    ' ----------------------------------------------------------
    %Form1_HELP                                     = 700
    ' ----------------------------------------------------------
    %Form1_HELP1                                    = 705
    %Form1_ABOUT                                    = 710
    
    DECLARE FUNCTION InitApplication() AS LONG
    DECLARE FUNCTION InitInstance(LONG) AS LONG
    GLOBAL g_szClassName AS ASCIIZ * 32
    GLOBAL hForm1&    ' Dialog handle
    GLOBAL hForm1_Menu0&
    GLOBAL hForm1_Menu1&
    GLOBAL hForm1_Menu3&
    GLOBAL PAFU AS STRING     ' path and file for input
    GLOBAL PAFUout AS STRING  ' path and file for output
    GLOBAL Delim AS STRING    ' Delimiter for saving and loading files
                              ' Set to $TAB (=CHR$(9)) in this program.
                              ' You may change this.
    '*******************************************************************************
    FUNCTION WINMAIN (BYVAL hInstance     AS LONG, _
                      BYVAL hPrevInstance AS LONG, _
                      lpCmdLine           AS ASCIIZ PTR, _
                      BYVAL nCmdShow      AS LONG) AS LONG
        LOCAL Msg AS tagMSG
        ' Initialize the common control library
        CALL InitComCtl32()
        IF (ISFALSE(InitApplication())) THEN FUNCTION = %False : EXIT FUNCTION
        IF (ISFALSE(InitInstance(nCmdShow))) THEN FUNCTION = %False : EXIT FUNCTION
        ' Create menu
        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_524, %MF_ENABLED
        MENU ADD STRING, hForm1_Menu1&, "E&xit",  %Form1_EXIT, %MF_ENABLED
        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&
        ShowWindow hForm1&, nCmdShow
        UpdateWindow hForm1&
        ' Create message loop
        WHILE GetMessage(Msg, %NULL, 0, 0)
            TranslateMessage Msg
            DispatchMessage Msg
        WEND
        FUNCTION = msg.wParam
    END FUNCTION
    '*******************************************************************************
    FUNCTION InitApplication() AS LONG
        LOCAL wcex AS WNDCLASSEX
        g_szClassName      = "GridClass"
        wcex.cbSize        = SIZEOF(wcex)
        wcex.style         = %CS_HREDRAW OR %CS_VREDRAW OR %CS_DBLCLKS OR %CS_GLOBALCLASS
        wcex.lpfnWndProc   = CODEPTR(MainWndProc)
        wcex.cbClsExtra    = 0
        wcex.cbWndExtra    = 0
        wcex.hInstance     = GetModuleHandle(BYVAL %NULL)
        wcex.hCursor       = LoadCursor( %NULL, BYVAL %IDC_ARROW )
        wcex.hbrBackground = GetStockObject(%LTGRAY_BRUSH)
        wcex.lpszMenuName  = %NULL
        wcex.lpszClassName = VARPTR( g_szClassName )
        wcex.hIcon         = LoadIcon( %NULL, BYVAL %IDI_APPLICATION )
        wcex.hIconSm       = LoadIcon( %NULL, BYVAL %IDI_APPLICATION )
        FUNCTION = RegisterClassEx (wcex)
    END FUNCTION
    '*******************************************************************************
    FUNCTION InitInstance(nCmdShow AS LONG) AS LONG
        LOCAL szTitle AS ASCIIZ * 64
        szTitle = "Header Based Grid Control With Cell Editing"
        hForm1& = CreateWindowEx(  0, _
                                g_szClassName, _
                                szTitle, _
                                %WS_BORDER OR %WS_DLGFRAME OR %WS_THICKFRAME OR %WS_CAPTION OR _
                                %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX _
                                OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
                                %DS_NOFAILCREATE OR %DS_SETFONT OR %CS_HREDRAW AND %CS_VREDRAW, _
                                %CW_USEDEFAULT, _
                                %CW_USEDEFAULT, _
                                %CW_USEDEFAULT, _
                                %CW_USEDEFAULT, _
                                BYVAL %NULL, _
                                BYVAL %NULL, _
                                GetModuleHandle(BYVAL %NULL), _
                                BYVAL %NULL)
        IF (ISFALSE(hForm1&)) THEN FUNCTION = %False : EXIT FUNCTION
        FUNCTION = %True
    END FUNCTION
    '
    SUB ResizeControls(BYVAL X AS LONG,BYVAL Y AS LONG)
        ' In this routine the positions and sizes of all controls
        ' are specified as proportions (~percentages) of the dialog
        ' X and Y dimensions. Imagine when doing the design that the
        ' dialog area is 100 x 100 in percent. Define the position and
        ' size of the controls according to this area. When resizing is
        ' done, the proportions (~percentages) defining each control are
        ' never changed - only X and Y (defining the absolute size of the
        ' dialog) are changed.
        '
        ' Variables defining position and size of each control in turn
        LOCAL Xp& ' Horizontal position (upper-left corner)
        LOCAL Yp& ' Vertical position   (upper-left corner)
        LOCAL W&  ' Width
        LOCAL H&  ' Height
        '
        SendMessage hForm1&, %WM_SETREDRAW, %FALSE, BYVAL %NULL ' Disable redraw temporarily to reduce flicker.
        ' Resize GRID.
        Xp = .01*X : Yp = .001*Y : W = .98*X : H = .91*Y
        ' Adjust height to avoid clipping of last line of grid.
        H = (H - HeaderHeight - GetSystemMetrics(%SM_CYHSCROLL)) \ LineHeight
        H = H * LineHeight + HeaderHeight + GetSystemMetrics(%SM_CYHSCROLL) + 2
        MoveWindow hGrid&,Xp,Yp,W,H,%TRUE
        SendMessage hForm1&, %WM_SETREDRAW, %TRUE, BYVAL %NULL ' enable redraw
    END SUB
    ' --------------------------------------------------------------------------
    SUB Form1_DEFAULT_Select() ' Produce default data set.
        LOCAL I&,hDC&
        LOCAL lpSize AS SIZEL
        LOCAL st AS ASCIIZ * 250
        LOCAL s AS STRING
        LOCAL PI2 AS DOUBLE
        PI2 = ATN(1) * 8 ' two PI
        ' Make default test data set.
        DATA "Rec. - ID ","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=8 ' number of columns
        Rows=1000   ' number of rows
        RESET DataArray() : RESET ColWidth()
        REDIM DataArray(0:Columns+1,0:Rows)' Column zero and row zero are used for headers.
        REDIM ColWidth(0:Columns+1)
        hDC = GetDC(hHead&)
        FOR I&=0 TO Columns + 1
            IF I&<= Columns THEN
                 DataArray(I&,0) = READ$(I&+1)
                 IF I& = 0 THEN st = "" ELSE st = FORMAT$(I&)+"   "
                 st = st + DataArray(I&,0)
                 GetTextExtentPoint32 hDC, st, LEN(st), lpSize
                 ColWidth(I&) = lpSize.cx + 10'tot' + 20 'lpSize.cx + 20
            ELSE
                 ColWidth(I&) = 2000
            END IF
        NEXT
        ReleaseDC hHead&, hDC
        INCR Columns ' Provide for one extra visible empty column
        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&)=CHR$(RND(65,90))+"."+CHR$(RND(65,90))+"."+CHR$(RND(65,90))+"."
            DataArray(1,I&)=LTRIM$(STR$(ROUND(SQR(-2*LOG(RND))*COS(PI2*RND)*17+84,1)))
            DataArray(2,I&)=LTRIM$(STR$(ROUND(SQR(-2*LOG(RND))*COS(PI2*RND)*18+182,1)))
            DataArray(3,I&)=LTRIM$(STR$(ROUND(VAL(DataArray(1,I&))*10000/VAL(DataArray(2,I&))^2,1)))
            DataArray(4,I&)=LTRIM$(STR$(RND(38,80)/10+ROUND(VAL(DataArray(3,I&)),0)/10))
            DataArray(5,I&)=LTRIM$(STR$(RND(19,70)/10+ROUND(VAL(DataArray(3,I&)),0)/10))
            DataArray(6,I&)=LTRIM$(STR$(ROUND(RND(-41,20)/3+VAL(DataArray(3,I&))*2.1,0)))
            DataArray(7,I&)=LTRIM$(STR$(ROUND(RND(95,160)+VAL(DataArray(3,I&)),0)))
            DataArray(8,I&)=LTRIM$(STR$(ROUND(RND(45,80)+VAL(DataArray(3,I&)),0)))
        NEXT
    '    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
        SendMessage hGrid&,%WM_CREATE,0,0 ' Force updating: (re-)creation of grid
    END SUB
    ' ------------------------------------------------
    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 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.
           ' Save the data - one row at a time
           FOR j&=0 TO Rows
               FOR i&=0 TO Columns-1
                   PRINT# hFile, DataArray(i&,j&);
                   ' Put delimiter after each field except the last.
                   IF i&<Columns-1 THEN  PRINT# hFile,Delim;
               NEXT
               PRINT# hFile, $CRLF; ' End the 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 hFile  AS LONG
       LOCAL b$,i&,j&,x&,k&
       LOCAL hDC&
       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
          '
          ' On crude checking file seems OK. Now read the file from start to end.
          hFile = FREEFILE
          OPEN PAFU FOR INPUT AS hFile
          Columns=x&-1 ' number of columns (subtract one to adjust to base zero)
          '
          ' Redimension DataArray. Important to set the right number of columns
          ' prior to using REDIM PRESERVE
          REDIM DataArray(0:Columns+1,0:0)
          '
          ' Read data into DataArray - one row at a time
          ' The first row is assumed to be column headers
          Rows=-1
          DO WHILE NOT EOF(hFile)
              INCR Rows ' number of rows
              LINE INPUT# hFile, b$
              REDIM PRESERVE DataArray(0:Columns+1,0:Rows)
              FOR i&=0 TO Columns
                  DataArray(i&,Rows)=PARSE$(b$,Delim,i&+1) ' Parse index starts with 1
              NEXT
          LOOP
          CLOSE hFile
          '
          ' Set column widths to header item widths.
          hDC = GetDC(hHead&)
          LOCAL lpSize AS SIZEL
          LOCAL st AS ASCIIZ * 250
          FOR I&=0 TO Columns + 1
              IF I&<= Columns THEN
                 IF I& = 0 THEN st = "" ELSE st = FORMAT$(I&)+"   "
                 st = st + DataArray(I&,0)
                 GetTextExtentPoint32 hDC, st, LEN(st), lpSize
                 ColWidth(I&) = lpSize.cx + 10
              ELSE
                  ColWidth(I&) = 2000
             END IF
          NEXT
          ReleaseDC hHead&, hDC
          '
          INCR Columns ' Provide for one extra visible empty column
          '
          SendMessage hGrid&,%WM_CREATE,0,0  ' Force updating: (re-)creation of grid
          FUNCTION = 1
       END IF
    END FUNCTION
    '
    SUB Form1_OPENFILE_Select()
        IF FilNameOpen() THEN
            IF Rows>=2 THEN
                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_HELP1_Select()
        LOCAL St AS STRING
        St="Header based virtual grid control with cell editing "+$CRLF+$CRLF+ _
        "This version of the header based virtual grid control enables you to "+ _
        "edit individual cells as well as column and row headers. Like in "+ _
        "Excel new text is placed in the selected cell just by typing the text "+ _
        "on the keyboard. You end entering new text by pressing ENTER, TAB, by "+ _
        "moving the selected cell or by scrolling. Before ending you may "+ _
        "retrieve the old text by pressing ESCAPE. In harmony with Excel you "+ _
        "can perform full editing of a cell by pressing function key 2 (F2). "+ _
        "When editing is started in this way you can insert and delete "+ _
        "characters in any position."+$CRLF+$CRLF+ _
        "Editing of column and row headers is started by a mouse click. Full "+ _
        "editing is always possible and editing needs to be ended by pressing "+ _
        "ENTER or TAB. This arrangement makes it more difficult to "+ _
        "accidentally change the headers."+$CRLF+$CRLF+ _
        "In this version you can import files from Excel and other similar "+ _
        "programs if the files have been saved in TAB-separated text format. "+ _
        "You can also save the data in the grid control in TAB-separated text "+ _
        "format, which can be imported in Excel and most other programs."+$CRLF+$CRLF+ _
        "Thanks to the PowerBasic Forum for great inspiration."+$CRLF+$CRLF+ _
        "Good luck!"+$CRLF+$CRLF+ _
        "Erik Christensen ---- e.chr@email.dk "
        MSGBOX St,%MB_ICONINFORMATION,"Virtual grid control with cell editing"
    END SUB
    ' ------------------------------------------------
    SUB Form1_ABOUT_Select
        LOCAL St AS STRING
        St="Virtual grid control program with cell editing, import and export of TAB-separated text (ASCII) files for PB for Windows 7. Program version 1.0 - November 9, 2002"+$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 MainWndProc
        DIM MinMaxPtr AS MINMAXINFO PTR
        DIM hStatusBar AS STATIC DWORD
        DIM StatusText AS ASCIIZ * 250
        STATIC First AS LONG
        LOCAL rc AS RECT, i&,j&,Res&
        DIM StatusBarHeight AS STATIC LONG
        SELECT CASE CBMSG
            CASE %WM_CREATE
              IF First = 0 THEN
                ' Specification of size of Data Array.
                ' Start up data
                Rows=200
                Columns=30
                '
                ' Grid routines are made for arrays no less than (4,20)
                Columns=MAX(4,Columns)
                Rows=MAX(20,Rows)
                ' One empty column is being added.
                REDIM DataArray(0:Columns+1,0:Rows)' Column zero and row zero are used for headers.
                REDIM ColWidth(0:Columns+1) ' Each column may have it own width if you want that at some time.
                ' Fill array with data
                FOR i&=0 TO Columns + 1
                    IF i = 0 THEN ColWidth(i&) = 46 ELSE ColWidth(i&) = 130
                    IF i > Columns THEN ColWidth(i&) = 2000
                    FOR j&=0 TO Rows
                        IF i&=0 THEN      ' Column zero is used for row headers.
                            IF j&=0 THEN  ' Label of row header column.
                                DataArray(i&,j&)= "R\C"
                            ELSE     '    ' Text of row headers.
                               ' IF j<=Rows THEN DataArray(i&,j&)= format$(j&)
                            END IF
                        ELSE     ' i& >= 1
                            IF j&=0 THEN  ' Row zero is used for column headers.
                              '  IF i<= Columns THEN DataArray(i&,j&)= format$(i&)
                            ELSE ' j& >= 1  Item/subitem content
                                IF i& <= Columns AND j <= Rows THEN DataArray(i&,j&)= "Column"+STR$(i&)+" Row"+STR$(j&)
                            END IF
                        END IF
                    NEXT
                NEXT
                Columns = Columns + 1
              '  Rows = Rows
                '
                Res& = InitHeaderGridCtrl
                hGrid& = CreateWindow("HEADERGRID", BYVAL 0, %WS_VISIBLE OR _
                                       %WS_CHILD OR %WS_HSCROLL OR %WS_VSCROLL OR %WS_BORDER, _
                                      0,0,0,0,CBHNDL, %FORM1_GRID, GetModuleHandle(BYVAL %NULL), BYVAL 0)
                ' Adapt window to Work Area on screen (desktop).
                SystemParametersInfo %SPI_GETWORKAREA, 0, BYVAL VARPTR(Rc), 0
                MoveWindow CBHNDL, 0, 0, Rc.nRight - Rc.nLeft, Rc.nBottom - Rc.nTop, 0
                '
                ' The next few lines define a status bar.
                ' NB: The area of the status bar is subtracted from the available client area.
                GetClientRect CBHNDL, rc
                hStatusBar = CreateStatusWindow(%SBARS_SIZEGRIP OR %WS_CHILD OR %WS_VISIBLE OR %WS_CLIPSIBLINGS OR %CCS_BOTTOM, "", CBHNDL, 0)
                StatusText = " Dialog Size in pixels: X: "+FORMAT$(rc.nRight,"####")+"   Y: "+FORMAT$(rc.nBottom,"####")
                SendMessage hStatusBar, %WM_SETTEXT, 0, VARPTR(StatusText)
                GetClientRect hStatusBar, rc
                StatusBarHeight& = rc.nBottom
                ShowWindow hGrid&, %SW_SHOW
                First = 1
              END IF
                '
            CASE %WM_SIZE
                ' Get size of dialog after tracking.
                GetClientRect CBHNDL, rc
                ' Resize status bar
                MoveWindow hStatusBar, rc.nLeft,rc.nBottom-StatusBarHeight, _
                    rc.nRight - rc.nLeft, StatusBarHeight, %TRUE
                ' Perform proportional resizing of controls.
                CALL ResizeControls(rc.nRight,rc.nBottom)
                StatusText = " Dialog Size in pixels: X: "+FORMAT$(rc.nRight,"####")+"   Y: "+FORMAT$(rc.nBottom,"####")
                SendMessage hStatusBar, %WM_SETTEXT, 0, VARPTR(StatusText)
                InvalidateRect CBHNDL, BYVAL %NULL, %FALSE
                '
            CASE %WM_GETMINMAXINFO
                MinMaxPtr=CBLPARAM
                ' Set the minimum size of dialog. You can define these values according to need.
                @MinMaxPtr.ptMinTrackSize.x = 400 ' minimum X of dialog in pixels
                @MinMaxPtr.ptMinTrackSize.y = 300 ' minimum Y of dialog in pixels
                '
            CASE %WM_COMMAND
                SELECT CASE LOWRD(CBWPARAM)
                ' Process Messages to Controls that have no Callback Function
                ' and Process Messages to Menu Items
                    CASE  %Form1_DEFAULT
                        Form1_DEFAULT_Select
                    CASE  %Form1_OPENFILE
                        Form1_OPENFILE_Select
                    CASE  %Form1_SAVEAS
                        Form1_SAVEAS_Select
                    CASE  %Form1_HELP1
                        Form1_HELP1_Select
                    CASE %Form1_ABOUT
                        Form1_ABOUT_Select
                    CASE  %Form1_EXIT
                        PostQuitMessage 0
                END SELECT
            CASE %WM_DESTROY
                PostQuitMessage 0
        END SELECT
        ' Pass unprocessed messages on to the default handler
        FUNCTION = DefWindowProc(CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
    END FUNCTION
    ' ------------------------------------------------
    ------------------
Working...
X