aligrid.pas

一个STRINGGRID 控件,比原DELPHI自带的STRINGGRID 功能强大

unit Aligrid;
(*$p+,t+,x+,b-*)
  { These are needed, especially the p must be the same as in forms }
  (*$i ah_def.inc *)
(*$ifdef Delphi_1 *)
  (*$d- *)   { Sorry, no debugging with Delphi 1, the unit is too complex }
(*$endif *)

{ Copyright 1995-2000 Andreas H鰎stemeier            Version 2.0 2000-02-12  }
{ this component is public domain - please check aligrid.hlp for             }
{ detailed info on usage and distributing                                    }

(*@/// interface *)
interface

(*@/// uses *)
uses
  SysUtils,
  typinfo,
(*$ifdef delphi_1 *)
  WinTypes,
  WinProcs,
(*$else *)
  windows,
(*$endif *)
  Messages,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  ExtCtrls,
  Grids,
  stdctrls,
{   buttons, }
  menus,
  ah_tool;
(*@\\\0000001401*)

const
  (*@/// control messages from and to the inplace edit *)
    cn_edit_cancel = wm_user+2000;  (* edit finished with ESC *)
    cn_edit_return = wm_user+2001;  (* edit finished with return *)
    cn_edit_exit   = wm_user+2002;  (* edit finished otherwise (cursor) *)
    cn_edit_show   = wm_user+2003;  (* edit is about to be shown *)
    cn_edit_toshow = wm_user+2004;  (* internal: show the editor *)
    cn_edit_update = wm_user+2005;  (* internal: editor position must be updated *)
  (*@\\\*)

type
  TMyAlign=(alRight,alLeft,alCenter,alDefault);
  T_nextcell=(nc_rightdown, nc_downright, nc_leftdown, nc_downleft,
              nc_leftup,    nc_upleft,    nc_rightup,  nc_upright);
  T_lastcell=(lc_newcolrow, lc_stop, lc_first, lc_exit);
  T_Wordwrap=(ww_none, ww_wordwrap, ww_ellipsis,ww_default);
  TCellEvent = procedure (Sender:TObject; col,row:longint) of object;
  TCellEventBool = procedure (Sender:TObject; col,row:longint; var result:boolean) of object;
  TCellDrawEvent = procedure (Sender:TObject; col,row:longint;
    var align:TMyAlign; var Wordwrap: T_Wordwrap);
  TColEvent = procedure (Sender:TObject; col:longint) of object;
  TRowEvent = procedure (Sender:TObject; row:longint) of object;
  TShowHintCellProc = procedure (Sender:TObject; col,row:longint; var HintStr: string;
    var CanShow: Boolean; var HintInfo: THintInfo) of object;
  t_relation = (rel_greater, rel_equal, rel_less);
  t_colrow = (c_column,c_fixed_column, c_row, c_fixed_row);
(*$ifdef delphi_ge_3 *)
  (*@/// THintMessage=record end; *)
  THintMessage=record
    Msg: Cardinal;
    Unused: Integer;
    HintInfo: PHintInfo;
    Result: Longint;
    end;
  (*@\\\0000000401*)
(*$endif *)
  TCompareFunction = function(Sender:TObject; colrow,compare1,compare2:longint):t_relation of object;
  TSortFunction = procedure (ColRow,Min,Max: longint; ByColumn,ascending: boolean) of object;
  TStringAlignGrid=class;  (* forward *)
  (*@/// TCellProperties=class(TObject) *)
  TCellProperties=class(TObject)
  protected
    f_grid: TStringAlignGrid;
    f_brush: TBrush;
    f_selBrush: TBrush;
    f_font: TFont;
    f_selfont: TFont;
    procedure SetFont(value: TFont);
    procedure SetSelFont(value: TFont);
    procedure SetBrush(value: TBrush);
    procedure SetSelBrush(value: TBrush);
    procedure WriteToWriter(writer:TWriter);   virtual;
    procedure ReadFromReader(Reader:TReader; grid:TStringAlignGrid);
    procedure ReadSingleProperty(Proptype:integer; Reader:TReader; grid:TStringAlignGrid);  virtual;
  public
    align: TMyAlign;
    wordwrap: T_Wordwrap;
    editable: byte;
    property brush:TBrush read f_brush write SetBrush;
    property selbrush:TBrush read f_selbrush write SetSelBrush;
    property Font:TFont read f_Font write SetFont;
    property selFont:TFont read f_selFont write SetSelFont;
    constructor Create(Grid:TStringAlignGrid);
    destructor destroy;                      override;
    procedure assign(value:TCellProperties); virtual;
    function isempty: boolean;               virtual;
    function clone:TCellProperties;          virtual;
    end;
  (*@\\\000000130B*)
  TCellPropertiesClass = class of TCellProperties;
  (*@/// TNewInplaceEdit = class(TInplaceEdit) *)
  TNewInplaceEdit = class(TInplaceEdit)
  private
    FAlignment: TMyAlign;
    f_multiline: boolean;
    procedure WMWindowPosChanged(var Message: TMessage); message WM_WINDOWPOSCHANGED;
    procedure EMSetSel(var Message: TMessage); message EM_SETSEL;
  protected
    Clicktime: longint;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure SetAlignment(Value:TMyAlign);
    procedure KeyPress(var Key: Char); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  (*$ifdef delphi_1 *)
    function GetGrid:TCustomGrid;
  (*$endif *)
    procedure UpdateContents;  (*$ifdef delphi_1 *) virtual; (*$else *) override; (*$endif *)
  public
    col, row: longint;  (* col and row of the cell *)
    event: boolean;     (* Before edit event already started? *)
    oldtext: string;    (* The text BEFORE the edit started *)
    { In Delphi 1's VCL the override is missing in TInplaceEdit }
    constructor Create(AOwner:TComponent); (*$ifndef delphi_1 *) override; (*$endif *)
    property Alignment: TMyAlign read FAlignment write SetAlignment;
    property MultiLine: boolean read f_multiline write f_multiline;
  (*$ifdef delphi_1 *)
    property  Grid: TCustomGrid read GetGrid;
  (*$endif *)
  (*$ifdef delphi_ge_3 *)
    property ImeMode;
    property ImeName;
  (*$endif *)
  end;
  (*@\\\0000001001*)
  (*@/// TStringAlignGrid=class(TStringGrid) *)
  TStringAlignGrid = class(TStringGrid)
  (*@/// -  The object creation, destroying and initalizing *)
  protected
    procedure Initialize;  virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  (*@\\\0000000201*)
  (*@/// -  The lists *)
  protected
    FPropCol: TList;
    FPropRow: TList;
    FFPropCol: TList;
    FFPropRow: TList;
    FPropCell: TList;

    FCellPropertiesClass:TCellPropertiesClass;

    function  GetObjectCol(ACol: longint):TCellProperties;
    procedure SetObjectCol(ACol: longint; const Value: TCellProperties);
    function  GetObjectRow(ARow: longint):TCellProperties;
    procedure SetObjectRow(ARow: longint; const Value: TCellProperties);
    function  GetObjectFixedCol(ACol: longint):TCellProperties;
    procedure SetObjectFixedCol(ACol: longint; const Value: TCellProperties);
    function  GetObjectFixedRow(ARow: longint):TCellProperties;
    procedure SetObjectFixedRow(ARow: longint; const Value: TCellProperties);

    function GetObjectCell(ACol,ARow: longint):TCellProperties;
    procedure SetObjectCell(ACol,ARow: longint; const Value: TCellProperties);

  protected
    property CellPropertiesClass:TCellPropertiesClass read FCellPropertiesClass write FCellPropertiesClass;
    property ObjectCell[ACol,ARow:longint]: TCellProperties read GetObjectCell write SetObjectCell;
    property ObjectRow[ACol:longint]: TCellProperties read GetObjectRow write SetObjectRow;
    property ObjectCol[ACol:longint]: TCellProperties read GetObjectCol write SetObjectCol;
    property ObjectFixedRow[ACol:longint]: TCellProperties read GetObjectFixedRow write SetObjectFixedRow;
    property ObjectFixedCol[ACol:longint]: TCellProperties read GetObjectFixedCol write SetObjectFixedCol;
  (*@\\\0000000801*)
  (*@/// +  Routines and variables for the alignments *)
  protected
    FAlign: TMyAlign;
    (*@/// The DFM read procedures (compatibility only) *)
    procedure ReadAlignCell(Stream: TStream);
    procedure ReadAlignCol(Stream: TStream);
    procedure ReadAlignRow(Stream: TStream);
    procedure ReadFixedAlignCol(Stream: TStream);
    procedure ReadFixedAlignRow(Stream: TStream);
    (*@\\\0000000201*)
    (*@/// property read/write for the alignments *)
    procedure SetAlign(const Value: TMyAlign);

    function GetAlignCol(ACol: longint):TMyAlign;
    procedure SetAlignCol(ACol: longint; const Value: TMyAlign);
    function GetFixAlignCol(ACol: longint):TMyAlign;
    procedure SetFixAlignCol(ACol: longint; const Value: TMyAlign);

    function GetAlignRow(ARow:longint):TMyAlign;
    procedure SetAlignRow(ARow:longint; const Value: TMyAlign);
    function GetFixAlignRow(ARow:longint):TMyAlign;
    procedure SetFixAlignRow(ARow:longint; const Value: TMyAlign);

    function GetAlignCell(ACol,ARow: longint):TMyAlign;
    procedure SetAlignCell(ACol,ARow: longint; const Value: TMyAlign);
    (*@\\\0000000301*)
    function ReadAlignColRow(Stream: TStream; colrow:t_colrow):boolean;
  {   procedure WriteAlignColRow(Stream: TStream; count: longint; list:TList); }
  public
    (*@/// property AlignCell/AlignCol/FixAlignCol/AlignRow/FixAlignRow *)
    property AlignCell[ACol,ARow:longint]: TMyAlign read GetAlignCell write SetAlignCell;
    property AlignCol[ACol:longint]: TMyAlign read GetAlignCol write SetAlignCol;
    property FixAlignCol[ACol:longint]: TMyAlign read GetFixAlignCol write SetFixAlignCol;
    property AlignRow[ARow:longint]: TMyAlign read GetAlignRow write SetAlignRow;
    property FixAlignRow[ARow:longint]: TMyAlign read GetFixAlignRow write SetFixAlignRow;
    (*@\\\0000000155*)
    (*@/// procedure ResetAlign...; *)
    procedure ResetAlignment;
    procedure ResetAlignCell(ACol,ARow:longint);
    procedure ResetAlignCol(ACol:longint);
    procedure ResetAlignFixedCol(ACol:longint);
    procedure ResetAlignRow(ARow:longint);
    procedure ResetAlignFixedRow(ARow:longint);

    procedure ResetAlignCellAll;
    procedure ResetAlignColAll;
    procedure ResetAlignRowAll;
    (*@\\\0000000801*)
  published
    property Alignment: TMyAlign read falign write SetAlign default alLeft;
  (*@\\\0000000B15*)
  (*@/// +  Routines and variables for the wordwraps *)
  protected
    f_wordwrap: T_Wordwrap;
    (*@/// property read/write for the wordwraps *)
    procedure SetWordWrap(value: T_Wordwrap);

    function GetWordwrapCol(ACol: longint):t_Wordwrap;
    procedure SetWordwrapCol(ACol: longint; const Value: t_Wordwrap);
    function GetFixWordwrapCol(ACol: longint):t_Wordwrap;
    procedure SetFixWordwrapCol(ACol: longint; const Value: t_Wordwrap);

    function GetWordwrapRow(ARow:longint):t_Wordwrap;
    procedure SetWordwrapRow(ARow:longint; const Value: t_Wordwrap);
    function GetFixWordwrapRow(ARow:longint):t_Wordwrap;
    procedure SetFixWordwrapRow(ARow:longint; const Value: t_Wordwrap);

    function GetWordwrapCell(ACol,ARow: longint):t_Wordwrap;
    procedure SetWordwrapCell(ACol,ARow: longint; const Value: t_Wordwrap);
    (*@\\\*)
  public
    (*@/// property WordwrapCell/WordwrapCol/FixWordwrapCol/WordwrapRow/FixWordwrapRow *)
    property WordwrapCell[ACol,ARow:longint]: t_Wordwrap read GetWordwrapCell write SetWordwrapCell;
    property WordwrapCol[ACol:longint]: t_Wordwrap read GetWordwrapCol write SetWordwrapCol;
    property FixWordwrapCol[ACol:longint]: t_Wordwrap read GetFixWordwrapCol write SetFixWordwrapCol;
    property WordwrapRow[ARow:longint]: t_Wordwrap read GetWordwrapRow write SetWordwrapRow;
    property FixWordwrapRow[ARow:longint]: t_Wordwrap read GetFixWordwrapRow write SetFixWordwrapRow;
    (*@\\\0000000401*)
    (*@/// procedure ResetWordwrap...; *)
    procedure ResetWordwrapCell(ACol,ARow:longint);
    procedure ResetWordwrapCol(ACol:longint);
    procedure ResetWordwrapFixedCol(ACol:longint);
    procedure ResetWordwrapRow(ARow:longint);
    procedure ResetWordwrapFixedRow(ARow:longint);

    procedure ResetWordwrapCellAll;
    procedure ResetWordwrapColAll;
    procedure ResetWordwrapRowAll;
    (*@\\\*)
  published
    property Wordwrap: T_Wordwrap read f_wordwrap write SetWordWrap default ww_none;
  (*@\\\0000000814*)
  (*@/// +  Routines and variables for the edit-enabled *)
  protected
    FEditable: boolean;   { allow switching on editing for single objects only }
    FAlwaysEdit: boolean; { for the component editor to have all cell editable }
    (*@/// The DFM read procedures (compatibility only) *)
    procedure ReadEditCell(Stream: TStream);
    procedure ReadEditCol(Stream: TStream);
    procedure ReadEditRow(Stream: TStream);

    { Utility functions }
    function ReadEditColRow(Stream: TStream; colrow:t_colrow):boolean;
    (*@\\\*)
    (*@/// property read/write for the edit-enabled *)
    function GetEditCol(ACol: longint):Boolean;
    procedure SetEditCol(ACol: longint; const Value: Boolean);

    function GetEditRow(ARow:longint):Boolean;
    procedure SetEditRow(ARow:longint; const Value: Boolean);

    function GetEditCell(ACol,ARow: longint):Boolean;
    procedure SetEditCell(ACol,ARow: longint; const Value: Boolean);
    (*@\\\*)
  public
    (*@/// property EditCell/EditCol/EditRow *)
    property EditCell[ACol,ARow:longint]: Boolean read GetEditCell write SetEditCell;
    property EditCol[ACol:longint]: Boolean read GetEditCol write SetEditCol;
    property EditRow[ARow:longint]: Boolean read GetEditRow write SetEditRow;
    (*@\\\000000010A*)
    (*@/// procedure ResetEdit...; *)
    procedure ResetEditCell(ACol,ARow:longint);
    procedure ResetEditCol(ACol:longint);
    procedure ResetEditRow(ARow:longint);

    procedure ResetEditCellAll;
    procedure ResetEditColAll;
    procedure ResetEditRowAll;
    (*@\\\000000071A*)
  published
    property Editable:boolean read FEditable write FEditable default true;
  (*@\\\0000000714*)
  (*@/// +  Routines and variables for the colors *)
  protected
    (*@/// The DFM read procedures (compatibility) *)
    procedure ReadColorCell(Reader: TReader);
    procedure ReadColorCol(Reader: TReader);
    procedure ReadColorRow(Reader: TReader);
    procedure ReadFixedColorCol(Reader: TReader);
    procedure ReadFixedColorRow(Reader: TReader);

    procedure ReadColorColRow(Reader: TReader; colrow:t_colrow);
    (*@\\\000000073B*)
    (*@/// property read/write for the colors *)
    function GetColorCol(ACol: longint):TColor;
    procedure SetColorCol(ACol: longint; const Value: TColor);
    function GetFixColorCol(ACol: longint):TColor;
    procedure SetFixColorCol(ACol: longint; const Value: TColor);

    function GetColorRow(ARow:longint):TColor;
    procedure SetColorRow(ARow:longint; const Value: TColor);
    function GetFixColorRow(ARow:longint):TColor;
    procedure SetFixColorRow(ARow:longint; const Value: TColor);

    function GetColorCell(ACol,ARow: longint):TColor;
    procedure SetColorCell(ACol,ARow: longint; const Value: TColor);

    procedure SetFixedColor(const Value: TColor);
    (*@\\\*)
    (*@/// variables and property read/write for alternating colors *)
    protected
      f_altcolcolor, f_altrowcolor: TColor;
      f_doaltcolcolor, f_doaltrowcolor: boolean;
      procedure setdoaltrowcolor(value:boolean);
      procedure setdoaltcolcolor(value:boolean);
      procedure setaltcolcolor(value:TColor);
      procedure setaltrowcolor(value:TColor);
    (*@\\\*)
  public
    (*@/// property ColorCell/ColorCol/FixColorCol/ColorRow/FixColorRow *)
    property ColorCell[ACol,ARow:longint]: TColor read GetColorCell write SetColorCell;
    property ColorCol[ACol:longint]: TColor read GetColorCol write SetColorCol;
    property FixColorCol[ACol:longint]: TColor read GetFixColorCol write SetFixColorCol;