Grid 內含 CheckBox or List Box 其他物件的方法 |
|
尚未結案
|
|
newbie
初階會員   發表：81 回覆：45 積分：25 註冊：2002-11-28 發送簡訊給我 |
|
|
turboted
版主 發表：95 回覆：754 積分：452 註冊：2002-07-23 發送簡訊給我 |
以下提供兩種方法
原文請見
http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20539050.html First of all, you could take a look at this example that shows how to add comboboxes to stringgrid cells. For adding checkboxes to a StringGrid I got two solutions: 1. using the genuine checkbox controls (a waste of window handles) 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. 2. faking the checkboxes 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 Best wishes,
Markus
|
|
newbie
初階會員 發表：81 回覆：45 積分：25 註冊：2002-11-28 發送簡訊給我 |
|
|
Charlies Chang
一般會員  發表：3 回覆：9 積分：7 註冊：2003-05-09 發送簡訊給我 |
2 樓版主回覆的方法
其中 forbidden := gridcheckboxMouseDown; 應為 [code delphi] OnMouseDown := gridcheckboxMouseDown; [/code]
編輯記錄
Charlies Chang 重新編輯於 2008-09-19 13:58:05， 註解 無‧
Charlies Chang 重新編輯於 2008-09-19 13:58:37， 註解 無‧ Charlies Chang 重新編輯於 2008-09-19 13:59:34， 註解 無‧ Charlies Chang 重新編輯於 2008-09-19 14:01:29， 註解 無‧ Charlies Chang 重新編輯於 2008-09-19 14:04:18， 註解 OnMouseDown := gridcheckboxMouseDown;‧ Charlies Chang 重新編輯於 2008-09-19 15:45:14， 註解 無‧ Charlies Chang 重新編輯於 2008-09-19 15:54:57， 註解 無‧ |
|
taishyang
站務副站長  發表：377 回覆：5490 積分：4563 註冊：2002-10-08 發送簡訊給我 |
Hi Charlies Chang:
Key不出來的原因是網站的關係, http://delphi.ktop.com.tw/board.php?cid=32&fid=1492&tid=90474 您可以找最近的問題回答,這問題有點久了 :P |
|
Charlies Chang
一般會員 發表：3 回覆：9 積分：7 註冊：2003-05-09 發送簡訊給我 |
發表時間：2003-05-16 09:57:36
IP:61.220.xxx.xxx 未訂閱
系統時間：2024-11-23 13:44:24
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |