type
TExCell = class(TStringGrid)

public
procedure DeleteRow(ARow: Longint);
procedure DeleteColumn(ACol: Longint);
procedure InsertRow(ARow: LongInt);
procedure InsertColumn(ACol: LongInt);
end;

procedure TExCell.InsertColumn(ACol: Integer);
begin
ColCount :=ColCount +1;
MoveColumn(ColCount-1, ACol);
end;

procedure TExCell.InsertRow(ARow: Integer);
begin
RowCount :=RowCount +1;
MoveRow(RowCount-1, ARow);
end;

procedure TExCell.DeleteColumn(ACol: Longint);
begin
MoveColumn(ACol, ColCount -1);
ColCount := ColCount - 1;
end;

procedure TExCell.DeleteRow(ARow: Longint);
begin
MoveRow(ARow, RowCount - 1);
RowCount := RowCount - 1;
end; 



2003-11-17 16:21:00    
發表評語»»»     

2003-11-17 16:22:50    如何編寫使StringGrid中的一列具有Check功能，和CheckBox效果一樣 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. 


2003-11-17 16:23:23    StringGrid組件Cells內容分行顯示 
在Tstringgrid.ondrawcell事件中：

DrawText(StringGrid1.Canvas.Handle,pchar(StringGrid1.Cells[Acol,Arow]),Length(StringGrid1.Cells[Acol,Arow]),Rect,DT_WORDBREAK or DT_LEFT);

可以實現文字換行！ 


2003-11-17 16:24:04    在StringGrid怎樣制作只讀的列 
在 OnSelectCell事件處理程序中,加入: (所有的列均設成可修改的)

if Col mod 2 = 0 then
  grd.Options := grd.Options + [goEditing]
else
  grd.Options := grd.Options - [goEditing]; 


2003-11-17 16:25:07    stringgrid從文本讀入的問題（Save/Load a TStringGrid to/from a file?） 
stringgrid從文本讀入的問題（Save/Load a TStringGrid to/from a file?）

// Save a TStringGrid to a file
procedure SaveStringGrid(StringGrid: TStringGrid; const FileName: TFileName);
var
f: TextFile;
i, k: Integer;
begin
AssignFile(f, FileName);
Rewrite(f);
with StringGrid do
begin
  // Write number of Columns/Rows
  Writeln(f, ColCount);
  Writeln(f, RowCount);
  // loop through cells
  for i := 0 to ColCount - 1 do
    for k := 0 to RowCount - 1 do
      Writeln(F, Cells[i, k]);
end;
CloseFile(F);
end;

// Load a TStringGrid from a file
procedure LoadStringGrid(StringGrid: TStringGrid; const FileName: TFileName);
var
f: TextFile;
iTmp, i, k: Integer;
strTemp: String;
begin
AssignFile(f, FileName);
Reset(f);
with StringGrid do
begin
  // Get number of columns
  Readln(f, iTmp);
  ColCount := iTmp;
  // Get number of rows
  Readln(f, iTmp);
  RowCount := iTmp;
  // loop through cells & fill in values
  for i := 0 to ColCount - 1 do
    for k := 0 to RowCount - 1 do
    begin
      Readln(f, strTemp);
      Cells[i, k] := strTemp;
    end;
  end;
CloseFile(f);
end;

// Save StringGrid1 to 'c:.txt':
procedure TForm1.Button1Click(Sender: TObject);
begin
SaveStringGrid(StringGrid1, 'c:.txt');
end;

// Load StringGrid1 from 'c:.txt':
procedure TForm1.Button2Click(Sender: TObject);
begin
LoadStringGrid(StringGrid1, 'c:.txt');
end;

*******************************************

打開一個已有的文本文件,并將內容放到stringgrid中,文本行與stringgrid行一致; 
在文本中遇到空格則放入下一cells.
搞定！注意，我只寫了一個空格間隔的，你自己修改一下splitstring可以用多個空格分隔！

procedure TForm1.Button1Click(Sender: TObject);
var
aa,bb:tstringlist;
i:integer;
begin
aa:=tstringlist.Create;
bb:=tstringlist.Create;
aa.LoadFromFile('c:.txt');
for i:=0 to aa.Count-1 do
begin
  bb:=SplitString(aa.Strings[i],' ');
  stringgrid1.Rows[i]:=bb;
end;
aa.Free;
bb.Free;
end;

其中splitstring為：

function SplitString(const source,ch:string):tstringlist;
var
temp:string;
i:integer;
begin
result:=tstringlist.Create;
temp:=source;
i:=pos(ch,source);
while i<>0 do
begin
  result.Add(copy(temp,0,i-1));
  delete(temp,1,i);
  i:=pos(ch,temp);
