2009-07-25 17:30

' QSTRINGGRID : Shows How To Change the Color of a Single Cell
' ------------------------------------------------------------
     $APPTYPE GUI
     $ESCAPECHARS ON
     $TYPECHECK ON
     $INCLUDE "RAPIDQ.INC"

     DECLARE SUB DemoDrawCell (Col%, Row%, State%, Rect AS QRECT, Sender AS QSTRINGGRID)
     DECLARE SUB DemoSelectCell (Col%, Row%, CanSelect%, Sender AS QSTRINGGRID)
     DECLARE SUB DeleteSelection (Sender AS QSTRINGGRID)

     SUB frmWindProc
     END SUB

     CREATE frmTestGrid AS QFORM
      Width = Screen.Width - 50
      Height = Screen.Height - 50
      autoscroll = false
      COLOR = &HB3D1C0
      CAPTION = "Test Selected Grid Coloring"
      wndproc = frmWindProc
     END CREATE

     CREATE gridDemo AS QSTRINGGRID
      Font.COLOR = &HFF0000
      PARENT = frmTestGrid
      Left = 4
      Top = 4
      Font.Size = 8
      Font.Name = "MS sans serif" ' Try "Lucida Console"
      AddOptions (goEditing)
      FixedRows = 1
      FixedCols = 1
      ColCount = 10
      RowCount = 10
      DefaultRowHeight = 16
      DefaultColWidth = 80
      Width = gridDemo.ColCount * (1 + gridDemo.DefaultColWidth) + 5
      Height = gridDemo.RowCount * (1 + gridDemo.DefaultRowHeight) + 5
      FixedColor = &HFFD5C0
      COLOR = &HC0FFFF
      ScrollBars = ssNone
      OnDrawCell = demoDrawCell
      OnSelectCell = demoSelectCell
     END CREATE
     frmTestGrid.Height = 5 + gridDemo.Height + 35
     frmTestGrid.Width = 5 + gridDemo.Width + 10

' flags cell(C, R) selected(1)/not selected(0)
     DIM gridDemoColor (0 TO gridDemo.ColCount, 0 TO gridDemo.RowCount) AS LONG

' Random fills the grid
     DEFINT R, C
     FOR R = 1 TO gridDemo.RowCount - 1
      FOR C = 1 TO gridDemo.ColCount -1
       gridDemo.Cell(C, R) = Format$("%3.4f", RND /100)
      NEXT C
     NEXT R

' Clicking on Cell(1,1)  UNSELECT All The grid
     gridDemo.Cell(1,1) = "UNSELECT"

' Colors For Selection Font & BG
     DEFINT cellFontColor, cellBGColor
     cellFontColor = &H800000 ' gridDemo.Color       ' to invert colors
     cellBGColor = &HC0C0FF   ' gridDemo.Font.Color   ' to invert colors

' *****************************************
     frmTestGrid.SHOWMODAL
' *****************************************

' Here are 3 subs   demoDrawCell  uncomment the one you want to test
' and comment the others

' Uses Only TextOut, requires Font.Size adapted to the height of the of
' the cell, and adding enough space to the grid string to fill the cell
' If not, part of the cell wont be colored
     SUB DemoDrawCell (Col%, Row%, State%, Rect AS QRECT, Sender AS QSTRINGGRID)
      IF  gridDemoColor (Col% , Row% ) THEN
       Sender.TextOut (Rect.left, Rect.Top, (Sender.Cell(Col%, Row%) - " ") _
        & "              " , cellFontColor, cellBGColor )
      END IF'
     END SUB


' Uses FILL Cell Then TextOut  ! Problem, it redraws the lines of the grid too :)
'SUB DemoDrawCell (Col%, Row%, State%, Rect AS QRect, Sender AS QStringGrid)
'    If  gridDemoColor (Col% , Row% ) then
'        Sender.Fillrect (Rect.Left , Rect.Top , Sender.Width , Sender.Height , cellBGCOLOR)
'        Sender.TextOut (Rect.left, Rect.Top, Sender.Cell(Col%, Row%), cellFontColor, cellBGColor ) ' gridDemo.Color, gridDemo.Font.Color)
'    END IF
'END SUB


' Uses FILL Cell Then TextOut  ! Problem, it redraws the lines of the grid too
' attempt not to tuch the lines with the Fill
'SUB DemoDrawCell (Col%, Row%, State%, Rect AS QRect, Sender AS QStringGrid)
'    If  gridDemoColor (Col% , Row%) then
'        Sender.Fillrect (Rect.Left + 4 , Rect.Top + 4 , Sender.Width - 8 , Sender.Height - 8 , cellBGCOLOR)
'        Sender.TextOut (Rect.left, Rect.Top, Sender.Cell(Col%, Row%), cellFontColor, cellBGColor ) ' gridDemo.Color, gridDemo.Font.Color)
'    END IF
'END SUB


     SUB DemoSelectCell (Col%, Row%, CanSelect%, Sender AS QSTRINGGRID)
      IF Col% = 1 AND Row% = 1 THEN
       DeleteSelection (Sender)
       EXIT SUB
      END IF
      IF Col% > 0 AND Row% > 0 THEN
       gridDemoColor (Col%, Row%) = NOT(gridDemoColor (Col%, Row%))
      END IF
      Sender.Repaint
     END SUB


     SUB DeleteSelection (Sender AS QSTRINGGRID)
      DEFINT R, C
      FOR R = 0 TO gridDemo.RowCount
       FOR C = 0 TO gridDemo.ColCount
        gridDemoColor (C, R) = 0
       NEXT C
      NEXT R
      Sender.Repaint
     END SUB

2009-07-25 17:30