dbgrid使用大全(delphi)

為 Delphi 資料表格增加色彩

作者： xxxx 發文時間： 2003.07.18 16:29:42

　　在 DELPHI 中經常用到網格控件（ DBGrid ）顯示資料，網格控件隻提供了每一行的顔色屬性，但在實際應用中我們經常希望它按某一行某一項的取值不同顯示不同的顔色，甚至在網格中的機關表格項中顯示出圖像等等，下面我們以一個簡單的例子來告訴大家怎麼做。

　　比如我們要求如果春季有退書用紅色表示，如果秋季有退書用黃色表示

　　利用 DBGrid 自繪功能可以很容易地實作這樣的要求。使用者可以處理 DBGrid 的 OnDrawColumnCell 事件，在其中實作特殊的效果。要判斷記錄是否滿足要求，可以使用 DBGrid 的 DataLink 屬性獲得資料，但 DBGrid 的 DataLink 屬性屬于保護成員，必須在 TCustomDBGrid 的子類中調用。

type

TMyCustomDBGrid = class(TCustomDBGrid);

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

var

sCjts,sQjTs:String;

begin

with TMyCustomerDBGrid(Sender) do

begin

Cjts:=DataLink.Fields[5].AsString;

sQjts:=DataLink.Fields[9].AsString;

if sCjts<> ‘‘ then 　　　　　　　 // 春季退書數量 >0 的用紅色顯示

Canvas.Brush.Color := clRed

else

if sQjts<> ‘‘ then 　　　　　　 // 秋季退書數量 >0 的用黃色顯示

Canvas.Brush.Color := clYellow

else

Canvas.Brush.Color:=clWhite;

Canvas.Font.Color:=clBlack;

canvas.fillrect(rect);

canvas.textout(rect.left+4,rect.top+4,Column.Field.AsString);

end;

　　由此方法可以延伸出其它控件的多種修飾方法，比如可以按資料項值采用不同的顔色，可以按記錄号顯示不同的顔色。總之，靈活應用 canvas 、 rect 及 bitmap 等對象，可以将各種網格裝飾得絢麗多彩。

如何才能得到 DBGRID 的行号，而不是資料集的行号？

Edit1.Text :=inttostr(TDrawGrid(DBGrid1).Row);

http://www.delphibbs.com/delphibbs/dispq.asp?lid=737517

在 Delphi 語言的資料庫程式設計中， DBGrid 是顯示資料的主要手段之一。但是 DBGrid 預設的外觀未免顯得單調和缺乏創意。其實，我們完全可以在我們的程式中通過程式設計來達到美化 DBGrid 外觀的目的。通過程式設計，我們可以改變 DBGrid 的表頭、網格、網格線的前景色和背景色，以及相關的字型的大小和風格。

以下的示例程式示範了對 DBGrid 各屬性的設定，使 Delphi 顯示的表格就像網頁中的表格一樣漂亮美觀。

示例程式的運作：

在 Form1 上放置 DBGrid1 、 Query1 、 DataSource1 三個資料庫元件，設定相關的屬性，使 DBGrid1 能顯示表中的資料。然後，在 DBGrid1 的 onDrawColumnCell 事件中鍵入以下代碼，然後運作程式，就可以看到神奇的結果了。本代碼在 Windows98 、 Delphi5.0 環境下調試通過。

procedure TMainForm.DBGrid1DrawColumnCell(Sender: TObject;

const Rect: TRect; DataCol: Integer; Column: TColumn;State: TGridDrawState);

var i :integer;

begin

if gdSelected in State then Exit;

// 定義表頭的字型和背景顔色：

for i :=0 to (Sender as TDBGrid).Columns.Count-1 do

begin

(Sender as TDBGrid).Columns[i].Title.Font.Name :=' 宋體 '; // 字型

(Sender as TDBGrid).Columns[i].Title.Font.Size :=9; // 字型大小

(Sender as TDBGrid).Columns[i].Title.Font.Color :=$000000ff; // 字型顔色 ( 紅色 )

(Sender as TDBGrid).Columns[i].Title.Color :=$0000ff00; // 背景色 ( 綠色 )

end;

// 隔行改變網格背景色：

if Query1.RecNo mod 2 = 0 then

(Sender as TDBGrid).Canvas.Brush.Color := clInfoBk // 定義背景顔色

else

(Sender as TDBGrid).Canvas.Brush.Color := RGB(191, 255, 223); // 定義背景顔色

// 定義網格線的顔色：

DBGrid1.DefaultDrawColumnCell(Rect,DataCol,Column,State);

with (Sender as TDBGrid).Canvas do // 畫 cell 的邊框

begin

Pen.Color := $00ff0000; // 定義畫筆顔色 ( 藍色 )

MoveTo(Rect.Left, Rect.Bottom); // 畫筆定位

LineTo(Rect.Right, Rect.Bottom); // 畫藍色的橫線

Pen.Color := $0000ff00; // 定義畫筆顔色 ( 綠色 )

MoveTo(Rect.Right, Rect.Top); // 畫筆定位

LineTo(Rect.Right, Rect.Bottom); // 畫綠色的豎線

end;

2003-11-11 17:07:42 問題 : Delphi5 - 隔行改變 DBGrid 網格顔色在 Form1 上放置 DBGrid1 、 Query1 、 DataSource1 三個資料庫元件，設定相關的屬性，使 DBGrid1 能顯示表中的資料。然後，在 DBGrid1 的 onDrawColumnCell 事件中鍵入以下代碼，然後運作程式

代碼 :

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

var i:integer;

begin

if gdSelected in State then Exit; // 隔行改變網格背景色：

if adoQuery1.RecNo mod 2 = 0 then

(Sender as TDBGrid).Canvas.Brush.Color := clinfobk // 定義背景顔色

else

(Sender as TDBGrid).Canvas.Brush.Color := RGB(191, 255, 223); // 定義背景顔色

// 定義網格線的顔色：

DBGrid1.DefaultDrawColumnCell(Rect,DataCol,Column,State);

with (Sender as TDBGrid).Canvas do // 畫 cell 的邊框

begin

Pen.Color := $00ff0000; // 定義畫筆顔色 ( 藍色 )

MoveTo(Rect.Left, Rect.Bottom); // 畫筆定位

LineTo(Rect.Right, Rect.Bottom); // 畫藍色的橫線

Pen.Color := clbtnface; // 定義畫筆顔色 ( 蘭色 )

MoveTo(Rect.Right, Rect.Top); // 畫筆定位

LineTo(Rect.Right, Rect.Bottom); // 畫綠色

end;

用 BDE 中的 table1 未能通過，顔色沒有隔行變化。

2003-11-11 17:12:09 在 Delphi 的 DBGrid 中插入其他可視元件 Delphi 提供了功能強大的 DBGrid 元件，以友善進行資料庫應用程式設計。但是如果我們僅僅利用 DBGrid 元件，每一個獲得焦點（ Grid ）隻是一個簡單的文本編輯框，不友善使用者輸入資料。 Delphi 也提供了一些其他資料元件來友善使用者輸入，比如 DBComboBox ， DBCheckBox 等元件，但這些元件卻沒有 DBGrid 功能強大。 Delphi 能不能象 Visual Foxpro 那樣讓 DBGrid 中獲得焦點網格可以是其它可視資料元件以友善使用者呢？其實我們可以通過在 DBGrid 中插入其他可視元件來實作這一點。

Delphi 對 DBGrid 處理的内部機制，就是在網格上浮動一個元件—— DBEdit 元件。你輸入資料的網格其實是浮動 DBEdit 元件，其他未獲得焦點地方不過是圖像罷了。是以，在 DBGrid 中插入其他可視元件就是在網格上浮動一個可視元件。是以任何元件，包括從簡單的 DbCheckBox 到複雜的對話框，都可以在 DBGrid 中插入。下面就是一個如何在 DBGrid 中插入 DBComboBox 元件的步驟，采用同樣的辦法可以插入其他元件。

1 、在 Delphi 4.0 中建立一個項目。

2 、分别拖動的 Data Access 元件闆上 DataSource 、 Table ， Data Controls 元件闆上 DBGrid ， DBComboBox 四個元件到 Form1 上。

3 、設定各個元件的屬性如下：

rcf1 對象屬性設定植

Form1 Caption ' 在 DBGrid 中插入 SpinEdit 元件示例 '

DataSource1 DataSet Table1

Table1 DatabaseName DBDEMOS

TableName 'teacher.DBF'

Active True

DBGrid1 DataSource DataSource1

DBComboBox1 DataField SEX

DataSource DataSource1

Visible False

Strings Items. ' 男 '| ' 女 '

注意：我在這裡用了 Teacher.dbf ，那是反映教職工的性别，隻能是“男”或者是“女”。

4 、 DrawDataCell 事件是繪制單元格，當獲得焦點網格所對應的字段與組合框所對應的字段一緻時，移動組合框到獲得焦點的網格上，并且使組合框可視，進而達到在 DBGrid 指定列上顯示 DBComboBox 的功能。設定 DBGrid1 的 OnDrawDataCell 事件如下：

procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect; Field: TField; State: TGridDrawState);

begin

if (gdFocused in State) then

begin

if (Field.FieldName = DBComboBox1.DataField ) then

begin

DBComboBox1.Left := Rect.Left + DBGrid1.Left;

DBComboBox1.Top := Rect.Top + DBGrid1.top;

DBComboBox1.Width := Rect.Right - Rect.Left;

DBComboBox1.Height := Rect.Bottom - Rect.Top;

DBComboBox1.Visible := True;

end;

5 、 DBGrid 指定單元格未獲得焦點時不顯示 DBComboBox ，設定 DBGrid1 的 OnColExit 事件如下：

procedure TForm1.DBGrid1ColExit(Sender: TObject);

begin

If DBGrid1.SelectedField.FieldName = DBComboBox1.DataField then

begin

