adbgrid.pas

来自「delphi编程控件」· PAS 代码 · 共 2,096 行 · 第 1/5 页

  FRepository : TAutoRepository;
  FReadOnly : Boolean;
  FSortedColumn : TAutoGridColumn;
  FOnColumnClick : TAutoColumnClick;
  FIncSearch : TAutoGridIncSearch;
  FFixedGroups : Integer;
  FAutoFilter : TAutoFilter;
  FOnDataSourceChanged : TNotifyEvent;
  FOnCustomDraw : TAutoGridCustomDrawEvent;
  FRecordLineWidth : Integer;
  FGridTemplate : TAutoDBGridTemplate;

  function GetDataSet : TDataSet;
  function GetDataSource : TDataSource;
  function GetGrid : TCustomAutoDBGrid;
  function GetRowHeight : Integer;
  procedure SetColor(Value : TColor);
  procedure SetDataSource(Value : TDataSource);
  procedure SetRecordLineWidth(Value : Integer);
  procedure SetRepository(Value : TAutoRepository);
  procedure SetFont(Value : TFont);
  procedure SetColumnFont(Value : TFont);
  procedure SetGroupFont(Value : TFont);
  procedure SetFields(Value : TAutoGridFields);
  procedure SetIncSearch(Value : TAutoGridIncSearch);
  procedure SetFixedGroups(Value : Integer);  
  procedure SetGroups(Value : TAutoGridGroups);
  procedure SetMaxLevel(Value : Integer);
  procedure SetLevels(Value : Integer);
  procedure SetOptions(Value : TAutoGridOptions);

  function CalcFontHeight(AFont : TFont) : Integer;
  procedure AssignReposGridLayout;
protected
  procedure BeginDrawGrid;
  procedure EndDrawGrid;
  procedure EndDrawGridEx(ARect : TRect);
  function CanUpdateGrid : Boolean;
  procedure ColumnDestroying(AColumn : TAutoGridColumn);
  procedure UpdateCustomizingFields;

  procedure LinkActive(Active : Boolean);
  procedure Scroll(Distance : Integer);
  procedure DataChanged;
  procedure RecordChanged(Field: TField);   
  procedure FieldNotification(AField : TField);
  procedure FontChanged(Sender : TObject);
  procedure GroupFontChanged(Sender : TObject);
  procedure ColumnFontChanged(Sender : TObject);

  function FixedOffSet : Integer;
  function GroupOffSet : Integer;
  function ColumnOffSet : Integer;
  function IndicatorOffset : Integer;
  function RecordLineOffSet : Integer;
  {$IFDEF DELPHI4}
  function  GetOwner: TPersistent; override; 
  {$ENDIF}
public
  constructor Create(AOwner : TComponent);
  destructor Destroy; override;
  procedure Assign(Source: TPersistent); override;

  property AutoFilter : TAutoFilter read FAutoFilter write FAutoFilter;
  property DataSet : TDataSet read GetDataSet;
  property Grid : TCustomAutoDBGrid read GetGrid;
  property LevelHeight : Integer read FFontHeight;
  property ColumnHeight : Integer read FColumnFontHeight;
  property Owner : TComponent read FOwner;
  property Repository : TAutoRepository read FRepository write SetRepository;
  property RowHeight : Integer read GetRowHeight;
  property SortedColumn : TAutoGridColumn read FSortedColumn;
  property OnColumnClick : TAutoColumnClick read FOnColumnClick write FOnColumnClick;
  property OnCustomDraw : TAutoGridCustomDrawEvent read FOnCustomDraw write FOnCustomDraw;
  property OnDataSourceChanged : TNotifyEvent read FOnDataSourceChanged write FOnDataSourceChanged;
published
  property Color : TColor read FColor write SetColor; 
  property DataSource : TDataSource read GetDataSource write SetDataSource;
  //Fields, Levels should be defined before Groups
  property Fields : TAutoGridFields read FFields write SetFields;
  //MaxLevel should be defined before Levels
  property MaxLevel : Integer read FMaxLevel write SetMaxLevel;
  property Levels : Integer read FLevels write SetLevels;
  property Groups : TAutoGridGroups read FGroups write SetGroups;
  property Font : TFont read FFont write SetFont;
  property FixedGroups : Integer read FFixedGroups write SetFixedGroups;
  property GroupFont : TFont read FGroupFont write SetGroupFont;
  property ColumnFont : TFont read FColumnFont write SetColumnFont;
  property IncSearch : TAutoGridIncSearch read FIncSearch write SetIncSearch;
  property Options : TAutoGridOptions read FOptions write SetOptions;
  property ReadOnly : Boolean read FReadOnly write FReadOnly;
  property RecordLineWidth : Integer read FRecordLineWidth write SetRecordLineWidth;
