flatgrids.pas

comerose_flatstyle_v4.42.9.0_d7.rar

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

{$I FlatStyle.inc}

interface

uses
  Windows, SysUtils, Messages, Classes, Controls, Forms, StdCtrls,
  Graphics, Grids, DBGrids, FlatUtils;

type
  TFlatDBGrid = class(TVersionDBGrid)
  private
    FSingleColor: TColor;
    FDoubleColor: TColor;
    FDbBgColor: boolean;
    OldGridWnd : TWndMethod;
    FParentColor: Boolean;
    FFocusColor: TColor;
    FBorderColor: TColor;
    FFlatColor: TColor;
    FMouseIn: Boolean;
    FLinesColor: TColor;
    procedure SetColors(Index: Integer; Value: TColor);
    procedure SetParentColor(Value: Boolean);
    procedure NewGridWnd (var Message : TMessage);
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
    procedure SetDbBgColor(const Value: boolean);
  protected
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); override;
    procedure RedrawBorder (const Clip: HRGN = 0);
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
    procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMParentColorChanged(var Message: TWMNoParams); message CM_PARENTCOLORCHANGED;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState); override;
  public
    constructor Create(AOwner: TComponent); override;
    property Canvas;
    property SelectedRows;
  published
    property DbBgColor :Boolean read FDbBgColor Write SetDbBgColor default true;
    property ColorFocused: TColor index 0 read FFocusColor write SetColors default clWhite;
    property ColorBorder: TColor index 1 read FBorderColor write SetColors default DefaultBorderColor;
    property ColorFlat: TColor index 2 read FFlatColor write SetColors default DefaultFlatColor;
    property ColorLines: TColor index 3 read FLinesColor write SetColors default DefaultBorderColor;
    property ColorRowSingle :TColor index 4 read FSingleColor Write SetColors default clWhite;
    property ColorRowDouble :TColor index 5 read FDoubleColor Write SetColors default clWhite;
    property ParentColor: Boolean read FParentColor write SetParentColor default false;
    property Align;
    property Anchors;
    property BiDiMode;
    property Columns stored False; //StoreColumns;
    property Constraints;
    property DataSource;
    property DefaultDrawing;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FixedColor;
    property Font;
    property ImeMode;
    property ImeName;
    property Options;
    property ParentBiDiMode;
    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 OnDrawColumnCell;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEditButtonClick;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
    property OnTitleClick;
  end;

  TFlatDrawGrid = class(TVersionDrawGrid)
  private
    FParentColor: Boolean;
    FFocusColor: TColor;
    FBorderColor: TColor;
    FFlatColor: TColor;
    FMouseIn: Boolean;
    FLinesColor: TColor;
    procedure SetColors(Index: Integer; Value: TColor);
    procedure SetParentColor(Value: Boolean);
  protected
    procedure RedrawBorder (const Clip: HRGN = 0);
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
    procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMParentColorChanged(var Message: TWMNoParams); message CM_PARENTCOLORCHANGED;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property ColorFocused: TColor index 0 read FFocusColor write SetColors default clWhite;
    property ColorBorder: TColor index 1 read FBorderColor write SetColors default DefaultBorderColor;
    property ColorFlat: TColor index 2 read FFlatColor write SetColors default DefaultFlatColor;
    property ColorLines: TColor index 3 read FLinesColor write SetColors default DefaultBorderColor;
    property ParentColor: Boolean read FParentColor write SetParentColor default false;
    property Align;
    property Anchors;
    property BiDiMode;
    property ColCount;
    property Constraints;
    property DefaultColWidth;
    property DefaultRowHeight;
    property DefaultDrawing;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FixedColor;
    property FixedCols;
    property RowCount;
    property FixedRows;
    property Font;
    property Options;
    property ParentBiDiMode;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ScrollBars;
    property ShowHint;
    property TabOrder;
    property Visible;
    property VisibleColCount;
    property VisibleRowCount;
    property OnClick;
    property OnColumnMoved;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawCell;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetEditMask;
    property OnGetEditText;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnRowMoved;
    property OnSelectCell;
    property OnSetEditText;
    property OnStartDock;
    property OnStartDrag;
    property OnTopLeftChanged;
  end;
  TFlatStringGrid = class;

  TFlatGridStrings = class(TStrings)
  private
    FGrid: TFlatStringGrid;
    FIndex: Integer;
    procedure CalcXY(Index: Integer; var X, Y: Integer);
  protected
    function Get(Index: Integer): string; override;
    function GetCount: Integer; override;
    function GetObject(Index: Integer): TObject; override;
    procedure Put(Index: Integer; const S: string); override;
    procedure PutObject(Index: Integer; AObject: TObject); override;
    procedure SetUpdateState(Updating: Boolean); override;
  public
    constructor Create(AGrid: TFlatStringGrid; AIndex: Longint);
    function Add(const S: string): Integer; override;
    procedure Assign(Source: TPersistent); override;
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Insert(Index: Integer; const S: string); override;
  end;

  TFlatStringGrid = class(TFlatDrawGrid)
  private
    FData: Pointer;
    FRows: Pointer;
    FCols: Pointer;
    FUpdating: Boolean;
    FNeedsUpdating: Boolean;
    FEditUpdate: Integer;
    procedure DisableEditUpdate;
    procedure EnableEditUpdate;
    procedure Initialize;
    procedure Update(ACol, ARow: Integer); reintroduce;
    procedure SetUpdateState(Updating: Boolean);
    function GetCells(ACol, ARow: Integer): string;
    function GetCols(Index: Integer): TStrings;
    function GetObjects(ACol, ARow: Integer): TObject;
    function GetRows(Index: Integer): TStrings;
    procedure SetCells(ACol, ARow: Integer; const Value: string);
    procedure SetCols(Index: Integer; Value: TStrings);
    procedure SetObjects(ACol, ARow: Integer; Value: TObject);
    procedure SetRows(Index: Integer; Value: TStrings);
    function EnsureColRow(Index: Integer; IsCol: Boolean): TFlatGridStrings;
    function EnsureDataRow(ARow: Integer): Pointer;
  protected
    procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState); override;
    function GetEditText(ACol, ARow: Longint): string; override;
    procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
    procedure RowMoved(FromIndex, ToIndex: Longint); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Cells[ACol, ARow: Integer]: string read GetCells write SetCells;
    property Cols[Index: Integer]: TStrings read GetCols write SetCols;
    property Objects[ACol, ARow: Integer]: TObject read GetObjects write SetObjects;
    property Rows[Index: Integer]: TStrings read GetRows write SetRows;
  end;

