Tdbgrid应用大全

1.隔行不同颜色显示
  with TDBGrid(Sender) do
  begin
    if (gdSelected in State) or (gdFocused in State) then
      Canvas.Brush.Color := clAqua
    else if DataSource.DataSet.RecNo mod 2 = 0 then
      Canvas.Brush.Color := $00F0F0F5
    else
      Canvas.Brush.Color := clWindow;
    DefaultDrawColumnCell(Rect, DataCol, Column, State);
  end;

2.Flat风格
  属性设茫?
  Ctrl3D = False
  Options.dgColLines = False
  Options.dgRowLines = False

type
  TGridAccess = class(TCustomGrid);

Form.OnCreate：
  with TGridAccess(DBGrid1) do
    Options := Options + [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine];

3.去掉滚动条
  private
    { Private declarations }
    FGridWndProc: TWndMethod;
    procedure GridWndProc(var Message: TMessage);

Form.OnCreate：
  TGridAccess(DBGrid1).ScrollBars := ssNone;
  FGridWndProc := DBGrid1.WindowProc;
  DBGrid1.WindowProc := GridWndProc;

Form.OnDestroy：
  DBGrid1.WindowProc := FGridWndProc;

procedure TForm1.GridWndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_PAINT, WM_NCPAINT:
      begin
        SetScrollRange(DBGrid1.Handle, SB_HORZ, 0, 0, False);
        SetScrollRange(DBGrid1.Handle, SB_VERT, 0, 0, False);
      end;
  end;
  FGridWndProc(Message);
end;

4.鼠标移到某个单元格，指针形状改变
procedure TForm1.DBGrid1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  Coord: TGridCoord;
begin
  Coord := TDBGrid(Sender).MouseCoord(X, Y);
  if (Coord.Y > 0) and (Coord.X = 1) and not TDBGrid(Sender).DataSource.DataSet.IsEmpty then
  begin // Coord.X=1，dgIndicator=True时说明在第一列，False时说明在第二列
    TDBGrid(Sender).Cursor := crHandPoint;
    StatusBar1.SimpleText := 'Click to open curve form';
  end
  else
  begin
    TDBGrid(Sender).Cursor := crDefault;
    StatusBar1.SimpleText := '';
  end;
end;

5.Options.dgRowSelect=True时，点击不同单元格列，执行不同的动作
  DBGrid的OnMouseDown/OnMouseUp事件在点击记录单元格时不会触发(点击固定行列区会触发)，而Options.dgRowSelect=True时，OnCellClick事件的Column总是传递第一个列对象，即Column.Index=0，即使你点击的是其他列，因此需要在OnCellClick中再判断点击的是哪个列，再根据不同列执行不同的动作。
procedure TForm1.DBGrid1CellClick(Column: TColumn);
var
  Coord: TGridCoord;
  P: TPoint;
begin
  GetCursorPos(P);
  Windows.ScreenToClient(TDBGrid(Sender).Handle, P);
  Coord := TDBGrid(Sender).MouseCoord(P.X, P.Y);
  if (Coord.Y > 0) and (Coord.X = 1) and not TDBGrid(Sender).DataSource.DataSet.IsEmpty then
    // Coord.X=1，dgIndicator=True时说明在第一列，False时说明在第二列
    ShowMessage(GridRate.Columns[0].Field.AsString);
end;

2006-1-5 15:50:45   

查看评语»»»

 2006-1-5 16:57:15    6.支持鼠标滚轮

方法一：
  private
    { Private declarations }
    procedure GridMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);

Form.OnCreate：
  TControlAccess(DBGrid1).OnMouseWheel := GridMouseWheel;

procedure TForm1.GridMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  TDBGrid(Sender).DataSource.DataSet.MoveBy(-WheelDelta div WHEEL_DELTA);
  Handled := True;
end;

方法二：
  private
    { Private declarations }
    FGridWndProc: TWndMethod;
    procedure GridWndProc(var Message: TMessage);

Form.OnCreate：
  FGridWndProc := DBGrid1.WindowProc;
  DBGrid1.WindowProc := GridWndProc;

Form.OnDestroy：
  DBGrid1.WindowProc := FGridWndProc;

procedure TForm1.GridWndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_MOUSEWHEEL:
      begin
        DBGrid1.DataSource.DataSet.MoveBy(-Smallint(Message.WParamHi) div WHEEL_DELTA);
      end;
  else FGridWndProc(Message);
  end;
end;

 

 2006-1-5 16:59:05    6.支持鼠标滚轮(补充)

type
  TControlAccess = class(TControl);

 

 2006-1-17 10:39:50    隔行不同颜色显示(2)

鉴于DataSource.DataSet.RecNo可能无效，改用DataLink.ActiveRecord。

type
  TDBGridAccess = class(TCustomDBGrid);