end;
result.Add(temp);
end;




StringGrid組件Cells內容對齊

在StringGrid的DrawCell事件中添加類似的代碼就可以了：

VAR
vCol, vRow : LongInt;
begin
vCol := ACol; vRow := ARow;
WITH Sender AS TStringGrid, Canvas DO
  IF vCol = 2 THEN BEGIN ///對于第2列設置為右對齊
    SetTextAlign(Handle, TA_RIGHT);
    FillRect(Rect);
    TextRect(Rect, Rect.RIGHT-2, Rect.Top+2, Cells[vCol, vRow]);
  END;
end; 


2003-11-17 16:28:41    當我將StringGird的options屬性中包含goRowSelect項時每當我選中StringGrid中一行， 則選中行用深藍色顯示，我想將深藍色改為其他顏色應怎樣該？ 
當我將StringGird的options屬性中包含goRowSelect項時每當我選中StringGrid中一行， 則選中行用深藍色顯示，我想將深藍色改為其他顏色應怎樣該？

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
With StringGrid1 do
begin
  If  (ARow= Krow) and not (acol = 0) then
  begin
     Canvas.Brush.Color :=clYellow;// ClBlue;
     Canvas.FillRect(Rect);
     Canvas.font.color:=ClBlack;
     Canvas.TextOut(rect.left , rect.top, cells[acol, arow]);
  end;
end;
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
ARow: Integer; var CanSelect: Boolean);
begin
krow := Arow;  //*
kcol := Acol;
end;  

注意：必須把變量KROW的值初始為1或其他不為0的值，否則如果鎖定第一行的話，第一行的顏色將被自設顏色取代，而鎖定行不會被重畫。 


2003-11-17 16:32:44    怎么改變StringGrid控件某一列的背景和某一列的只讀屬性,StringGrid控件標題欄的對齊. 
怎么改變StringGrid控件某一列的背景和某一列的只讀屬性,StringGrid控件標題欄的對齊.
請參考以下代碼：
在OnDrawCell事件中處理背景色。程序如下：
//將第二列背景變為紅色。
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
if not((acol=1) and (arow>=stringgrid1.fixedrows)) then exit;
with stringgrid1 do
begin
  canvas.Brush.color:=clRed;
  canvas.FillRect(Rect);
  canvas.TextOut(rect.left+2,rect.top+2,cells[acol,arow])
end;
end;

//加入如下代碼,那么StringGrid的第四列就只讀了.其他列非只讀
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
begin
with StringGrid1 do begin
  if ACol = 4 then
    Options := Options - [goEditing]
  else Options := Options + [goEditing];
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
dx,dy:byte;
begin
if (acol = 4) and not (arow = 0) then
  with stringgrid1 do
  begin
    canvas.Brush.color := clYellow;
    canvas.FillRect(Rect);
    canvas.font.color := clblue;
    dx:=2;//調整此值，控制字在網格中顯示的水平位置
    dy:=2;//調整此值，控制字在網格中顯示的垂直位置
    canvas.TextOut(rect.left+dx , rect.top+dy , cells[acol, arow]);
  end;
//控制標題欄的對齊
if (arow = 0) then
  with stringgrid1 do
  begin
    canvas.Brush.color := clbtnface;
    canvas.FillRect(Rect);
    dx := 12; //調整此值，控制字在網格中顯示的水平位置
    dy := 5; //調整此值，控制字在網格中顯示的垂直位置
    canvas.TextOut(rect.left + dx, rect.top + dy, cells[acol, arow]);
  end;
end;   


2003-11-17 16:37:15    在stringGrid中使用回車鍵模擬TAB鍵切換單元格的功能實現 
......
procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
label
nexttab;
begin
if key=#13 then
begin
  key:=#0;
  nexttab:
  if (stringgrid1.Col<stringgrid1.ColCount-1) then
    begin
      stringgrid1.Col:=stringgrid1.Col+1;
    end
  else
  begin
    if stringgrid1.Row>=stringgrid1.RowCount-1 then
      stringgrid1.RowCount:=stringgrid1.rowCount+1;
    stringgrid1.Row:=stringgrid1.Row+1;
    stringgrid1.Col:=0;
    goto nexttab;
  end;
end;
end;
.........   


2003-11-17 16:42:17    stringgrid如何清空 
with StringGrid1 do for I := 0 to ColCount - 1 do Cols[I].Clear; 


2003-11-17 16:44:00    選中某單元格,然后在該單元格中修改 
-> 選中某單元格,然后在該單元格中修改

