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