Board index » delphi » how to draw checkbox in TStringGrid cell?

how to draw checkbox in TStringGrid cell?

I would like to place a checkbox in a string grid's cell.

How would I use the OnDrawCell event to paint a
functioning checkbox there?

Thanks for any help.

Alan Goodman

 

Re:how to draw checkbox in TStringGrid cell?


Here's an example of how to do it in a DBGrid:
ftp://ftp.iwaynet.net/users/csoft/cbdemo.zip

Paul / ColumbuSoft
www.columbusoft.com

Quote
Me <M...@Mine.com> wrote in message

news:391C1670.34E6979D@nospammers.etour.com...
Quote
> I would like to place a checkbox in a string grid's cell.

> How would I use the OnDrawCell event to paint a
> functioning checkbox there?

> Thanks for any help.

> Alan Goodman

Re:how to draw checkbox in TStringGrid cell?


Quote
In article <391C1670.34E69...@nospammers.etour.com>, Me wrote:
> I would like to place a checkbox in a string grid's cell.

> How would I use the OnDrawCell event to paint a
> functioning checkbox there?

Alan,

following are two example how you may approach this. The first creates real
life checkboxes, which consumes quite a few window handles. The second
fakes the boxes and is thus much more resource-friendly.

 Add checkboxes to the column of a grid
 unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Grids;

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    StringGrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure StringGrid1TopLeftChanged(Sender: TObject);
    procedure gridcheckboxMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  chk: TCheckbox;
  i: integer;
begin
  with stringgrid1 do begin
    rowcount := 30;
    colcount := 10;
    for i:= fixedrows to rowcount-1 do begin
      cells[1,i] := ' ';
      chk:= TCheckbox.Create( stringgrid1 );
      with chk do begin
        name := format('CellChk%d_%d',[1,i]);
        caption := '';
        checked := false;
        visible := false;
        parent  := stringgrid1;
        width   := height;
        OnMouseDown := gridcheckboxMouseDown;
      end;
      Objects[1,i] := chk;
    end;
  end;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  chk: TCheckbox;
  grid: TStringgrid;
begin
  grid := Sender As TStringgrid;
  if (aCol = 1) and (aRow >= grid.FixedRows)
  then begin
    chk:= TCheckbox(grid.Objects[ aCol, aRow ]);
    If Assigned(chk) Then Begin
      chk.SetBounds( (rect.left + rect.right - chk.width) div 2,
                     (rect.top + rect.bottom - chk.height) div 2,
                     chk.width, chk.height );
      if not chk.visible then
        chk.show;              
    End;
  end;

end;

type
  tgridcracker = Class( tstringgrid );

procedure TForm1.StringGrid1TopLeftChanged(Sender: TObject);
begin
  tgridcracker(Sender).InvalidateCol(1);
end;

procedure TForm1.gridcheckboxMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  With Sender As TCheckbox Do
    Checked := not Checked;
end;

end.

 -----

Showing checkboxes in a stringgrid

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Grids;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FCheck, FNoCheck: TBitmap;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  If not ( gdFixed In State ) and (aCol = 1) Then Begin
    With (Sender As TStringgrid).Canvas Do Begin
      brush.color := $E0E0E0;
      // checkboxes look better on a non-white background
      Fillrect( rect );
      If Odd(aRow) Then
        Draw( (rect.right + rect.left - FCheck.width) div 2,
              (rect.bottom + rect.top - FCheck.height) div 2,
              FCheck )
      Else
        Draw( (rect.right + rect.left - FNoCheck.width) div 2,
              (rect.bottom + rect.top - FNoCheck.height) div 2,
              FNoCheck )
    End;
  End;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  bmp: TBitmap;