DBComboBox1.Visible := false;

end;

6 、當 DBGrid 指定列獲得焦點時 DrawDataCell 事件隻是繪制單元格，并顯示 DBComboBox ，但是 DBComboBox 并沒有獲得焦點，資料的輸入還是在單元格上進行。在 DBGrid1 的 KeyPress 事件中調用 SendMessage 這個 Windows API 函數将資料輸入傳輸到 DBComboBox 上，進而達到在 DBComboBox 上進行資料輸入。是以還要設定 KeyPress 事件如下：

procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);

begin

if (key < > chr(9)) then

begin

if (DBGrid1.SelectedField.FieldName =DBComboBox1.DataField) then

begin

DBComboBox1.SetFocus;

SendMessage(DBComboBox1.Handle ， WM_Char ， word(Key) ， 0);

end;

程式在中文 Windows 98 ， Delphi 4.015 下調試通過。希望本文能使你可以更加友善快捷的開發資料庫應用程式。

2003-11-11 17:17:56 鎖定 DBGrid 左邊的列我在使用 Delphi3 進行資料庫程式設計的時候，希望 DBGRID 構件在顯示資料的時候能象 FoxPro 的 BROWSE 指令一樣，鎖定左邊指定的幾列不進行滾動，請問應用什麼方法來實作？

我們知道 Delphi 的 TStringGrid 有一個屬性 FixedCols 來指定不滾動的列。雖然 TDBGrid 不能直接使用這一屬性，但通過強制類型轉換也可以首先這一功能，因為這兩個類都來自 TCustomGrid 類。下面我們以 Delphi 3.0 的 Demos/Db/CtrlGrid 為例來說明具體的用法。在這個例子的 TFmCtrlGrid.FormShow 過程中加入如下一行：

TStringGrid(DbGrid1).FixedCols := 2;

運作該程式，在左右移動各列時， Symbol 列不會移動。除了這種方法，也可以采用下面的方法：首先在 Form 聲明部分加上

type TMyGrid = Class(TDBGrid) end;

然後在 TFmCtrlGrid.FormShow 過程中加入：

TMyGrid(DbGrid1).FixedCols := 2;

兩者從形式上略有不同，但實質都是一樣的。我們這裡設定 FixedCols 為 2 ，這是因為在 DBGrid 構件最左側有個訓示列，如果你将 DBGrid 的 Options 屬性的 dgIndicator 設為 False ，則應設定 FixedCols 為 1 。

2003-11-11 17:21:36 使 dbgrid 的某幾筆資料變色你可在 DBGrid 元件的 DrawDataCell 事件中依資料的條件性來改變格子或文字的顔色 .

如 :

OnDrawDataCell(...)

begin

with TDBGrid(Sender) do

begin

if ( 條件 ) then

Canvas.TextOut(Rect.Left + 4

Rect.Top + 2

' 要顯示的文字如表格的資料 ');

end;

而你會看到 DBGrid 的顯示資料怎麽有重疊的情況那是因為原本 DBGrid 要顯示的資料與 TextOut 所顯示的資料重疊

解決方法 :

在 Query 元件所加入的欄位 ( 在元件上按右鍵會有 Add Fields... 的選單 ) 在不要顯示資料的欄位的 OnGetText 事件中有一參數設定為 False;

procedure TForm1.Query1Detail1GetText(Sender: TField; var Text: string;

DisplayText: Boolean);

begin

// 決定在 DBGrid 得知表格資料時要不要顯示所得到的資料 False -> 不顯示

// 就可避免與 TextOut 的文字重疊了

DisplayText : = False;

end;

如果用 Delphi 3 處理很簡單 . 例如 : 對表中某字段當其數值小于 0 時為紅字其他為黑字 .

在 DBGrid.OnDrawColumnCell(...) 中 :

begin

if TableField.AsInteger < 0 then

DBGrid.Canvas.Font.Color := clRed

else

DBGrid.Canvas.Font.Color := clBlack;

DBGrid.DefaultDrawColumnCell(...);

end;

這樣對 Field 指定的格式仍舊生效不必重寫 .

2003-11-11 17:25:29 實戰 Delphi 資料網格色彩特效 Delphi 中的資料網格控件 (TDbGrid) 對于顯示和編輯資料庫中大量的資料起着十分重要的作用；然而，在使用資料網格控件的同時，也往往因為表格中大量的資料不易區分，而令操作者眼花缭亂。如何提高網格控件的易用性，克服它的此項不足呢？本文從改變資料網格的色彩配置角度，提出了一種解決辦法。

以下為資料網格控件的 6 種特殊效果的實作方法，至于資料網格控件與資料集如何連接配接的方法從略。

1. 縱向斑馬線效果：實作網格的奇數列和偶數列分别以不同的顔色顯示以差別相鄰的資料列。

file:// 在 DbGrid 的 DrawColumnCell 事件中編寫如下代碼：

Case DataCol Mod 2 = 0 of

True: DbGrid1.Canvas.Brush.Color:= clBlue; file:// 偶數列用藍色

False: DbGrid1.Canvas.Brush.Color:= clAqua; file:// 奇數列用淺綠色

End;

DbGrid1.Canvas.Pen.Mode:=pmMask;

DbGrid1.DefaultDrawColumnCell (Rect

DataCol

Column

State);

2. 縱向斑馬線，同時以紅色突出顯示目前單元格效果：以突出顯示目前選中的字段。

file:// 将上述代碼修改為：

Case DataCol Mod 2 = 0 of

True: DbGrid1.Canvas.Brush.Color:= clBlue; file:// 偶數列用藍色

False: DbGrid1.Canvas.Brush.Color:= clAqua; file:// 奇數列用淺綠色

End;

If ((State = [gdSelected]) or (State=[gdSelectedgdFocused])) then

If Not DbGrid1.SelectedRows.CurrentRowSelected then

DbGrid1.Canvas.Brush.Color:=clRed; file:// 目前選中單元格顯示紅色

DbGrid1.Canvas.Pen.Mode:=pmMask;

DbGrid1.DefaultDrawColumnCell (Rect

DataCol

Column

State);

上述兩種方法突出了列的顯示效果。

3 ．在資料網格中以紅色突出顯示目前選中的行。

設定 DbGrid 控件的 Options 屬性中的 dgRowSelect 屬性為真， Color 屬性為 clAqua( 背景色 )

在 DbGrid 的 DrawColumnCell 事件中編寫如下代碼：

if ((State = [gdSelected]) or (State=[gdSelected gdFocused])) then

DbGrid1.Canvas.Brush.color:=clRed; file:// 目前行以紅色顯示，其它行使用背景的淺綠色

DbGrid1.Canvas.pen.mode:=pmmask;

DbGrid1.DefaultDrawColumnCell (Rect

DataCol

Column

State);

4 ．行突顯的斑馬線效果：既突出目前行，又區分不同的列（字段）。

file:// 其它屬性設定同 3 ，将上述代碼修改為：

if ((State = [gdSelected]) or (State=[gdSelectedgdFocused])) then

begin

Case DataCol Mod 2 = 0 of

True : DbGrid1.Canvas.Brush.color:=clRed; file:// 目前選中行的偶數列顯示紅色

False: DbGrid1.Canvas.Brush.color:=clblue; file:// 目前選中行的奇數列顯示藍色

end;

DbGrid1.Canvas.pen.mode:=pmmask;

DbGrid1.DefaultDrawColumnCell (Rect

DataCol

Column

State);

end;

5 ．橫向斑馬線，同時以紅色突顯目前行效果。

file:// 其它屬性設定同 3 ，将上述代碼修改為：

Case Table1.RecNo mod 2 = 0 of file:// 根據資料集的記錄号進行判斷

True : DbGrid1.Canvas.Brush.color:=clAqua; file:// 偶數行用淺綠色顯示

False: DbGrid1.Canvas.Brush.color:=clblue; file:// 奇數行用藍色表示

end;

if ((State = [gdSelected]) or (State=[gdSelectedgdFocused])) then file:// 選中行用紅色顯示

DbGrid1.Canvas.Brush.color:=clRed;

DbGrid1.Canvas.pen.mode:=pmMask;

DbGrid1.DefaultDrawColumnCell (Rect

DataCol

Column

State);

6 ．雙向斑馬線效果：即行間用不同色區分，同時，選中行以縱向斑馬線效果區分不同的列。

file:// 其它屬性設定同 3 ，将上述代碼修改為：

Case Table1.RecNo mod 2 = 0 of file:// 根據資料集的記錄号進行判斷

True : DbGrid1.Canvas.Brush.color:=clAqua; file:// 偶數行用淺綠色顯示

False: DbGrid1.Canvas.Brush.color:= clblue; file:// 奇數行用藍色表示

end;

If ((State = [gdSelected]) or (State=[gdSelectedgdFocused])) then

Case DataCol mod 2 = 0 of

True : DbGrid1.Canvas.Brush.color:=clRed; file:// 目前選中行的偶數列用紅色

False: DbGrid1.Canvas.Brush.color:= clGreen; file:// 目前選中行的奇數列用綠色表示

end;

DbGrid1.Canvas.pen.mode:=pmMask;

DbGrid1.DefaultDrawColumnCell (Rect

DataCol

Column

State);

上述 6 種方法分别就資料網格控件的列和行的色彩進行了設定，讀者可以根據自己的需要設定特效。該程式在 Delphi5 中測試通過。

2003-11-13 11:11:31 點選 DBGrid 的 Title 對查詢結果排序關鍵詞 :DBGrid 排序

欲實作點選 DBGrid 的 Title 對查詢結果排序，想作一個通用程式，不是一事一議，例如不能在 SQL 語句中增加 Order by ... ，因為 SQL 可能原來已經包含 Order by ... ，而且點選另一個 Title 時又要另外排序，目的是想作到象資料總管那樣随心所欲。

procedure TFHkdata.SortQuery(Column:TColumn);

