線上訂房服務-台灣趴趴狗聯合訂房中心
發文 回覆 瀏覽次數:1957
推到 Plurk!
推到 Facebook!

激死我...stringgrid + checkbox還是不能,why?

尚未結案
BorlandUser
中階會員


發表:148
回覆:217
積分:73
註冊:2004-02-19

發送簡訊給我
#1 引用回覆 回覆 發表時間:2004-05-10 11:39:04 IP:203.185.xxx.xxx 未訂閱
procedure TMainUserGroupForm.RightGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); Var CheckBox: TCheckBox; Begin With RightGrid Do Begin CheckBox := TCheckBox(Objects[ACol, ARow]); If (CheckBox <> Nil) Then Begin CheckBox.Height := DefaultRowHeight - 1; CheckBox.Left := CellRect(ACol, ARow).Left 5; CheckBox.Top := CellRect(ACol, ARow).Top 1; CheckBox.Width := CellRect(ACol, ARow).Right - CellRect(ACol, ARow).Left - 8; End; End; End; Procedure TMainUserGroupForm.SetRightGrid; Var CheckBox: TCheckBox; intX, intY: Integer; Begin RightGrid.RowCount := Length(c_FunctionName) 1; For intX := 1 To Length(c_FunctionName) Do Begin If Length(RightGrid.Cells[1, intX]) = 0 Then Begin RightGrid.Cells[1, intX] := c_FunctionName[intX, 1]; For intY := 2 To 6 Do Begin If (c_FunctionName[intX, intY] = 'T') Then Begin With CheckBox Do Begin CheckBox := TCheckBox.Create(RightGrid); Name := Format('RightGridCheckBox_%d_%d', [ intY, intX ] ); Caption := ''; Checked := False; Visible := False; Enabled := False; Parent := RightGrid; Height := RightGrid.DefaultRowHeight - 1; Left := RightGrid.CellRect(intY, intX).Left 5; Top := RightGrid.CellRect(intY, intX).Top 1; Width := RightGrid.CellRect(intY, intX).Right - RightGrid.CellRect(intY, intX).Left - 8; Show; GridCheckBoxMouseDown; RightGrid.Objects[intY, intX] := CheckBox; End; End; End; End; End; End; 點解移動scorll bar時還,checkbox的value走了位...
william
版主


發表:66
回覆:2535
積分:3048
註冊:2002-07-11

發送簡訊給我
#2 引用回覆 回覆 發表時間:2004-05-10 13:44:46 IP:147.8.xxx.xxx 未訂閱
Do you mean the checkbox does not move upon scrolling of the grid? I think you should take a look at the OnTopLeftChanged event.
BorlandUser
中階會員


發表:148
回覆:217
積分:73
註冊:2004-02-19

發送簡訊給我
#3 引用回覆 回覆 發表時間:2004-05-11 10:07:32 IP:203.185.xxx.xxx 未訂閱
還是不行...當個grid向下移動時,checkbox會跟著走,但當scorll上時,就不會,而且當在grid中的checbox 被勾選了後,移動scroll bar,便會使到checkbox的value走掉了?為何呢?有誰人能試著成功呢? ~_~ 救命...我錯在那兒..
william
版主


發表:66
回覆:2535
積分:3048
註冊:2002-07-11

發送簡訊給我
#4 引用回覆 回覆 發表時間:2004-05-11 11:06:56 IP:147.8.xxx.xxx 未訂閱
Perhaps you could post a sample project demonstrating your problems? Anyway, personally I think it may be better in creating your own grid control with custom inplace editors. Take a look at the source for TDBGrid and TInplaceEdit...
hagar
版主


發表:143
回覆:4056
積分:4445
註冊:2002-04-14

發送簡訊給我
#5 引用回覆 回覆 發表時間:2004-05-11 11:27:29 IP:202.39.xxx.xxx 未訂閱
小弟試了一下, checkbox 的 value 並沒有走掉 因為數個 checkbox 重疊在一起了 只是找不到解決的方法. 可以參考 Peter Below 的範例: 
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.
-- 悟嗎?
BorlandUser
中階會員