implementation

uses RTLConsts;

{ TFlatDBGrid }

constructor TFlatDBGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSingleColor    := clWhite;
  FDoubleColor    := clWhite;//$00FFF0E1;
  OldGridWnd      := self.WindowProc ;
  self.WindowProc := NewGridWnd;
  fDBBGColor      := True;
  BorderStyle   := bsNone;
  FFocusColor   := clWhite;
  FBorderColor  := DefaultBorderColor;
  FLinesColor   := DefaultBorderColor;
  FFlatColor    := DefaultFlatColor;
  FParentColor  := True;
  FMouseIn      := False;
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);
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.RedrawBorder(const Clip: HRGN);
var
  Attrib:TBorderAttrib;
begin
  with Attrib do
  begin
   Ctrl        := self;
   FocusColor  := ColorFocused;
   BorderColor := ColorBorder;
   FlatColor   := ColorFlat;
   MouseState  := FMouseIn;
   FocusState  := Focused;
   DesignState := ComponentState;
   HasBars     := ScrollBars = ssBoth;
  end;
  Color := DrawEditBorder(Attrib,Clip);
end;

procedure TFlatDBGrid.SetParentColor(Value: Boolean);
begin
  if Value <> FParentColor then
  begin
    FParentColor := Value;
    if FParentColor then
    begin
      if Parent <> nil then
        FFlatColor := TForm(Parent).Color;
      RedrawBorder;
    end;
  end;