var

SqlStr,myFieldName,TempStr: string;

OrderPos: integer;

SavedParams: TParams;

begin

if not (Column.Field.FieldKind in [fkData,fkLookup]) then exit;

if Column.Field.FieldKind =fkData then

myFieldName := UpperCase(Column.Field.FieldName)

else

myFieldName := UpperCase(Column.Field.KeyFields);

while Pos(myFieldName,';')<>0 do

myFieldName := copy(myFieldName,1,Pos(myFieldName,';')-1)+ ',' + copy(myFieldName,Pos(myFieldName,';')+1,100);

with TQuery(TDBGrid(Column.Grid).DataSource.DataSet) do

begin

SqlStr := UpperCase(Sql.Text);

// if pos(myFieldName,SqlStr)=0 then exit;

if ParamCount>0 then

begin

SavedParams := TParams.Create;

SavedParams.Assign(Params);

end;

OrderPos := pos('ORDER',SqlStr);

if (OrderPos=0) or (pos(myFieldName,copy(SqlStr,OrderPos,100))=0) then

TempStr := ' Order By ' + myFieldName + ' Asc'

else if pos('ASC',SqlStr)=0 then

TempStr := ' Order By ' + myFieldName + ' Asc'

else

TempStr := ' Order By ' + myFieldName + ' Desc';

if OrderPos<>0 then SqlStr := Copy(SqlStr,1,OrderPos-1);

SqlStr := SqlStr + TempStr;

Active := False;

Sql.Clear;

Sql.Text := SqlStr;

if ParamCount>0 then

begin

Params.AssignValues(SavedParams);

SavedParams.Free;

end;

Prepare;

Open;

end;

2003-11-13 11:13:57 去掉 DbGrid 的自動添加功能

關鍵詞 :DbGrid

移動到最後一條記錄時再按一下“下”就會追加一條記錄，如果去掉這項功能

procedure TForm1.DataSource1Change(Sender: TObject; Field: TField);

begin

if TDataSource(Sender).DataSet.Eof then TDataSource(Sender).DataSet.Cancel;

end;

2003-11-16 12:05:46 DBGrid 不支援滑鼠的上下移動的解決代碼 ( 感謝 wangxian11 提供 ) 自己捕捉 WM_MOUSEWHEEL 消息處理

private

OldGridWnd : TWndMethod;

procedure NewGridWnd (var Message : TMessage);

public

procedure TForm1.NewGridWnd(var Message: TMessage);

var

IsNeg : Boolean;

begin

if Message.Msg = WM_MOUSEWHEEL then

begin

IsNeg := Short(Message.WParamHi) < 0;

if IsNeg then

DBGrid1.DataSource.DataSet.MoveBy(1)

else

DBGrid1.DataSource.DataSet.MoveBy(-1)

end

else

OldGridWnd(Message);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

OldGridWnd := DBGrid1.WindowProc ;

DBGrid1.WindowProc := NewGridWnd;

end;

2003-11-17 14:46:56 dbgrid 中移動焦點到指定的行和列 dbgrid 是從 TCustomGrid 繼承下來的，它有 col 與 row 屬性，隻不過是 protected 的，不能直接通路，要處理一下，可以這樣：

TDrawGrid(dbgrid1).row:=row;

TDrawGrid(dbgrid1).col:=col;

dbgrid1.setfocus;

就可以看到效果了。

1 這個方法是絕對有問題的，它會引起 DBGrid 内部的混亂，因為 DBGrid 無法定位目前紀錄，如果 DBGrid 隻讀也就罷了（隻讀還是會出向一些問題，比如原本隻能單選的紀錄現在可以出現多選等等，你可以自己去試試），如果 DBGrid 可編輯那問題就可大了，因為目前紀錄的關系，你更改的資料字段很可能不是你想象中的

2 我常用的解決辦法是将上程式改為（随便設定 col 是安全的，沒有一點問題）

Query1.first;

TDrawGrid(dbgrid1).col:=1;

dbgrid1.setfocus;

這就讓焦點移到第一行第一列當中

2003-11-17 14:55:26 如何使 DBGRID 網格的顔色随此格中的資料值的變化而變化？在做界面的時候，有時候為了突出顯示資料的各個特性（如過大或者過小等），需要通過改變字型或者顔色，本文就是針對這個情況進行的說明。

如何使 DBGRID 網格的顔色随此格中的資料值的變化而變化。如 <60 的網格為紅色？

Delphi 中資料控制構件 DBGrid 是用來反映資料表的最重要、也是最常用的構件。在應用程式中，如果以彩色的方式來顯示 DBGrid ，将會增加其可視性，尤其在顯示一些重要的或者是需要警示的資料時，可以改變這些資料所在的行或列的前景和背景的顔色。

　　 DBGrid 屬性 DefaultDrawing 是用來控制 Cell （網格）的繪制。若 DefaultDrawing 的預設設定為 True ，意思是 Delphi 使用 DBGrid 的預設繪制方法來制作網格和其中所包含的資料，資料是按與特定列相連接配接的 Tfield 構件的 DisplayFormat 或 EditFormat 特性來繪制的；若将 DBGrid 的 DefaultDrawing 特性設定成 False ， Delphi 就不繪制網格或其内容，必須自行在 TDBGrid 的 OnDrawDataCell 事件中提供自己的繪制例程（自畫功能）。

　　在這裡将用到 DBGrid 的一個重要屬性：畫布 Canvas ，很多構件都有這一屬性。 Canvas 代表了目前被顯示 DBGrid 的表面，你如果把另行定義的顯示内容和風格指定給 DBGrid 對象的 Canvas ， DBGrid 對象會把 Canvas 屬性值在螢幕上顯示出來。具體應用時，涉及到 Canvas 的 Brush 屬性和 FillRect 方法及 TextOut 方法。 Brush 屬性規定了 DBGrid.Canvas 顯示的圖像、顔色、風格以及通路 Windows GDI 對象句柄， FillRect 方法使用目前 Brush 屬性填充矩形區域，方法 TextOut 輸出 Canvas 的文本内容。

　　以下用一個例子來詳細地說明如何顯示彩色的 DBGrid 。在例子中首先要有一個 DBGrid 構件，其次有一個用來産生彩色篩選條件的 SpinEdit 構件，另外還有 ColorGrid 構件供自由選擇資料單元的前景和背景的顔色。

　　 1. 建立名為 ColorDBGrid 的 Project ，在其窗體 Form1 中依次放入所需構件，并設定屬性為相應值，具體如下所列：

　　 Table1 DatabaseName: DBDEMOS

TableName: EMPLOYEE.DB

Active: True;

　　 DataSource1 DataSet: Table1

　　 DBGrid1 DataSource1: DataSource1

DefaultDrawing: False

　　 SpinEdit1 Increment:200

Value: 20000

　　 ColorGrid1 GridOrdering: go16 ＊ 1

　　 2. 為 DBGrid1 構件 OnDrawDataCell 事件編寫響應程式：

// 這裡編寫的程式是 <60 的網格為紅色的情況，其他的可以照此類推

　　 procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;Field: TField; State: TGridDrawState);

　　 begin

　　 if Table1.Fieldbyname( ′ Salary ′ ).value<=SpinEdit1.value then

　　 DBGrid1.Canvas.Brush.Color:=ColorGrid1.ForeGroundColor

　　 else

　　 DBGrid1.Canvas.Brush.Color:=ColorGrid1.BackGroundColor;

　　 DBGrid1.Canvas.FillRect(Rect);

　　 DBGrid1.Canvas.TextOut(Rect.left ＋ 2,Rect.top ＋ 2,Field.AsString);

　　 end;

　　這個過程的作用是當 SpinEdit1 給定的條件得以滿足時，如′ salary ′變量低于或等于 SpinEdit1.Value 時， DBGrid1 記錄以 ColorGrid1 的前景顔色來顯示，否則以 ColorGrid1 的背景顔色來顯示。然後調用 DBGrid 的 Canvas 的填充過程 FillRect 和文本輸出過程重新繪制 DBGrid 的畫面。

　　 3. 為 SpinEdit1 構件的 OnChange 事件編寫響應代碼：

　　 procedure TForm1.SpinEdit1Change(Sender: TObject);

　　 begin

　　 DBGrid1.refresh; // 重新整理是必須的，一定要重新整理哦

　　 end;

　　當 SpinEdit1 構件的值有所改變時，重新重新整理 DBGrid1 。

　　 4. 為 ColorGrid1 的 OnChange 事件編寫響應代碼：

　　 procedure TForm1.ColorGrid1Change(Sender: TObject);

　　 begin

　　 DBGrid1.refresh; // 重新整理是必須的，一定要重新整理哦

　 end;

　　當 ColorGrid1 的值有所改變時，即滑鼠的右鍵或左鍵單擊 ColorGrid1 重新重新整理 DBGrid1 。

　　 5. 為 Form1 窗體（主窗體）的 OnCreate 事件編寫響應代碼：

　　 procedure TForm1.FormCreate(Sender: TObject);

　　 begin

　　 ColorGrid1.ForeGroundIndex:=9;

　　 ColorGrid1.BackGroundIndex:=15;

　 end;

　　在主窗建立時，将 ColorGrid1 的初值設定前景為灰色，背景為白色，也即 DBGrid 的字型顔色為灰色，背景顔色為白色。

　　 6. 現在，可以對 ColorDBGrid 程式進行編譯和運作了。當用滑鼠的左鍵或右鍵單擊 ColorGrid1 時， DBGrid 的字型和背景顔色将随之變化。

　　在本文中，隻是簡單展示了以彩色方式顯示 DBGrid 的原理，當然，還可以增加程式的複雜性，使其實用化。同樣道理，也可以将這個方法擴充到其他擁有 Canvas 屬性的構件中，讓應用程式的使用者界面更加友好。