procedure TForm1.GridListDrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
begin
  with TDBGrid(Sender) do
  begin
    Canvas.Font.Color := clBlack;
    if (gdSelected in State) or (gdFocused in State) then
      Canvas.Brush.Color := clAqua
    else if Odd(TDBGridAccess(Sender).DataLink.ActiveRecord) then
      Canvas.Brush.Color := $00F0F0F5
    else
      Canvas.Brush.Color := clWindow;

    DefaultDrawColumnCell(Rect, DataCol, Column, State);
  end;
end;

 

 2006-1-17 14:48:45    7.显示行号

unit HackGrid;

interface

uses Windows, SysUtils, Grids, DBGrids;

type
  THackGrid = class
  protected
    class procedure NewSetColumnAttributes;
  public
    class procedure Hook(AIndicatorWidth: Integer);
    class procedure Unhook;
    class procedure DrawOrds(Sender: TObject; AState: TGridDrawState);
  end;

implementation

var
  GOldSetColumnAttributes: Pointer;
  GIndicatorWidth: Integer;

type
  TDBGridAccess = class(TCustomDBGrid);

{ THackGrid }

class procedure THackGrid.Hook(AIndicatorWidth: Integer);
var
  obj: TObject;
  vmt, vmtIndex: Integer;
  method, newMethod: Pointer;
  dwOldProtect: DWORD;
begin
  GIndicatorWidth := AIndicatorWidth;
  if GOldSetColumnAttributes <> nil then Exit;

  obj := TDBGrid.Create(nil);
  try
    vmt := PInteger(obj)^;
    asm
          MOV     vmtIndex,VMTOFFSET TDBGridAccess.SetColumnAttributes;
    end;
    method := Pointer(vmt + vmtIndex);
    GOldSetColumnAttributes := PPointer(method)^;

    VirtualProtect(method, 4, PAGE_READWRITE, dwOldProtect);
    newMethod := @THackGrid.NewSetColumnAttributes;
    PPointer(method)^ := newMethod;
    VirtualProtect(method, 4, dwOldProtect, dwOldProtect);
  finally
    obj.Free;
  end;
end;

class procedure THackGrid.Unhook;
var
  obj: TObject;
  vmt, vmtIndex: Integer;
  method: Pointer;
  dwOldProtect: DWORD;
begin
  if GOldSetColumnAttributes = nil then Exit;

  obj := TDBGrid.Create(nil);
  try
    vmt := PInteger(obj)^;
    asm
          MOV     vmtIndex,VMTOFFSET TDBGridAccess.SetColumnAttributes;
    end;
    method := Pointer(vmt + vmtIndex);

    VirtualProtect(method, 4, PAGE_READWRITE, dwOldProtect);
    PPointer(method)^ := GOldSetColumnAttributes;
    VirtualProtect(method, 4, dwOldProtect, dwOldProtect);
  finally
    obj.Free;
    GOldSetColumnAttributes := nil;
  end;
end;

class procedure THackGrid.NewSetColumnAttributes;
var
  Grid: Pointer;
begin
  asm
        MOV     Grid,EAX
        CALL    GOldSetColumnAttributes
  end;
  with TDBGridAccess(Grid) do
    if (dgIndicator in Options) and (GIndicatorWidth > DBGrids.IndicatorWidth) then
      ColWidths[0] := GIndicatorWidth;
end;

class procedure THackGrid.DrawOrds(Sender: TObject; AState: TGridDrawState);
var
  FrameOffs: Integer;
  R: TRect;
begin
  with TDBGridAccess(Sender) do
  begin
    R := CellRect(0, DataLink.ActiveRecord+1);
    if (gdFixed in AState) and ([dgRowLines, dgColLines] * Options =
      [dgRowLines, dgColLines]) then
      FrameOffs := 1 else
      FrameOffs := 2;
    R.Right := R.Right - 6{FIndicator.Width} - FrameOffs - 2;
    DrawText(Canvas.Handle, PChar(IntToStr(DataLink.ActiveRecord+1)), -1, R,
      DT_RIGHT or DT_VCENTER or DT_SINGLELINE);  
  end;
end;

end.

使用：
procedure TForm1.FormCreate(Sender: TObject);
begin
  THackGrid.Hook(28);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  THackGrid.Unhook;
end;

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
begin
  with TDBGrid(Sender) do
  begin
    Canvas.Font.Color := clBlack;
    if DataCol = 0 then // 一行只画一次
    begin
      Canvas.Brush.Color := clBtnFace;
      THackGrid.DrawOrds(Sender, State);
    end;
    DefaultDrawColumnCell(Rect, DataCol, Column, State);
  end;
end;

 

 2006-1-23 16:24:07    7.显示行号(2)