設置屬性:
  StringGrid1.Options:=StringGrid1.Options+[goEditing]; 


2003-11-17 16:46:14    讓記錄在StringGrid中分頁顯示 
在Uses中加入： ADOInt 

//首先設定PageSize，取出PageCount
procedure TForm1.Button1Click(Sender: TObject);
begin
ADoquery1.Recordset.PageSize :=spinedit1.Value;
Edit1.Text := IntToStr(ADoquery1.Recordset.PageCount);
ShowData(spinedit2.Value);
end; 

//然后將AbsolutePage的數據乾坤大挪移到StringGrid1中 
procedure TForm1.ShowData(page:integer);
var
iRow, iCol, iCount : Integer;
rs : ADOInt.Recordset;
begin
ADoquery1.Recordset.AbsolutePage:=Page;
Currpage:=page;  
iRow := 0;
iCol := 1;
stringgrid1.Cells[iCol, iRow] := 'FixedCol1';
Inc(iCol);
stringgrid1.Cells[iCol, iRow] := 'FixedCol2';
Inc(iRow);
Dec(iCol);
rs := adoquery1.Recordset;
for iCount := 1 to SpinEdit1.Value do 
begin
  stringgrid1.Cells[iCol, iRow] := rs.Fields.Get_Item('FieldName1').Value;
  Inc(iCol);
  stringgrid1.Cells[iCol, iRow] := rs.Fields.Get_Item('FieldName1').Value;
  Inc(iRow);
  Dec(iCol);
  rs.MoveNext;
end;
 
//上一頁 
procedure TForm1.Button2Click(Sender: TObject);
begin
If (CurrPage)<>1 then
  ShowData(CurrPage-1);
end;

//下一頁
procedure TForm1.Button3Click(Sender: TObject);
begin
If CurrPage<>ADoquery1.Recordset.PageCount then
  ShowData(CurrPage+1);
end; 


2003-11-17 16:48:51    打印StringGrid的程序源碼 
這段代碼沒有看懂，但是可能有的朋友需要，所以共享一下子 ：）

procedure TForm1.SpeedButton11Click(Sender: TObject);
Var
Index_R ,ALeft: Integer;
Index : Integer;
begin
StringGrid_File('D:\AAA.TXT');
if Not LinkTextFile then
begin
  ShowMessage('失敗');
  Exit;
end;
//
QuickRep1.DataSet := ADOTable1;
Index_R := ReSize(StringGrid1.Width);
ALeft := 13;
Create_Title(TitleBand1,ALeft,24,HeaderControl1.Sections.Items[0].Width,20,
   HeaderControl1.Sections[0].Text,taLeftJustify);
with Create_QRDBText(DetailBand1,ALeft,8,StringGrid1.ColWidths[0],20,
       StringGrid1.Font,taLeftJustify) do
begin
  DataSet := ADOTable1;
  DataField := ADOTable1.Fields[0].DisplayName;
end;
ALeft := ALeft + StringGrid1.ColWidths[0] * Index_R + Index_R;
For Index := 1 to ADOTable1.FieldCount - 1 do
begin
  Create_VLine(TitleBand1,ALeft - 13,16,1,40);
  Create_Title(TitleBand1,ALeft,24,HeaderControl1.Sections.Items[Index].Width,20,
    HeaderControl1.Sections[Index].Text,taLeftJustify);
  Create_VLine(DetailBand1,ALeft - 13,-1,1,31);
  with Create_QRDBText(DetailBand1,ALeft ,8,StringGrid1.ColWidths[Index] * Index_R,20,
       StringGrid1.Font,taLeftJustify) do
  begin
    DataSet := ADOTable1;
    DataField := ADOTable1.Fields[Index].DisplayName;
  end;
  ALeft := ALeft + StringGrid1.ColWidths[Index] *  Index_R + Index_R;
end;
QuickRep1.Preview;
end;

function TForm1.ReSize(AGridWidth: Integer): Integer;
begin
Result := Trunc(718 / AGridWidth);
end;

function TForm1.StringGrid_File(AFileName: String): Boolean;
var
StrValue : String;
Index : Integer;
ACol , ARow : Integer;
AFileValue : System.TextFile;
begin
StrValue := '';
Try
  AssignFile(AFileValue , AFileName);
  ReWrite(AFileValue);
  StrValue := HeaderControl1.Sections[0].Text;
  For Index := 1 to HeaderControl1.Sections.Count - 1 do
    StrValue := StrValue + ',' + HeaderControl1.Sections[Index].Text;
  Writeln(AFileValue,StrValue);