2003-11-17 14:58:08 判斷 Grid 是否有滾動條？這是一個小技巧，如果為了風格的統一的話，還是不要用了。：）

。。。

if (GetWindowlong(Stringgrid1.Handle, GWL_STYLE) and WS_VSCROLL) <> 0 then

ShowMessage('Vertical scrollbar is visible!');

if (GetWindowlong(Stringgrid1.Handle, GWL_STYLE) and WS_HSCROLL) <> 0 then

ShowMessage('Horizontal scrollbar is visible!');

。。。

2003-11-17 15:04:27 兩個 Grid 的同步滾動在實際制作一個項目當中，有時候需要幾個 grid 一起同步滾動以減少使用者的操作量。希望下面那段代碼對您有一定的參考價值。

{1.}

unit SyncStringGrid;

interface

uses

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

type

TSyncKind = (skBoth, skVScroll, skHScroll);

TSyncStringGrid = class(TStringGrid)

private

FInSync: Boolean;

FsyncGrid: TSyncStringGrid;

FSyncKind: TSyncKind;

{ Private declarations }

procedure WMVScroll(var Msg: TMessage); message WM_VSCROLL;

procedure WMHScroll(var Msg: TMessage); message WM_HSCROLL;

protected

{ Protected declarations }

public

{ Public declarations }

procedure DoSync(Msg, wParam: Integer; lParam: Longint); virtual;

published

{ Published declarations }

property SyncGrid: TSyncStringGrid read FSyncGrid write FSyncGrid;

property SyncKind: TSyncKind read FSyncKind write FSyncKind default skBoth;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('Samples', [TSyncStringGrid]);

end;

procedure TSyncStringGrid.WMVScroll(var Msg: TMessage);

begin

if not FInSync and Assigned(FSyncGrid) and (FSyncKind in [skBoth, skVScroll]) then

FSyncGrid.DoSync(WM_VSCROLL, Msg.wParam, Msg.lParam);

inherited;

end;

procedure TSyncStringGrid.WMHScroll(var Msg: TMessage);

begin

if not FInSync and Assigned(FSyncGrid) and (FSyncKind in [skBoth, skHScroll]) then

FSyncGrid.DoSync(WM_HSCROLL, Msg.wParam, Msg.lParam);

inherited;

end;

procedure TSyncStringGrid.DoSync(Msg, wParam: Integer; lParam: Longint);

begin

FInSync := True;

Perform(Msg, wParam, lParam);

FinSync := False;

end;

end.

{****************************************}

{2.}

private

OldGridProc1, OldGridProc2: TWndMethod;

procedure Grid1WindowProc(var Message: TMessage);

procedure Grid2WindowProc(var Message: TMessage);

public

{...}

procedure TForm1.Grid1WindowProc(var Message: TMessage);

begin

OldGridProc1(Message);

if ((Message.Msg = WM_VSCROLL) or (Message.Msg = WM_HSCROLL) or Message.msg = WM_Mousewheel)) then

begin

OldGridProc2(Message);

end;

procedure TForm1.Grid2WindowProc(var Message: TMessage);

begin

OldGridProc2(Message);

if ((Message.Msg = WM_VSCROLL) or (Message.Msg = WM_HSCROLL) or (Message.msg = WM_Mousewheel)) then

begin

OldGridProc1(Message);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

OldGridProc1 := StringGrid1.WindowProc;

OldGridProc2 := StringGrid2.WindowProc;

StringGrid1.WindowProc := Grid1WindowProc;

StringGrid2.WindowProc := Grid2WindowProc;

end;

2003-11-19 9:35:04 在 Delphi 中随意控制 DBGrid 每一行的顔色簡易方法 Delphi 中使用 DBGrid 控件時，每一列都能按需要随意地改變顔色，但要改變每一行的顔色卻很難，那麼在不重新制作新控制件的情況下，有沒有好的辦法讓 DBGrid 按照使用者自己要求随意改變每一行顔色的？答案是有，下面介紹一種簡單的方法。

要改變 DBGrid 每一行的顔色，隻要在 ONDrawColumnCell 事件中設定要改變顔色的行的條件，

并指定 DBGrid 的 Canvas.Brush.color 屬性并且把 Canvas.pen.mode 屬性設成 pmmask ，再調用 DBGrid 的 DefaultDrawColumnCell 方法即可。注意在改變這兩個屬性前要先保護好原來的

Canvas.Brush.color 屬性的值，調節器用完成 DefaultDrawColumnCell 方法後要把原屬性值改

回，現以 Delphi/demos/db/clientmd 目錄下的示範程式 clintproj.dpr 為例子 , 做簡單說明，下面是對程式中的栅格 MemberGrid 的合條件的整行進行變色，變成黑體背景黃色的，其它不合條件的行的顔色為正常字型，白色背景，隻在 DrawColumnCelL 事件中設條件其它的不變，如下：