begin
  FCheck:= TBitmap.Create;
  FNoCheck:= TBitmap.Create;
  bmp:= TBitmap.create;
  try
    bmp.handle := LoadBitmap( 0, PChar(OBM_CHECKBOXES ));
    // bmp now has a 4x3 bitmap of divers state images
    // used by checkboxes and radiobuttons
    With FNoCheck Do Begin
      // the first subimage is the unchecked box
      width := bmp.width div 4;
      height := bmp.height div 3;
      canvas.copyrect( canvas.cliprect, bmp.canvas, canvas.cliprect );
    End;
    With FCheck Do Begin
      // the second subimage is the checked box
      width := bmp.width div 4;
      height := bmp.height div 3;
      canvas.copyrect(
        canvas.cliprect,
        bmp.canvas,
        rect( width, 0, 2*width, height ));
    End;
  finally
    bmp.free
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FNoCheck.Free;
  FCheck.Free;
end;

end.

Peter Below (TeamB)  100113.1...@compuserve.com)
No e-mail responses, please, unless explicitly requested!

Re:how to draw checkbox in TStringGrid cell?


Faking the checkboxes works fine, but how can I then allow users to edit the
values, either by clicking on the cell that contains the fake checkbox or by
pressing spacebar while in edit mode in the cell?

Thanks,

Alan

"Peter Below (TeamB)" <100113.1...@compuXXserve.com> wrote in message
news:VA.000050aa.00ccac56@antispam.compuserve.com...

Quote
> In article <391C1670.34E69...@nospammers.etour.com>, Me wrote:
> > I would like to place a checkbox in a string grid's cell.

> > How would I use the OnDrawCell event to paint a
> > functioning checkbox there?

> Alan,

> following are two example how you may approach this. The first creates
real
> life checkboxes, which consumes quite a few window handles. The second
> fakes the boxes and is thus much more resource-friendly.

>  Add checkboxes to the column of a grid
>  unit Unit1;

> interface

> uses
>   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
>   StdCtrls, ComCtrls, Grids;

> type
>   TForm1 = class(TForm)
>     StatusBar1: TStatusBar;
>     StringGrid1: TStringGrid;
>     procedure FormCreate(Sender: TObject);
>     procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
>       Rect: TRect; State: TGridDrawState);
>     procedure StringGrid1TopLeftChanged(Sender: TObject);
>     procedure gridcheckboxMouseDown(Sender: TObject; Button: TMouseButton;
>       Shift: TShiftState; X, Y: Integer);
>   private
>     { Private declarations }
>   public
>     { Public declarations }
>   end;

> var
>   Form1: TForm1;

> implementation

> {$R *.DFM}

> procedure TForm1.FormCreate(Sender: TObject);
> var
>   chk: TCheckbox;
>   i: integer;
> begin
>   with stringgrid1 do begin
>     rowcount := 30;
>     colcount := 10;
>     for i:= fixedrows to rowcount-1 do begin
>       cells[1,i] := ' ';
>       chk:= TCheckbox.Create( stringgrid1 );
>       with chk do begin
>         name := format('CellChk%d_%d',[1,i]);
>         caption := '';
>         checked := false;
>         visible := false;
>         parent  := stringgrid1;
>         width   := height;
>         OnMouseDown := gridcheckboxMouseDown;
>       end;
>       Objects[1,i] := chk;
>     end;
>   end;
> end;

> procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
>   Rect: TRect; State: TGridDrawState);
> var
>   chk: TCheckbox;
>   grid: TStringgrid;
> begin
>   grid := Sender As TStringgrid;
>   if (aCol = 1) and (aRow >= grid.FixedRows)
>   then begin
>     chk:= TCheckbox(grid.Objects[ aCol, aRow ]);
>     If Assigned(chk) Then Begin
>       chk.SetBounds( (rect.left + rect.right - chk.width) div 2,
>                      (rect.top + rect.bottom - chk.height) div 2,
>                      chk.width, chk.height );
>       if not chk.visible then
>         chk.show;
>     End;
>   end;

> end;

> type
>   tgridcracker = Class( tstringgrid );

> procedure TForm1.StringGrid1TopLeftChanged(Sender: TObject);
> begin
>   tgridcracker(Sender).InvalidateCol(1);
> end;