上面的代码在数据记录数<DBGrid显示行数的时候才有效，汗！
下面的代码经测试基本可行，不过在数据集执行Last，当前记录已经在最后一条并且Eof=True时，再Insert插入，显示的行号比实际的大1，主要在判断是Insert插入还是Append添加的操作是通过判断Eof进行的，这就会导致误判，其他情况目前还没有发现显示不正确的。

unit MyGrid;

interface

uses Windows, Messages, Classes, SysUtils, DB, Grids, DBGrids;

type
  TMyDBGrid = class(TDBGrid)
  private
    FIndicatorWidth: Integer;
    FFirstRecNo: Integer;
    FOldBeforeInsert: TDataSetNotifyEvent;
    procedure DataSetBeforeInsert(DataSet: TDataSet);
    function GetDataSource: TDataSource;
    procedure SetDataSource(const Value: TDataSource);
    procedure SetIndicatorWidth(const Value: Integer);
  protected
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
    procedure SetColumnAttributes; override;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property IndicatorWidth: Integer read FIndicatorWidth write SetIndicatorWidth default 28;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
  end;

implementation


{ TMyDBGrid }

constructor TMyDBGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIndicatorWidth := 28;
end;

procedure TMyDBGrid.DataSetBeforeInsert(DataSet: TDataSet);
var
  iRow: Integer;
begin
  iRow := Row;
  if dgTitles in Options then Dec(iRow);
  FFirstRecNo := DataSet.RecNo - iRow;
  if Assigned(FOldBeforeInsert) then FOldBeforeInsert(DataSet);
end;

procedure TMyDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
  AState: TGridDrawState);
var
  OldActive, iRow, RowNo: Integer;
begin
  inherited DrawCell(ACol, ARow, ARect, AState);

  if (dgIndicator in Options) then
  begin
    Dec(ACol);
    if dgTitles in Options then Dec(ARow);

    if Assigned(DataLink) and DataLink.Active and (ACol < 0) and (ARow >= 0) then
    begin
      if DataLink.DataSet.State = dsInsert then
      begin
        if DataLink.DataSet.Eof then // Append
        begin
          iRow := Row;
          if dgTitles in Options then Dec(iRow);
          RowNo := DataLink.DataSet.RecordCount - iRow + ARow + 1
        end else // Insert
          RowNo := FFirstRecNo + ARow;
      end
      else
      begin
        OldActive := DataLink.ActiveRecord;
        try
          DataLink.ActiveRecord := ARow;
          RowNo := DataSource.DataSet.RecNo;
        finally
          DataLink.ActiveRecord := OldActive;
        end;
      end;

      ARect.Right := ARect.Right - 6{FIndicator.Width} - 2{FrameOffs} - 2{Space};
      DrawText(Canvas.Handle, PChar(IntToStr(RowNo)), -1, ARect,
        DT_RIGHT or DT_VCENTER or DT_SINGLELINE);
    end;
  end;
end;

function TMyDBGrid.GetDataSource: TDataSource;
begin
  Result := inherited DataSource;
end;

procedure TMyDBGrid.SetColumnAttributes;
begin
  inherited;
  if (dgIndicator in Options) then
    ColWidths[0] := FIndicatorWidth;
end;

procedure TMyDBGrid.SetDataSource(const Value: TDataSource);
begin
  if Assigned(DataSource) and Assigned(DataSource.DataSet) then
    DataSource.DataSet.BeforeInsert := FOldBeforeInsert;

  if Assigned(Value) and Assigned(Value.DataSet) then
  begin
    FOldBeforeInsert := Value.DataSet.BeforeInsert;
    Value.DataSet.BeforeInsert := DataSetBeforeInsert;
  end else
    FOldBeforeInsert := nil;

  inherited DataSource := Value;
end;

procedure TMyDBGrid.SetIndicatorWidth(const Value: Integer);
begin
  if FIndicatorWidth <> Value then
  begin
    FIndicatorWidth := Value;
    if (dgIndicator in Options) then
      ColWidths[0] := FIndicatorWidth;
  end;
end;

procedure TMyDBGrid.WMSize(var Message: TWMSize);
var
  OldRow: Integer;
begin
  OldRow := Row;
  inherited;
  FFirstRecNo := FFirstRecNo - (Row - OldRow);
end;

end.

测试代码：
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, ExtCtrls, DBCtrls, Grids, DBGrids, StdCtrls;

type
  TForm1 = class(TForm)
    DBNavigator1: TDBNavigator;
    ADOConnection1: TADOConnection;
    ADOTable1: TADOTable;
    DataSource1: TDataSource;
    Button1: TButton;
    Label1: TLabel;
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses MyGrid;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  with TMyDBGrid.Create(Self) do
  begin
    Parent := Panel1;
    Align := alClient;
    IndicatorWidth := 40;
    Options := Options - [dgTitles];
    DataSource := DataSource1;
  end;
  ADOTable1.Open;
  Label1.Caption := IntToStr(ADOTable1.RecordCount);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ADOTable1.Append;
end;

end.