procedure TClientForm.MemberGridDrawColumnCell(Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

var

oldcolor:tcolor;

oldpm:tpenmode;

begin

if DM.ProjectTEAM_LEADER.Value = DM.Emp_ProjEMP_NO.Value then { 設定變色的行的條件 }

MemberGrid.Canvas.Font.Style := [fsBold];

MemberGrid.DefaultDrawColumnCell(Rect, DataCol, Column, State);

{ 上面是示範程式的原内容，以下是增加部分 }

if DM.ProjectTEAM_LEADER.Value =DM.Emp_ProjEMP_NO.Value then { 設定變色的行的條件 }

begin

oldpm:= MemberGrid.Canvas.pen.mode;

oldcolor:= MemberGrid.Canvas.Brush.color;

MemberGrid.Canvas.Brush.color:=clyellow;

MemberGrid.Canvas.pen.mode:=pmmask;

MemberGrid.DefaultDrawColumnCell(Rect, DataCol, Column, State);

MemberGrid.Canvas.Brush.color:=oldcolor;

MemberGrid.Canvas.pen.mode:=oldpm;

end;

感覺上這個方法和前面的幾個顔色控制方法的原理是一樣的，都是通過 ONDrawColumnCell 事件來實作變色醒目美化的功能。：）

2003-11-19 9:43:56 如何在 DBGrid 中能支援多項記錄的選擇這份文檔來自國外，粗略看了一下，很有用，推薦給大家學習使用。

【 Question 】： How to do multi-selecting records in TDBGrid?

When you add [dgMultiSelect] to the Options property of a DBGrid, you give yourself the ability to select multiple records within the grid.

The records you select are represented as bookmarks and are stored in the SelectedRows property.

The SelectedRows property is an object of type TBookmarkList. The properties and methods are described below.

// property SelectedRows: TBookmarkList read FBookmarks;

// TBookmarkList = class

// public

{* The Clear method will free all the selected records within the DBGrid *}

// procedure Clear;

{* The Delete method will delete all the selected rows from the dataset *}

// procedure Delete;

{* The Find method determines whether a bookmark is in the selected list. *}

// function Find(const Item: TBookmarkStr;

// var Index: Integer): Boolean;

{* The IndexOf method returns the index of the bookmark within the Items property. *}

// function IndexOf(const Item: TBookmarkStr): Integer;

{* The Refresh method returns a boolean value to notify whether any orphans were dropped (deleted) during the time the record has been selected in the grid. The refresh method can be used to update the selected list to minimize the possibility of accessing a deleted record. *}

// function Refresh: Boolean; True = orphans found

{* The Count property returns the number of currently selected items in the DBGrid *}

// property Count: Integer read GetCount;

{* The CurrentRowSelected property returns a boolean value and determines whether the current row is selected or not. *}

// property CurrentRowSelected: Boolean

// read GetCurrentRowSelected

// write SetCurrentRowSelected;

{* The Items property is a TStringList of TBookmarkStr *}

// property Items[Index: Integer]: TBookmarkStr

// read GetItem; default;

// end;

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, DBGrids, DB, DBTables;

type

TForm1 = class(TForm)

Table1: TTable;

DBGrid1: TDBGrid;

Count: TButton;

Selected: TButton;

Clear: TButton;

Delete: TButton;

Select: TButton;

GetBookMark: TButton;

Find: TButton;

FreeBookmark: TButton;

DataSource1: TDataSource;

procedure CountClick(Sender: TObject);

procedure SelectedClick(Sender: TObject);

procedure ClearClick(Sender: TObject);

procedure DeleteClick(Sender: TObject);

procedure SelectClick(Sender: TObject);

procedure GetBookMarkClick(Sender: TObject);

procedure FindClick(Sender: TObject);

procedure FreeBookmarkClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

Bookmark1: TBookmark;

z: Integer;

implementation

{$R *.DFM}

//Example of the Count property

procedure TForm1.CountClick(Sender: TObject);

begin

if DBgrid1.SelectedRows.Count > 0 then

begin

showmessage(inttostr(DBgrid1.SelectedRows.Count));

end;

//Example of the CurrentRowSelected property

procedure TForm1.SelectedClick(Sender: TObject);

begin

if DBgrid1.SelectedRows.CurrentRowSelected then

showmessage('Selected');

end;

//Example of the Clear Method

procedure TForm1.ClearClick(Sender: TObject);

begin

dbgrid1.SelectedRows.Clear;

end;

//Example of the Delete Method

procedure TForm1.DeleteClick(Sender: TObject);

begin

DBgrid1.SelectedRows.Delete;

end;

This example iterates through the selected rows of the grid and displays the second field of the dataset.

The Method DisableControls is used so that the DBGrid will not update when the dataset is changed. The last position of the dataset is saved as a TBookmark.

The IndexOf method is called to check whether or not the bookmark is still existent.

The decision of using the IndexOf method rather than the Refresh method should be determined by the specific application.

procedure TForm1.SelectClick(Sender: TObject);

var

x: word;

TempBookmark: TBookMark;

begin

DBGrid1.Datasource.Dataset.DisableControls;

with DBgrid1.SelectedRows do

if Count > 0 then

begin

TempBookmark:= DBGrid1.Datasource.Dataset.GetBookmark;

for x:= 0 to Count - 1 do

begin

if IndexOf(Items[x]) > -1 then

begin

DBGrid1.Datasource.Dataset.Bookmark:= Items[x];

showmessage(DBGrid1.Datasource.Dataset.Fields[1].AsString);

end;

DBGrid1.Datasource.Dataset.GotoBookmark(TempBookmark);

DBGrid1.Datasource.Dataset.FreeBookmark(TempBookmark);

DBGrid1.Datasource.Dataset.EnableControls;

end;

This example allows you to set a bookmark and and then search for the bookmarked record within selected a record(s) within the DBGrid.

//Sets a bookmark

procedure TForm1.GetBookMarkClick(Sender: TObject);

begin

Bookmark1:= DBGrid1.Datasource.Dataset.GetBookmark;

end;

//Frees the bookmark

procedure TForm1.FreeBookmarkClick(Sender: TObject);

begin

if assigned(Bookmark1) then

begin

DBGrid1.Datasource.Dataset.FreeBookmark(Bookmark1);

Bookmark1:= nil;

end;

//Uses the Find method to locate the position of the bookmarked record within the selected list in the DBGrid

procedure TForm1.FindClick(Sender: TObject);

begin

if assigned(Bookmark1) then

begin

if DBGrid1.SelectedRows.Find(TBookMarkStr(Bookmark1),z) then

showmessage(inttostr(z));

end;

end.

2003-11-19 10:11:21 另外一種可以在在 Delphi 中随意控制 DBGrid 每一行顔色的方法有個問題是在 Delphi 中使用 DBGrid 時，如何讓 DBGrid 中每一行顔色按照使用者自己的意願控

制。最初看到這個問題時，我們以為非常非常簡單，是以馬上動手準備解決它。結果卻發現不是

那麼回事，傳統方法根本不能發揮作用。在電腦面前一直坐到淩晨 4 點，不斷地調試，幸運地是憑借平時積累的一點程式設計經驗，終于找到了開門的匙鑰。現将它充公，供大家享用。

1 、資料表的建立

在 Delphi 的工具菜單中選擇 Database desktop ，在資料庫 DBDemos 下建立一個名為

example.db 的資料表。資料表的字段和内容如下：

Name Age Wage

張山 25 500

王武 57 1060

李市 30 520

劉牛 28 390

2 、建立基于 TDBGrid 的 TColoredDBGrid 元件

在 Delphi 元件菜單中，選擇 New Component, 在彈出對話框中作以下設定：

Ancestor Type = TDBGrid

Class Name = TColoredDBGrid

然後單擊 OK 按鈕， Delphi 自動完成元件基本架構的定義。增添 OnDRawColoredDBGrid 事件并

使它出現在 Object Inspector 的 Events 中以便在應用程式中設定改變行顔色的條件。重載

DrawCell 方法，隻能自己繪制單元格。不能通過在 OnDrawColumnCell 來設定顔色，因為在

OnDrawColumnCell 改變單元格的顔色會再次觸發 OnDrawColumnCell 。

下面就是所建立元件的源程式。

3 、建立應用程式進行驗證。

在 Delphi 檔案菜單中選擇 New 建立新的應用程式工程 Project1 和主窗體 Form1 ，設定 Form1 的

Caption 屬性為“控制 DBGrid 行顔色的示例”。在主窗體上添加 Data Source 、 Table 、 Button 和

ColoredDBGrid 元件。設定各元件的屬性如下：

Table1.Database=’DBDemos’

Table1.Tablename=’example.db’

Datasource1.Dataset=Table1

ColoredDBGrid1.Datasource=DataSource1

Button1.Caption= ’ 退出’

在 ColoredDBGrid1 的 onDRawColoredDBGrid 事件中輸入下列代碼，設定由 Wage （工資）來決

定在 ColoredDBGrid1 各行的顔色。

procedure TForm1.ColoredDBGrid1 DRawColoredDBGrid (Sender: TObject; Field: TField; var Color: TColor; var Font: TFont);

Var

p : Integer;

begin

p := Table1.FindField('wage').AsInteger;

// 取得目前記錄的 Wage 字段的值。

if (p < 500) then begin

// 程式将根據 wage 值設定各行的顔色。

Color := clGreen;

Font.Style := [fsItalic];

// 不僅可以改變顔色 , 還可以改變字型

end;

if(p >= 500) And (p < 800) then

Color := clRed;

if(p >=800) then begin

Color := clMaroon;

Font.Style := [fsBold];

end;

// 用‘退出’按鈕結束程式運作。

procedure TForm1.Button1Click(Sender: TObject);

begin

Close;

end;

2003-11-19 10:16:11 在一個 Dbgrid 中顯示多資料庫在資料庫程式設計中，不必要也不可能将應用程式操作的所有資料庫字段放入一個資料庫檔案中。正确的資料庫結構應是：将資料庫字段放入多個資料庫檔案，相關的資料庫都包含一個唯一

的關鍵字段，在多資料庫結構裡可以建立聯系。

例如：要編制一個人事管理程式，為簡化示範程式，隻建立兩個資料庫，每個資料庫都隻建

立兩個字段。

個人簡介 jianjie.dbf ，由人事處維護；工資情況 gongzi.dbf ，由财務處維護。

1. 資料庫的建立

進入 DataBase Desktop ，建立資料庫結構如下：

jianjie.dbf

編号字段名 :bianhao size:4 type:number

姓名字段名 :xingming size:10 type:character

gongzi.dbf

編号字段名 :bianhao size:4 type:number

工資字段名 :gongzi size:4 Dec 2 type:number

注意：兩個資料庫的 bianhao 字段的 size 、 type 必須一緻。實際上，兩資料庫檔案可以分布

在網絡的不同計算機上，為便于示範，分别存為″ c: /test/jianjie.dbf ″和 ″ c:/test

/gongzi.dbf ″。

2. 應用程式的編制

啟動 Delphi ，建立一個工程，在窗體中加入 Query 控件 Query1 ， databasename 屬性設為 c:

/test ；

加入 DataSource 控件 datasource1 ， DataSet 屬性設為 Query1 ；加入 DbGrid 控件 dbgrid1 ，

DataSource 屬性設為 DataSource1 ，将 Query1.sql 屬性設為

SELECT DISTINCT A.bianhao,a.xingming, b.gongzi

FROM ″ jianjie.dbf ″ A, ″ gongzi.DBF ″ b

WHERE A.bianhao=b.bianhao

再将 Query1.enabled 屬性設為 True ，不用編譯， DbGrid1 就會顯示 : bianhao ，

xingming ， gongzi 三個字段。如果 jianjie.dbf 和 gongzi.dbf 中有記錄，則記錄會顯示出來。因

篇幅所限，此文隻介紹了 Dbgrid 中顯示多個資料庫内容的一般方法，讀者可在此基礎上進行完

善，使該方法更好地适應您的需要。

2003-11-19 10:19:40 在 DBGrid 中如何讓回車變為光标右移動

在 Form.OnKeyPress 事件中寫如下代碼：

if Key = #13 then

if ActiveControl = DBGrid1 then begin

TDBGrid(ActiveControl).SelectedIndex := TDBGrid(ActiveControl).SelectedIndex + 1;

Key := #0;

end;

有 2 點需要注意：

1. 當光标達到 DBGird 最右列的時候，再按回車，光标還會停留在原地。

2.Key := #0

2003-11-19 10:25:07 從 DBGrid 中複制記錄 procedure TForm1.DBGrid1DblClick(Sender: TObject);

var

x : integer ;

HadToOpen : boolean ;

begin

with Sender as TDBGrid do begin

HadToOpen := not tTarget.Active ;

if HadToOpen then

tTarget.Active := True ;

tTarget.Append ;

for x := 0 to FieldCount - 1 do

case Fields[x].DataType of

ftBoolean : tTarget.FieldByName(Fields[x].FieldName).AsBoolean := Fields[x].AsBoolean

ftString : tTarget.FieldByName(Fields[x].FieldName).AsString := Fields[x].AsString

ftFloat : tTarget.FieldByName(Fields[x].FieldName).AsFloat := Fields[x].AsFloat

ftInteger : tTarget.FieldByName(Fields[x].FieldName).AsInteger := Fields[x].AsInteger

ftDate : tTarget.FieldByName(Fields[x].FieldName).AsDateTime := Fields[x].AsDateTime ;

end ;

tTarget.Post ;

if HadToOpen then

tTarget.Active := False ;

end ;

end;

2003-11-19 10:27:58 使用 DBGrid 的複選項（請參考如何在 DBGrid 中能支援多項記錄的選擇） procedure TForm1.SelectClick(Sender: TObject);

var

x: word;

TempBookmark: TBookMark;

begin

DBGrid1.Datasource.Dataset.DisableControls;

with DBgrid1.SelectedRows do

if Count <> 0 then

begin

TempBookmark:= DBGrid1.Datasource.Dataset.GetBookmark;

for x:= 0 to Count - 1 do

begin

if IndexOf(Items[x]) > -1 then

begin

DBGrid1.Datasource.Dataset.Bookmark:= Items[x];

showmessage(DBGrid1.Datasource.Dataset.Fields[1].AsString);

end;

DBGrid1.Datasource.Dataset.GotoBookmark(TempBookmark);

DBGrid1.Datasource.Dataset.FreeBookmark(TempBookmark);

DBGrid1.Datasource.Dataset.EnableControls;

end;

2003-11-19 10:32:27 在 DBGrid 上 Drag & Drop （拖放）我們在做程式中發現，如果能夠讓使用者将一個 Edit 的内容直接拖放到一個 DBGrid 裡，會顯得很友善，但在程式編制過程中發現，似乎拖放隻能拖放到目前的記錄上，那假如要拖放到其他記錄又怎麼辦呢，總不能讓使用者先選擇記錄，然後再拖放吧。

後來，通過研究發現，當用滑鼠點 DBGrid 時， DBGrid 會自動将記錄指針移動到所點選的記錄上，這就給了我一個思路，讓程式模拟在 DBGrid 上的一次點選先讓光标移動到那條記錄上，然後就可以将拖放的資料寫入 DBgrid 裡面了。

通過事實證明這個思路是可行的。下面，我就告訴大家我的做法：

1) 首先在 Form 上放一個 DBGrid ，并它能夠顯示記錄， ( 這比較簡單，就不用多說了 )