發表:148
回覆:217
積分:73
註冊:2004-02-19

發送簡訊給我
#6 引用回覆 回覆 發表時間:2004-05-11 11:44:03 IP:203.185.xxx.xxx 未訂閱
@_@"好像很複雜...能解釋一下中間的幾個步驟嗎?
BorlandUser
中階會員


發表:148
回覆:217
積分:73
註冊:2004-02-19

發送簡訊給我
#7 引用回覆 回覆 發表時間:2004-05-11 22:07:21 IP:219.77.xxx.xxx 未訂閱
還是不能........help........help....................why
Chance36
版主


發表:31
回覆:1033
積分:792
註冊:2002-12-31

發送簡訊給我
#8 引用回覆 回覆 發表時間:2004-05-11 22:44:58 IP:203.204.xxx.xxx 未訂閱
BorlandUser 你好
  試試改用事件的參數Rect    procedure TMainUserGroupForm.RightGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
Var
  CheckBox: TCheckBox;
Begin
  With RightGrid Do
  Begin
    CheckBox := TCheckBox(Objects[ACol, ARow]);
    If (CheckBox <> Nil) Then
    Begin
      CheckBox.Height := DefaultRowHeight - 1;
      CheckBox.Left := RightGrid.Left Rect.Left 5;//CellRect(ACol, ARow).Left   5;
      CheckBox.Top := RightGrid.Top Rect.Top 1;//CellRect(ACol, ARow).Top   1;
      CheckBox.Width := Rect.Right-Rect.Left-8;//CellRect(ACol, ARow).Right - CellRect(ACol, ARow).Left - 8;
    End;
  End;
End;
修正一下!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 發表人 - chance36 於 2004/05/11 23:01:07
BorlandUser
中階會員


發表:148
回覆:217
積分:73
註冊:2004-02-19

發送簡訊給我
#9 引用回覆 回覆 發表時間:2004-05-11 22:59:52 IP:219.77.xxx.xxx 未訂閱
不行...........還是不行...你能幫我測試下嗎?我真的很雖要解決...謝
Chance36
版主


發表:31
回覆:1033
積分:792
註冊:2002-12-31

發送簡訊給我
#10 引用回覆 回覆 發表時間:2004-05-11 23:10:39 IP:203.204.xxx.xxx 未訂閱
BorlandUser 你好
  我已修正過的仍然不行?還有一個注意事項,當StringGrid.Parent不是Form時,還要將CheckBox.Parent := StringGrid.Parent;如下    procedure TMainUserGroupForm.RightGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
Var
  CheckBox: TCheckBox;
Begin
  With RightGrid Do
  Begin
    CheckBox := TCheckBox(Objects[ACol, ARow]);
    If (CheckBox <> Nil) Then
    Begin
      CheckBox.Parent := RightGrid.Parent;
      CheckBox.Height := DefaultRowHeight - 1;
      CheckBox.Left := RightGrid.Left Rect.Left 5;//CellRect(ACol, ARow).Left   5;
      CheckBox.Top := RightGrid.Top Rect.Top 1;//CellRect(ACol, ARow).Top   1;
      CheckBox.Width := Rect.Right-Rect.Left-8;//CellRect(ACol, ARow).Right - CellRect(ACol, ARow).Left - 8;
    End;
  End;
End;
若還是不行,你也要說明一下,怎麼不行?執行的狀況如何?才好判斷呀!不然就將程式上傳到[會員求助程式檔案上傳區],然後拉個連結過來,好讓大家可以深入了解問題的所在。 發表人 - chance36 於 2004/05/11 23:16:03
BorlandUser
中階會員


發表:148
回覆:217
積分:73
註冊:2004-02-19

