Handle-Free Checkboxes in a String Grid (Delphi)

BradTrupp.com -- Tags -- Code -- Handle-Free Checkboxes in a String Grid (Delphi)

Handle-Free Checkboxes in a String Grid (Delphi)
(2006/01/14)

'Handle-Free' Checkboxes in a String Grid
by Brad Trupp (c) 1997

This was the draft for an article I wrote back in 1997. It was published February of that year as hax # 252 in Visual Developer. Visual Developer was a magazine published by The Coriolis Group until 2001. You can read a little more of its history on Jeff Duntemann's ContraPositive Diary.

Have you ever put together a large form with a few hundred controls and see your old friend the EOutOfResources exception when you ran it? One reason is that your form is using too many windows handles.

This HAX example shows how to imbed checkboxs in any cell in a TStringGrid and use exactly zero additional windows handles. Start by dropping a stringgrid on your form and setting your maximum columns and rows. Next, add an array of boolean with the same dimensions as the stringgrid to hold the value of the checkboxes. Our FormCreate method fills the stringgrid with some initial text values and sets all the checkboxes to true. This is so the checkboxes will display initially as checked.

The grids DrawCell method is called each time a cell needs to be drawn. It clears out the cell region, calculates where the checkbox goes, calls our DrawCheckBox routine to print the check box, and finally prints the cell’s text. Since DrawCheckBox routine is passed the sender TStringGrid, and uses the senders canvas property, it can be called from any TStringGrid. The Rectangle method draws the empty checkbox. The “X” inside is done by drawing lines from top left to bottom right and bottom left to top right corners.

We detect if our checkbox was clicked by saving the mouse X and Y co-ordinates on the grid’s MouseDown event and comparing then against the mouse co-ordinates on the MouseUp event. If the two sets are in the same grid cell and are in the check box area then it’s a hit. If so, we store the new status of the checkbox in our boolean array and redraw the checkbox to the correct state.

A few ways you can extend this sample are to allow for multiple check boxes or use bitmaps to show checked and unchecked.

Listing 1: PGRID.PAS
unit Pgrid;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Grids;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; Col, Row: Longint;
      Rect: TRect; State: TGridDrawState);
    procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    cb: array[0..9,0..9] of boolean;
    DownMouseX, DownMouseY : integer;
    procedure DrawCheckBox( Sender: TObject; Rect: TRect; myState: boolean);
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
   iCol, iRow: integer;
begin
     for iCol:= 0 to 9 do for iRow:= 0 to 9 do begin
         cb[iCol,iRow]:=true;
         StringGrid1.cells[iCol,iRow]:=char( ord('A')+iCol+iRow);
         end;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; Col, Row: Longint;
  Rect: TRect; State: TGridDrawState);
var
   myOffset: longint;
   R: TRect;
   s: string;
begin
     if ( Col = 0 ) or ( Row = 0 ) then exit;
     myOffset := Rect.Bottom - Rect.Top - 2;
     (Sender as TStringGrid).Canvas.FillRect(Rect);
     R := Classes.Rect( Rect.Left, Rect.Top, Rect.Left+myoffset-1, Rect.Bottom );
     DrawCheckBox( sender, R, cb[Col,Row]);
     R := Classes.Rect( Rect.Left+myoffset+2, Rect.Top, Rect.Right, Rect.Bottom );
     (Sender as TStringGrid).Canvas.TextRect(  R, R.Left + 2,R.Top+2,
             (Sender as TStringGrid).Cells[ Col, Row] );
end;

procedure TForm1.StringGrid1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
     DownMouseX:=X; DownMouseY:=Y;
end;

procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  R, ARect : TRect;
  itemHeight : integer;
  Col1, Row1, Col2, Row2: longint;
begin
  with (Sender as TStringGrid) do begin
      MouseToCell(DownMouseX, DownMouseY, Col1, Row1);
          MouseToCell(X, Y, Col2, Row2);

          if ( Col1 > 0 ) and (Col1 = Col2) and
                 ( Row1 > 0 ) and (Row1 = Row2) then
          begin
                ARect :=cellrect( col, row);
        itemHeight := ARect.Bottom - ARect.Top - 2;
                { Are the mouse down and mouse up positions in the same box? }
                if ( ARect.Left < X ) and ( X < ARect.Left+2+itemHeight-1 ) and
                   ( ARect.Top < Y ) and  ( Y < ARect.Bottom )and
                   ( ARect.Left < X) and  ( X < ARect.Left+itemHeight-1 ) and
                   ( ARect.Top < Y ) and  ( Y < ARect.Bottom ) then begin
                         cb[Col,Row] := not cb[Col,Row];
             R := Rect( ARect.Left, ARect.Top, ARect.Left+itemHeight-1, ARect.Bottom );
             DrawCheckBox( sender, R, cb[Col,Row]);
                   end;
      end;
  end;
end;

procedure TForm1.DrawCheckBox( Sender: TObject; Rect: TRect; myState: boolean);
var
  itemheight, itemIndent : integer;
begin
with (Sender as TStringGrid) do begin
     itemHeight := Rect.Bottom - Rect.Top - 2;
     Canvas.Font.Color := Font.Color;
     Canvas.Pen.Color := Font.Color;
     Canvas.Rectangle(
        Rect.Left + 1, Rect.Top + 1,
        Rect.Left + 1 + ItemHeight, Rect.Top + ItemHeight + 1);
     { draw X in box }
     if myState then begin
        Canvas.MoveTo( Rect.Left + 1, Rect.Top + 1);
        Canvas.LineTo( Rect.Left + 1 + ItemHeight, Rect.Top + ItemHeight + 1);
        Canvas.MoveTo( Rect.Left + ItemHeight, Rect.Top + 1);
        Canvas.LineTo( Rect.Left , Rect.Top + ItemHeight + 1);
        end;
     end;
end;

end.

Tags: Code