2) 在 Form 上放一個 Edit

3) 修改 Edit 的屬性，把 DragMode 改為 dmAutoMatic, 讓使用者能夠拖放

4) 在 Dbgrid 的 DragOver 事件中增加如下代碼：讓它能夠接收 Drag & drop

procedure TForm1.DBGrid1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);

begin

accept:=true;

end;

5) 在 Dbgrid 的 DragDrop 事件中增加如下代碼：讓它能夠自動跳到光标所指定的記錄上

procedure TForm1.DBGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);

begin

if Source<>Edit1 then exit;

with Sender as TDbGrid do begin

Perform(wm_LButtonDown,0,MakeLong(x,y));

PerForm(WM_LButtonUp, 0,MakeLong(x,y));

SelectedField.Dataset.edit;

SelectedField.AsString:=Edit1.text;

end;

至此，我們就實作了想要的功能，其中 PerForm 是 TControl 的一個通用方法目的是繞過 Windows 本身的消息循環，而将消息直接發給要發的 Control ，其具體使用方法請參考 Delphi 的幫助。

2003-11-19 10:39:19 如何使 DBGrid 的指針不移動？

【問題】：我用 DBGRID 顯示 TABLE 中的内容 , 現在我要從頭到尾讀一遍 TABLE 裡的資料 , 用

Table1.First,Next 來做會使 DBGRID 裡面的指針也跟着跑 , 怎麼才能使這時候 DBGRID 裡面的指針不

動呢 ?

【答案】：使用如下代碼即可：

　　 with DataSet do

　　 try

　　 DisableControls;

　　 Do_something;

　　 finally

　　 EnableControls;

　　 end;

2003-11-19 10:42:14 如何動态更新 DBGrid 的顔色？（請同時參考“如何使 DBGRID 網格的顔色随此格中的資料值的變化而變化？”） DBGrid 控件是一個有許多使用者接口的顯示資料庫的控件，以下的程式告訴您如何根據顯示的内容改變字型的顯示顔色。例如，如果一個城市的人口大于 200 萬，我們就讓它顯示為藍色。使用的控件事件為 DBGrid.OnDrawColumeCell.

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect:TRect;DataCol:

Integer; Column: TColumn; State: TGridDrawState);

begin

if Table1.FieldByName('Population').AsInteger > 20000000 then

DBGrid1.Canvas.Font.Color := clBlue;

DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);

end;

上面的例子是簡單的，但是你可以根據自己的需要擴充，例如字型也變化等，甚至你可以調用畫圓的函數在數字上畫上一個紅色的圓圈。

2003-11-19 10:45:14 使用 DBGrid 顯示日期在使用 DBGRID 控件時顯示 DATATIME 時其年份是為 2 位的，但我們在步入 2000 年後需要顯示的日期是 4 位，如： 1998 、 2001 。在資料庫中該字段隻有在 2000 年後才會顯示 4 位，怎麼辦呢？下面我們就讓該字段在 DBGRID 控件中也顯示 4 位的日期格式：輕按兩下 Table1 控件，就會出現 form1.table 窗體，擊右鍵，選 Add Fields... ，選擇日期字段後按 ok ，窗體中就出現了資料庫的日期字段名，點日期的那個字段名，屬性框裡就出現了該字段的資訊，裡面有一項 DispalyFormat ，在該顯示格式裡輸入 yyyy.mm.dd ，那麼 DBGRID 控件就出現完整的日期了。

2003-11-19 10:48:37 在 TDBGrid 控件中實作拖放的另外一個思路（請同時參考在 DBGrid 上 Drag & Drop （拖放））在本 unit 中，自定義 TMyCustomDBGrid=class(TCustomDBGrid), 再如下引用 :

TMyCustomDBGrid(DBGrid1).MouseDown(...)

或

DBGrid1 as TMyCustomDBGrid).MouseDown(...) 即可。

2003-11-19 10:56:11 在 dbgrid 表格中如何設定按Enter鍵相當于單 click ？【例程】：

在窗體 form1 中放入 table1,datasource1,dbgrid1, 設好聯連關系，使 dbgrid1 中能正确顯示出 table1 的資料。然後：

procedure TForm1.DBGrid1KeyPress(Sender: TObject;

var Key: Char);

begin

with DBGrid1 do

if Key=#13 then

DBGrid1CellClick(Columns[SelectedIndex]);

end;

procedure TForm1.DBGrid1CellClick(Column: TColumn);

begin

with DBGrid1 do

showmessage(format('row=%d',[SelectedIndex]));

end;

2003-11-19 11:07:55 Delphi 的 DBGrid 中的下拉清單和查找字段程式設計方法資料網格是非常流行的資料輸入和顯示形式，像大家熟悉的 Excel 、 VFP 中的功能強大的 BROWS 等，為廣大程式員樂于采用。在用 Delphi 開發資料庫應用系統時，利用資料網格 DBGrid 輸入資料時，有些字段隻允許某幾個固定的字元串，像檔案案卷的保管期限，隻有“永久”、“長期”和“短期”三種，可否從一個下拉清單中進行選擇，進而友善輸入和避免輸入錯誤呢？還有一些字段，例如職工資訊庫中的機關編号（在另外的機關庫中儲存着機關的詳細資訊），在輸入和顯示職工資料時，能否不對機關編号進行操作，而代之于更加直覺的機關庫中的機關名稱呢？答案是肯定的， Delphi 的資料網格控件 DBGrid ，支援下拉清單和查找字段的程式設計，而且，程式設計的過程都是可視化的，不需要寫一行語句。

一、 DBGrid 中的下拉清單

在 DBGrid 網格中實作下拉清單，設定好 DBGrid 中該字段的 PickList 字元串清單、初始的序号值 DropDownRows 即可。以職工資訊庫中的籍貫字段（字元串類型）為例，具體設計步驟如下：

1 、在窗體上放置 Table1 、 DataSource1 、 DBGrid1 、 DBNavigator1 等控件對象，按下表設定各個對象的屬性 :

---------------------------------------

對象屬性設定值

---------------------------------------

Table1 DataBase sy1

Table 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

Table zgk.dbf // 職工資訊庫

Table2 DataBase sy1

Table dwk.dbf // 機關資訊庫

DataSource1 DataSet Table1

DbGrid1 DataSource DataSource1

DBNavigator1 DataSource Datasource1

------------------------------------------

2 、輕按兩下 Table1, 在彈出的 Form1.Table1 視窗中，用右鍵彈出快捷菜單，單擊 Add Fields 菜單項；選擇所有的字段後，按 OK 按鈕。

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-11-19 11:23:29 Delphi 中定制 DBGrid 控件　　在 Delphi 中 ,DBGrid 控件是一個開發資料庫軟體不能不使用的控件 , 其功能非常強大 , 可以配合 SQL 語句實作幾乎所有資料報表的顯示 , 操作也非常簡單 , 屬性、過程、事件等都非常直覺 , 但是使用中 , 有時侯還是需要一些其他功能 , 例如列印、斑馬紋顯示、将 DBGrid 中的資料轉存到 Excel97 中等等。這就需要我們定制 DBGrid, 以更好的适應我們的實際需要定制 DBGrid, 實作了以上列舉的功能 , 對于列印功能則是在 DBGrid 的基礎上聯合 QuickReport 的功能 , 直接進行 DBGrid 的列印及預覽 , 使用者感覺不到 QuickReport 的存在 , 隻需調用方法 WpaperPreview 即可 ; 對于轉存資料到 Excel 也是一樣 , 不過這裡使用的是自動化變量 Excel 而已。由于程式太長 , 不能詳細列舉 , 這裡介紹一個完整的實作斑馬紋顯示的 DBGrid, 名字是 NewDBGrid 。根據這個小程式 , 讀者可以添加其他更好、更多、更實用的功能。

　　 NewDBGrid 的實作原理就是繼承 DBGrid 的所有功能 , 同時添加新的屬性：

Wzebra,WfirstColor ,WsecondColor 。

當 Wzebra 的值為 True 時 , 顯示斑馬紋效果 , 其顯示的效果是單數行顔色為 WfirstColor, 雙數行顔色為 WsecondColor 。具體的見下面程式清單 :

unit NewDBGrid;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DB, Grids, DBGrids, Excel97;

type

TDrawFieldCellEvent = procedure(Sender: TObject; Field: TField;

var Color: TCOlor; var Font: TFont; Row: Longint) of object;

// 新的資料控件由 TDBGrid 繼承而來

TNewDBGrid = class(TDBGrid)

private

// 私有變量

FWZebra: Boolean; // 是否顯示斑馬顔色

FWFirstColor: TColor; // 單數行顔色

FWSecondColor: TCOlor; // 雙數行顔色

FDrawFieldCellEvent: TDrawFieldCellEvent;

procedure AutoInitialize; // 自動初使化過程

procedure AutoDestroy;

function GetWFirstColor: TColor;

//FirstColor 的讀寫函數及過程

procedure SetWFirstColor(Value: TColor);

function GetWSecondColor: TCOlor;

procedure SetWSecondColor(Value: TColor);

function GetWZebra: Boolean;

procedure SetWZebra(Value: Boolean);

protected

procedure Scroll(Distance: Integer); override;

// 本控件的重點過程

procedure DrawCell(Acol, ARow: Longint; ARect:

TRect; AState: TGridDrawState); override;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

published