end;

TAutoGridHitTypeInfo = (aghtNone, aghtCell, aghtLevelEdge, aghtGroup, aghtColumn,
                     aghtGroupEdge, aghtColumnEdge);

TAutoGridHitInfo = record
  Column : TAutoGridColumn;
  Group : TAutoGridGroup;
  Row : Integer;
  hitType : TAutoGridHitTypeInfo;
end;

TAutoGridState = (agsNormal, agsLevelSizing, agsGroupSizing, agsColumnSizing,
               agsColumnDown, agsColumnDraging, agsIncSearching, agsHorzScrolling);
TAutoGridCellClick = procedure(Sender : TObject; AColumn : TAutoGridColumn) of object;

TCustomAutoDBGrid = class(TCustomControl)
private
  FGridLayout : TAutoGridLayout;
  FLeftVis : Integer;
  FGridState : TAutoGridState;
  FHitTest: TPoint;
  FGridHitInfo : TAutoGridHitInfo;
  FSizingPos, FOldSizingPos : Integer;
  FDownColumn : TAutoGridColumn;
  FDragImage: TImageList;
  FDragBmp: TBitmap;
  FDragRect : TRect;
  FDragGroup : TAutoGridGroup;
  FDragGridField : TAutoGridField;
  FDragLevel, FDragLevelIndex : Integer;
  FPointDragging : TPoint;
  FIsStartDrag : Boolean;
  FDrawGridCount : Integer;
  FDrawBmp : TBitmap;
  FScrollDataFlag : Boolean;
  FCustomDrawFont : TFont;
  FOnCellClick : TAutoGridCellClick;
  FDataSource : TDataSource;

  FSelectedColumn : TAutoGridColumn;
  FSelectedRow : Integer;
  FRowCount : Integer;
  FAcquireFocus: Boolean;
  FShowHorzScrollBar : Boolean;
  FInplaceEditor : TWinControl;
  FEditedColumn : TAutoGridColumn;

  FBorderStyle: TBorderStyle;
  FIndicators : TImageList;

  function GetAutoFilter : TAutoFilter;
  function GetColumnHeight : Integer;
  function GetRepository : TAutoRepository;
  function GetFirstVisibleGroupIndex : Integer;
  function GetGroups : TAutoGridGroups;
  function GetLastVisibleGroupIndex : Integer;
  function GetGridWidth : Integer;
  function GetFixedGroups : Integer;
  function GetFontHeight : Integer;
  function GetLevels : Integer;
  function GetRowHeight : Integer;
  function GetSelectedColumn : TAutoGridColumn;
  function GetSelectedField : TField;  
  function GetSelectedRow : Integer;
  function GetOnColumnClick : TAutoColumnClick;
  function GetOnCustomDraw : TAutoGridCustomDrawEvent;
  procedure SetAutoFilter(Value : TAutoFilter);
  procedure SetBorderStyle(Value: TBorderStyle);
  procedure SetRepository(Value : TAutoRepository);
  procedure SetDownColumn(Value : TAutoGridColumn);
  procedure SetGridState(Value : TAutoGridState);
  procedure SetGridLayout(Value : TAutoGridLayout);
  procedure SetLeftVis(Value : Integer);
  procedure SetSelectedColumn(Value : TAutoGridColumn);
  procedure SetSelectedField(Value : TField);
  procedure SetSelectedRow(Value : Integer);
  procedure SetOnColumnClick(Value : TAutoColumnClick);
  procedure SetOnCustomDraw(Value : TAutoGridCustomDrawEvent);  

  function GetIsCustomizing : Boolean;
  function GetGridHitInfo(Pos : TPoint) : TAutoGridHitInfo;
  function GetNextColumn(AColumn : TAutoGridColumn; Var ARow : Integer;
            Key : Integer) : TAutoGridColumn;
  function GetVisibleGroupCount : Integer;
  function GetVisibleGroup(Index : Integer) : TAutoGridGroup;          

  // Sizing off set
  function ColumnOffSet : Integer;
  function GroupOffSet : Integer;
  function IndicatorOffset : Integer;

  //Drawing
  procedure DrawGroupCaptions;
  procedure DrawGroupCaption(AGroup : TAutoGridGroup);
  procedure DrawColumnCaption(AColumn : TAutoGridColumn);
  procedure DrawIndicators;
  procedure DrawGroupRects;
  procedure DrawGridLines;
  procedure DrawColumnCells;
  procedure DrawSizingLine;
  procedure DrawDragingArrows(Draw : Boolean);
  procedure BeginDrawGrid;
  procedure EndDrawGrid;
  procedure EndDrawGridEx(ARect : TRect);
  procedure RepaintIndicator(ARow : Integer);    
  //Scrolling
  function LastLeftVis : Integer;
  function FixedOffSet : Integer;
  procedure NextLeftVis(APixels : Integer);
  procedure PrevLeftVis(APixels : Integer);
  procedure MakeColumnVisible(AColumn : TAutoGridColumn);

  procedure EndDrag(Flag : Boolean);
  procedure StartDrag;

  function AcquireFocus: Boolean;
  function IsAnyColumn : Boolean;
  procedure SetBufferCount;

  procedure ShowHorzScrollBar;
  procedure UpdateVertScrollBar;
  procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
  procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;

  procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
  procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
  procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
  procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
  procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
