dbgrideh.pas

Dbgrid 增强(附源码):支持多表头,多固定列,按表头排序,支持合计列,并支持直接打印

    property Row;
    property VisibleRowCount;
    property VisibleColCount;
    property IndicatorOffset: Byte read FIndicatorOffset;
    property TitleOffset: Byte read FTitleOffset;

    property FooterRowCount: Integer read GetFooterRowCount write SetFooterRowCount default 0;
    property FrozenCols: Integer read FFrozenCols write SetFrozenCols default 0;
    property OnDrawFooterCell:TDrawFooterCellEvent read FOnDrawFooterCell write FOnDrawFooterCell;

    property TitleHeight: Integer read ReadTitleHeight write WriteTitleHeight default 0;
    property TitleLines: Integer read ReadTitleLines write WriteTitleLines default 0;
    property VTitleMargin: Integer read FVTitleMargin write WriteVTitleMargin default 10;
//    property HTitleMargin: Integer read FHTitleMargin write WritEhTitleMargin default 0;
    property UseMultiTitle: Boolean read FUseMultiTitle write WriteUseMultiTitle default False;
    property AutoFitColWidths: Boolean read FAutoFitColWidths write WriteAutoFitColWidths default False;
    property MinAutoFitWidth: Integer read FMinAutoFitWidth write WriteMinAutoFitWidth default 0;
    property RowHeight: Integer read GetRowHeight write SetRowHeight default 0;
    property RowLines: Integer read GetRowLines write SetRowLines default 0;
    property RowSizingAllowed:Boolean read FRowSizingAllowed write SetRowSizingAllowed default False;
    property DrawMemoText:Boolean read FDrawMemoText write SetDrawMemoText default false;
    property OnCheckButton: TCheckTitleEhBtnEvent read FOnCheckButton write FOnCheckButton;
    property OnGetBtnParams: TGetBtnEhParamsEvent read FOnGetBtnParams write FOnGetBtnParams;
    property OnTitleBtnClick: TTitleEhClickEvent read FOnTitleBtnClick write FOnTitleBtnClick;
    property OnGetCellParams: TGetCellEhParamsEvent read FOnGetCellParams write FOnGetCellParams;
    property OnGetFooterParams: TGetFooterParamsEvent read FOnGetFooterParams write FOnGetFooterParams;
    property SumList:TDBGridEhSumList read FSumList write SetSumList;
    property OnSumListRecalcAll: TNotifyEvent read FOnSumListRecalcAll write FOnSumListRecalcAll;
    property VisibleColumns: TColumnsEhList read FVisibleColumns write FVisibleColumns;
    property HorzScrollBar: TDBGridEhScrollBar read FHorzScrollBar write SetHorzScrollBar;
    property VertScrollBar: TDBGridEhScrollBar read FVertScrollBar write SetVertScrollBar;
    property OptionsEh: TDBGridEhOptions read FOptionsEh write SetOptionsEh
                                  default [dghFixed3D,dghHighlightFocus,dghClearSelection];
    property OnSortMarkingChanged: TNotifyEvent read FOnSortMarkingChanged write FOnSortMarkingChanged;
    property SortMarkedColumns: TColumnsEhList read FSortMarkedColumns write FSortMarkedColumns;
    property Selection:TDBGridEhSelection read FSelection;
    property TitleImages:{$IFDEF EH_LIB_4}TCustomImageList{$ELSE}TImageList{$ENDIF} read FTitleImages write SetTitleImages;
    property TimerActive: Boolean read FTimerActive;
    property AllowedOperations: TDBGridEhAllowedOperations read FAllowedOperations write FAllowedOperations
                                   default [alopInsertEh, alopUpdateEh, alopDeleteEh, alopAppendEh];
    //\\\

  end;

  TDBGridEh = class(TCustomDBGridEh)
  public
    //ddd
    property GridHeight;
    property RowCount;
    //\\\
    property Canvas;
    property SelectedRows;
  published
    property Align;
    property BorderStyle;
    property Color;
    property Columns stored False; //StoreColumns;
    property Ctl3D;
    property DataSource;
    property DefaultDrawing;
    property DragCursor;
    property DragMode;
    property Enabled;
    property FixedColor;
    property Font;
    property ImeMode;
    property ImeName;
    property Options;
    property ParentColor;
    property ParentCtl3D;
    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 OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnStartDrag;
    property OnTitleClick;

{$IFDEF Eh_LIB_4} {Borland Delphi 4.0 or C++ Builder 4.0}
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    property OnEndDock;
    property OnStartDock;
{$ENDIF}

    //ddd
    property AllowedOperations;
    property FooterRowCount;
    property FrozenCols;
    property TitleHeight;
    property TitleLines;
    property VTitleMargin;
//    property HTitleMargin;
    property UseMultiTitle;
    property AutoFitColWidths;
    property MinAutoFitWidth;
    property RowHeight;
    property RowSizingAllowed;
    property RowLines;
    property DrawMemoText;
    property SumList;
    property HorzScrollBar;
    property VertScrollBar;
    property TitleImages;
    property OptionsEh;

    property OnDrawFooterCell;
    property OnGetFooterParams;
    property OnCheckButton;
    property OnGetBtnParams;
    property OnTitleBtnClick;
    property OnGetCellParams;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnSumListRecalcAll;
    property OnSortMarkingChanged;
    //\\\

  end;

{const
  IndicatorWidth = 11;}
var
  SortMarkerFont :TFont;

const
  ColSelectionAreaHeight : Integer = 7;

