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

Virtual grid control based on header control

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

  • Virtual grid control based on header control

    ' Virtual grid control based on header control
    '
    ' I am well aware of Borje Hagsten's fine virtual list (lately expanded to
    ' a grid control by James Klutho). However, I was attracted to a simpler
    ' approach inspired by the header control example in Herbert Schildt's fine
    ' book on Windows programming from the ground up.
    '
    ' This first version is just to present the result so far. Now the grid can
    ' only be used to display data. Two-dimensional string arrays of any size
    ' within the limits of the memory can be displayed. The best meat is in the
    ' %WM_PAINT section of the GridCallBack function. In a later version I
    ' will add some editing facilities - including insertion, deletion and
    ' addition of rows and columns. Comments and suggestions for improvement
    ' are welcome.
    '
    ' Thanks to the PowerBasic Forum for great inspiration.
    '
    ' Best wishes
    '
    ' Erik Christensen ---- e.chr@email.dk
    '
    ' P.S. December 3, 2005. Small change so that it also runs without
    ' problems on the PBWIN80-version.
    '------------------------------------------------------------------------------
    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"
    
    '******************************************************************************
    '** Potential Include File Part ***********************************************
    '******************************************************************************
    '------------------------------------------------------------------------
    %FORM1_HEADER             = 130
    %FORM1_GRID               = 135
    '
    GLOBAL hGrid&                ' Handle of grid control
    GLOBAL hHead&                ' Handle of header control of grid control
    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
    '------------------------------------------------------------------------------
    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 hFont AS LONG
        STATIC hGrayPen AS LONG, hLightGrayPen AS LONG
        STATIC memDCgr AS LONG, hBitGr AS LONG
        STATIC siX AS SCROLLINFO
        STATIC siY AS SCROLLINFO
        STATIC PageRows AS LONG      ' Number of rows on a page
        STATIC PageColumns AS LONG   ' Number of columns on a page
        '
        SELECT CASE CBMSG
            CASE %WM_CREATE
                '
                ' Create Header and set its font.
                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)
                hFont = MakeFont(8,%FW_NORMAL,0,0,0,"MS Sans Serif")
                SendMessage hHead&,%WM_SETFONT,hFont,MAKLNG(%TRUE,0)
                '
                ' 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 20
                    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
                '
                hGrayPen = CreatePen(%PS_SOLID, 0, %GRAY)
                hLightGrayPen = CreatePen(%PS_SOLID, 0, %LTGRAY)
                '
                ' 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)
                '
                ' 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, %FALSE)
                '
                ' 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, %FALSE)
                '
                SetFocus CBHNDL
                '
            CASE %WM_VSCROLL
                SELECT CASE LOWRD(CBWPARAM)
                    CASE %SB_TOP           : siY.nPos = siY.nMin ' Home
                    CASE %SB_BOTTOM        : siY.nPos = siY.nMax ' End
                    CASE %SB_LINEDOWN      : INCR siY.nPos
                    CASE %SB_PAGEDOWN      : siY.nPos = siY.nPos + siY.nPage - 1
                    CASE %SB_LINEUP        : DECR siY.nPos
                    CASE %SB_PAGEUP        : siY.nPos = siY.nPos - siY.nPage + 1
                    CASE %SB_THUMBTRACK
                        Res& = GetScrollInfo(CBHNDL, %SB_VERT, siY)
                        siY.nPos   = siY.nTrackPos
                    CASE ELSE              : EXIT FUNCTION
                END SELECT
                ' 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
                SELECT CASE LOWRD(CBWPARAM)
                    CASE %SB_LEFT          : siX.nPos = siX.nMin ' Home
                    CASE %SB_RIGHT         : siX.nPos = siX.nMax ' End
                    CASE %SB_LINERIGHT     : INCR siX.nPos
                    CASE %SB_PAGERIGHT     : siX.nPos = MAX(siX.nPos + siX.nPage - 2 , siX.nPos + 1)
                    CASE %SB_LINELEFT      : DECR siX.nPos
                    CASE %SB_PAGELEFT      : siX.nPos = MIN(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
                ' 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_KEYDOWN
                ' Process arrow keys etc. for grid. hGrid& needs to have focus.
                LOCAL VScrollNotify AS WORD : VScrollNotify = -1
                LOCAL HScrollNotify AS WORD : HScrollNotify = -1
                SELECT CASE CBWPARAM
                    CASE %VK_UP    : VScrollNotify = %SB_LINEUP
                    CASE %VK_PRIOR : VScrollNotify = %SB_PAGEUP
                    CASE %VK_NEXT  : VScrollNotify = %SB_PAGEDOWN
                    CASE %VK_DOWN  : VScrollNotify = %SB_LINEDOWN
                    CASE %VK_HOME  : VScrollNotify = %SB_TOP    : HScrollNotify = %SB_LEFT
                    CASE %VK_END   : VScrollNotify = %SB_BOTTOM : HScrollNotify = %SB_RIGHT
                    CASE %VK_LEFT  : HScrollNotify = %SB_LINELEFT
                    CASE %VK_RIGHT : HScrollNotify = %SB_LINERIGHT
                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_PAINT
                '
                ' Draw grid
                STATIC PrevX AS LONG
                IF siX.nPos <> PrevX THEN ' Horizontal scrolling has taken place
                    ' Then update header items
                    FOR i& = 1 TO MIN(siX.nPage + 15, Columns + 1)
                        IF i&+siX.nPos>Columns THEN
                            s ="  "
                            headitem.cxy = 2000 ' set very wide extra column
                        ELSE
                            s = DataArray(i&+siX.nPos,0)
                            headitem.cxy = ColWidth(i&+siX.nPos)
                        END IF
                        headitem.pszText = VARPTR(s)
                        headitem.cchTextMax = LEN(headitem.pszText)
                        SendMessage hHead&, %HDM_SETITEM, i&, VARPTR(headitem)
                    NEXT
                    PrevX = siX.nPos
                END IF
                '
                GetClientRect CBHNDL,rc
                rc.nTop = HeaderHeight
                Res&=FillRect(memDCgr, rc, GetStockObject(%WHITE_BRUSH))
                GetClientRect CBHNDL,rc2
                rc2.nTop = HeaderHeight
                GetTextMetrics memDCgr, tm
                TextHeight = 0 : j = 0
                '
                ' 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 text
                        IF i = 0 THEN ' Row header text
                            s = DataArray(0, j + siY.nPos - 1)
                        ELSE          ' Cell text
                            s = DataArray(i + siX.nPos, j + siY.nPos - 1)
                        END IF
                        '
                        ' Add "..." to truncated entries
                        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
                        '
                        ' Set text background color
                        IF i=0 THEN ' Row header column
                            SetBkColor memDCgr,%LTGRAY
                        ELSE        ' Remaining columns
                            SetBkColor memDCgr,%WHITE
                        END IF
                        '
                        ' Write cell text
                        TextOut memDCgr, (ColStart+Spacing), _
                        (HeaderHeight+1+(j-1)*LineHeight), s, BYVAL LEN(s)
                        '
                        IF i = 0 THEN ' 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
                        END IF
                        '
                        ' Prepare to draw next column
                        ColStart = ColStart + ColWidth(i + idx)
                        INCR i
                    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
                '
                ' 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
                '
                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
                            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 ELSE
                    END SELECT
                END IF
                '
            CASE %WM_SIZE
                '
                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 hGrayPen THEN DeleteObject hGrayPen
                IF hLightGrayPen THEN DeleteObject hLightGrayPen
                IF hFont THEN DeleteObject hFont
                IF memDCgr THEN DeleteDC memDCgr
                IF hBitGr  THEN DeleteObject hBitGr
                '
        END SELECT
        ' Pass unprocessed messages on to the default handler
        FUNCTION = DefWindowProc(CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
        '
    END FUNCTION
    
    '******************************************************************************
    '** Program Main Part *********************************************************
    '******************************************************************************
    
    %Form1_EXIT  = 530
    
    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&
    
    '*******************************************************************************
    FUNCTION WINMAIN (BYVAL hInstance     AS LONG, _
                      BYVAL hPrevInstance AS LONG, _
                      BYVAL 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& ,"E&xit", hForm1_Menu1&, %MF_ENABLED
        MENU ADD STRING, hForm1_Menu1&, "E&xit",  %Form1_EXIT, %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"
        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 = .05*X : Yp = .01*Y : W = .9*X : H = .9*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
    ' --------------------------------------------------------------------------
    CALLBACK FUNCTION MainWndProc
        DIM MinMaxPtr AS MINMAXINFO PTR
        DIM hStatusBar AS STATIC DWORD
        DIM StatusText AS ASCIIZ * 250
        LOCAL rc AS RECT, i&,j&,Res&
        DIM StatusBarHeight AS STATIC LONG
        SELECT CASE CBMSG
            CASE %WM_CREATE
                ' Specification of size of Data Array.
                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&) = 65 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&)= "Row"
                            ELSE     '    ' Text of row headers.
                                IF j<=Rows THEN DataArray(i&,j&)= "Row"+STR$(j&)
                            END IF
                        ELSE     ' i& >= 1
                            IF j&=0 THEN  ' Row zero is used for column headers.
                                IF i<= Columns THEN DataArray(i&,j&)= "Column"+STR$(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
                '
            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)
                    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
    ' ------------------------------------------------



    [This message has been edited by Erik Christensen (edited December 03, 2005).]
Working...
X