|
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; ----------------------------------------------- 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; ----------------------------------------------- procedure TForm1.DBGrid1ColExit(Sender: TObject); begin If DBGrid1.SelectedField.FieldName = DBComboBox1.DataField then begin DBComboBox1.Visible := false; end; end; ----------------------------------------------- 在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); ----------------------------------------------- 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); ----------------------------------------------- 设置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); ----------------------------------------------- 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; ----------------------------------------------- 横向斑马线， 同时以红色突显当前行效果。 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); ----------------------------------------------- 双向斑马线效果：即行间用不同色区分，同时，选中行以纵向斑马线效果区分不同的列。 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); ----------------------------------------------- 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; ----------------------------------------------- dbgrid中移动焦点到指定的行和列 dbgrid是从TCustomGrid继承下来的，它有col与row属性，只不过是protected的，不能直接访问，要处理一下，可以这样： Query1.first; TDrawGrid(dbgrid1).col:=1; dbgrid1.setfocus; ----------------------------------------------- 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; ----------------------------------------------- 1.为SpinEdit1构件的OnChange事件编写响应代码： procedure TForm1.SpinEdit1Change(Sender: TObject); begin DBGrid1.refresh; //刷新是必须的 end; 当SpinEdit1构件的值有所改变时，重新刷新DBGrid1。 2.为ColorGrid1的OnChange事件编写响应代码： procedure TForm1.ColorGrid1Change(Sender: TObject); begin DBGrid1.refresh; //刷新是必须的 end; 当ColorGrid1的值有所改变时，即鼠标的右键或左键单击ColorGrid1重新刷新DBGrid1。 3.为Form1窗体（主窗体）的OnCreate事件编写响应代码： procedure TForm1.FormCreate(Sender: TObject); begin ColorGrid1.ForeGroundIndex:=9; ColorGrid1.BackGroundIndex:=15; end; ----------------------------------------------- 判断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!'); ----------------------------------------------- 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; ----------------------------------------------- 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. ----------------------------------------------- 在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 中的内容输出至 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; ----------------------------------------------- 数据网格自动适应宽度///////源代码开始 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; ///////使用示例结束 |
|
|