property WZebra: Boolean read GetWZebra write SetWZebra;

property OnDblClick;

property OnDragDrop;

property OnKeyUp;

property OnKeyDown;

property OnKeyPress;

property OnEnter;

property OnExit;

property OnDrawDataCell;

property WFirstColor: TColor

read GetWFirstColor write SetWFirstColor;

property WSecondColor: TColor

read GetWSecondColor write SetWSecondColor;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('Data Controls', [TNewDBGrid]);

end;

procedure TNewDBGrid.AutoInitialize;

begin

FWFirstColor := RGB(239, 254, 247);

FWSecondColor := RGB(249, 244, 245);

{ 可以在次添加需要的其它控件及初使化參數 }

end;

procedure TNewDBGrid.AutoDestroy;

begin

{ 在這裡釋放自己添加參數等占用的系統資源 }

end;

procedure TNewDBGrid.SetWZebra(Value: Boolean);

begin

FWZebra := Value;

Refresh;

end;

function TNewDBGrid.GetWZebra: Boolean;

begin

Result := FWZebra;

end;

function TNewDBGrid.GetWFirstColor: TColor;

begin

Result := FWFirstColor;

end;

procedure TNewDBGrid.SetWFirstColor(Value: TColor);

begin

FWFirstColor := Value;

Refresh;

end;

function TNewDBGrid.GetWSecondColor: TColor;

begin

Result := FWSecondColor;

end;

procedure TNewDBGrid.SetWSecondColor(Value: TColor);

begin

FWSecondColor := Value;

Refresh;

end;

constructor TNewDBGrid.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

AutoInitialize;

end;

destructor TNewDBGrid.Destroy;

begin

AutoDestroy;

inherited Destroy;

end;

// 實作斑馬效果

procedure TNewDBGrid.DrawCell(ACol, ARow:

Longint; ARect: TRect; AState: TGridDrawState);

var

OldActive: Integer;

Highlight: Boolean;

Value: string;

DrawColumn: Tcolumn;

cl: TColor;

fn: TFont;

begin

{ 如果處于控件裝載狀态 , 則直接填充顔色後退出 }

if csLoading in ComponentState then

begin

Canvas.Brush.Color := Color;

Canvas.FillRect(ARect);

Exit;

end;

if (gdFixed in AState) and (ACol - IndicatorOffset < 0) then

begin

inherited DrawCell(ACol, ARow, ARect, AState);

Exit;

end;

{ 對于列标題 , 不用任何修飾 }

if (dgTitles in Options) and (ARow = 0) then

begin

inherited DrawCell(ACol, ARow, ARect, AState);

Exit;

end;

if (dgTitles in Options) then Dec(ARow);

Dec(ACol, IndicatorOffset);

if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =

[dgRowLines, dgColLines]) then

begin

{ 縮減 ARect, 以便填寫資料 }

InflateRect(ARect, -1, -1);

end

else

with Canvas do

begin

DrawColumn := Columns[ACol];

Font := DrawColumn.Font;

Brush.Color := DrawColumn.Color;

Font.Color := DrawColumn.Font.Color;

if FWZebra then // 如果屬性 WZebra 為 True 則顯示斑馬紋

if Odd(ARow) then

Brush.Color := FWSecondColor

else

Brush.Color := FWFirstColor;

if (DataLink = nil) or not DataLink.Active then

FillRect(ARect)

else

begin

Value := '';

OldActive := DataLink.ActiveRecord;

try

DataLink.ActiveRecord := ARow;

if Assigned(DrawColumn.Field) then

begin

Value := DrawColumn.Field.DisplayText;

if Assigned(FDrawFieldCellEvent) then

begin

cl := Brush.Color;

fn := Font;

FDrawFieldCellEvent(self, DrawColumn.Field, cl, fn, ARow);

Brush.Color := cl;

Font := fn;

end;

Highlight := HighlightCell(ACol, ARow, Value, AState);

if Highlight and (not FWZebra) then

begin

Brush.Color := clHighlight;

Font.Color := clHighlightText;

end;

if DefaultDrawing then

DefaultDrawColumnCell(ARect, ACol, DrawColumn, AState);

if Columns.State = csDefault then

DrawDataCell(ARect, DrawColumn.Field, AState);

DrawColumnCell(ARect, ACol, DrawColumn, AState);

finally

DataLink.Activerecord := OldActive;

end;

if DefaultDrawing and (gdSelected in AState) and

((dgAlwaysShowSelection in Options) or Focused)

and not (csDesigning in Componentstate)

and not (dgRowSelect in Options)

and (ValidParentForm(self).ActiveControl = self) then

begin

// 顯示目前光标處為藍底黃字 , 同時加粗顯示

Windows.DrawFocusRect(Handle, ARect);

Canvas.Brush.COlor := clBlue;

Canvas.FillRect(ARect);

Canvas.Font.Color := clYellow;

Canvas.Font.Style := [fsBold];

DefaultDrawColumnCell(ARect, ACol, DrawColumn, AState);

end;

if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =

[dgRowLines, dgColLines]) then

begin

InflateRect(ARect, -2, -2);

DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMRIGHT);

DrawEdge(Canvas.Handle, ARect, BDR_SUNKENINNER, BF_TOPLEFT);

end;

// 如果移動光标等 , 則需要重新整理顯示 DBGrid

procedure TNewDBGrid.Scroll(Distance: Integer);

begin

inherited Scroll(Distance);

refresh;

end;

end.

以上程式在 Win98 + Delphi 5 下調試通過。

2003-11-19 11:27:19 在 DBGrid 控件中顯示圖形　　如果在資料庫中設定了一個為 BLOB 類型的字段用于儲存圖形 , 在使用 DBGrid 控件顯示時 , 在表格中顯示的是 BLOB, 而無法顯示出圖形 , 當然 , 有一些第三方控件可以顯示出圖形 , 但是要去找第三方控件不是一件容易的事 , 而且有些好用的都需要付費。能不能在 DBGrid 中顯示圖形呢？答案是肯定的。

　　在 DBGrid 的 OnDrawCell 事件中加入如下代碼即可在 DBGrid 控件中顯示圖形。

var

Bmp: TBitmap;

begin

if (Column.Field.DataTyp = ftBLOB) or (Column.Field.DataTyp = ftGraphic) then

begin

Bmp:=TBitmap.Create;

try

Bmp.Assign(Column.Field);

DBGrid1.Canvas.StretchDraw(Rect,Bmp);

Bmp.Free;

Except

Bmp.Free;

end;

　　按照類似的方法 , 就可以在 DBGrid 中顯示 Memo 類型的字段内容。

　　另外 , 在往資料庫中儲存圖形時 , 建議使用 EMF 圖元檔案 , 這樣資料庫檔案的大小不會變的十分驚人 , 我試過了 , 同樣是一幅 400*300 的圖形 , 如果用位圖 , 儲存 100 多幅時 , 資料庫檔案大小會達到近 20MB, 而使用 EMF 矢量圖形儲存 , 儲存 800 多幅時才 260 多 KB, 儲存 EMF 矢量圖形的方法與儲存位圖是差不多的 , 在 DBGrid 中顯示也差不多 , 隻不過 BLOB 型字段内容不能直接 Assign 給 EMF 檔案 , 要用 MemoryStream 來中轉。

2003-11-19 11:31:15 如何偵測 DBGrid 目前的記錄與欄位資訊請問用什麽方式可以抓到遊标或滑鼠目前所在 DBGrid 的 Record? 我的意思是 , 讓遊标所在之 record 可以立即顯示在另外的 edit 内

如果您的問題是對應一組 Edit 元件的話 , 建議采用 TDBEdit 或 TDBLabel, 可以不必再費心管記錄位置 ;

如果是隻有一個 EditBox, 内容要一直反應 DBGrid 的目前記錄的目前欄位 , 那可以同時在 DataSource 的 OnDataChange 與 DbGrid 的 OnColEnter 這兩個事件中寫更新 EditBox 内容的程式 .

例如 DBGrid 的 OnColEnter 事件 :

procedure TForm1.DBGrid1ColEnter(Sender: TObject);

begin

if DBGrid1.SelectedField <> nil then

Edit1.Text := DBGrid1.SelectedField.AsString;

end;

但隻靠 OnColEnter 是不夠的 , 因為 , 在同一個 Column( 同一個欄位 ) 上下移動反白方格時 , OnColEnter 是不會被觸發的 , 是以 , 可以再搭配 OnDataChange 事件 , 在 State 為 dsBrowse 時的 DataChange, 可以視同記錄位置的改變 , 以下的程式是呼叫 DBGrid 的 OnColEnter 事件處理程式 :

procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField);

begin

if DataSource1.State = dsBrowse then

DBGrid1ColEnter(Sender);

end;

2003-11-19 11:39:38 用 DbGrid 制作 edit 錄入時的下拉提示框在 Delphi 語言中提拱了不少資料輸入的方法 , 如可從資料庫中選擇或人工輸入的控件有 :DBListBox 、 DBComboBox 、 DBLookupListBox 、 DBLookupComboBox 等。但對于這樣一個例子 : 資料庫名為 dm.db, 其中有兩個字段 :

代碼 :Code

名稱 :Name

要求根據使用者輸入的代碼 , 去擷取該代碼對應的名稱。

一般的使用者并不知道代碼和名稱的對應關系 , 如讓使用者輸入代碼 , 選出對應的名稱 , 由于上述的控件不能使操作人員看到代碼和名稱的對應關系 , 如讓使用者根據代碼用下拉框去查找到對應的該條紀錄的名稱 , 将很難操作。