> procedure TForm1.gridcheckboxMouseDown(Sender: TObject;
>   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
> begin
>   With Sender As TCheckbox Do
>     Checked := not Checked;
> end;

> end.

>  -----

> Showing checkboxes in a stringgrid

> unit Unit1;

> interface

> uses
>   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
>   StdCtrls, ExtCtrls, Grids;

> type
>   TForm1 = class(TForm)
>     StringGrid1: TStringGrid;
>     procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
>       Rect: TRect; State: TGridDrawState);
>     procedure FormCreate(Sender: TObject);
>     procedure FormDestroy(Sender: TObject);
>   private
>     { Private declarations }
>     FCheck, FNoCheck: TBitmap;
>   public
>     { Public declarations }
>   end;

> var
>   Form1: TForm1;

> implementation

> {$R *.DFM}

> procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
>   Rect: TRect; State: TGridDrawState);
> begin
>   If not ( gdFixed In State ) and (aCol = 1) Then Begin
>     With (Sender As TStringgrid).Canvas Do Begin
>       brush.color := $E0E0E0;
>       // checkboxes look better on a non-white background
>       Fillrect( rect );
>       If Odd(aRow) Then
>         Draw( (rect.right + rect.left - FCheck.width) div 2,
>               (rect.bottom + rect.top - FCheck.height) div 2,
>               FCheck )
>       Else
>         Draw( (rect.right + rect.left - FNoCheck.width) div 2,
>               (rect.bottom + rect.top - FNoCheck.height) div 2,
>               FNoCheck )
>     End;
>   End;
> end;

> procedure TForm1.FormCreate(Sender: TObject);
> var
>   bmp: TBitmap;
> begin
>   FCheck:= TBitmap.Create;
>   FNoCheck:= TBitmap.Create;
>   bmp:= TBitmap.create;
>   try
>     bmp.handle := LoadBitmap( 0, PChar(OBM_CHECKBOXES ));
>     // bmp now has a 4x3 bitmap of divers state images
>     // used by checkboxes and radiobuttons
>     With FNoCheck Do Begin
>       // the first subimage is the unchecked box
>       width := bmp.width div 4;
>       height := bmp.height div 3;
>       canvas.copyrect( canvas.cliprect, bmp.canvas, canvas.cliprect );
>     End;
>     With FCheck Do Begin
>       // the second subimage is the checked box
>       width := bmp.width div 4;
>       height := bmp.height div 3;
>       canvas.copyrect(
>         canvas.cliprect,
>         bmp.canvas,
>         rect( width, 0, 2*width, height ));
>     End;
>   finally
>     bmp.free
>   end;
> end;

> procedure TForm1.FormDestroy(Sender: TObject);
> begin
>   FNoCheck.Free;
>   FCheck.Free;
> end;

> end.

> Peter Below (TeamB)  100113.1...@compuserve.com)
> No e-mail responses, please, unless explicitly requested!

Re:how to draw checkbox in TStringGrid cell?


Please watch your over quoting.  Thank you.

Quote
Alan wrote:

--
Jeff Overcash (TeamB)
      (Please do not email me directly unless  asked. Thank You)
And so I patrol in the valley of the shadow of the tricolor
I must fear evil. For I am but mortal and mortals can only die.
Asking questions, pleading answers from the nameless
faceless watchers that stalk the carpeted  corridors of Whitehall.
             (Fish)

Re:how to draw checkbox in TStringGrid cell?


The code I mentioned above includes methods for handling the spacebar and
double-click.

Paul / ColumbuSoft
www.columbusoft.com

Quote
Alan <agood...@xnospammersx.dctc.com> wrote in message

news:8fpvhv$ee815@bornews.borland.com...
Quote
> Faking the checkboxes works fine, but how can I then allow users to edit
the
> values, either by clicking on the cell that contains the fake checkbox or
by
> pressing spacebar while in edit mode in the cell?

> Thanks,

> Alan

Re:how to draw checkbox in TStringGrid cell?


Quote
> I would like to place a checkbox in a string grid's cell.

Check out ElTree (freeware) included in ElPack, at http://www.eldos.org
it is a stringgrid-checkboxlist-treeview all in one.

