Dbgrid使用技巧(下)- -
二、建立項目，實現功能
1．新建一項目，併爲表單添加相關控件，各控件主要屬性如下表：
2．建立各Click的事件代碼
Button1(打開表)的Click事件代碼如下：
procedure TForm1.Button1Click(Sender: TObject);
begin
Table1.Open; // 打開Table1關聯的表Student
end;
Button2(關閉表單)的Click事件代碼如下：
procedure TForm1.Button2Click(Sender: TObject);
begin
Application.Terminate;
end;
DBGrid1的TitleClick事件代碼如下：
procedure TForm1.DBGrid1TitleClick(Column: TColumn);
//注：本過程參數Column包含的信息量非常多
begin
MySort(DBGrid1,Column);
end; //調用字段排序
其中，MySort(DBGrid1,Column)爲自定義的排序過程，具體代碼見下述。
3．建立通用處理模塊
爲使該功能具有“通用性”，將其定義爲一過程。
首先，預聲明過程及建立兩個全局私有變量：
...
Type
...
procedure MySort(DBGrid0:TDBGrid; Column: TColumn);//預聲明過程
private
{ Private declarations }
psIndexName:string; //記錄當前索引名稱
plAscend:boolean; //記錄當前索引名稱的索引狀態
public
{ Public declarations }
end;
...
其次，該過程完整代碼如下：
procedure TForm1.MySort(DBGrid0:TDBGrid; Column: TColumn);
var
//本模塊使用到的psIndexName, plAscend兩個變量見上定義
mode:char; //記錄是“升序”還是“降序”
ColName:string; //記錄當前字段名
iCol:Integer; //記錄當前列號
begin
with DBGrid0.DataSource.DataSet as TTable do //Table0
begin
//檢測當前工作表是否已打開
if not Active
then begin
MessageBeep(0);
Application.MessageBox('工作表尚未打開！','停止',MB_OK+MB_ICONSTOP);
Abort
end;
//檢測當前字段是否“能排序”。以下字段類型不能排序
case Column.Field.DataType of
ftBoolean,
ftBytes,
ftBlob, //Binary
ftMemo,
ftGraphic,
ftFmtMemo, //Formatted memo
ftParadoxOle: //OLE
begin
MessageBeep(0);
Application.MessageBox(Pchar('項目"'+Column.FieldName+'"'+'不能排序！'),'停止',MB_OK+MB_ICONSTOP);
Abort
end;
end; //case
mode:='0';
iCol:=Column.Field.FieldNo-1;
try
ColName:=Column.fieldname;
if psIndexName=Column.fieldname
then begin //與原來同列
if plAscend //升序
then begin
mode:='2';
IndexName:=ColName+'2'; //應“降序”
end
else begin
mode:='1';
IndexName:=ColName+'1'; //應“升序”
end;
plAscend:=not plAscend;
end
else begin //新列
IndexName:=ColName+'2';
plAscend:=false;
psIndexName:=ColName;
end;
except
on EDatabaseError do //若未有索引，則重新建立
begin
Messagebeep(0);
//以下新建索引
IndexName:='';
Close;
Exclusive:=true;
if mode='1'
then AddIndex(ColName+'1',ColName,[ixCaseInsensitive],'')//
else //包括'0'
AddIndex(ColName+'2',ColName,[ixDescending,ixCaseInsensitive],'');
Exclusive:=false;
Open;
try //try 1
if mode<>'1'
then begin
mode:='2';//轉換
plAscend:=false;
end
else plAscend:=true;
IndexName:=ColName+mode;
psIndexName:=ColName;
except
on EDBEngineError do
IndexName:='';
end //try 2
end
end;
First;
end; //with
DBGrid0.SelectedIndex:=iCol;
end;//End of MySort
本過程已對所有可能的錯誤進行了相應的檢測及處理，代碼是比較完整的。因此，把該過程放入你相應的單元中，對每一個DBGrid，只要傳遞不同的DBGrid及Column參數，就能實現對應數據表的自動排序處理，而事先只爲某字段建立一關鍵索引即可，其它Secondery Indexes的建立均在程序中自動完成，但會爲每一個建立了索引的字段生成了一些附加文件（如*.XG?,*YG?等）。當然若有必要，可以在表單關閉前將所有的附加文件刪除。
2003-11-19 12:16:05 將 DBGrid 中的內容輸出至 Excel 或 ClipBoard
//注意:下面的方法必須包含 ComObj, Excel97 單元
//-----------------------------------------------------------
// if toExcel = false, export dbgrid contents to the Clipboard
// if toExcel = true, export dbgrid to Microsoft Excel
procedure ExportDBGrid(toExcel: Boolean);
var
bm: TBookmark;
col, row: Integer;
sline: String;
mem: TMemo;
ExcelApp: Variant;
begin
Screen.Cursor := crHourglass;
DBGrid1.DataSource.DataSet.DisableControls;
bm := DBGrid1.DataSource.DataSet.GetBookmark;
DBGrid1.DataSource.DataSet.First;
// create the Excel object
if toExcel then
begin
ExcelApp := CreateOleObject('Excel.Application');
ExcelApp.WorkBooks.Add(xlWBatWorkSheet);
ExcelApp.WorkBooks[1].WorkSheets[1].Name := 'Grid Data';
end;
// First we send the data to a memo
// works faster than doing it directly to Excel
mem := TMemo.Create(Self);
mem.Visible := false;
mem.Parent := MainForm;
mem.Clear;
sline := '';
// add the info for the column names
for col := 0 to DBGrid1.FieldCount-1 do
sline := sline + DBGrid1.Fields[col].DisplayLabel + #9;
mem.Lines.Add(sline);
// get the data into the memo
for row := 0 to DBGrid1.DataSource.DataSet.RecordCount-1 do
begin
sline := '';
for col := 0 to DBGrid1.FieldCount-1 do
sline := sline + DBGrid1.Fields[col].AsString + #9;
mem.Lines.Add(sline);
DBGrid1.DataSource.DataSet.Next;
end;
// we copy the data to the clipboard
mem.SelectAll;
mem.CopyToClipboard;
// if needed, send it to Excel
// if not, we already have it in the clipboard
if toExcel then
begin
ExcelApp.Workbooks[1].WorkSheets['Grid Data'].Paste;
ExcelApp.Visible := true;
end;
FreeAndNil(mem);
// FreeAndNil(ExcelApp);
DBGrid1.DataSource.DataSet.GotoBookmark(bm);
DBGrid1.DataSource.DataSet.FreeBookmark(bm);
DBGrid1.DataSource.DataSet.EnableControls;
Screen.Cursor := crDefault;
end;
2003-11-19 12:20:56 怎樣獲得DBGrid中的cell的座標???//新建一個工程,在窗體上加一個StringGrid
//下面是unit1.pas
unit Unit1;
interface
uses
Windows Messages SysUtils Classes Graphics Controls Forms Dia
logs
Grids;
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
procedure FormCreate(Sender: TObject);
procedure StringGrid1DblClick(Sender: TObject);
procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X Y: Integer);
procedure StringGrid1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
const
WeekDayName :Array[1..7] of String=('星期一' '星期二' '星期三' '星期四
' '星期五' '星期六' '星期日');
var
X_Pos Y_Pos:integer;//鼠標在窗體的位置
Col_Pos Row_Pos:integer;//單元位置
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
i:integer;
begin
Application.HintPause:=100;
Font.Size :=10;
Caption:='STring岩石程序';
StringGrid1.ShowHint :=True;
StringGrid1.ColCount :=8;
StringGrid1.RowCount :=12;
StringGrid1.Cells[0 0]:='第18周';
for i:=1 to StringGrid1.ColCount -1 do
StringGrid1.Cells[i 0]:=WeekDayName[i];
for i:=1 to StringGrid1.RowCount -1 do
StringGrid1.Cells[0 i]:=InttoStr(i+7)+':00';
StringGrid1.Options :=StringGrid1.Options+[goTabs goROwSizing goColSizing]-[goEditing];
end;
procedure TForm1.StringGrid1DblClick(Sender: TObject);
var
SchemeItem:String;
begin
StringGrid1.MouseToCell(X_Pos Y_Pos Col_Pos Row_Pos) ; //轉換到單位位置
if (Col_Pos<0 )or (Row_Pos<0 ) then
Exit;
if (StringGrid1.Cells[Col_Pos Row_Pos]<>'' ) then //取消計劃概要
begin
StringGrid1.Cells[Col_Pos Row_Pos]:='';
Exit;
end;
SchemeItem:=InputBox('提示' '請輸入計劃概要:' '會議');
StringGrid1.Cells[Col_Pos Row_Pos]:=SchemeItem;
End;
procedure TForm1.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X Y: Integer);
begin
X_Pos:=x;
Y_Pos:=y;
end;
procedure TForm1.StringGrid1Click(Sender: TObject);
begin
StringGrid1.MouseToCell(X_Pos Y_Pos Col_Pos Row_Pos);//轉化到單元位置
StringGrid1.Hint :=StringGrid1.Cells[Col_Pos Row_Pos];//暫時借用該特性顯示工作計劃
end;
end.
2003-11-19 12:33:15 多層表頭的DBGrid（推薦大家學習，很有用） TclientDataSet控件是在Delphi中設計多層分佈式數據庫程序的核心控件，在Delphi3中它最早出現，在Delphi4和Delphi5中得到了進一步加強。TclientDataSet控件具有強大的功能，無論是單層、兩層C/S和多層結構都可以使用TclientDataSet控件。從borland公司的公佈的資料看，它的功能還將得到不斷增強，本文主要介紹利用TclientDataSet控件的特色功能——抽象字段類型配合TDBGRID控件實現複雜題頭。
在設計數據庫錄入界面時，經常需要實現一些複雜題頭，這通常需要利用第三方控件或進行特殊處理才能實現。而在Delphi中利用TClientDataSe的ADT（抽象字段類型）配合TDbgrid控件，可以非常容易地實現這種題頭。
下面就以一個員工的工資信息表來說明具體步驟。
假設某單位的工資信息表的結構如圖所示。
－－－－－－－－－－－－－－－－－
基本信息
－－－－－－－－－－－－－－－－－
性別 | 年齡 | 籍貫 | 職稱
首先生成一個新的 Application,在窗體上添加一個 TClientDataSet 構件和 TDataSource 構件,其 name 屬性分別爲 ClientDataSet1 和 DataSource1 ,並把 DataSource1 的 DataSource 屬性設置爲 ClientDataSet1 上；添加一個 TDBGRID 和 TdbNavigator 控件，命名爲 DBGRID1 和 DbNavigator1，其 Datasource1 屬性設置爲 ClientDataSet1。
然後建立 TclientDataSet 的字段定義。這裏只介紹如何定義抽象字段：將基本信息和工資作爲兩個抽象字段，如圖3所示，將兩個字段分別命名爲 INFO 和 Salary。
然後依次建立 INFO 字段和 SALARY 的子字段，單擊對象觀察器的 ChildDefs，進入子字段編輯器，依次輸入該字段的子字段。然後調用 TclientDataSet 的快捷菜單（鼠標點擊 TclientDataSet 控件，然後右擊鼠標） CreateDataSet 建立 CDS 數據表，並保存文件。最後建立 TClientDataSet 的永久字段，TclientDataSet 的快捷菜單，選擇ADD All Fields。
至此有關 ClientDataSet 的設置完畢。
在設置完 ClientDataSet 之後，需要設置DBGRID的顯示屬性。主要就是設置 Colums 的有關屬性（略）。編譯運行即可出現如圖2所示的運行界面。然後添加一個 Tdbnavigator 控件，將其 DataSource 屬性設置爲 Datasource1。這些與普通的基於BDE的數據庫應用是一樣的，不多敘述。
2003-11-19 13:33:24 在 dbgrid 中實現 copy、paste 功能 工具條上的Cut、Copy和Paste加速按鈕,對於使用Windows下編輯器的人來說,恐怕都是非常熟悉而且不可缺少的。Delphi中的有些控件,如:TDBEdit、TDBImage、TDBMemo、TEdit等,具有CutToClipboard、CopyToClipboard和PasteFromClipboard方法,在這些控件上,利用這幾個方法,只要通過簡單的編程,就可以實現上述加速按鈕。但TDBGrid控件卻不提供上述方法,無法直接實現這幾種功能。而在單機的數據庫應用程序中,TDBGrid卻經常被用來進行數據(包括數字和文字)的輸入,沒有Copy和Paste功能,使用起來深感不便。筆者在編程過程中,利用中間控件進行“過渡”,間接地實現了這幾種功能。
【主要思路】：既然TDBGrid控件無法直接實現Copy和Paste編輯功能,則可以將TDBGrid控件中需要進行這幾種編輯的字段(Field)的內容,轉移到具備這幾種功能的控件(以TDBEdit爲例)中去,編輯完畢後,再傳回到TDBGrid中。
【具體方法】：在已設計好的包含有TDBGrid控件(設名爲DBGrid1)的窗體中,增加一個TDBEdit(設名爲DBEdit1)控件,其DataSources屬性設爲與DBGrid1的DataSources屬性相同,對DBGrid1控件的OnColEnter事件編程,使DBEdit1的DataField屬性值等於DBGrid1控件的被選擇字段的字段名。再在窗體中增加兩個快速按鈕:Copy和Paste,圖形可選Delphi子目錄下ImagesιButtons子目錄裏的Copy.bmp和Paste.bmp。
對Copy快速按鈕的OnClick事件編程:
DBEdit1.CopyToClipboard;
對Paste快速按鈕的OnClick事件編程:
DBEdit1.PasteFromClipboard;
DBGrid1.SelectedField.AsString:=DBEdit1.Text;
此時,如果DBGrid1中的某一單元Cell數字需要粘貼另一單元Cell2的部分或全部內容,用鼠標單擊選擇Cell2,此時DBEdit1所顯示的內容與Cell2的內容相同。在DBEdit1中用鼠標拖曳選擇部分或全部內容,單擊Copy快速按鈕;再用鼠標單擊選擇Cell,此時DBEdit1所顯示的內容與Cell相同,在DBEdit中欲粘貼剛纔所選內容的位置插入光標,單擊Paste快速按鈕,則剛纔所選內容插入到光標位置,Cell的內容也隨之改變成插入後的內容,由此完成了一次Copy—Paste操作。
用這種方法實現Copy—Paste操作,比正常的操作多了一次鼠標的鍵擊、兩次鼠標的移動。在重複輸入的內容不多,且操作者鍵盤輸入很快很熟練的情況下,這種實現Copy—Paste的方法,意義似乎不大。但如果應用程序的使用者是那些並沒有掌握某種快速文字輸入技巧、很有可能還在使用拼音輸入法的人,如果使用者對正常的Copy—Paste方法本來就不熟練(則感覺不到這種方法的不合常規),且又非常地善於在一長串的同音字裏翻來翻去地尋找的話,這還是一種不錯的方法。如果哪位讀者有能在TDBGrid中實現常規Copy—Paste操作的方法,請不吝賜教。
以下是有關的程序代碼:
procedure TUnitDetail.DBGrid1ColEnter(Sender:TObject);
begin
case DBGrid1.SelectedIndex of
0:DBEdit1.DataField:='UnitNum';
1:DBEdit1.DataField:='UnitName';
2:DBEdit1.DataField:='Header';
3:DBEdit1.DataField:='Address';
4:DBEdit1.DataField:='Tel';
end;
end;
procedure TUnitDetail.SBCopyClick(Sender:TObject);
begin
DBEdit1.CopyToClipboard;
end;
procedureTUnitDetail.SBPasteClick(Sender:TObject);
begin
DBEdit1.PasteFromClipboard;
DBGrid1.SelectedField.AsString:=DBEdit1.text;
end;
2003-11-19 13:34:33 禁止在DBGrid中按delete刪除記錄procedure TForm1.DBGrid1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if (ssctrl in shift) and (key=vk_delete) then key:=0;
end;
2003-11-19 13:39:54 給 DBGrid 添加搜索功能下面給出一個完整的例子，要注意的是：一開始需要將查詢的字段全部加入TDBGrid中，否則會有訪問衝突的。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Db, DBTables, Grids, DBGrids, StdCtrls, ExtCtrls, DBCtrls;
type
TTFm_Main = class(TForm)
qry_Data: TQuery;
Ds_Data: TDataSource;
Ed_Search: TEdit; //附加一個TEdit框.
dbg_Data: TDBGrid;
Database1: TDatabase; //數據庫構件，試驗時可任意設定。
DBNavigator1: TDBNavigator;
procedure dbg_DataTitleClick(Column: TColumn);
procedure FormCreate(Sender: TObject);
procedure Ed_SearchChange(Sender: TObject);
private
{ Private declarations }
FQueryStatement: string; // SQL 查詢語句。
FALphaNumericKeyPress: TKeyPressEvent;
public
{ Public declarations }
property QueryStatement: string read FQueryStatement;
procedure FloatOnKeyPress(Sender: TObject; var Key: Char);
end;
var
TFm_Main: TTFm_Main;
implementation
{$R *.DFM}
procedure TTFm_Main.dbg_DataTitleClick(Column: TColumn);
var
vi_Counter: Integer;
vs_Field: string;
begin
with dbg_Data do
begin
//First, deselect all the Grid Columns
for vi_Counter := 0 to Columns.Count - 1 do
Columns[vi_Counter].Color := clWindow;
//Next "Select" the column the user has Clicked on
Column.Color := clTeal;
//Get the FieldName of the Selected Column
vs_Field := Column.FieldName;
//Order the Grid Data by the Selected column
with qry_Data do
begin
DisableControls;
Close;
SQL.Clear;
SQL.Text := QueryStatement + ' ORDER BY ' + vs_Field;
Open;
EnableControls;
end;
//Get the DataType of the selected Field and change the Edit event
//OnKeyPress to the proper method Pointer
case Column.Field.DataType of
ftFloat: Ed_Search.OnKeyPress := FloatOnKeyPress;
else
Ed_Search.OnKeyPress := FALphaNumericKeyPress;
end;
end;
end;
procedure TTFm_Main.FloatOnKeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in ['0'..'9', #13, #8, #10, #46]) then
Key := #0;
end;
procedure TTFm_Main.FormCreate(Sender: TObject);
begin
//Keep a pointer for the default event Handler
FALphaNumericKeyPress := Ed_Search.OnKeyPress;
//Set the original Query SQL Statement
FQueryStatement := 'SELECT * FROM your_table_name';
//Select the first Grid Column
dbg_DataTitleClick(dbg_Data.Columns[0]);
end;
procedure TTFm_Main.Ed_SearchChange(Sender: TObject);
var
vi_counter: Integer;
vs_Field: string;
begin
try
with dbg_Data do
begin
//First determine wich is the Selected Column
for vi_Counter := 0 to Columns.Count - 1 do
if Columns[vi_Counter].Color = clTeal then
begin
vs_Field := Columns[vi_Counter].FieldName;
Break;
end;
//Locate the Value in the Query
with qry_Data do
case Columns[vi_Counter].Field.DataType of
ftFloat: Locate(vs_Field, StrToFloat(Ed_Search.Text),
[loCaseInsensitive, loPartialKey]);
else
Locate(vs_Field, Ed_Search.Text, [loCaseInsensitive, loPartialKey]);
end;
end;
except
end;
end;
end.
2003-11-19 13:53:23 數據網格自動適應寬度///////源代碼開始
uses
Math;
function DBGridRecordSize(mColumn: TColumn): Boolean;
{ 返回記錄數據網格列顯示最大寬度是否成功 }
begin
Result := False;
if not Assigned(mColumn.Field) then Exit;
mColumn.Field.Tag := Max(mColumn.Field.Tag,
TDBGrid(mColumn.Grid).Canvas.TextWidth(mColumn.Field.DisplayText));
Result := True;
end; { DBGridRecordSize }
function DBGridAutoSize(mDBGrid: TDBGrid; mOffset: Integer = 5): Boolean;
{ 返回數據網格自動適應寬度是否成功 }
var
I: Integer;
begin
Result := False;
if not Assigned(mDBGrid) then Exit;
if not Assigned(mDBGrid.DataSource) then Exit;
if not Assigned(mDBGrid.DataSource.DataSet) then Exit;
if not mDBGrid.DataSource.DataSet.Active then Exit;
for I := 0 to mDBGrid.Columns.Count - 1 do begin
if not mDBGrid.Columns[I].Visible then Continue;
if Assigned(mDBGrid.Columns[I].Field) then
mDBGrid.Columns[I].Width := Max(mDBGrid.Columns[I].Field.Tag,
mDBGrid.Canvas.TextWidth(mDBGrid.Columns[I].Title.Caption)) + mOffset
else mDBGrid.Columns[I].Width :=
mDBGrid.Canvas.TextWidth(mDBGrid.Columns[I].Title.Caption) + mOffset;
mDBGrid.Refresh;
end;
Result := True;
end; { DBGridAutoSize }
///////源代碼結束
///////使用示例開始
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
DBGridRecordSize(Column);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DBGridAutoSize(DBGrid1);
end;
///////使用示例結束
2003-11-19 13:55:47 移除DBGrid的垂直滾動條（參考“判斷Grid是否有滾動條？”）type
TNoVertScrollDBGrid = class(TDBGrid)
protected
procedure Paint; override;
end;
procedure Register;
implementation
procedure TNoVertScrollDBGrid.Paint;
begin
SetScrollRange(Self.Handle, SB_VERT, 0, 0, False);
inherited Paint;
end;
procedure Register;
begin
RegisterComponents('Data Controls', [TNoVertScrollDBGrid]);
end;
end.
2003-11-19 14:00:48 DBGrid拖放的例子（請同時參考“在TDBGrid控件中實現拖放的另外一個思路/在DBGrid上Drag & Drop（拖放）”）unit GridU1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, Db, DBTables, Grids, DBGrids, StdCtrls;
type
TForm1 = class(TForm)
MyDBGrid1: TDBGrid;
Table1: TTable;
DataSource1: TDataSource;
Table2: TTable;
DataSource2: TDataSource;
MyDBGrid2: TDBGrid;
procedure MyDBGrid1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure MyDBGrid1DragOver(Sender, Source: TObject;
X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure MyDBGrid1DragDrop(Sender, Source: TObject;
X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
SGC : TGridCoord;
procedure TForm1.MyDBGrid1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
DG : TDBGrid;
begin
DG := Sender as TDBGrid;
SGC := DG.MouseCoord(X,Y);
if (SGC.X > 0) and (SGC.Y > 0) then
(Sender as TDBGrid).BeginDrag(False);
end;
procedure TForm1.MyDBGrid1DragOver(Sender, Source: TObject;
X, Y: Integer; State: TDragState; var Accept: Boolean);
var
GC : TGridCoord;
begin
GC := (Sender as TDBGrid).MouseCoord(X,Y);
Accept := Source is TDBGrid and (GC.X > 0) and (GC.Y > 0);
end;
procedure TForm1.MyDBGrid1DragDrop(Sender, Source: TObject;
X, Y: Integer);
var
DG : TDBGrid;
GC : TGridCoord;
CurRow : Integer;
begin
DG := Sender as TDBGrid;
GC := DG.MouseCoord(X,Y);
with DG.DataSource.DataSet do begin
with (Source as TDBGrid).DataSource.DataSet do
Caption := 'You dragged "'+Fields[SGC.X-1].AsString+'"';
DisableControls;
CurRow := DG.Row;
MoveBy(GC.Y-CurRow);
Caption := Caption+' to "'+Fields[GC.X-1].AsString+'"';
MoveBy(CurRow-GC.Y);
EnableControls;
end;
end;
end.
2003-11-24 11:03:41 解決dbgrid上下移動的另外一種辦法不用重新寫控件,也不用改控件!直接將光色代碼部分加到你的窗體單無中就行.
type
【 TDBGrid = class(DBGrids.TDBGrid)
private
FOldGridWnd : TWndMethod;
procedure NewGridWnd (var Message : TMessage);
public
constructor Create(AOwner: TComponent); override;
end;】
TXXXForm = class(TForm)
......
end;
{ TDBGrid }
【constructor TDBGrid.Create(AOwner: TComponent);
begin
inherited;
Self.FOldGridWnd := Self.WindowProc;
Self.WindowProc := NewGridWnd;
end;
procedure TDBGrid.NewGridWnd(var Message: TMessage);
var
IsNeg : Boolean;
begin
if Message.Msg = WM_MOUSEWHEEL then
begin
IsNeg := Short(Message.WParamHi) < 0;
if IsNeg then
self.DataSource.DataSet.MoveBy(1)
else
self.DataSource.DataSet.MoveBy(-1)
end
else Self.FOldGridWnd(Message);
end;
】
TDBGrid = class(DBGrids.TDBGrid)
....
end;
一定要放在最前面,也可以將【】紅色部分代碼寫一共用單無中,
然後uses publicunit;
再加上這一句:
TDBGrid = Class(publicunit.TDBGrid);
TXXFrom =Class(TForm)
2003-11-25 17:29:59 修改過的Grids，可以支持鼠標滾輪翻頁的功能。 拷貝到/delphi/source/vcl目錄下就能使用。不過我用的是D7，低版本的朋友還是先看看再使用，以防不測。
修改過的Grids，可以支持鼠標滾輪翻頁的功能。
2003-12-1 10:29:21 可以支持鼠標滾輪翻頁的功能的Grids 詳細說明見內。
可以支持鼠標滾輪翻頁的功能的Grids
2003-12-9 10:34:26 關於DBGrid中下拉列表的兩種設計比較一、DBGrid 中 的 下 拉 列 表
在 DBGrid 網格中實現下拉列表，設置好 DBGrid 中該字段的 PickList 字符串列表、初始的序號值 DropDownRows 即可。以職工信息庫中的籍貫字段（字符串類型）爲例，具體設計步驟如下：
1、在窗體上放置 Table1、DataSource1、DBGrid1、DBNavigator1 等控件對象，按下表設置各個對象的屬性:
---------------------------------------
對象 屬性 設定值
---------------------------------------
Table1 DataBase sy1
TableName zgk.dbf //職工信息庫
DataSource1 DataSet Table1
DbGrid1 DataSource DataSource1
DBNavigator1 DataSource Datasource1
-------------------------------------------
2、雙擊 Table1，在彈出的 Form1.Table1 窗口中，用右鍵彈出快捷菜單，單擊 Add Fields 菜單項；選擇所有的字段後，按 OK 按鈕。
3、修改第 2 步新增字段的 DisplayLabel 屬性。以 Table1ZGBH 字段爲例， 在 Object Inspector 窗口中選擇 Table1ZGBH，修改屬性 DisplayLabel= 職工編號，其餘字段類似。
4、雙擊 DBGrid1，在彈出的 Editing DBGrid1.Columns 窗口中， 單擊 Add all Fields 按鈕，增加 Table1 的所有字段。
5、在 Editing DBGrid1.Columns 窗口，選擇 jg 這一行，切換到 Object Inspector 窗口，修改它的 PickList.Strings 爲
“湖北枝江市
北京市
河南平頂山市
浙江德清市”
6、在 Form1.Oncreate 事件中寫入語句：
Table1.Open;
7、F9 運行，用鼠標點擊某個記錄的籍貫字段，右邊即出現一個按鈕，點擊這個按鈕，可出現一個下拉列表，包含第 5 步中輸入的四行字符串，可用鼠標進行選擇。當然也可以自行輸入一個並不屬下拉列表中的字符串。
二、DBGrid 中 的 查 找 字 段
所謂查找字段(LookUp Field)，即 DBGrid中的某個關鍵字段的數值來源於另外一個數據庫的相應字段。運用查找字段技術，不僅可以有效的避免輸入錯誤，而且 DBGrid 的顯示方式更爲靈活，可以不顯示關鍵字段，而顯示源數據庫中相對應的另外一個字段的數據。
例如，我們在 DBGrid 中顯示和編輯職工信息，包括職工編號、職工姓名、籍貫、所在單位編號，而單位編號來源於另一個數據庫表格——單位庫，稱“單位編號”爲關鍵字段。如果我們直接顯示和編輯單位編號的話，將會面對 1、2、3 等非常不直觀的數字，編輯時極易出錯。但是如果顯示和編輯的是單位庫中對應的單位名稱話，將非常直觀。這就是 DBGrid 的所支持的查找字段帶來的好處。
實現 DBGrid 的查找字段同樣不需要任何語句，具體設計步驟如下：
1、在窗體上放置 Table1、Table2、DataSource1、DBGrid1、DBNavigator1 等控件對象，按下表設置各個對象的屬性:
---------------------------------------
對象 屬性 設定值
---------------------------------------
Table1 DataBase sy1
TableName zgk.dbf //職工信息庫
Table2 DataBase sy1
TablenAME dwk.dbf //單位信息庫
DataSource1 DataSet Table1
DbGrid1 DataSource DataSource1
DBNavigator1 DataSource Datasource1
------------------------------------------
2、雙 擊Table1，在彈出的 Form1.Table1 窗口中，用右鍵彈出快捷菜單，單擊 Add Fields 菜單項；選擇所有的字段後，按 OK 按鈕。
3、修改第 2 步新增字段的 DisplayLabel 屬性。以 Table1ZGBH 字段爲例，在 Object Inspector 窗口中選擇 Table1ZGBH，修改屬性 DisplayLabel= 職工編號，其餘字段類似。
4、設置 Table1DWBH.Visible=False。
5、在 Form1.Table1 窗口，用右鍵彈出快捷菜單，單擊 New Field 菜單項，新增一個查找字段 DWMC，在彈出的窗口設置相應的屬性，按 OK 按鈕確認；在 Object Inspector 窗口，設置 Table1DWMC.DisplayLabel= 單位名稱。
6、在 Form1.Oncreate 事件中寫入語句：
Table1.Open;
7、按 F9 運行，當光標移至某個記錄的單位名稱字段時，用鼠標點擊該字段，即出現一個下拉列表，點擊右邊的下箭頭，可在下拉列表中進行選擇。在這裏可以看出，下拉列表的內容來自於單位信息庫，並且不能輸入其他內容。
三、DBGrid 中的下拉列表和查找字段的區別
雖然 DBGrid 中的下拉列表和查找字段，都是以下拉列表的形式出現的，但兩者有很大的差別。
1、用 PickList 屬性設置的下拉列表，它的數據是手工輸入的，雖然也可以在程序中修改，但動態特性顯然不如直接由另外數據庫表格提取數據的查找字段。
2、用 PickList 屬性設置的下拉列表，允許輸入不屬於下拉列表中的數據，但查找字段中只能輸入源數據庫中關鍵字段中的數據，這樣更能保證數據的完整性。
3、用 PickList 屬性設置的下拉列表設計較爲簡單。
2003-12-10 14:44:11 用 dbgrid 或 dbgrideh 如何讓所顯示數據自動滾動？procedure TForm1.Timer1Timer(Sender: TObject);
var
m:tmessage;
begin
m.Msg:=WM_VSCROLL;
m.WParamLo:=SB_LINEDOWN;
m.WParamHi:=1 ;
m.LParam:=0;
postmessage(self.DBGrid1.Handle,m.Msg,m.WParam,m.LParam);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
self.Timer1.Enabled:=true;
end;
如果需要讓他自動不斷地從頭到尾滾動，添加如下代碼
if table1.Eof then table1.First;
2003-12-10 14:58:31 DBGrid 對非布爾字段的欄中如何出現 CheckBox 選擇輸入可將dbgrid關聯的dataset中需顯示特殊內容字段設爲顯式字段，並在OnGetText事件中寫如下代碼：
以table舉例：
procedure TForm1.Table1Myfield1GetText(Sender: TField;
var Text: String; DisplayText: Boolean);
var Pd:string;
begin
inherited;
pd:=table1.fieldbyname('myfield1').asstring;
if pd='1' then
Text:='□'
else
if pd='2' then
text:='▲'
else
Text:='√';
end;
2003-12-15 9:22:15 DbGrid控件隱藏或顯示標題欄DbGrid控件隱藏或顯示標題欄
1、 新建一個帶兩個參數的過程(第1個參數是菜單對象，第2 個是DbGrid控件):
Procedure ViewTitle(Sender:TObject;DbgColumns:TDBGrid);
//隱藏或顯示DbGrid標題欄
2、 然後按Ctrl+Shift+C組合鍵,定義的過程會在實現部分出現。
Procedure FrmStock.ViewTitle(Sender:TObject;DbgColumns:TDBGrid);
begin
With (Sender as TMenuItem) do
begin
Checked:=not Checked;
DbgColumns.Columns[Tag].Visible:=Checked;
end;
end;
3、 把菜單子項的Tag設置成跟DbGrid的Columns值相對應,比如:
DbGrid有一個標題欄是‘日期‘在第0列,然後把要觸法該列的菜單的Tag設置成0。
4、 把菜單的OnClick事件選擇ViewTitle該過程。
2003-12-16 11:48:15 有關雙擊dbgrid排序的問題（想讓用戶雙擊dbgird控件的某一個字段時就升序,再雙擊就降序....?）【DFW：DouZheng】procedure TForm1.DBGrid1TitleClick(Column: TColumn);
var
temp, title: string;
begin
temp := Column.FieldName;
qusp.Close;
if Column.Index <> lastcolumn then
begin
if (Pos('↑', DBGrid1.Columns[LastColumn].Title.Caption) > 0) or (Pos('↓', DBGrid1.Columns[LastColumn].Title.Caption) > 0) then
DBGrid1.Columns[LastColumn].Title.Caption := Copy(DBGrid1.Columns[LastColumn].Title.Caption, 3, Length(DBGrid1.Columns[LastColumn].Title.Caption) - 2);
qusp.Sql[icount] := 'order by ' + temp + ' asc';
DBGrid1.Columns[Column.Index].Title.Caption := '↑' + DBGrid1.Columns[Column.Index].Title.Caption;
lastcolumn := column.Index;
end
else
begin
LastColumn := Column.Index;
title := DBGrid1.Columns[LastColumn].Title.Caption;
if Pos('↑', title) > 0 then
begin
qusp.Sql[icount] := 'order by ' + temp + ' desc';
Delete(title, 1, 2);
DBGrid1.Columns[LastColumn].Title.Caption := '↓' + title;
end
else if Pos('↓', title) > 0 then
begin
qusp.Sql[icount] := 'order by ' + temp + ' asc';
Delete(title, 1, 2);
DBGrid1.Columns[LastColumn].Title.Caption := '↑' + title;
end
else
begin
qusp.Sql[icount] := 'order by ' + temp + ' asc';
DBGrid1.Columns[LastColumn].Title.Caption := '↑' + title;
end;
end;
qusp.Open;
end;
2003-12-16 17:02:46 在DBGrid中，怎樣才能讓我能點擊一個單元格選擇整行，又可以編輯單元格的內容呢？【hongxing_dl 提供代碼】 在設計過程中，有時候數據較大量，field 較多的時候，只是點擊單元格可能會對某個field的數據誤操作（如數據錯行），爲此纔會想到這個問題，解決辦法如下：
點擊單元格就改當前行顏色。這個辦法也算是沒辦法的辦法吧！
type
TMyDBGrid=class(TDBGrid);
//////////////////////////////////
//DBGrid1.Options->dgEditing=True
//DBGrid1.Options->dgRowSelect=False
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
with TMyDBGrid(Sender) do
begin
if DataLink.ActiveRecord=Row-1 then
begin
Canvas.Font.Color:=clWhite;
Canvas.Brush.Color:=$00800040;
end
else
begin
Canvas.Brush.Color:=Color;
Canvas.Font.Color:=Font.Color;
end;
DefaultDrawColumnCell(Rect,DataCol,Column,State);
end;
end;
測試通過（d7）！
2003-12-17 13:52:49 怎樣在DbGrid的左邊，實現像EXCEL那樣的自動編號？這些編號與表無關.呵呵，很厲害的 Grid 控件強人 hongxing_dl，以下是他的代碼（可以解決問題）
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, DBGrids, StdCtrls, Buttons, Db, DBTables, ExtCtrls, jpeg;
const ROWCNT=20;
type
tmygrid=class(tdbgrid)
protected
procedure Paint;override;
procedure DrawCell(ACol:Integer;ARow:Integer;ARect:TRect;AState:TGridDrawState);override;
public
constructor create(AOwner:TComponent);override;
destructor destroy;override;
end;
TForm1 = class(TForm)
BitBtn1: TBitBtn;
DataSource1: TDataSource;
Table1: TTable;
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
mygrid:tmygrid;
implementation
{$R *.DFM}
{tmygrid}
constructor tmygrid.create(AOwner:TComponent);
begin
inherited create(Owner);
RowCount:=ROWCNT;
end;
destructor tmygrid.destroy;
begin
inherited;
end;
procedure tmygrid.Paint;
begin
RowCount:=ROWCNT;
if dgIndicator in options then
ColWidths[0]:=30;
inherited;
end;
procedure tmygrid.DrawCell(ACol:Integer;ARow:Integer;ARect:TRect;AState:TGridDrawState);
begin
inherited;
if (ARow>=1) and (ACol=0) then
Canvas.TextRect(ARect,ARect.Left,ARect.Top,IntToSTr(ARow));
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
mygrid:=tmygrid.create(Self);
mygrid.parent:=self;
mygrid.left:=0;
mygrid.top:=0;
mygrid.Height:=300;
mygrid.DataSource:=DataSource1;
end;
end.
2003-12-22 9:22:15 如何將幾個DBGRID裏的內容導入同一個EXCEL表中？前言：
在軟件實際製作中，爲節省開發成本和開發週期，一些軟件人員通常會吧DBGrid中的數據直接導出到Excel表中，而先前能看到的函數僅僅只能在WorkBook的一個Sheet中導入數據，不支持多Sheet！。
單元應用：
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, DBTables, Grids, DBGrids, ActiveX, ComObj,
Excel2000, OleServer;
測試環境：
OS：Win2k Pro；Excel2k；Delphi6.0
源程序：
{
功能描述：把DBGrid輸出到Excel表格（支持多Sheet）
設計：CoolSlob
日期：2002-10-23
支持：[email protected]
調用格式：CopyDbDataToExcel([DBGrid1, DBGrid2]);
}
procedure CopyDbDataToExcel(Args: array of const);
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
I: Integer;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;
try
XLApp := CreateOleObject(‘Excel.Application‘);
except
Screen.Cursor := crDefault;
Exit;
end;
XLApp.WorkBooks.Add;
XLApp.SheetsInNewWorkbook := High(Args) + 1;
for I := Low(Args) to High(Args) do
begin
XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name;
Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];
if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end;
TDBGrid(Args[I].VObject).DataSource.DataSet.first;
for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
Sheet.Cells[1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;
jCount := 1;
while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do
begin
for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
Sheet.Cells[jCount + 1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString;
Inc(jCount);
TDBGrid(Args[I].VObject).DataSource.DataSet.Next;
end;
end;
XlApp.Visible := True;
Screen.Cursor := crDefault;
end;
2003-12-22 9:25:32 DbGrid控件的標題欄彈出菜單DbGrid控件的標題欄彈出菜單
procedure TFrmOrderPost.DbgOrderPostMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
CurPost:TPoint;
begin
GetCursorPos(CurPost);//獲得鼠標當前座標
if (y<=17) and (x<=vCurRect.Right) then
begin
if button=mbright then
begin
PmTitle.Popup(CurPost.x,CurPost.y);
end;
end;
end;
//vCurRect該變量在DbGrid的DrawColumnCell事件中獲得
{procedure TFrmOrderPost.DbgOrderPostDrawColumnCell(Sender: TObject;const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
vCurRect:=Rect;//vCurRect在實現部分定義
end;}
2003-12-22 10:12:55 DbGrid控件的標題欄彈出菜單DbGrid控件的標題欄彈出菜單
procedure TFrmOrderPost.DbgOrderPostMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
CurPost:TPoint;
begin
GetCursorPos(CurPost);//獲得鼠標當前座標
if (y<=17) and (x<=vCurRect.Right) then
begin
if button=mbright then
begin
PmTitle.Popup(CurPost.x,CurPost.y);
end;
end;
end;
//vCurRect該變量在DbGrid的DrawColumnCell事件中獲得
{procedure TFrmOrderPost.DbgOrderPostDrawColumnCell(Sender: TObject;const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
vCurRect:=Rect;//vCurRect在實現部分定義
end;}
2003-12-22 10:14:26 把DBGrid輸出到Excel表格（支持多Sheet）{
功能描述：把DBGrid輸出到Excel表格（支持多Sheet）
調用格式：CopyDbDataToExcel([DBGrid1, DBGrid2]);
}
procedure CopyDbDataToExcel(Args: array of const);
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
I: Integer;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;
try
XLApp := CreateOleObject(‘Excel.Application‘);
except
Screen.Cursor := crDefault;
Exit;
end;
XLApp.WorkBooks.Add;
XLApp.SheetsInNewWorkbook := High(Args) + 1;
for I := Low(Args) to High(Args) do
begin
XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name;
Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];
if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end;
TDBGrid(Args[I].VObject).DataSource.DataSet.first;
for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
Sheet.Cells[1, iCount + 1] :=
TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;
jCount := 1;
while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do
begin
for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
Sheet.Cells[jCount + 1, iCount + 1] :=
TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString;
Inc(jCount);
TDBGrid(Args[I].VObject).DataSource.DataSet.Next;
end;
XlApp.Visible := True;
end;
Screen.Cursor := crDefault;
end;
2004-1-2 11:26:02 自制精美易用的DBGrid【陳大峯】 看了以上這麼多的技巧和方法，想必大家未免會有一種衝動吧－自己動手做一個DBGrid，下面就介紹一種自制DBGrid的方法啦。
Delphi中的TDBGrid是一個使用頻率很高的VCL元件。TDBGrid有許多優良的特性，例如它是數據綁定的，能夠定義功能強大的永久字段，事件豐富等，特別是使用非常簡單。但是，與FoxPro、VB 、PB中的DBGrid相比就會發現，TDBGrid也有明顯的缺陷：它的鍵盤操作方式非常怪異難用。雖然很多人都通過編程把回車鍵轉換成Tab鍵來改進TDBGrid的輸入方式，但是仍然不能很好地解決問題，這是爲什麼呢？本文將對造成這種缺陷的根本原因進行分析，並在此基礎上製作一個輸入極其簡便、界面風格類似Excel的DBGridPro元件。
DBGrid的格子（Cell）有四種狀態：輸入狀態（有輸入光標，可以輸入，記作狀態A1）；下拉狀態（彈出了下拉列表，可以選擇，記作狀態A2）；高亮度狀態（沒有輸入光標，可以輸入，記作狀態B）；顯示狀態（不能輸入，記作狀態C）。DBGrid接受的控制鍵有回車，Tab，Esc，以及方向鍵。據此可以畫出每個Cell的狀態轉換圖：
不難看出，當用戶移動輸入焦點時，對不同的移動方向要用不同的操作方法，甚至可能必須使用多個不同的鍵或藉助鼠標來完成一個操作。當有下拉列表和要斜向移動的時候這種問題尤爲明顯。因此，輸入困難的根本原因是其狀態圖過於複雜和不一致。基於這種認識，我們可以對DBGrid作三點改造：
改造1：顯然B狀態是毫無意義的，應該去掉。這意味着焦點每進入一個新的Cell，就立即進入編輯狀態，而不要再按回車了。每個進入狀態B的Cell都需要重新繪製，因此我們可以在繪製動作中判斷是否有狀態爲gdFocused的Cell，若有則設置EditorMode爲真。值得注意的是，TDBGrid用來畫Cell的函數DefaultDrawColumnCell並不是虛函數，因此不能通過繼承改變其行爲，而只能使用其提供的事件OnDrawColumnCell來插入一些動作。在DBGridPro中，這一點是通過實現顯示事件OnDrawColumnCell來實現的。但是這樣一來，外部對象就不能使用該事件了，所以提供了一個OnOwnDrawColumnCell事件來替代它。見代碼中的Create和DefaultDrawColumnCell函數。
改造2：控制鍵應該簡化，儘量增加每個控制鍵的能力。在DBGridPro中，強化了方向鍵和回車鍵的功能：當光標在行末行首位置時，按方向鍵就能跳格；回車能橫向移動輸入焦點，並且還能彈出下拉列表（見改造3）。在實現方法上，可以利用鍵盤事件API（keybd_event）來將控制鍵轉換成TDBGrid的控制鍵（如在編輯狀態中回車，則取消該事件並重新發出一個Tab鍵事件）。當監測到左右方向鍵時，通過向編輯框發送EM_CHARFROMPOS消息判斷編輯框中的光標位置，以決定是否應該跳格。見代碼中的DoKeyUped函數。
改造3：簡化下拉類型Cell的輸入方式。在DBGridPro中，用戶可以用回車來彈出下拉列表。這種方式看起來可能會造成的回車功能的混淆，但是隻要處理得當，用戶會覺得非常方便：當進入下拉類型的Cell之後，如果用戶直接鍵入修改，則按回車進入下一格；否則彈出下拉列表，選擇之後再按回車時關閉下拉列表並立即進入下一格。見代碼中的DoKeyUped函數和DefaultDrawColumnCell函數。
一番改造之後，用戶輸入已經非常方便了，但是又帶來了新的問題：在TDBGrid中，用戶可以通過高亮度的Cell很快知道焦點在哪裏，而DBGridPro中根本不會出現這種Cell，所以用戶可能很難發現輸入焦點！一種理想的方法是像Excel一樣在焦點位置處放一個黑框--這一點是可以實現的（如圖2）。
Windows中提供了一組API，用於在窗口上建立可接受鼠標點擊事件的區域（Region）。多個Region可以以不同的方式組合起來，從而得到"異型"窗口，包括空心窗口。DBGridPro就利用了這個功能。它在內部建立了一個黑色的Panel，然後在上面設置空心的Region，並把它"套"在有輸入焦點的Cell上，這樣用戶就能看到一個醒目的邊框了。
好事多磨，現在又出現了新的問題：當Column位置或寬度改變時，其邊框必須同步變化。僅利用鼠標事件顯然不能完全解決這個問題，因爲在程序中也可以設置Column的寬度；用事件OnDrawColumnCell也不能解決（寬度改變時並不觸發該事件）。幸運的是，TDBGrid中的輸入框實際上是一個浮動在它上面的TDBGridInplaceEdit（繼承自TInplaceEdit），如果我們能監測到TDBGridInplaceEdit在什麼時候改變大小和位置，就可以讓邊框也跟着改變了。要實現這一點，用一個從TDBGridInplaceEdit繼承的、處理了WM_WINDOWPOSCHANGED消息的子類來替換原來的TDBGridInplaceEdit將是最簡單的辦法。通過查看源代碼發現，輸入框由CreateEditor函數創建的，而這是個虛函數--這表明TDBGrid願意讓子類來創建輸入框，只要它是從TInplaceEdit類型的。從設計模式的角度來看，這種設計方法被稱爲"工廠方法"（Factory Method），它使一個類的實例化延遲到其子類。看來現在我們的目的就要達到了。
不幸的是，TDBGridInplaceEdit在DBGrids.pas中定義在implement中（這樣外部文件就無法看到其定義了），因此除非把它的代碼全部拷貝一遍，或者直接修改DBGrids.pas文件（顯然這前者不可取；後者又會帶來版本兼容性問題），我們是不能從TDBGridInplaceEdit繼承的。難道就沒有好辦法了嗎？當然還有：我們可以利用TDBGridInplaceEdit的可讀寫屬性WindowProc來捕獲WM_WINDOWPOSCHANGED消息。WindowProc實際上是一個函數指針，它指向的函數用來處理髮到該窗口元件的所有消息。於是，我們可以在CreateEditor中將創建出的TDBGridInplaceEdit的WndProc替換成我們自己實現的勾掛函數的指針，從而實現和類繼承相同的功能。這樣做的缺點是破壞了類的封裝性，因爲我們不得不在DBGridPro中處理屬於TDBGridInplaceEdit的工作。當然，可能還有其他更好的方法，歡迎讀者提出建議。
至此，TDBGrid已經被改造成一個操作方便、界面美觀的DBGridPro了，我們可以把它註冊成VCL元件使用。以下是它的源代碼：
unit DBGridPro;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Grids, DBGrids, ExtCtrls, richEdit, DBCtrls, DB;
type TCurCell = Record {當前焦點Cell的位置}
X : integer; {有焦點Cell的ColumnIndex}
Y : integer; {有焦點Cell所在的紀錄的紀錄號}
tag : integer; {最近進入該Cell後是否彈出了下拉列表}
r : TRect; {沒有使用}
end;
type
TDBGridPro = class(tcustomdbgrid)
private
hr,hc1 : HWND; {創建空心區域的Region Handle}
FPan : TPanel; {顯示黑框用的Panel}
hInplaceEditorWndProc : TWndMethod; {編輯框原來的WindowProc}
{勾掛到編輯框的WindowProc}
procedure InPlaceEditorWndProcHook(var msg : TMessage);
procedure AddBox; {顯示邊框}
{實現TCustomDBGrid的OnDrawColumnCell事件}
procedure DoOwnDrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
{處理鍵盤事件}
procedure DoKeyUped(Sender: TObject; var Key: Word; Shift: TShiftState);
protected
curCell : TCurCell; {記錄當前有焦點的Cell}
FOwnDraw : boolean; {代替TCustomDBGrid.DefaultDrawing}
FOnDraw : TDrawColumnCellEvent; {代替TCustomDBGrid.OnDrawColumnCell}
function CreateEditor : TInplaceEdit; override;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure DefaultDrawColumnCell(const Rect: TRect;DataCol: Integer; Column: TColumn; State: TGridDrawState); overload;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
published
property Align;
property Anchors;
property BiDiMode;
property BorderStyle;
property Color;
property Columns stored False; //StoreColumns;
property Constraints;
property Ctl3D;
property DataSource;
property OwnDraw : boolean read FOwnDraw write FOwnDraw default false;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FixedColor;
property Font;
property ImeMode;
property ImeName;
property Options;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property TabStop;
property TitleFont;
property Visible;
property OnCellClick;
property OnColEnter;
property OnColExit;
property OnColumnMoved;
property OnDrawDataCell; { obsolete }
property OnOwnDrawColumnCell : TDrawColumnCellEvent read FOnDraw write FOnDraw;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEditButtonClick;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyup;
property OnKeyPress;
property OnKeyDown;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
property OnTitleClick;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Data Controls', [TDBGridPro]);
end;
{ TDBGridPro }
procedure TDBGridPro.AddBox;
var
p,p1 : TRect;
begin
GetWindowRect(InPlaceEditor.Handle,p);
GetWindowRect(FPan.Handle,p1);
if (p.Left=p1.Left) and (p.Top=p1.Top) and (p.Right=p1.Right) and (p.Bottom=p1.Bottom) then exit;
if hr<>0 then DeleteObject(hr);
if hc1<>0 then DeleteObject(hc1);
{創建內外兩個Region}
hr := CreateRectRgn(0,0,p.Right-p.Left+4,p.Bottom-p.Top+4);
hc1:= CreateRectRgn(2,2,p.Right-p.Left+2,p.Bottom-p.Top+2);
{組合成空心Region}
CombineRgn(hr,hc1,hr,RGN_XOR);
SetWindowRgn(FPan.Handle,hr,true);
FPan.Parent := InPlaceEditor.Parent;
FPan.ParentWindow := InPlaceEditor.ParentWindow;
FPan.Height := InPlaceEditor.Height+4;
FPan.Left := InPlaceEditor.Left-2;
FPan.Top :=InPlaceEditor.Top-2;
FPan.Width := InPlaceEditor.Width+4;
FPan.BringToFront;
end;
constructor TDBGridPro.Create(AOwner: TComponent);
begin
inherited;
{創建作爲邊框的Panel}
FPan := TPanel.Create(nil);
FPan.Parent := Self;
FPan.Height := 0;
FPan.Color := 0;
FPan.Ctl3D := false;
FPan.BevelInner := bvNone;
FPan.BevelOuter := bvNone;
FPan.Visible := true;
DefaultDrawing := false;
OnDrawColumnCell := DoOwnDrawColumnCell;
OnOwnDrawColumnCell := nil;
curCell.X := -1;
curCell.Y := -1;
curCell.tag := 0;
hr := 0;
hc1 := 0;
end;
function TDBGridPro.CreateEditor: TInplaceEdit;
begin
result := inherited CreateEditor;
hInPlaceEditorWndProc := result.WindowProc;
result.WindowProc := InPlaceEditorWndProcHook;
end;
procedure TDBGridPro.DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
{如果要畫焦點，就讓DBGrid進入編輯狀態}
if (gdFocused in State) then
begin
EditorMode := true;
AddBox;
{如果是進入一個新的Cell，全選其中的字符}
if (curCell.X <> DataCol) or (curCell.Y <> DataSource.DataSet.RecNo)
then begin
curCell.X := DataCol;
curCell.Y := DataSource.DataSet.RecNo;
curCell.tag := 0;
GetWindowRect(InPlaceEditor.Handle,curCell.r);
SendMessage(InPlaceEditor.Handle,EM_SETSEL,0,1000);
end;
end else {正常顯示狀態的Cell}
TCustomDBGrid(Self).DefaultDrawColumnCell(Rect,DataCol,Column,State);
end;
destructor TDBGridPro.Destroy;
begin
FPan.Free;
inherited;
end;
procedure TDBGridPro.DoKeyUped(Sender: TObject; var Key: Word; Shift: TShiftState);
var
cl : TColumn;
begin
cl := Columns[SelectedIndex];
case Key of
VK_RETURN:
begin
{一個Column爲下拉類型，如果：
1 該Column的按鈕類型爲自動類型
2 該Column的PickList非空，或者其對應的字段是lookup類型}
if (cl.ButtonStyle=cbsAuto) and ((cl.PickList.Count>0) or (cl.Field.FieldKind=fkLookup)) and (curCell.tag = 0) and not (ssShift in Shift) then
begin
{把回車轉換成Alt+向下彈出下拉列表}
Key := 0;
Shift := [ ];
keybd_event(VK_MENU,0,0,0);
keybd_event(VK_DOWN,0,0,0);
keybd_event(VK_DOWN,0,KEYEVENTF_KEYUP,0);
keybd_event(VK_MENU,0,KEYEVENTF_KEYUP,0);
curCell.tag := 1;
exit;
end;
{否則轉換成Tab}
Key := 0;
keybd_event(VK_TAB,0,0,0);
keybd_event(VK_TAB,0,KEYEVENTF_KEYUP,0);
end;
VK_RIGHT :
begin
{獲得編輯框中的文字長度}
i := GetWindowTextLength(InPlaceEditor.Handle);
{獲得編輯框中的光標位置}
GetCaretPos(p);
p.x := p.X + p.Y shr 16;
j := SendMessage(InPlaceEditor.Handle,EM_CHARFROMPOS,0,p.X);
if (i=j) then {行末位置}
begin
Key := 0;
keybd_event(VK_TAB,0,0,0);
keybd_event(VK_TAB,0,KEYEVENTF_KEYUP,0);
end;
end;
VK_LEFT:
begin
GetCaretPos(p);
p.x := p.X + p.Y shr 16;
if SendMessage(InPlaceEditor.Handle,EM_CHARFROMPOS,0,p.X)=0 then
begin {行首位置}
Key := 0;
keybd_event(VK_SHIFT,0,0,0);
keybd_event(VK_TAB,0,0,0);
keybd_event(VK_TAB,0,KEYEVENTF_KEYUP,0);
keybd_event(VK_SHIFT,0,KEYEVENTF_KEYUP,0);
end;
end;
else begin {記錄用戶是否作了修改}
if (Columns[SelectedIndex].PickList.Count>0) and (curCell.tag = 0) then
if SendMessage(InPlaceEditor.Handle,EM_GETMODIFY,0,0)=1 then
curCell.tag := 1;
end;
end;
end;
procedure TDBGridPro.DoOwnDrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
if FOwnDraw=false then DefaultDrawColumnCell(Rect,DataCol,Column,State);
if @OnOwnDrawColumnCell<>nil then OnOwnDrawColumnCell(Sender,Rect,DataCol, Column,State);
end;
procedure TDBGridPro.InPlaceEditorWndProcHook(var msg: TMessage);
var m : integer;
begin
m := msg.Msg;
{=inherited}
hInplaceEditorWndProc(msg);
{如果是改變位置和大小，重新加框}
if m=WM_WINDOWPOSCHANGED then AddBox;
end;
procedure TDBGridPro.KeyUp(var Key: Word; Shift: TShiftState);
begin
inherited;
DoKeyUped(Self,Key,Shift);
end;
end.
{以上代碼在Windows2000，Delphi6上測試通過}
2004-3-20 14:34:24 打印 TDBGrid內容
procedure PrintDbGrid(DataSet:TDataSet;DbGrid:TDbGrid;Title:String);
var
PointX,PointY:integer;
ScreenX:integer;
i,lx,ly:integer;
px1,py1,px2,py2:integer;
RowPerPage,RowPrinted:integer;
ScaleX:Real;
THeight:integer;
TitleWidth:integer;
SumWidth:integer;
PageCount:integer;
SpaceX,SpaceY:integer;
RowCount:integer;
begin
PointX:=Round(GetDeviceCaps(printer.Handle,LOGPIXELSX)/2.54);
PointY:=Round(GetDeviceCaps(printer.Handle,LOGPIXELSY)/2.54);
ScreenX:=Round(Screen.PixelsPerInch/2.54);
ScaleX:=PointX/ScreenX;
RowPrinted:=0;
SumWidth:=0;
printer.BeginDoc;
With Printer.Canvas do
begin
DataSet.DisableControls;
DataSet.First ;
THeight:=Round(TextHeight('我')*1.5);//設定每行高度爲字符高的1.5倍
SpaceY:= Round(TextHeight('我')/4);
SpaceX:=Round(TextWidth('我')/4);
RowPerpage:=Round((printer.PageHeight-5*PointY)/THeight); //上下邊緣各2釐米
ly:=2*PointY;
PageCount:=0;
while not DataSet.Eof do
begin
if (RowPrinted=RowPerPage) or (RowPrinted=0) then
begin
if RowPrinted<>0 then
Printer.NewPage;
RowPrinted:=0;
PageCount:=PageCount+1;
Font.Name:='宋體';
Font.size:=16;
Font.Style:=Font.Style+[fsBold];
lx:=Round((Printer.PageWidth-TextWidth(Title))/2);
ly:=2*PointY;
TextOut(lx,ly,Title);
Font.Size:=11;
Font.Style:=Font.Style-[fsBold];
lx:=Printer.PageWidth-5*PointX;
ly:=Round(2*PointY+0.2*PointY);
if RowPerPage*PageCount>DataSet.RecordCount then
RowCount:=DataSet.RecordCount
else
RowCount:=RowPerPage*PageCount;
TextOut(lx,ly,'第'+IntToStr(RowPerPage*(PageCount-1)+1)+'-'+IntToStr(RowCount)+'條，共'+IntToStr(DataSet.RecordCount)+'條');
lx:=2*PointX;
ly:=ly+THeight*2;
py1:=ly-SpaceY;
if RowCount=DataSet.RecordCount then
py2:=py1+THeight*(RowCount-RowPerPage*(PageCount-1)+1)
else
py2:=py1+THeight*(RowPerPage+1);
SumWidth:=lx;
for i:=0 to DBGrid.Columns.Count-1 do
begin
px1:=SumWidth-SpaceX;
px2:=SumWidth;
MoveTo(px1,py1);
LineTo(px2,py2);
TitleWidth:=TextWidth(DBGrid.Columns[i].Title.Caption);
lx:=Round(SumWidth+(DBGrid.Columns[i].width*scaleX-titleWidth)/2);
TextOut(lx,ly,DBGrid.Columns[i].Title.Caption);
SumWidth:=Round(SumWidth+DBGrid.Columns[i].width*scaleX)+SpaceX*2;
end;
px1:=SumWidth; //畫最後一條豎線
px2:=SumWidth;
MoveTo(px1,py1);
LineTo(px2,py2);
px1:=2*PointX; //畫第一條橫線
px2:=SumWidth;
py1:=ly-SpaceY;
py2:=ly-SpaceY;
MoveTo(px1,py1);
LineTo(px2,py2);
py1:=py1+THeight;
py2:=py2+THeight;
MoveTo(px1,py1);
LineTo(px2,py2);
end;
lx:=2*PointX;
ly:=ly+THeight;
px1:=lx;
px2:=SumWidth;
py1:=ly-SpaceY+THeight;
py2:=ly-SpaceY+THeight;
MoveTo(px1,py1);
LineTo(px2,py2);
for i:=0 to DBGrid.Columns.Count-1 do
begin
TextOut(lx,ly,DataSet.FieldByname(DBGrid.Columns[i].Fieldname).AsString);
lx:=Round(lx+DBGrid.Columns[i].width*ScaleX+SpaceX*2);
end;
RowPrinted:=RowPrinted+1;
DataSet.next;
end;
DataSet.first;
DataSet.EnableControls;
end;
printer.EndDoc;
end;
打印StringGrid內容
Procedure TACDListerMain.PrintTable;
Var
margins: TRect;
spacing: Integer;
Cols: TList;
Dlg: TPrintProgressDlg;
Procedure SetColumnWidth;
Var
i, k, w: Integer;
Begin
Printer.Canvas.Font.Style := [ fsBold ];
For i := 0 To Pred( Grid.ColCount ) Do
Cols.Add( Pointer( Printer.Canvas.TextWidth( Grid.Cells[ i,0 ] )));
Printer.Canvas.Font.Style := [];
For i := 1 To Pred( Grid.RowCount ) Do
For k := 0 To Pred( Grid.ColCount ) Do Begin
w:= Printer.Canvas.TextWidth( Grid.Cells[ k, i ] );
If w > Integer( Cols[ k ] ) Then
Cols[ k ] := Pointer( w );
End; { For }
w := 2 * Printer.Canvas.Font.PixelsPerInch div 3;
margins :=
Rect( w, w, Printer.PageWidth-w, Printer.PageHeight - w );
spacing := Printer.Canvas.Font.PixelsPerInch div 10;
w := 0;
For i := 0 To Pred(cols.Count) Do
w := w + Integer( cols[ i ] ) + spacing;
w := w - spacing;
If w > (margins.right-margins.left ) Then Begin
w := w - (margins.right-margins.left );
cols[ cols.Count-2 ] :=
Pointer( Integer( cols[ cols.Count-2 ] ) - w );
End; { If }
w:= 0;
For i := 0 To Pred(cols.Count) Do
w := w + Integer( cols[ i ] ) + spacing;
margins.right := w - spacing + margins.left;
End; { SetColumnWidth }
Procedure DoPrint;
Var
i: Integer;
y: Integer;
Procedure DoLine(lineno: Integer);
Var
x, n: Integer;
r: TRect;
th: Integer;
Begin
If Length(Grid.Cells[0,lineno]) = 0 Then Exit;
x:= margins.left;
With Printer.Canvas Do Begin
th := TextHeight( '膟' );
For n := 0 To Pred( Cols.Count ) Do Begin
r := Rect( 0, 0, Integer(Cols[ n ]), th);
OffsetRect( r, x, y );
TextRect( r, x, y, Grid.Cells[ n, lineno ] );
x := r.right + spacing;
End; { For }
End; { With }
y := y + th;
End; { DoLine }
Procedure DoHeader;
Begin
y:= margins.top;
With Printer.Canvas Do Begin
Font.Style := [ fsBold ];
DoLine( 0 );
Pen.Width := Font.PixelsPerInch div 72;
Pen.Color := clBlack;
MoveTo( margins.left, y );
LineTo( margins.right, y );
Inc( y, 2 * Pen.Width );
Font.Style := [ ];
End; { With }
End; { DoHeader }
Begin
y:= 0;
For i := 1 To Pred( Grid.RowCount ) Do Begin
Dlg.Progress( i );
Application.ProcessMessages;
If FPrintAborted Then Exit;
If y = 0 Then
DoHeader;
DoLine( i );
If y >= margins.bottom Then Begin
Printer.NewPage;
y:= 0;
End; { If }
End; { For }
End; { DoPrint }
Begin
FPrintAborted := False;
Dlg := TPrintProgressDlg.Create( Application );
With Dlg Do
try
OnAbort := PrintAborted;
Display( cPrintPreparation );
SetProgressRange( 0, Grid.RowCount );
Show;
Application.ProcessMessages;
Printer.Orientation := poLandscape;
Printer.BeginDoc;
Cols:= Nil;
try
Cols:= TLIst.Create;
Printer.Canvas.Font.Assign( Grid.Font );
SetColumnWidth;
Display( cPrintProceeding );
Application.ProcessMessages;
DoPrint;
finally
Cols.Free;
If FPrintAborted Then
Printer.Abort
Else
Printer.EndDoc;
end;
finally
Close;
End; { With }
End; { TACDListerMain.PrintTable }
2004-3-23 9:30:43 在DELPHI中利用API實現網格內組件的嵌入--------------------------------------------------------------------------------
Delphi中向TDBGrid添加組件是一件十分麻煩的事情。筆者在這裏向大家介紹一種利用WIN32 API函數在TDBGRID中嵌入CHECKBOX組件的方法。
TDBGrid部件是用於顯示和編輯數據庫表中記錄信息的重要部件，它是我們在程序設計過程中要經常使用的一個強有力的工具。TDBGrid具有很多重要的屬性，我們可以在程序設計階段和程序運行過程中進行設置。TDBGrid部件中有很多重要的屬性，我們在這裏重點介紹Option屬性和DefaultDrawing屬性，其他屬性及其設置方法請參看聯機幫助文件。
Options屬性：它是TDBGrid部件的一個擴展屬性，在程序設計階段設置Options屬性可以控制TDBGrid部件的顯示特性和對事件的響應特性。
DefalultDrawing屬性：該屬性是布爾型屬性，它用於控制網格中各網格單元的繪製方式。在缺省情況下，該屬性的值爲True，也就是說Delphi使用網格本身缺省的方法繪製網格中各網格單元，並填充各網格單元中的內容，各網格單元中的數據根據其對應的字段部件的DisplayFormat屬性和EidtFormat屬性進行顯示和繪製。如果DefaulDrawing屬性被設置爲False，Delphi不會自動地繪製網格中各網格單元和網格單元中的數據，用戶必須自己爲TDBGrid部件的OnDrawDataCell事件編寫相應的程序以用於繪製各網格單元和其中的數據。
需要注意的是，當一個布爾字段得到焦點時，TDBGrid.Options中的 gdEditing屬性不能被設置成爲可編輯模式。另外，TDBGrid.DefaultDrawing屬性不要設置爲FALSE，否則，就不能得到網格中畫布屬性的句柄。
程序設計開始時就應考慮：需要設定一變量來存儲原始的 TDBGrid.Options的所有屬性值。這樣，當一boolean字段所在欄得到焦點時將要關閉TDBGrid.Options中gdEditing的可編輯模式。與此相對應，若該欄失去焦點時，就要重新恢復原始的 TDBGrid.Options的所有屬性值。
在實例中可以通過鼠標點擊或敲打空格鍵改變布爾值，這樣就需要觸發TDBGrid.OnCellClick事件和TDBGrid.OnKeyDown事件。因爲這兩個事件都是改變單元格中邏輯字段的布爾值，所以爲了減少代碼的重複最好創建一個私有過程（SaveBoolean;）來完成邏輯值的輸入，以後，在不同的事件中調用此過程即可。
對 TDBGrid.OnDrawColumnCell事件的處理是整個程序的關鍵。處理嵌入組件的顯示的傳統方法是：在表單上實際添加組件對象，然後對組件的位置屬性與網格中單元格的位置屬性進行調整，以達到嵌入的視覺效果。這種方法雖然可行但代碼量大，實際運行時控制性很差。筆者採用的方法是充分利用WIN32 API函數：DrawFrameControl()，由於此函數可以直接畫出Checkbox組件，所以就無須在表單中實際添加組件。如何使用API函數：DrawFrameControl()是本程序技巧所在。
在TDBGrid.OnDrawColumnCell事件中，我想大家會注意到：設定一個整型數組常數，而這個返回的整數值是與布爾值相一致的，如果字段是邏輯字段，則只將其布爾值放入數組中，提供給DrawFrameControl()函數中的狀態參數進行調用，從而實現了Checkbox組件在網格中的嵌入效果。
源代碼如下：
type
TForm1 = class(TForm)
DataSource1: TDataSource;
Table1: TTable;
DBGrid1: TDBGrid;
procedure DBGrid1DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer;
Column: TColumn; State: TGridDrawState);
procedure DBGrid1ColEnter(Sender: TObject);
procedure DBGrid1ColExit(Sender: TObject);
procedure DBGrid1CellClick(Column: TColumn);
procedure DBGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
OriginalOptions : TDBGridOptions;
procedure SaveBoolean;
public
{ Public declarations }
end;
{...}
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer;
Column: TColumn; State: TGridDrawState);
const
// 這個整數值將按照布爾值返回，並送入數組
CtrlState : array[Boolean] of Integer = (DFCS_BUTTONCHECK,DFCS_BUTTONCHECK or DFCS_CHECKED);
begin
//確保只有在邏輯字段才能插入組件
if Column.Field.DataType = ftBoolean then
begin
DBGrid1.Canvas.FillRect(Rect);
DrawFrameControl(DBGrid1.Canvas.Handle,
Rect,
DFC_BUTTON,
CtrlState[Column.Field.AsBoolean]);
end;
end;
procedure TForm1.DBGrid1ColEnter(Sender: TObject);
begin
// 確保該欄是邏輯字段
if DBGrid1.SelectedField.DataType = ftBoolean then
begin
OriginalOptions := DBGrid1.Options;
DBGrid1.Options := DBGrid1.Options - [dgEditing];
end;
end;
procedure TForm1.DBGrid1ColExit(Sender: TObject);
begin
//確保該欄是邏輯字段
if DBGrid1.SelectedField.DataType = ftBoolean then
DBGrid1.Options := OriginalOptions;
end;
procedure TForm1.DBGrid1CellClick(Column: TColumn);
begin
//確保該欄是邏輯字段
if DBGrid1.SelectedField.DataType = ftBoolean then
SaveBoolean();
end;
procedure TForm1.DBGrid1KeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
begin
//確保該欄是邏輯字段和空格鍵在鍵盤中被敲擊
if ( Key = VK_SPACE ) and
( DBGrid1.SelectedField.DataType = ftBoolean ) then
SaveBoolean();
end;
procedure TForm1.SaveBoolean;
begin
DBGrid1.SelectedField.Dataset.Edit;
DBGrid1.SelectedField.AsBoolean :=not DBGrid1.SelectedField.AsBoolean;
DBGrid1.SelectedField.Dataset.Post;
end;
以上源程序在PWIN+DELPHI5.0環境調試通過，可以直接引用。