'
' --------------------------------------------------------------------
' Two Lines of Text In A QStringGrid Cell
'
' By     J.Philippe     December    2001
' --------------------------------------------------------------------
' Problem resolved in Creating a Bitmap Array ; one BitMap for each
'      Cell of the QstringGrid ; then method TextOut is used to draw
'      the 2 Text Lines in the required BitMap ; then drawing the
'      BitMap in the QstringGrid Cell on event OnDrawCell.
' Line Separator In the grid.Cell : "/"
'      example :   myGrid.Cell (Col, Row) = "Line1/Line2"
' --------------------------------------------------------------------
'
'$TYPECHECK ON
$INCLUDE "RAPIDQ.INC"
$ESCAPECHARS ON

DECLARE FUNCTION Setfocus Lib "user32" Alias "SetFocus"(hwnd As Long) AS LONG

Declare Subi DrawGridBitMap ( ... ) ' Colx, Rowx, fcx, bcx, gccx, gcfcx, grfcx
Declare Sub OnDrawCell_gridDemo (Col%, Row%, State%, cellRect AS QRect)
Declare Sub OnSelectCell_gridDemo (Col%, Row%, CanSelect%)
Declare Sub OnTimer_tmrWrite
Declare Sub OnClic_AnyMenu (Sender As QMenuItem)

CREATE frmDemoGridBmp AS QFORM
    Caption = "frmDemoGridBmp Not Easy! ...  COLORS COULD BE BETTER :)"
    Width = 800
    Height = 500
    Center
    CREATE Main AS QMAINMENU
        CREATE mnuRandom AS QMENUITEM
            Caption = "&RandomFillGrid"
            OnClick = OnClic_AnyMenu
        END CREATE
        CREATE mnuManually AS QMENUITEM
            Caption = "&ManuallyFillGrid"
            OnClick = OnClic_AnyMenu
        END CREATE
        CREATE mnuClearGrid AS QMENUITEM
            Caption = "&ClearGrid"
            OnClick = OnClic_AnyMenu
        END CREATE
    END CREATE
    Create pnlInput As QPanel
        Height = 40
        Color = &HFFE0FF
        Align = alTop
        Font.Bold = True
        Alignment = taRightJustify
    End Create
    CREATE GridDemo AS QSTRINGGRID
        Align = AlClient
        ColCount = 6
        RowCount = 6
        FixedRows = 1
        FixedCols = 1
        DefaultRowHeight = 60
        DefaultColWidth = 120
        OnDrawCell = OnDrawCell_gridDemo
        OnSeLectCell = OnSelectCell_gridDemo
        Cell (0,0) = "Opening/Balance"
        Cell (1,0) = "Debit"
        Cell (2,0) = "Credit"
        Cell (3,0) = "Closing/Balance"
        Cell (0,1) = "Col=0/Col=1"
        Cell (0,2) = "Col=0/Col=2"
        Cell (0,3) = "Col=0/Col=3"
    END CREATE
    CREATE edtManually AS QEdit
        Parent = pnlInput
        Align = alLeft
        Top = 10
        Width = 300
        Font.Size = 10
        ShowHint = True
        Hint = "Enter here :\nCOLUMN ROW STRING1 STRING2\nSingle Space separated"
        Text = "1 2 Write This"
        Visible = False
    END CREATE
END CREATE

Application.HintHidePause = 4000

' Table of BitMaps, one for each Cell
' ------------------------------
Create cellBitmap (0 To (gridDemo.ColCount - 1), 0 To (gridDemo.RowCount - 1)) As QBitmap '
End Create

' Initilise the Cells of the Grid
' ------------------------------
DefInt R, C
For R = 0 To gridDemo.RowCount - 1
    For C = 0 To gridDemo.ColCount - 1
        DrawGridBitMap C, R, &H0000C0, &H0DFFFF, &HFFFFC0, &HC0FFFF, &HFFC0FF
        DoEvents
    Next C
Next R

' Timer for Random Filling the Grid Cells
' ---------------------------------------
Dim tmrWrite As Qtimer
tmrWrite.Interval = 300
tmrWrite.OnTimer = OnTimer_tmrWrite
tmrWrite.Enabled = False
' Its random Strings
DefStr sStr(0 To 10) = {"RapidQ", "is the", "Most", "Funny", "Free", "Compiler", _
                        "that", "You Can", "Find", "On", "Internet"}
'
' ***********************************************************************
frmDemoGridBmp.ShowModal
' ***********************************************************************

' MASTER DRAWING PROCEDURE
' ------------------------
Sub OnDrawCell_gridDemo (Col%, Row%, State_, cellRect AS QRect)
    gridDemo.Draw (cellRect.Left, cellRect.Top , CellBitMap(Col%, Row%).Bmp)
End Sub