Cheers,

--
-----------------------------------------------
Marcelo Montagna -  marcelo1 @ forum . nu
My website: The Kibbutz Volunteers Travel Guide
http://www.forum.nu

Re:how to draw checkbox in TStringGrid cell?


Quote
In article <8fpvhv$ee...@bornews.borland.com>, Alan wrote:
> Faking the checkboxes works fine, but how can I then allow users to edit the
> values, either by clicking on the cell that contains the fake checkbox or by
> pressing spacebar while in edit mode in the cell?

Here is an enhanced example that handles mouse clicks on the grid and key
events.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Grids;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure StringGrid1Click(Sender: TObject);
    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
    FCheck, FNoCheck: TBitmap;
    procedure ToggleCheckbox(acol, arow: Integer);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
type
  TGridCracker = Class( TStringgrid );

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  grid: TStringgrid;
begin
  If not ( gdFixed In State ) and (aCol = 1) Then Begin
    grid:= Sender As TStringgrid;
    With grid.Canvas Do Begin
      brush.color := $E0E0E0;
      // checkboxes look better on a non-white background
      Fillrect( rect );
      // listbox state is encoded by the Objects property
      If Assigned(grid.Objects[aCol, aRow]) Then
        Draw( (rect.right + rect.left - FCheck.width) div 2,
              (rect.bottom + rect.top - FCheck.height) div 2,
              FCheck )
      Else
        Draw( (rect.right + rect.left - FNoCheck.width) div 2,
              (rect.bottom + rect.top - FNoCheck.height) div 2,
              FNoCheck )
    End;
  End;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
  bmp: TBitmap;
begin
  FCheck:= TBitmap.Create;
  FNoCheck:= TBitmap.Create;
  bmp:= TBitmap.create;
  try
    bmp.handle := LoadBitmap( 0, PChar(OBM_CHECKBOXES ));
    // bmp now has a 4x3 bitmap of divers state images
    // used by checkboxes and radiobuttons
    With FNoCheck Do Begin
      // the first subimage is the unchecked box
      width := bmp.width div 4;
      height := bmp.height div 3;
      canvas.copyrect( canvas.cliprect, bmp.canvas, canvas.cliprect );
    End;
    With FCheck Do Begin
      // the second subimage is the checked box
      width := bmp.width div 4;
      height := bmp.height div 3;
      canvas.copyrect(
        canvas.cliprect,
        bmp.canvas,
        rect( width, 0, 2*width, height ));
    End;
  finally
    bmp.free
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FNoCheck.Free;
  FCheck.Free;
end;

procedure TForm1.StringGrid1Click(Sender: TObject);
var
  pt: TPoint;
  grid: TStringgrid;
  aCol, aRow: Integer;
begin
  GetCursorPos( pt );
  grid := Sender As TStringgrid;
  pt:= grid.ScreenToClient( pt );
  grid.MouseToCell( pt.x, pt.y, aCol, aRow );
  If (aCol = 1) and (aRow >= grid.fixedRows) Then Begin
    // click landed in a checkbox cell
    ToggleCheckbox( aCol, aRow );
  End;
end;

procedure TForm1.ToggleCheckbox( acol, arow: Integer );
begin
  If aCol = 1 Then
    With TGridCracker( stringgrid1 ) Do Begin
      If Assigned( Objects[aCol, aRow] ) Then
        Objects[aCol, aRow] := Nil
      Else
        Objects[aCol, aRow] := Pointer(1);
      InvalidateCell( aCol, aRow );
    End;
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
  With Sender as TStringgrid Do
    If aCol = 1 Then
      Options := Options - [ goediting ]
    Else
      Options := Options + [ goediting ];
end;

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
begin
  If Key = #32 Then
    With Sender As Tstringgrid Do
      If Col = 1 Then Begin
        ToggleCheckbox( Col, row );
        Key := #0;
      End;
end;

end.

Peter Below (TeamB)  100113.1...@compuserve.com)
No e-mail responses, please, unless explicitly requested!

Other Threads