flatdbgrid.pas

相信大家已经找很长时间了

{******************************************************************}
{ 经典的dbgrid控件,增加列排序功能,增加隔行背景色. xdywdy修改完成   }                                    
{******************************************************************}
unit FlatDbGrid;

interface

uses
  Windows, Messages, Classes, Controls, Forms, Graphics, StdCtrls, Grids,dbgrids,
  dbclient,ADODB,db,FlatSB;

type
  TFlatDBGrid = class(TDBGrid)
  private
    FSingleColor: TColor;
    FDoubleColor: TColor;
        FDbBgColor: boolean;
    OldGridWnd : TWndMethod;
    procedure NewGridWnd (var Message : TMessage);
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
    procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP;
    procedure SetSingleColor(Const Value: TColor);
    procedure SetDoubleColor(const Value: TColor);
    procedure SetDbBgColor(const Value: boolean);
  protected
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TColumn; State: TGridDrawState); override;
    procedure TitleClick(Column: TColumn);  override;
  public
    constructor Create (AOwner: TComponent); override;
    property Canvas;
    property SelectedRows;
  published
    property ColorRowSingle :TColor read FSingleColor Write SetSingleColor default clWhite;
    property ColorRowDouble :TColor read FDoubleColor Write SetDoubleColor default clWhite;
    property DbBgColor :Boolean read FDbBgColor Write SetDbBgColor default true;
  end;

implementation

{ TFlatDBGrid }

constructor TFlatDBGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSingleColor    := clWhite;
  FDoubleColor    := clWhite;//$00FFF0E1;
  OldGridWnd      := self.WindowProc ;
  self.WindowProc := NewGridWnd;
  fDBBGColor      := True;
end;

procedure TFlatDBGrid.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
   OldGridWnd(Message);
end;



procedure TFlatDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
  Column: TColumn; State: TGridDrawState);
begin
  inherited;
  if GdSelected in State then  exit;
if DbBgColor then
begin
  if DataSource.DataSet.RecNo mod 2<>0 then
    Canvas.Brush.Color:= FSingleColor   //读取单横颜色值。。。
  else Canvas.Brush.Color:=FDoubleColor; // 读取双横颜色值。$00F7E7E7。。
end;
  DefaultDrawColumnCell(Rect, DataCol, Column, State);

{  Canvas.Brush.Color:=FColorLine;      //选择线型颜色。。。
  //绘制数据区的表格边框
  FRect.Bottom:=Rect.Bottom+1;
  FRect.Top:=Rect.Top-1;
  FRect.Left:=Rect.Left-1;
  FRect.Right:=Rect.Right+1;
  Canvas.FrameRect(FRect);
  //对表格进行绘制}
end;


procedure TFlatDBGrid.SetDoubleColor(const Value: TColor);
begin
  FDoubleColor := Value;
  repaint;
end;

procedure TFlatDBGrid.SetSingleColor(const Value: TColor);
begin
  FSingleColor := Value;
  repaint;
end;

procedure TFlatDBGrid.SetDbBgColor(const Value: boolean);
begin
  FDbBgColor := Value;
  repaint;
end;

procedure TFlatDBGrid.WMVScroll(var Message: TWMVScroll);
var
  SI: TScrollInfo;
begin
inherited;
  if Datalink.Active then
    with Message, DataLink.DataSet do
      case ScrollCode of
        SB_THUMBPOSITION:
          begin
            if IsSequenced then
            begin
              SI.cbSize := sizeof(SI);
              SI.fMask := SIF_ALL;
              SetScrollPos(self.Handle,SB_VERT,Pos,True);    //强行设定滚动条的位置
              GetScrollInfo(Self.Handle, SB_VERT, SI);
              if SI.nTrackPos <= 1 then First
              else if SI.nTrackPos >= RecordCount then Last
              else RecNo := SI.nTrackPos;
            end
            else
              case Pos of
                0: First;
                1: MoveBy(-VisibleRowCount);
                2: Exit;
                3: MoveBy(VisibleRowCount);
                4: Last;
              end;
          end;
      end; 
end;

procedure TFlatDBGrid.WMKeyUp(var Message: TWMKeyUp);
    procedure setTitle;
    var ii:integer;
        cStr:string;
        c:TColumn;
    begin
      for ii:=0 to Columns.Count-1 do
      begin
        c:=Columns[ii];
        cStr:=c.Title.Caption;
        if (pos('▲',cStr)=1) or (pos('▼',cStr)=1) then begin
          Delete(cStr,1,2);
          c.Title.Caption:=cStr;
        end;
      end;
    end;
begin
  inherited;
  if Message.CharCode=27 then
  begin
    setTitle;
    if Assigned(DataSource) then
    begin
      DataSource.DataSet.Close;
      DataSource.DataSet.Open;
    end;  
  end;
end;

procedure TFlatDBGrid.TitleClick(Column: TColumn);
var s,cFieldName:string;
    i:integer;
    DataSet:TDataSet;
    procedure setTitle;
    var ii:integer;
        cStr:string;
        c:TColumn;
    begin
      for ii:=0 to TDBGrid(Column.Grid).Columns.Count-1 do
      begin
        c:=TDBGrid(Column.Grid).Columns[ii];
        cStr:=c.Title.Caption;
        if (pos('▲',cStr)=1) or (pos('▼',cStr)=1) then begin
          Delete(cStr,1,2);
          c.Title.Caption:=cStr;
        end;
      end;
    end;
begin
  inherited;
  if not Assigned(DataSource) then  Exit;
  setTitle;
  DataSet:=Column.Grid.DataSource.DataSet;
  if Column.Field.FieldKind=fkLookup then
    cFieldName:=Column.Field.KeyFields
  else if Column.Field.FieldKind=fkCalculated then
    cFieldName:=Column.Field.KeyFields
  else
    cFieldName:=Column.FieldName;
  if DataSet is TCustomADODataSet then begin
    s:=TCustomADODataSet(DataSet).Sort;
    if s='' then begin
      s:=cFieldName;
      Column.Title.Caption:='▲'+Column.Title.Caption;
    end
    else begin 
      if Pos(cFieldName,s)<>0 then begin
        i:=Pos('DESC',s); 
        if i<=0 then begin
          s:=s+' DESC';
          Column.Title.Caption:='▼'+Column.Title.Caption;
        end 
        else begin
          Column.Title.Caption:='▲'+Column.Title.Caption;
          Delete(s,i,4);
        end;
      end
      else begin
        s:=cFieldName;
        Column.Title.Caption:='▲'+Column.Title.Caption;
      end;
    end;
    TCustomADODataSet(DataSet).Sort:=s;
  end
  else if DataSet is TClientDataSet then begin
    if TClientDataSet(DataSet).indexfieldnames<>'' then
    begin
      i:=TClientDataSet(DataSet).IndexDefs.IndexOf('i'+Column.FieldName);
      if i=-1 then
      begin
        with TClientDataSet(DataSet).IndexDefs.AddIndexDef do
        begin
          Name:='i'+Column.FieldName;
          Fields:=Column.FieldName;
          DescFields:=Column.FieldName;
        end;
      end;
      TClientDataSet(DataSet).IndexFieldNames:='';
      TClientDataSet(DataSet).IndexName:='i'+Column.FieldName;
      Column.Title.Caption:='▼'+Column.Title.Caption;
    end
    else
    begin
      TClientDataSet(DataSet).IndexName:='';
      TClientDataSet(DataSet).IndexFieldNames:=column.fieldname;
      Column.Title.Caption:='▲'+Column.Title.Caption ;
    end;
  end;
end;

end.