' Draw A Bitmap For (Col, Row)
' ----------------------------
Subi DrawGridBitMap ( ... )       ' (Colx, Rowx, fcx, bcx, gccx, gcfcx, grfcx)
    ' fcx    text forecolor
    ' bcx    text back GroundColor
    ' gccx   grid cell color
    ' gcfcx  grid column fixedColor
    ' grfcx  grid row fixed Color
    DefStr sLine1, sLine2, sGrid
    DefInt iPtr, bgCellColor, Colx, Rowx, fcx, bcx, gccx, gcfcx, grfcx
    gcfcx = &HC0FFFF
    grfcx = &HFFC0FF
    gccx = &HFFFFC0
    fcx = &H0000C0
    bcx = &H0DFFFF
    If ParamValCount > 0 Then Colx = ParamVal(1)
    If ParamValCount > 1 Then Rowx = ParamVal(2)
    If ParamValCount > 2 Then fcx = ParamVal(3)
    If ParamValCount > 3 Then bcx = ParamVal(4)
    If ParamValCount > 4 Then gccx = ParamVal(5)
    If ParamValCount > 5 Then gcfcx = ParamVal(6)
    If ParamValCount > 6 Then grfcx = ParamVal(7)
    sLine1 = ""
    sLine2 = ""
    sGrid = ""
    sGrid = gridDemo.Cell (Colx, Rowx)
    If sGrid <> "" Then
        iPtr = Instr (sGrid, "/")
        If iPtr Then
            sLine1 = Left$ (sGrid, iPtr - 1)
            sLine2 = Mid$(sGrid, iPtr + 1)
        Else
            sLine1 = sGrid
        End If
    End If
    cellBitmap(Colx,Rowx).Font.Size = 10
    cellBitmap(Colx,Rowx).Font.Bold = True
    cellBitmap(Colx,Rowx).Height = gridDemo.defaultRowHeight
    cellBitmap(Colx,Rowx).Width = gridDemo.defaultColWidth
    bgCellColor = gccx
    If Colx < gridDemo.FixedCols  Then bgCellColor = gcfcx
    If Rowx < gridDemo.FixedRows Then bgCellColor = grfcx
    cellBitmap(Colx, Rowx).FillRect (1, 1, gridDemo.defaultColWidth, gridDemo.defaultRowHeight, bgCellColor)
    cellBitmap(Colx, Rowx).TextOut (3, 3, sLine1, fcx, bcx)
    cellBitmap(Colx ,Rowx).TextOut (3, 33, sLine2, fcx, bcx)
End Sub

' ---------------------------------------------------------------------------------------------------------

' NON SPECIFIC PROCEDURES
' -----------------------
Sub OnClic_AnyMenu (Sender)
    DefInt C, R
    DefStr s1, s2
    Select Case Sender.Handle
        Case mnuRandom.Handle
            If tmrWrite.Enabled = False Then
                edtManually.Visible = False
                tmrWrite.Enabled = True
                pnlInput.Caption = "RE CLIC ON MENU RandomFillGrid TO STOP    "
            Else
                tmrWrite.Enabled = False
                pnlInput.Caption = ""
           End If
        Case mnuManually.Handle
            tmrWrite.Enabled = False
            If edtManually.Visible = False Then
                edtManually.Left = Screen.MouseX - frmDemoGridBmp.Left
                edtManually.Visible = True
                pnlInput.Caption = "  RE CLIC ON MENU MannuallyFillGrid TO SET    "
            Else
                edtManually.Visible = False
                C = Val(Rtrim$(LTrim$(Field$(edtManually.Text, " ", 1))))
                R = Val(Rtrim$(LTrim$(Field$(edtManually.Text, " ", 2))))
                s1 = Field$(edtManually.Text, " ", 3)
                s2 = Field$(edtManually.Text, " ", 4)
                gridDemo.Cell (C, R) = s1 & "/" & s2
                DrawGridBitMap C, R, &HFF0000, &H00FF00, &H0000FF, &HC0FFFF, &HFFC0FF
                pnlInput.Caption = ""
            End If
        Case mnuClearGrid.Handle
            tmrWrite.Enabled = False
            edtManually.Visible = False
            For C = gridDemo.FixedCols To gridDemo.ColCount - 1
                For R = gridDemo.FixedRows To gridDemo.RowCount - 1
                    gridDemo.Cell (C, R) = ""
                    DrawGridBitMap C, R, &H0000C0, &H0DFFFF, &HFFFFC0, &HC0FFFF, &HFFC0FF                    
                Next R
            Next C
            pnlInput.Caption = ""
    End Select
End Sub

' Filling One Random Selected Cell Every INTERVAL
' -----------------------------------------------
Sub OnTimer_tmrWrite
    DefInt iLine1, iLine2, C, R
    C = 1 + Rnd (gridDemo.ColCount - 1)
    R = 1 + Rnd (gridDemo.RowCount - 1)
    iLine1 = Rnd (11)
    iLine2 = Rnd (11)
    gridDemo.Cell (C, R) = sStr(iLine1) & "/" & sStr(iLine2)
    DrawGridBitMap C, R, &H0DFFFF, &H0000C0, &HFFC0C0, &HC0FFFF, &HFFC0FF
End sub