protected
  procedure CreateParams(var Params: TCreateParams); override;
  procedure CreateWnd; override;
  procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
    X, Y: Integer); override;
  procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
    X, Y: Integer); override;
  procedure Paint; override;
  procedure WndProc(var Message : TMessage); override;

  procedure DoColumnDragging;

  procedure DrawColumnCell(AColumn : TAutoGridColumn; ARow : Integer);

  procedure OnCloseCustomizingForm(Sender: TObject; var Action: TCloseAction);
  procedure OnGBClickCustomizingForm(Sender: TObject);

  procedure CreateInplaceEditor;
  procedure DestroyInplaceEditor;
  procedure ShowEditor;
  procedure HideEditor;
  procedure DataSetMoveBy(Distance : Integer; GoToFirst : Boolean);

  property AutoFilter : TAutoFilter read GetAutoFilter write SetAutoFilter;
  property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  property ColumnHeight : Integer read GetColumnHeight;
  property Repository : TAutoRepository read GetRepository write SetRepository;
  property DownColumn : TAutoGridColumn read FDownColumn write SetDownColumn;
  property FirstVisibleGroupIndex : Integer read  GetFirstVisibleGroupIndex;
  property InplaceEditor : TWinControl read FInplaceEditor;
  property LastVisibleGroupIndex : Integer read  GetLastVisibleGroupIndex;
  property FixedGroups : Integer read GetFixedGroups;
  property GridLayout : TAutoGridLayout read FGridLayout write SetGridLayout;
  property GridState : TAutoGridState read FGridState;
  property GridWidth : Integer read GetGridWidth;
  property Groups : TAutoGridGroups read GetGroups;
  property LeftVis : Integer read FLeftVis write SetLeftVis;
  property LevelHeight : Integer read GetFontHeight;
  property Levels : Integer read GetLevels;
  property RowCount : Integer read FRowCount;
  property RowHeight : Integer read GetRowHeight;
  property SelectedRow : Integer read GetSelectedRow write SetSelectedRow;
  property VisibleGroupCount : Integer read GetVisibleGroupCount;
  property VisibleGroups[Index : Integer] : TAutoGridGroup read GetVisibleGroup;
  property OnColumnClick : TAutoColumnClick read GetOnColumnClick write SetOnColumnClick;
  property OnCustomDraw : TAutoGridCustomDrawEvent read GetOnCustomDraw write SetOnCustomDraw;
  property OnCellClick : TAutoGridCellClick read FOnCellClick write FOnCellClick;
public
  constructor Create(AOwner : TComponent); override;
  destructor Destroy; override;
  procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  procedure Notification(AComponent: TComponent; Operation: TOperation); override;

  procedure ColumnsCustomizing;
  procedure EndColumnsCustomizing;
  property IsCustomizing : Boolean read GetIsCustomizing;
  property SelectedColumn : TAutoGridColumn read GetSelectedColumn write SetSelectedColumn;
  property SelectedField : TField read GetSelectedField write SetSelectedField;
end;

TAutoDBGrid = class(TCustomAutoDBGrid)
public
  property GridState;
published
  property Align;
  property AutoFilter;
  property BorderStyle;
  property ParentCtl3D;
  property Enabled;
  property Repository;  
  property GridLayout;
  property TabStop default True;
  property OnColumnClick;
  property OnCustomDraw;
  property Cursor;
  property DragCursor;
  property DragMode;
  property Hint;
  property PopupMenu;
  property ShowHint;
  property Visible;
  property OnCellClick;  
  property OnClick;
  property OnDblClick;
  property OnDragDrop;
  property OnDragOver;
  property OnEndDrag;
  property OnMouseDown;
  property OnMouseMove;
  property OnMouseUp;
  property OnStartDrag;
  property OnEnter;
  property OnExit;
  property OnKeyDown;
  property OnKeyPress;
  property OnKeyUp;
