newdbgrid.pas

仓库管理信息系统 DELPHI代码作的

unit NewDBGrid;
interface
uses
  Windows, Messages, SysUtils, Classes,
  Graphics, Controls,  Forms, Dialogs,
  DB, Grids, DBGrids;
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.