aligrid.pas

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

    property ColorRow[ARow:longint]: TColor read GetColorRow write SetColorRow;
    property FixColorRow[ARow:longint]: TColor read GetFixColorRow write SetFixColorRow;
    (*@\\\0000000301*)
    (*@/// procedure ResetColor...; *)
    procedure ResetColorCell(ACol,ARow:longint);
    procedure ResetColorCol(ACol:longint);
    procedure ResetColorFixedCol(ACol:longint);
    procedure ResetColorRow(ARow:longint);
    procedure ResetColorFixedRow(ARow:longint);

    procedure ResetColorCellAll;
    procedure ResetColorColAll;
    procedure ResetColorRowAll;
    (*@\\\0000000701*)
    property AlternateColorCol: TColor read f_altcolcolor write setaltcolcolor default clWindow;
    property AlternateColorRow: TColor read f_altrowcolor write setaltrowcolor default clWindow;
    property DoAlternateColorCol: boolean read f_doaltcolcolor write setdoaltcolcolor default false;
    property DoAlternateColorRow: boolean read f_doaltrowcolor write setdoaltrowcolor default false;
  published
    property FixedColor write SetFixedColor;
  (*@\\\0000000A01*)
  (*@/// +  Routines and variables for the selected colors *)
  protected
    (*@/// The DFM read procedures (compatibility) *)
    procedure ReadSelColorCell(Reader: TReader);
    procedure ReadSelColorCol(Reader: TReader);
    procedure ReadSelColorRow(Reader: TReader);

    function ReadSelColorColRow(Reader: TReader; colrow:t_colrow):boolean;
    (*@\\\0000000501*)
  protected
    (*@/// property read/write for the colors *)
    f_SelCellColor: TColor;
    procedure SetSelCellColor(Value: TColor);

    function GetSelColorCol(ACol: longint):TColor;
    procedure SetSelColorCol(ACol: longint; const Value: TColor);

    function GetSelColorRow(ARow:longint):TColor;
    procedure SetSelColorRow(ARow:longint; const Value: TColor);

    function GetSelColorCell(ACol,ARow: longint):TColor;
    procedure SetSelColorCell(ACol,ARow: longint; const Value: TColor);
    (*@\\\0000000301*)
  public
    (*@/// property SelectedColorCell/SelectedColorCol/SelectedColorRow *)
    property SelectedColorCell[ACol,ARow:longint]: TColor read GetSelColorCell write SetSelColorCell;
    property SelectedColorCol[ACol:longint]: TColor read GetSelColorCol write SetSelColorCol;
    property SelectedColorRow[ARow:longint]: TColor read GetSelColorRow write SetSelColorRow;
    (*@\\\*)
    (*@/// procedure ResetColor...; *)
    procedure ResetSelectedColorCell(ACol,ARow:longint);
    procedure ResetSelectedColorCol(ACol:longint);
    procedure ResetSelectedColorRow(ARow:longint);

    procedure ResetSelectedColorCellAll;
    procedure ResetSelectedColorColAll;
    procedure ResetSelectedColorRowAll;
    (*@\\\*)
  published
    property SelectedCellColor:TColor read f_SelCellColor write SetSelCellColor default clActiveCaption;
  (*@\\\0000000901*)
  (*@/// +  Routines and variables for the selected font colors *)
  protected
    (*@/// The DFM read procedures (compatibility) *)
    procedure ReadSelFontColorCell(Reader: TReader);
    procedure ReadSelFontColorCol(Reader: TReader);
    procedure ReadSelFontColorRow(Reader: TReader);
    function ReadSelFontColorColRow(Reader:TReader; colrow:t_colrow):boolean;
    (*@\\\000000040A*)
  protected
    (*@/// property read/write for the colors *)
    f_SelFontColor: TColor;
    procedure SetSelFontColor(Value: TColor);

    function GetSelFontColorCol(ACol: longint):TColor;
    procedure SetSelFontColorCol(ACol: longint; const Value: TColor);

    function GetSelFontColorRow(ARow:longint):TColor;
    procedure SetSelFontColorRow(ARow:longint; const Value: TColor);

    function GetSelFontColorCell(ACol,ARow: longint):TColor;
    procedure SetSelFontColorCell(ACol,ARow: longint; const Value: TColor);
    (*@\\\000000010F*)
  public
    (*@/// property SelectedFontColorCell/SelectedFontColorCol/SelectedFontColorRow *)
    property SelectedFontColorCell[ACol,ARow:longint]: TColor read GetSelFontColorCell write SetSelFontColorCell;
    property SelectedFontColorCol[ACol:longint]: TColor read GetSelFontColorCol write SetSelFontColorCol;
    property SelectedFontColorRow[ARow:longint]: TColor read GetSelFontColorRow write SetSelFontColorRow;
    (*@\\\*)
    (*@/// procedure ResetColor...; *)
    procedure ResetSelectedFontColorCell(ACol,ARow:longint);
    procedure ResetSelectedFontColorCol(ACol:longint);
    procedure ResetSelectedFontColorRow(ARow:longint);

    procedure ResetSelectedFontColorCellAll;
    procedure ResetSelectedFontColorColAll;
    procedure ResetSelectedFontColorRowAll;
    (*@\\\*)
  published
    property SelectedFontColor:TColor read f_SelFontColor write SetSelFontColor default clWhite;
  (*@\\\0000000601*)
  (*@/// +  Routines and variables for the fonts *)
  protected
    FFixedFont: TFont;
    function FixedFontChanged:boolean;
    (*@/// The DFM read procedures (compatibility) *)
    procedure ReadFontCell(Reader: TReader);
    procedure ReadFontCol(Reader: TReader);
    procedure ReadFontRow(Reader: TReader);
    procedure ReadFixedFontCol(Reader: TReader);
    procedure ReadFixedFontRow(Reader: TReader);

    function ReadFontColRow(Reader: TReader; colrow:t_colrow):boolean;
    (*@\\\*)
    (*@/// property read/write for the fonts *)
    function GetFontCell(ACol,ARow: longint):TFont;
    procedure SetFontCell(ACol,ARow: longint; const Value: TFont);

    function GetFontCol(ACol: longint):TFont;
    procedure SetFontCol(ACol: longint; const Value: TFont);
    function GetFontFixedCol(ACol: longint):TFont;
    procedure SetFontFixedCol(ACol: longint; const Value: TFont);
    function GetFontRow(ARow: longint):TFont;
    procedure SetFontRow(ARow: longint; const Value: TFont);
    function GetFontFixedRow(ARow: longint):TFont;
    procedure SetFontFixedRow(ARow: longint; const Value: TFont);
    function GetFontColRowInternal(AColRow: longint; create:boolean; List:TList):TFont;

    procedure SetFixedFont(value: TFont);
    (*@\\\0000000E01*)
    (*@/// utility functions *)
    function GetFontCellComplete(ACol,ARow: longint):TFont;
    function GetFontCellInternal(ACol,ARow: longint; create:boolean):TFont;
    procedure FontChanged(AFont: TObject);
    (*@\\\0000000316*)
  public
    (*@/// property CellFont/ColFont/FixedColFont/RowFont/FixedRowFont *)
    property CellFont[ACol,ARow:longint]: TFont read GetFontCell write SetFontCell;
    property ColFont[ACol:longint]: TFont read GetFontCol write SetFontCol;
    property RowFont[ARow:longint]: TFont read GetFontRow write SetFontRow;
    property FixedColFont[ACol:longint]: TFont read GetFontFixedCol write SetFontFixedCol;
    property FixedRowFont[ARow:longint]: TFont read GetFontFixedRow write SetFontFixedRow;
    (*@\\\*)
    (*@/// procedure Reset...; *)
    procedure ResetFontCell(ACol,ARow:longint);
    procedure ResetFontCol(ACol:longint);
    procedure ResetFontFixedCol(ACol:longint);
    procedure ResetFontRow(ARow:longint);
    procedure ResetFontFixedRow(ARow:longint);

    procedure ResetFontCellAll;
    procedure ResetFontColAll;
    procedure ResetFontRowAll;
    (*@\\\*)
  { published }
    property FixedFont: TFont read FFixedFont write SetFixedFont stored FixedFontChanged;
  (*@\\\0000000901*)
  (*@/// +  Routines and variables for the brushs *)
  protected
    FFixedBrush: TBrush;
    (*@/// The DFM read procedures (compatibility only) *)
    procedure ReadBrushCell(Reader: TReader);
    procedure ReadBrushCol(Reader: TReader);
    procedure ReadBrushRow(Reader: TReader);
    procedure ReadFixedBrushCol(Reader: TReader);
    procedure ReadFixedBrushRow(Reader: TReader);

    function ReadBrushColRow(Reader: TReader; colrow:t_colrow):boolean;
    (*@\\\0000000744*)
    (*@/// property read/write for the brushs *)
    function GetBrushCell(ACol,ARow: longint):TBrush;
    procedure SetBrushCell(ACol,ARow: longint; const Value: TBrush);

    function GetBrushCol(ACol: longint):TBrush;
    procedure SetBrushCol(ACol: longint; const Value: TBrush);
    function GetBrushFixedCol(ACol: longint):TBrush;
    procedure SetBrushFixedCol(ACol: longint; const Value: TBrush);
    function GetBrushRow(ARow: longint):TBrush;
    procedure SetBrushRow(ARow: longint; const Value: TBrush);
    function GetBrushFixedRow(ARow: longint):TBrush;
    procedure SetBrushFixedRow(ARow: longint; const Value: TBrush);
    function GetBrushColRowInternal(AColRow: longint; create:boolean; List:TList):TBrush;
    (*@\\\*)
    (*@/// utility functions *)
    function GetBrushCellComplete(ACol,ARow: longint):TBrush;
    function GetBrushCellInternal(ACol,ARow: longint; create:boolean):TBrush;
    procedure BrushChanged(ABrush: TObject);
    (*@\\\000000032B*)
  public
    (*@/// property CellBrush/ColBrush/FixedColBrush/RowBrush/FixedRowBrush *)
    { The Brush for each cell and for col and row }
    property CellBrush[ACol,ARow:longint]: TBrush read GetBrushCell write SetBrushCell;
    property ColBrush[ACol:longint]: TBrush read GetBrushCol write SetBrushCol;
    property RowBrush[ARow:longint]: TBrush read GetBrushRow write SetBrushRow;
    property FixedColBrush[ACol:longint]: TBrush read GetBrushFixedCol write SetBrushFixedCol;
    property FixedRowBrush[ARow:longint]: TBrush read GetBrushFixedRow write SetBrushFixedRow;
    (*@\\\0000000501*)
    (*@/// procedure ResetBrush...; *)
    procedure ResetBrushCell(ACol,ARow:longint);
    procedure ResetBrushCol(ACol:longint);
    procedure ResetBrushFixedCol(ACol:longint);
    procedure ResetBrushRow(ARow:longint);
    procedure ResetBrushFixedRow(ARow:longint);

    procedure ResetBrushCellAll;
    procedure ResetBrushColAll;
    procedure ResetBrushRowAll;
    (*@\\\*)
  (*@\\\0000000801*)
  (*@/// +  Routines and variables for the hints *)
  protected
    FHintCellLast: TPoint;
    FShowCellHints: Boolean;
    FHintCell: TList;
    FSaveHint: Boolean;
    FOnShowHintCell: TShowHintCellProc;
    procedure ReadHint(Reader: TReader);
    procedure WriteHint(Writer: TWriter);
    function GetHintCell(ACol,ARow: longint):string;
    procedure SetHintCell(ACol,ARow: longint; const Value: string);
    procedure ShowHintCell(var HintStr: (*$ifdef shortstring*)string;(*$else*)ansistring;(*$endif*)
      var CanShow: Boolean; var HintInfo: THintInfo);
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  (*$ifdef delphi_ge_3 *)
    procedure CMHintShow(var Message: THintMessage); message CM_HINTSHOW;
  (*$endif *)
  public
    property HintCell[ACol,ARow:longint]:string read GetHintCell write SetHintCell;
    procedure ResetHintCellAll;
  published
    property ShowCellHints: boolean read FShowCellHints write FShowCellHints default true;
    property OnShowHintCell: TShowHintCellProc read FOnShowHintCell write FOnShowHintCell;
  (*@\\\000000161A*)
  (*@/// +  Routines and variables for the cells itself *)
  protected
    FCell: TList;        { Only for loading and saving the cells property }
    FSaveCells: Boolean;
    procedure ReadCells(Reader: TReader);
    procedure WriteCells(Writer: TWriter);
    procedure ListToCells(List:TList);
    procedure CellsToList(var List:TList);
    function GetCellAsDate(ACol,ARow:longint):TDateTime;
    procedure SetCellAsDate(ACol,ARow:longint; value:TDateTime);
    function GetCellAsInt(ACol,ARow:longint):longint;
    procedure SetCellAsInt(ACol,ARow:longint; value:longint);
  public
    property CellsAsDate[ACol,ARow:longint]: TDateTime read GetCellAsDate write SetCellAsDate;
    property CellAsInt[ACol,ARow:longint]:longint read GetCellAsInt write SetCellAsInt;
  (*@\\\0000000D03*)
  (*@/// +  The ResetAll methods as shortcuts *)
  public
    procedure ResetAllCell(ACol,ARow:longint);
    procedure ResetAllCol(ACol:longint);
    procedure ResetAllFixedCol(ACol:longint);
    procedure ResetAllRow(ARow:longint);
    procedure ResetAllFixedRow(ARow:longint);

    procedure ResetAllCellAll;
    procedure ResetAllColAll;
    procedure ResetAllRowAll;
  (*@\\\0000000201*)
  (*@/// +  The Inplace-Edit and it's events sent to the grid *)
  protected
    edit_visible: boolean;
    f_reshow_edit: boolean;
    f_last_sel_pos: longint;
    f_last_sel_len: longint;
    f_on_after_edit: TCellEvent;
    f_on_cancel_edit: TCellEvent;
    f_on_before_edit: TCellEvent;
    f_on_validate: TCellEventBool;
    f_selectall: boolean;
    f_edit_multi: boolean;
    function CreateEditor: TInplaceEdit; override;
    function CanEditShow: Boolean; override;
    procedure mcn_edit_return(var msg:TMessage); message cn_edit_return;
    procedure mcn_edit_cancel(var msg:TMessage); message cn_edit_cancel;
    procedure mcn_edit_exit(var msg:TMessage); message cn_edit_exit;
    procedure mcn_edit_show(var msg:TMessage); message cn_edit_show;
    procedure mcn_edit_show_it(var msg:TMessage); message cn_edit_toshow;
    procedure mcn_edit_update(var msg:TMessage); message cn_edit_update;
    procedure doExit; override;
    procedure doEnter; override;
    procedure KeyPress(var Key: Char); override;
    procedure WMLButtonDown(var Message: TMessage); message WM_LBUTTONDOWN;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure WMCommand(var Message: TWMCommand); message WM_COMMAND;
    procedure UpdateText_;
    procedure Update_Edit;
  public
    procedure ShowEdit;
    procedure HideEdit(cancel:boolean);
  published
    property OnAfterEdit: TCellEvent read f_on_after_edit write f_on_after_edit;
    property OnCancelEdit: TCellEvent read f_on_cancel_edit write f_on_cancel_edit;
    property OnBeforeEdit: TCellEvent read f_on_before_edit write f_on_before_edit;
    property OnValidateEdit: TCellEventBool read f_on_validate write f_on_validate;
    property SelectEditText: boolean read f_selectall write f_selectall default true;
    property EditMultiline: boolean read f_edit_multi write f_edit_multi default false;
  (*@\\\0000001B01*)
  (*@/// +  Insertion and removing and moving and exchanging of columns and rows *)
  protected
    procedure RowMoved(FromIndex, ToIndex: Longint); override;
    procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
  public
    procedure RemoveCol(ACol:longint);
    procedure RemoveRow(ARow:longint);
    procedure InsertCol(ACol:longint);
    procedure InsertRow(ARow:longint);
    procedure ExchangeRow(FromIndex, ToIndex: Longint);
    procedure ExchangeCol(FromIndex, ToIndex: Longint);
  (*@\\\*)
  (*@/// +  Import and export functions *)
  protected
    f_html_caption: string;
    f_html_border: integer;
  public
    property HTMLCaption: string read f_html_caption write f_html_caption;
    property HTMLBorder: integer read f_html_border write f_html_border default 0;
    function Contents2HTML(data:TMemorystream):TMemorystream;
    procedure Contents2HTMLClipboard;
    function Contents2CSV(data:TMemorystream; csv:char; range:TGridRect):TMemorystream;
    procedure CSV2Contents(data:TStream; csv:char; range:TGridRect);
    procedure Contents2CSVClipboard(csv:char; range:TGridRect);
    procedure ClipboardCSV2Contents(csv:char; range:TGridRect);
    procedure SaveToFile(const filename:string);
    procedure LoadFromFile(const filename:string);
    procedure CopyToClipboard;
    procedure CopyFromClipboard;
  (*@\\\0000000601*)
  (*@/// +  Miscellaneous stuff like internal calculations etc. *)
  protected
    function is_fixed(ACol,ARow: longint):boolean;
    procedure WMChar(var Msg: TWMChar); message WM_CHAR;
    procedure CalcTextSize(ACol,ARow:longint; var Width,height: integer);
    function textheight(ACol,ARow:longint):integer;
    function textwidth(ACol,ARow:longint):integer;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure TopLeftChanged; override;
  public
    procedure ClearSelection;
    procedure NextEditableCell(var ACol,ARow:longint);
    procedure NextCell(direction:t_nextcell; LastCellBehaviour:t_lastcell; Var ACol,ARow:longint);
  (*$ifdef delphi_ge_3 *)
  published
    property ImeMode;
    property ImeName;
  (*$endif *)
  (*@\\\0000000801*)
  (*@/// -  For the DFM read/write *)
  protected
    procedure Loaded; override;
    procedure DefineProperties(Filer: TFiler); override;