procedure WriteTextEh(ACanvas: TCanvas;      // Canvas
                      ARect: TRect;          // Draw rect and ClippingRect
                      FillRect:Boolean;      // Fill rect Canvas.Brash.Color
                      DX, DY: Integer;       // InflateRect(Rect, -DX, -DY) for text
                      const Text: string;    // Draw text
                      Alignment: TAlignment; // Text alignment
                      Layout: TTextLayout;   // Text layout
                      MultyL:Boolean;        // Word break
                      EndEllipsis:Boolean;   // Truncate long text by ellipsis
                      LeftMarg,              // Left margin
                      RightMarg:Integer);    // Right margin

implementation

uses DBConsts, Dialogs, IniFiles, Comctrls, CommCtrl;

{$R DBGRIDEH.RES}


const
  bmArrow = 'DBGARROWEH';
  bmEdit = 'DBEDITEH';
  bmInsert = 'DBINSERTEH';
  bmMultiDot = 'DBMULTIDOTEH';
  bmMultiArrow = 'DBMULTIARROWEH';
//ddd
  bmSmDown = 'DBSMDOWNEH';
  bmSmUp = 'DBSMUPEH';
  bmEditWhite = 'DBGARROWEHW';
  crDownCurEh:Integer = 0;
  crRightCurEh:Integer = 0;
//\\\

  MaxMapSize = (MaxInt div 2) div SizeOf(Integer);  { 250 million }


var
  FCheckBoxWidth, FCheckBoxHeight: Integer;

procedure GetCheckSize;
begin
  with TBitmap.Create do
    try
      Handle := LoadBitmap(0, PChar(32759));
      FCheckBoxWidth := Width div 4;
      FCheckBoxHeight := Height div 3;
    finally
      Free;
    end;
end;

{ Error reporting }


procedure RaiseGridError(const S: string);
begin
  raise EInvalidGridOperation.Create(S);
end;

procedure KillMessage(Wnd: HWnd; Msg: Integer);
// Delete the requested message from the queue, but throw back
// any WM_QUIT msgs that PeekMessage may also return
var
  M: TMsg;
begin
  M.Message := 0;
  if PeekMessage(M, Wnd, Msg, Msg, pm_Remove) and (M.Message = WM_QUIT) then
    PostQuitMessage(M.wparam);
end;

//ddd

//Pure RX
type
  //ddd
  TCharSet = Set of Char;
  //\\\

function ExtractWord(N: Integer; const S: string; WordDelims: TCharSet): string; forward;

function GetDefaultSection(Component: TComponent): string;
var
  F: TCustomForm;
  Owner: TComponent;
begin
  if Component <> nil then begin
    if Component is TCustomForm then Result := Component.ClassName
    else begin
      Result := Component.Name;
      if Component is TControl then begin
        F := GetParentForm(TControl(Component));
        if F <> nil then Result := F.ClassName + Result
        else begin
          if TControl(Component).Parent <> nil then
            Result := TControl(Component).Parent.Name + Result;
        end;
      end
      else begin
        Owner := Component.Owner;
        if Owner is TForm then
          Result := Format('%s.%s', [Owner.ClassName, Result]);
      end;
    end;
  end
  else Result := '';
end;

function Max(A, B: Longint): Longint;
begin
  if A > B then Result := A
  else Result := B;
end;

function Min(A, B: Longint): Longint;
begin
  if A < B then Result := A
  else Result := B;
end;

function iif(Condition:Boolean;V1,V2:Integer):Integer;
begin
  if (Condition) then Result := V1 else Result := V2;
end;

//\\\

procedure GridInvalidateRow(Grid: TCustomDBGridEh; Row: Longint);
var
  I: Longint;
begin
  for I := 0 to Grid.ColCount - 1 do Grid.InvalidateCell(I, Row);
end;

function DefineCursor(Identifier: PChar): TCursor;
var Handle:HCursor;
begin
  Handle := LoadCursor(hInstance, Identifier);
  if Handle = 0 then raise EOutOfResources.Create('Cannot load cursor resource');
  for Result := 1 to High(TCursor) do
    if Screen.Cursors[Result] = Screen.Cursors[crArrow]  then
    begin
      Screen.Cursors[Result] := Handle;
      Exit;
    end;
  raise EOutOfResources.Create('Too many user-defined cursors');
end;

{ TDBGridInplaceEdit } 

{ TDBGridInplaceEdit adds support for a button on the in-place editor,
  which can be used to drop down a table-based lookup list, a stringlist-based
  pick list, or (if button style is esEllipsis) fire the grid event
  OnEditButtonClick.  }

type
  TEditStyle = (esSimple, esEllipsis, esPickList, esDataList, esDateCalendar ,esUpDown, esDropDown);
  TPopupListbox = class;
  TPopupMonthCalendar = class;

  TDBGridInplaceEdit = class(TInplaceEdit)
  private
    FButtonWidth: Integer;
    FDataList: TDBLookupListBox;
    FPickList: TPopupListbox;
    FActiveList: TWinControl;
    FLookupSource: TDatasource;
    FEditStyle: TEditStyle;
    FListVisible: Boolean;
    FTracking: Boolean;
    FPressed: Boolean;
    //ddd
    FPopupMonthCalendar: TPopupMonthCalendar;
    FWordWrap: Boolean;
    FUpDown:TUpDown;
    procedure ListMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure ListMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure UpDownChanging (Sender: TObject; var AllowChange: Boolean);
    procedure UpDownClick(Sender: TObject; Button: TUDBtnType);
    //\\\
    procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SetEditStyle(Value: TEditStyle);
    procedure StopTracking;
    procedure TrackButton(X,Y: Integer);
    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CancelMode;
    procedure WMCancelMode(var Message: TMessage); message WM_CancelMode;
    procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message wm_LButtonDblClk;