使StringGrid中的一列具有Check功能

字体大小: 中小 标准 ->行高大小: 标准
unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Grids;

type

TForm1 = class(TForm)

grid: TStringGrid;

procedure FormCreate(Sender: TObject);

procedure gridDrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

procedure gridClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

fcheck,fnocheck:tbitmap;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

var

i:SmallInt;

bmp:TBitmap;

begin

FCheck:= TBitmap.Create;

FNoCheck:= TBitmap.Create;

bmp:= TBitmap.create;

try

bmp.handle := LoadBitmap( 0, PChar(OBM_CHECKBOXES ));

With FNoCheck Do Begin

width := bmp.width div 4;

height := bmp.height div 3;

canvas.copyrect( canvas.cliprect, bmp.canvas, canvas.cliprect );

End;

With FCheck Do Begin

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.gridDrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

begin

if not (gdFixed in State) then

with TStringGrid(Sender).Canvas do

begin

brush.Color:=clWindow;

FillRect(Rect);

if Grid.Cells[ACol,ARow]='yes' 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 - FCheck.width) div 2,

(rect.bottom + rect.top - FCheck.height) div 2,

FNoCheck );

end;

end;

procedure TForm1.gridClick(Sender: TObject);

begin

if grid.Cells[grid.col,grid.row]='yes' then

grid.Cells[grid.col,grid.row]:='no'

else

grid.Cells[grid.col,grid.row]:='yes';

end;

end.

此文章由 http://www.ositren.com 收集整理 ,地址为: http://www.ositren.com/htmls/68391.html