end;

procedure TFlatDBGrid.CMSysColorChange(var Message: TMessage);
begin
    if (Parent <> nil)and(FParentColor) then
      FFlatColor := TForm(Parent).Color;
    RedrawBorder;
end;

procedure TFlatDBGrid.CMParentColorChanged(var Message: TWMNoParams);
begin
    if (Parent <> nil)and(FParentColor) then
       FFlatColor := TForm(Parent).Color;
    RedrawBorder;
end;

procedure TFlatDBGrid.SetColors(Index: Integer; Value: TColor);
begin
  case Index of
    0: FFocusColor    := Value;
    1: FBorderColor   := Value;
    2: begin
         FFlatColor   := Value;
         FParentColor := False;
       end;
    3: FLinesColor    := Value;
    4: FSingleColor   := Value;
    5: FDoubleColor   := Value;
  end;
  Repaint;
  RedrawBorder;
end;

procedure TFlatDBGrid.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if (GetActiveWindow <> 0) then
  begin
    FMouseIn := True;
    RedrawBorder;
  end;
end;

procedure TFlatDBGrid.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  FMouseIn := False;
  RedrawBorder;
end;

procedure TFlatDBGrid.CMEnabledChanged(var Message: TMessage);
const
  EnableColors: array[Boolean] of TColor = (clBtnFace, clWindow);
begin
  inherited;
  Color := EnableColors[Enabled];
  RedrawBorder;
end;

procedure TFlatDBGrid.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  if not(csDesigning in ComponentState) then
     RedrawBorder;
end;

procedure TFlatDBGrid.WMKillFocus(var Message: TWMKillFocus);
begin
  inherited;
  if not(csDesigning in ComponentState) then
     RedrawBorder;
end;

procedure TFlatDBGrid.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  inherited;
  InflateRect(Message.CalcSize_Params^.rgrc[0], -3, -3);
end;

procedure TFlatDBGrid.WMNCPaint(var Message: TMessage);
begin
  inherited;
  RedrawBorder(HRGN(Message.WParam));
end;

procedure TFlatDBGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
  AState: TGridDrawState);
var FRect:TRect;
begin
  inherited;
  //绘制数据区的表格边框
  with ARect, Canvas do
  begin
   if (ACol = 0)or(ARow = 0) then
   begin
     if ARow > 0 then begin
        FRect := Rect(Left-1,Top-1,Right,Bottom+2);
        DrawFrame(Canvas, FRect, FLinesColor, FLinesColor, 1)
     end else if ACol > 0 then begin
        FRect := Rect(Left-2,Top,Right+1,Bottom+1);
        DrawFrame(Canvas, FRect, FLinesColor, FLinesColor, 1)
     end else begin
        FRect := Rect(Left,Top,Right+1,Bottom+1);
        DrawButtonBorder(Canvas,FRect,FLinesColor,1)
     end;
   end else begin
      FRect := Rect(Left-1,Top-1,Right+1,Bottom+1);
      DrawButtonBorder(Canvas,FRect,FLinesColor,1);
   end;
  end;
end;

{ TFlatDrawGrid }

constructor TFlatDrawGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  BorderStyle   := bsNone;
  FFocusColor   := clWhite;
  FBorderColor  := DefaultBorderColor;
  FLinesColor   := DefaultBorderColor;
  FFlatColor    := DefaultFlatColor;
  FParentColor  := True;
  FMouseIn      := False;
end;

procedure TFlatDrawGrid.RedrawBorder(const Clip: HRGN);
var
  Attrib:TBorderAttrib;
begin
  with Attrib do
  begin
   Ctrl        := self;
   FocusColor  := ColorFocused;
   BorderColor := ColorBorder;
   FlatColor   := ColorFlat;
   FocusState  := Focused;
   MouseState  := FMouseIn;
   DesignState := ComponentState;
   HasBars     := ScrollBars = ssBoth;