發送簡訊給我
#11 引用回覆 回覆 發表時間:2004-05-11 23:21:33 IP:219.77.xxx.xxx 未訂閱
unit MainUserGroup;    interface    uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, StdCtrls, Buttons, ComCtrls, Grids, FMTBcd, DB, SqlExpr;    type   TMainUserGroupForm = class(TForm)     PageControl: TPageControl;     TabSheet1: TTabSheet;     TabSheet2: TTabSheet;     TabSheet3: TTabSheet;     StatusBar1: TStatusBar;     StringGrid1: TStringGrid;     SQLQuery1: TSQLQuery;     Edit1: TEdit;     procedure FormCreate(Sender: TObject);     procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;       Rect: TRect; State: TGridDrawState);   private     { Private declarations }     m_Mode: string;     m_GroupID: Integer;     procedure RefreshRightGrid;     procedure GridCheckBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);   public     { Public declarations }   end;    var   MainUserGroupForm: TMainUserGroupForm;    implementation    {$R *.dfm}    Uses DBModule, GlobalData, GlobalFunction;    procedure TMainUserGroupForm.FormCreate(Sender: TObject); begin   m_Mode := 'Ready';   RefreshRightGrid; end;    procedure TMainUserGroupForm.RefreshRightGrid; var   I, J: Integer;   ck: TCheckBox; begin   StringGrid1.RowCount := Length(g_FunctionName) + 1;   For I := 1 To Length(g_FunctionName) Do   Begin     If Length(StringGrid1.Cells[1, I]) = 0 Then     Begin       StringGrid1.Cells[1, I] := g_FunctionName[I, 1];          For J := 2 To 6 Do       Begin         If (g_FunctionName[I, J] = 'T') Then         Begin           ck := TCheckBox.Create(StringGrid1);           ck.Name := format('GridChkBox_%d_%d', [ J, I ] );           ck.caption := '';           ck.Checked := False;           ck.visible := False;           ck.parent := StringGrid1.Parent;           ck.Height := StringGrid1.DefaultRowHeight - 1;           ck.Left   := StringGrid1.CellRect(J, I).Left + 5;           ck.Top    := StringGrid1.CellRect(J, I).top + 1;           ck.Width  := StringGrid1.CellRect(J, I).Right - StringGrid1.CellRect(J, I).Left - 5;           ck.Show;              ck. GridCheckBoxMouseDown;           StringGrid1.Objects[J, I] := ck;         End;       End;     End;   End; end; procedure TMainUserGroupForm.GridCheckBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin   with Sender As TCheckbox do     Checked := not Checked; end;    procedure TMainUserGroupForm.StringGrid1DrawCell(Sender: TObject; ACol,   ARow: Integer; Rect: TRect; State: TGridDrawState); var   ck:tcheckbox; begin   ck:=tcheckbox(stringgrid1.objects[ACol,ARow]);   if(ck<>nil)then   begin       ck.Height := StringGrid1.DefaultRowHeight - 1;       ck.Left   := StringGrid1.Left+Rect.Left+5;       ck.Top    := StringGrid1.Left+Rect.Top+1;       ck.Width  := Rect.Right-Rect.Left-5;   End; end;    Initialization   RegisterClass(TMainUserGroupForm);    end.         以上是我改了的圖片,但這樣..就選不到勾選,而且顏色也變了...
Chance36
版主


發表:31
回覆:1033
積分:792
註冊:2002-12-31