根據這種情況 , 我編制了下面程式 , 把 DBGrid 做為 Edit 的下拉清單框輔助操作 , 在 DBGrid 中直覺地顯示出代碼和名稱的對應關系 , 并且能夠根據使用者錄入代碼的變化情況 , 随時更新 DBGrid 中的記錄指針 , 使使用者可以直覺友善地點取所需要的名字 , 而且 DBGrid 是依據使用者在 Edit 中輸入代碼時才顯現 , 跳出 Edit 框即消失。這種方法既為使用者錄入提供了友善 , 又不影響界面的整體美觀 , 效果不錯。現把該程式提供給大家 , 你們可根據自己的需要 , 對程式進行加工處理 , 應用于程式開發中 , 希望起到抛磚引玉的作用。

【問題】：做這樣一個小程式 : 讓使用者輸入代碼 , 然後将名稱顯示在窗體上。

1 、首先我們可以建立一個 Form, 在此 Form 中增加控件 :

Table : Table1, 設定其屬性對應代碼庫 dm.db, 并将 Active 置為 True

DataSource : DataSource1, 設定其屬性 DataSet 為 Table1

Edit : CodeEdit,NameEdit 分别對應代碼輸入框和名稱顯示框

DBGrid : DBGrid1, 設定其屬性 DataSource 為 DataSource1

并把 CodeEdit 的屬性 Text 的值置空 ,NameEdit 的屬性 Text 的值置空。

2 、對照以下語句 , 修改 CodeEdit 的 OnEnter 、 OnExit 、 OnKeyDown 、 OnKeyUp 事件 :

在 CodeEdit 的 OnEnter 事件如下 :

procedure TForm1.CodeEditEnter(Sender: TObject);

begin

if CodeEdit.text<>'' then

begin

CodeEdit.SelStart:=length(CodeEdit.text);

Table1.locate('code', CodeEdit.text,[lopartialkey]);

End;

end;

CodeEdit 的 OnExit 事件如下 :

procedure TForm1.CodeEditExit(Sender: TObject);

begin

if activecontrol<>dbgrid1 then

begin

dbgrid1.Visible:=false;

Table1.Locate('code',codeedit.text,[lopartialkey]);

if Table1.Eof then

begin

dbgrid1.Visible:=true;

exit;

end;

if not Table1.Eof then

begin

codeedit.Text:=Table1.fieldbyname('code').asstring;

NameEdit.Text := Table1.fieldbyname('name').asstring;

end;

CodeEdit 的 OnKeyDown 事件如下 :

Procedure Tform1.CodeEditKeyDown(Sender: TObject;var Key: Word;Shift: TShiftState);

var

i:integer;

begin

if (Table1.RecordCount>0) then

begin

case key of 48..57:

begin

dbgrid1.Visible:=true;

Table1.Locate('code',CodeEdit.text,[lopartialkey]);

end;

vk_next:

if dbgrid1.Visible then

begin

i:=0;

while (not Table1.Eof) and (i<11) do

begin

Table1.Next;

i:=i+1;

end;

CodeEdit.Text:=Table1.fieldbyname('code').asstring;

End;

vk_prior:

if dbgrid1.Visible then

begin

i:=0;

while (not Table1.Bof) and (i<11) do

begin

Table1.prior;

i:=i+1;

end;

CodeEdit.Text:=Table1.fieldbyname('code').asstring;

end;

vk_down:

if dbgrid1.Visible then

begin

if not Table1.Eof then

begin

Table1.Next;

CodeEdit.Text:=Table1.fieldbyname('code').asstring;

end;

vk_up:

if dbgrid1.Visible then

begin

if not Table1.Bof then

begin

Table1.Prior;

CodeEdit.Text:=Table1.fieldbyname('code').asstring;

end;

end

else

dbgrid1.Visible:=false;

CodeEdit.SelStart:=length(CodeEdit.text);

end;

CodeEdit 的 OnKeyUp 事件如下 :

procedure Tform1.CodeEditKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

if (Table1.RecordCount>0) then

begin

if ((key>=48) and (key<=57)) then

Table1.Locate('code',codeedit.text,[lopartialkey]);

if (key=VK_back) and (codeedit.text<>'') then

Table1.Locate('code',codeedit.text,[lopartialkey]);

if (key=VK_BACK) and (codeedit.text='') then

Table1.First;

if (key=vk_down) or (key=vk_up) or (key=vk_prior) or (key=vk_next) then

if dbgrid1.Visible then

codeedit.Text:=Table1.fieldbyname('code').asstring;

end

else

dbgrid1.Visible:=false;

codeedit.SelStart:=length(codeedit.text);

end;

本程式在 Windows98+Delphi4.0 、 5.0 下均調試通過。

2003-11-19 11:49:55 Delphi 的 dbgrid 中根據資料的屬性不同顯示不同的顔色（請同時參考如何動态更新 DBGrid 的顔色？ / 如何使 DBGRID 網格的顔色随此格中的資料值的變化而變化？）

在應用系統中 , 使用者常常要求把資料按不同的顔色顯示出來 , 隻要你在 Dbgrid 的 DrawColumnCell 事件中加入以下代碼就可以了 :

If Query.fieldbyname(' 字段名 ').values 滿足條件 then

Begin

Dbgrid.Canvas.Brush.Color := 顔色 ( 如 :clInfoBk) ;

Dbgrid.DefaultDrawColumnCell( Rect, DataCol, Column, [gdFixed,gdFocused,gdSelected] );

End ;

2003-11-19 12:00:18 給 DBGrid 加入排序功能（同時參考“點選 DBGrid 的 Title 對查詢結果排序”）

在實際資料庫管理系統中，使用者對表中資料的操作，最頻繁的莫過于浏覽查詢了，而查詢中若能提供為某字段建立的排序功能，則非常有利于使用者對“關鍵資料”的了解。

Windows 的使用者都知道，在“我的電腦”或“資料總管”中打開任一檔案夾，若以“詳細資料”方式檢視，系統會顯示出該檔案夾下的子檔案夾和檔案相關資訊，如：名稱、類型、大小、修改時間，使用者隻需要單擊标題欄中的相應項，則系統自動按該項進行“升序”（或“降序”）的排列顯示，這樣使用者便能輕松檢視相應的檔案夾或檔案對象的内容。

受此啟發，考慮能不能在顯示資料的 Grid 表格中完成如此功能呢？答案是肯定的。下面以在 Delphi 中的實作方法為例，通過具體内容，介紹該功能的實作。

步驟如下：

一、先建立一資料表

該表以 Delphi 中最常用的 Paradox 為類型，取名為 Student ，反映（在職）學生的基本情況。該表各字段定義如下：

--------------------------------------------

字段名　　　　類型　　　　　　大小

序号　　　　　 Short 型　　　　　 / (Key*)

學号　　　　　 Alpha 型　　　　　 6

出生日期　　　 Date 型　　　　　 /

性别　　　　　 Alpha 型　　　　　 2

婚否　　　　　 Logical 型　　　　 /

英語　　　　　 Number 型　　　　 /

高數　　　　　 Number 型　　　　 /

PASCAL 　　　　 Number 型　　　　 /

備注　　　　　 Memo 型　　　　　 20

-------------------------------------------

儲存後，随意往表中輸入 3 至 5 條記錄内容。

注：①表中必須建立關鍵索引（為首字段建立）。此處為“序号”字段；

② 該表中使用了 Paradox 常用的幾種字段類型，但尚未全部包含。

二、建立項目，實作功能

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:='Unit  Num';

　 1:DBEdit1.DataField:='UnitName';

　　 2:DBEdit1.DataField:='Header';

　　 3:DBEdit1.DataField:='Address';

　　 4:DBEdit1.DataField:='Tel';

　　 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;

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;

except

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.

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 中的下拉列表

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;

二、 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 按鈕。

4 、設定 Table1DWBH.Visible=False 。

5 、在 Form1.Table1 視窗，用右鍵彈出快捷菜單，單擊 New Field 菜單項，新增一個查找字段 DWMC ，在彈出的視窗設定相應的屬性，按 OK 按鈕确認；在 Object Inspector 視窗，設定 Table1DWMC.DisplayLabel= 機關名稱。

6 、在 Form1.Oncreate 事件中寫入語句：

Table1.Open;

三、 DBGrid 中的下拉清單和查找字段的差別

雖然 DBGrid 中的下拉清單和查找字段，都是以下拉清單的形式出現的，但兩者有很大的差别。

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;

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;

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;

測試通過（ 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;

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;

//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;

//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 也有明顯的缺陷：它的鍵盤操作方式非常怪異難用。雖然很多人都通過程式設計把Enter鍵轉換成 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 中，強化了方向鍵和Enter鍵的功能：當光标在行末行首位置時，按方向鍵就能跳格；回車能橫向移動輸入焦點，并且還能彈出下拉清單（見改造 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;

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;

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;

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;

　　 procedure TForm1.DBGrid1ColEnter(Sender: TObject);

　　 begin

　　 // 確定該欄是邏輯字段

　　 if DBGrid1.SelectedField.DataType = ftBoolean then

　　 begin

　　　　 OriginalOptions := DBGrid1.Options;

　　　　 DBGrid1.Options := DBGrid1.Options - [dgEditing];

　　 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;

dbgrid使用大全(delphi)

繼續閱讀

報錯：'mysql' 不是内部或外部指令，也不是可運作的程式或批處理檔案。

Linxu常用指令技巧彙總

ERROR 1 (HY000): Can't create/write to file '/tmp/#sql_4188_1.MYI' (Errcode: 28)

極其無聊的 StrtoDate 失敗

艱難安裝LDAP,SSL認證

《Linux指令行與Shell腳本程式設計大全第2版.布盧姆》pdf

MySQL的4種隔離級别？出現問題

XX系統實施過程問題總結

無元件上傳圖檔到資料庫中，最完整解決方案

【MySQL資料庫】資料庫索引事務1.索引2.事務

neo4j之cypher使用文檔

NOSQL安全攻擊

mybatis_入門程式Mybatis入門

GridView終極用法(一)

登入plsql 報錯 the account is locked --使用者被鎖

SequoiaDB巨杉資料庫C++驅動概述