end;

TAutoDBGridTemplate = class(TAutoRepositoryChild)
private
  FGridLayout : TAutoGridLayout;

  function GetAutoFilter : TAutoFilter;
  function GetOnColumnClick : TAutoColumnClick;
  function GetOnCustomDraw : TAutoGridCustomDrawEvent;
  procedure SetAutoFilter(Value : TAutoFilter);
  procedure SetGridLayout(Value : TAutoGridLayout);
  procedure SetOnColumnClick(Value : TAutoColumnClick);
  procedure SetOnCustomDraw(Value : TAutoGridCustomDrawEvent);
protected
  function GetDataSet : TDataSet; override;
  procedure RemoveFromRepository(Value : TAutoRepository); override;
  procedure AddToRepository(Value : TAutoRepository); override;
public
  constructor Create(AOwner : TComponent); override;
  destructor Destroy; override;

  procedure Notification(AComponent: TComponent; Operation: TOperation); override;
published
  property AutoFilter : TAutoFilter read GetAutoFilter write SetAutoFilter;
  property GridLayout : TAutoGridLayout read FGridLayout write SetGridLayout;
  property OnColumnClick : TAutoColumnClick read GetOnColumnClick write SetOnColumnClick;
  property OnCustomDraw : TAutoGridCustomDrawEvent read GetOnCustomDraw write SetOnCustomDraw;  
end;

implementation

{$R adbgrid.res}

uses aclconst, adbgrged, Dialogs, agraphic, adefctrl, audbstrs, DBTables,
  Menus;

const
  MaxMapSize = (MaxInt div 2) div SizeOf(Integer);
  
type
  PIntArray = ^TIntArray;
  TIntArray = array[0..MaxListSize] of Integer;

{Global methods}
function  DrawCaptionText(ACanvas : TCanvas; AFont : TFont; ARect : TRect;
      AAlignment : TAlignment; AText : String; Selected : Boolean) : Integer;
const
  AlignFlags : array [TAlignment] of Integer =
    ( DT_LEFT or DT_WORDBREAK or DT_VCENTER or DT_SINGLELINE or DT_EXPANDTABS or DT_NOPREFIX,
      DT_RIGHT or DT_WORDBREAK or DT_VCENTER or DT_SINGLELINE or DT_EXPANDTABS or DT_NOPREFIX,
      DT_CENTER or DT_WORDBREAK or DT_VCENTER or DT_SINGLELINE or DT_EXPANDTABS or DT_NOPREFIX );
begin
  ACanvas.Font.Assign(AFont);
  if Selected then
    ACanvas.Font.Color := clWindow
  else ACanvas.Font.Color := AFont.Color;
  Result := GetDrawText(ACanvas, ARect,  AAlignment, AText);
  DrawText(ACanvas.Handle, PChar(AText), Length(AText), ARect, AlignFlags[AAlignment]);
end;

procedure DrawSortedImage(ACanvas : TCanvas; AHeight, X, Y : Integer; IsUp, IsSelected : Boolean);
Var
  r : TRect;
  AWidth : Integer;
  OldColor : TColor;

  function GetGrayColor : TColor;
  begin
    if(IsSelected) then
      Result := clBtnFace
    else Result := clGray;  
  end;

  function GetWhiteColor : TColor;
  begin
    if(IsSelected) then
      Result := clBlack
    else Result := clWindow;
  end;

begin
  if(AHeight mod 2 = 1) then
    Dec(AHeight);
  AWidth := AHeight - 1;
  SetRect(r, X, Y, X + AWidth, Y + AHeight);
  with ACanvas do begin
    OldColor := Pen.Color;
    if IsUp then begin
      Pen.Color := GetGrayColor;
      Polyline([Point(r.Left, r.Bottom - 1),
        Point(r.Left + AWidth div 2, r.Top + 1),
        Point(r.Left + AWidth div 2 + 1, r.Top)]);
      Pen.Color := GetWhiteColor;
      Polyline([Point(r.Left, r.Bottom), Point(r.Right, r.Bottom),
        Point(r.Right, r.Bottom - 1), Point(r.Left + AWidth div 2 + 1, r.Top + 1)]);
    end else begin
      Pen.Color := GetWhiteColor;
      Polyline([Point(r.Right, r.Top + 1),
        Point(r.Right - AWidth div 2, r.Bottom - 1),
        Point(r.Right - AWidth div 2 + 1, r.Bottom)]);