發送簡訊給我
#12 引用回覆 回覆 發表時間:2004-05-11 23:37:50 IP:203.204.xxx.xxx 未訂閱
貼上程式碼時按一下工具鈕中有[#]的按鈕,然後在〔code〕在這裏插入程式碼〔/code〕 貼出的文章才會有縮格的效果
For J := 2 To 6 Do
Begin
  If (g_FunctionName[I, J] = 'T') Then
  Begin
    //ck := TCheckBox.Create(StringGrid1);
    ck := TCheckBox.Create(Self);// <------- 改成Self
    ck.Name := format('GridChkBox_%d_%d', [ J, I ] );
    ck.caption := '';
    ck.Checked := False;
    ck.visible := False;
    ck.parent := StringGrid1.Parent;
    ck.Height := StringGrid1.DefaultRowHeight - 1;
    ck.Left := StringGrid1.CellRect(J, I).Left   5;
    ck.Top := StringGrid1.CellRect(J, I).top   1;
    ck.Width := StringGrid1.CellRect(J, I).Right - StringGrid1.CellRect(J, I).Left - 5;
    // ck.Show;  <----這行可省略        // ck. GridCheckBoxMouseDown;<---沒特殊動作可以不要
    StringGrid1.Objects[J, I] := ck;
  End;
End;
 
[greeen]因為CheckBox 在你點下去時本來就會 沒勾變有勾 接著又在OnMouseDown事件中改變了Checked的屬性(有勾又變沒勾了)[/green]
BorlandUser
中階會員


發表:148
回覆:217
積分:73
註冊:2004-02-19

發送簡訊給我
#13 引用回覆 回覆 發表時間:2004-05-11 23:48:34 IP:219.77.xxx.xxx 未訂閱
但是grid內的checkbox郤不會走...就算在ondrawcell加回移動code也是這樣..     這是移動前 這是移動後.. checkbox走了位置,連value也變了
Chance36
版主


發表:31
回覆:1033
積分:792
註冊:2002-12-31

發送簡訊給我
#14 引用回覆 回覆 發表時間:2004-05-11 23:55:03 IP:203.204.xxx.xxx 未訂閱
 
procedure TMainUserGroupForm.StringGrid1DrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  ck:tcheckbox;
begin
  ck:=tcheckbox(stringgrid1.objects[ACol,ARow]);
  if(ck<>nil)then
  begin
    ck.Height := StringGrid1.DefaultRowHeight - 1;
    ck.Left := StringGrid1.Left Rect.Left 5;
    ck.Top := StringGrid1.Left Rect.Top 1;
    ck.Width := Rect.Right-Rect.Left-5;
  End Else Begin  // 這部份漏接了
    inherited DrawCell;
  End;
end;
問題還不止這些唷!我再看看,我先洗個澡,待會再來 發表人 - chance36 於 2004/05/12 00:04:26
BorlandUser
中階會員


發表:148
回覆:217
積分:73
註冊:2004-02-19

發送簡訊給我
#15 引用回覆 回覆 發表時間:2004-05-12 00:03:42 IP:219.77.xxx.xxx 未訂閱
DrawCell是什麼function,為什麼compile時,說undefine identifier?
BorlandUser
中階會員


發表:148
回覆:217
積分:73
註冊:2004-02-19

發送簡訊給我
#16 引用回覆 回覆 發表時間:2004-05-12 00:15:34 IP:219.77.xxx.xxx 未訂閱
我這個問題已拖了很久...再解決不下去...請千萬也要幫一個大忙..感激萬分..
Chance36
版主


發表:31
回覆:1033
積分:792
註冊:2002-12-31

發送簡訊給我
#17 引用回覆 回覆 發表時間:2004-05-12 00:48:12 IP:203.204.xxx.xxx 未訂閱
 
// 答案出爐了
procedure TMainUserGroupForm.StringGrid1DrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  ck:tcheckbox;
begin
  ck:=tcheckbox(stringgrid1.objects[ACol,ARow]);
  if(ck<>nil)then
  begin
    ck.Visible := True;// <--------- 加上這一行 因為Grid捲動後 通通被Disable
    //  ck.BringToFront;  // 一般沒有異常狀況 不用加
    ck.Height := StringGrid1.DefaultRowHeight - 1;
    ck.Left := StringGrid1.Left Rect.Left 5;
    ck.Top := StringGrid1.Left Rect.Top 1;
    ck.Width := Rect.Right-Rect.Left-5;
  End Else Begin  // 這部份漏接了
    inherited ; //  DrawCell; <------- 後面拿掉
  End;
end;    再於StringGrid的 OnTopLeftChanged事件中 ,把所有的CheckBox.Visiableyrhne 為False    procedure TForm1.StringGrid1TopLeftChanged(Sender: TObject);
Var
  r,c:Integer ;
begin
  With TStringGrid(Sender) Do Begin
    For r:=FixedRows To RowCount-1 Do Begin
      For c := FixedCols To ColCount-1 Do Begin
        If objects[c,r] <> nil  Then
          TCheckBox(objects[c,r]).Visible := False;
      End;
    End;
  End;
end;
BorlandUser
中階會員


發表:148
回覆:217
積分:73
註冊:2004-02-19

發送簡訊給我
#18 引用回覆 回覆 發表時間:2004-05-12 00:52:20 IP:219.77.xxx.xxx 未訂閱
嘩...真係得了....我明天回到公司再試清楚..T_T...多謝你..真的很感謝你...簡直是我的再生父母... 不過我不太明白什麼時後會觸發OnTopLeftChange ?
BorlandUser
中階會員


發表:148
回覆:217
積分:73
註冊:2004-02-19

發送簡訊給我
#19 引用回覆 回覆 發表時間:2004-05-12 00:54:53 IP:219.77.xxx.xxx 未訂閱
我想問多少少問題..就是為何一定要用stringgrid.parent作為checkbox的parent呢?只用stringgrid會有何分別 萬分感謝你.....一世也記著你...
Chance36
版主


發表:31
回覆:1033
積分:792
註冊:2002-12-31

發送簡訊給我
#20 引用回覆 回覆 發表時間:2004-05-12 01:10:06 IP:203.204.xxx.xxx 未訂閱
引言: 不過我不太明白什麼時後會觸發OnTopLeftChange ? 就是為何一定要用stringgrid.parent作為checkbox的parent呢?只用stringgrid會有何分別
1.事件名稱已說明清楚啦!左上的Cell改變時,剛開始是[1,1]為左上Cell,往下捲動一列,不就變成[1,2]了嗎? 2.這問題,沒有圖形輔助,真不好說明,以Left來說明好了,假設Form 上放個Panel,又在Panel上放StringGrid,關係如下 Panel1.Parent := Form1; Panel1.Left := 10 ; Panel.Top := 10 ; StringGrid.Parent:= Panel, StringGrid.Left:=10, StringGrid.Top:= 10; 現有一個CheckBox ,對應到StringGrid.Cells[0,0]時,其左上座標是多少? CheckBox.Parent := Form時 CheckBox.Left := Panel.Left StringGrid.Left CellRect(c,r); CheckBox.Parent := Panel時 CheckBox.Left := StringGrid.Left CellRect(c,r); 若CheckBox.Parent := StringGrid時 CheckBox.Left := CellRect(c,r); 好像沒問題,畫面也正常,但是用滑鼠點看看,是不是不聽話?我也不知原因 主要是少一層關係而已,程式碼也比較乾淨,萬一StringGrid放在多層Panel又加PageControl,其中又有Panel或其他Contaner的物件中,那可就麻煩了。所以只要Parent設成與StringGrid一樣後,只要相對於StringGrid的位移算出來就一勞永逸。 發表人 - chance36 於 2004/05/12 01:23:23
BorlandUser
中階會員


發表:148
回覆:217
積分:73
註冊:2004-02-19

發送簡訊給我
#21 引用回覆 回覆 發表時間:2004-05-12 01:19:58 IP:219.77.xxx.xxx 未訂閱
我想我明白你的意思...首先多謝你解答我的問題..明日再試結果..不過相信不會再有問題,多謝你幫忙,謝謝 ^_^
BorlandUser
中階會員


發表:148
回覆:217
積分:73
註冊:2004-02-19

發送簡訊給我
#22 引用回覆 回覆 發表時間:2004-05-12 10:53:22 IP:203.185.xxx.xxx 未訂閱
試到啦,多謝你,好成功.... ps.我也要努力,多幫助大家 ^^
jest0024
高階會員


發表:11
回覆:310
積分:224
註冊:2002-11-24

發送簡訊給我
#23 引用回覆 回覆 發表時間:2004-05-12 17:30:44 IP:203.67.xxx.xxx 未訂閱
用繪的方式..
//自訂繪製TCheckBox的方法
procedure DrawCheckBox(Canvas:TCanvas;Ck:TCheckBox;Const R:TRect);
Const
  bW = 13;
var
  tx,ty :Integer;
  bR    :TRect;
  uState:Integer;
begin
  Canvas.Brush.Style:=bsSolid;
  Canvas.Brush.Color:=ck.Color;
  Canvas.FillRect(R);
  Canvas.Brush.Style:=bsClear;
  Canvas.Font:=ck.Font;
  //繪製方塊  DFCS_INACTIVE(Not Enabled) DFCS_CHECKED        (Checked)
  uState:=DFCS_BUTTONCHECK;
  if(Not ck.Enabled)then uState:=uState or DFCS_INACTIVE;
  if(ck.Checked)then uState:=uState or DFCS_CHECKED;
  tx:=R.Left;
  ty:=R.Top (R.Bottom-R.Top-bw)div 2;
  DrawFrameControl(Canvas.Handle,Rect(tx,ty,tx bw,ty bw),DFC_BUTTON,uState);
  //繪製文字
  tx:=tx bw 5;
  ty:=R.Top (R.Bottom-R.Top-Canvas.TextHeight('A'))div 2;
  if(Not Ck.Enabled)then begin
    Canvas.Font.Color:=clWindow;
    Canvas.TextOut(tx 1,ty 1,ck.Caption);
    Canvas.Font.Color:=clGrayText;
    Canvas.TextOut(tx  ,ty  ,ck.Caption);
  end else Canvas.TextOut(tx,ty,ck.Caption);
end;    //建立CheckBox元件
procedure TForm1.FormCreate(Sender: TObject);
var
  ck :TCheckBox;
  i,j:Integer;
begin
  for j:=1 to StringGrid1.RowCount-1 do
  for i:=1 to StringGrid1.ColCount-1 do begin
    ck:=TCheckBox.Create(Self);
    ck.Visible:=False;
    ck.Parent:=StringGrid1.Parent; 
    ck.Caption:=Format('(%d,%d)',[i,j]);
    ck.CkExit; //離開checkBox時要把checkbox隱藏
    ck.Color :=StringGrid1.Color;
    StringGrid1.Objects[i,j]:=ck;
  end;
end;    //離開元件時,自動隱藏
procedure TForm1.CkExit(Sender:TObject);
begin
  if Sender is TCheckBox then TCheckBox(Sender).Visible:=False;
end;    //表格重繪時,須以自訂方式重繪
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  ck:TCheckBox;
begin
  ck:=TCheckBox(StringGrid1.Objects[ACol,ARow]);
  if(ck<>nil)then DrawCheckBox(StringGrid1.Canvas,ck,Rect);
end;    //當選擇相對表格時,將相對的Ck顯示並移動焦點
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
var
  ck:TCheckBox;
  fR:TRect;
begin
  ck:=TCheckBox(StringGrid1.Objects[ACol,ARow]);
  if(ck=nil)then Exit;
  fR:=StringGrid1.CellRect(ACol,ARow);
  //將Ck放到表格相對位置
  Ck.Left:=StringGrid1.Left fR.Left 2;
  Ck.Top :=StringGrid1.Top fR.Top 2;
  Ck.Width:=fR.Right-fR.Left;
  Ck.Height:=fR.Bottom-fR.Top;
  //顯示ck並將焦點移到Ck
  Ck.Visible:=True;
  Ck.Checked:=Not Ck.Checked;
  Ck.SetFocus;
end;    
學而時習之不亦樂乎! 發表人 - jest0024 於 2004/05/13 00:17:24
系統時間:2018-01-18 23:43:43
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!