tsdbgrid.pas

企业进销存管理系统

        FGrid: TtsCustomDBGrid;
        FBkmList: TtsSetList;
        FLastBkmListIndex: Integer;

        function  NewNode(NodeValue : Pointer) : TtsSetNode; override;
        function  GetBkmList: TtsSetList;
        procedure ResetBkmList;
        procedure GetBkmListPos(Bkm: TBookmarkStr; var Top, Bottom: Integer);

        property  Grid: TtsCustomDBGrid read FGrid write FGrid;
        property  LastBkmListIndex: Integer read FLastBkmListIndex write FLastBkmListIndex;
        property  BkmList: TtsSetList read GetBkmList;

    public
        constructor Create; override;
        destructor  Destroy; override;

        function  Add(NodeValue : string) : Pointer; override;
        procedure Assign(Source: TtsCustomSet); override;
        procedure Clear; override;
        function  First: Variant;
        function  Last: Variant;
        function  Next(Bkm: Variant): Variant;
        function  Previous(Bkm: Variant): Variant;
        function  Remove(NodeValue : string) : Pointer; override;
    end;

    TtsSelectedRange = record
        First: TtsBkmPos;
        Last: TtsBkmPos;
    end;

    TtsSelectedList = class(TStringList)
    protected
        procedure ClearList;
        function  GetItem(Index: Integer): string;
        procedure SetItem(Index: Integer; Value: string);

    public
        destructor Destroy; override;
        procedure  AddItem(Value: string);
        property   Item[Index: Integer]: string read GetItem write SetItem;
    end;

    PtsRangeBuffer = ^TtsRangeBuffer;
    TtsRangeBuffer = array[1..(MaxListSize div ((SizeOf(TtsSelectedRange) div SizeOf(Longint)) + 1))] of TtsSelectedRange;

    {TtsDBSelection}
    {Set of selected rows, implemented as an array of selected bookmark ranges.}

    TtsDBSelection = class(TObject)
    protected
        FGrid: TtsCustomDBGrid;
        FUnboundSelection: TtsSelection;
        FBookmarkSet: TtsBookmarkSet;
        FStoreUnselected: Boolean;
        FRangeBufSize: Longint;
        FRangeBuffer: PtsRangeBuffer;
        FRangeCount: Longint;
        FUseRangeSelection: Boolean;
        FAllSelected: Boolean;

        function  Assign(Source: TtsDBSelection): Boolean;
        procedure AssignRangeBuffer(Source: TtsDBSelection);
        function  RowsSelected: Boolean;
        procedure CheckRowsSelected;
        function  GetAllSelected: Boolean;
        procedure SetAllSelected(Value: Boolean);
        procedure ClearBkm(First, Last: Longint; Assign: Boolean);
        procedure ResizeRangeBuffer(NewSize: Longint);
        procedure SearchRangeIndex(Top, Bottom: Longint; DataRow: TtsBkmPos;
                                   var Position: Longint; var Found: Boolean);
        procedure AdjustRangeBuffer(NewCount: Longint);
        procedure MoveRangeBuffer(FromIndex, ToIndex: Longint; Count: Longint);
        procedure InsertNewRange(Index: Longint; Range: TtsSelectedRange; CombineRange: TtsCombineRange);
        procedure RemoveRange(FirstIndex, LastIndex: Longint; Range: TtsSelectedRange);
        procedure CombineRanges(FirstIndex, LastIndex: Longint; Range: TtsSelectedRange);
        procedure CompRangeIndexes(Range: TtsSelectedRange; var FirstIndex, LastIndex: Longint;
                                   var FirstFound, LastFound: Boolean);
        procedure AddSetSelection(const FromRow, ToRow: TtsBkmPos; var Changed: Boolean);
        procedure AddRangeSelection(const FromRow, ToRow: TtsBkmPos; var Changed: Boolean);
        procedure AddBkmPosSelection(const FromRow, ToRow: TtsBkmPos; var Changed: Boolean);
        procedure AddSelection(FromRow, ToRow: TBookmarkStr; var Changed: Boolean);
        procedure RemoveRangeSelection(const FromRow, ToRow: TtsBkmPos; var Changed: Boolean);
        procedure RemoveSetSelection(const FromRow, ToRow: TtsBkmPos; var Changed: Boolean);
        procedure RemoveBkmPosSelection(const FromRow, ToRow: TtsBkmPos; var Changed: Boolean);
        procedure RemoveSelection(FromRow, ToRow: TBookmarkStr; var Changed: Boolean);
        function  CombinePrevRange(var BkmPos: TtsBkmPos; var Index: Longint; SetToPrev: Boolean): Boolean;
        function  CombineNextRange(var BkmPos: TtsBkmPos; var Index: Longint; SetToNext: Boolean): Boolean;
        procedure CalcStartRange(BkmPos: TtsBkmPos; Index: Longint; var Range: TtsSelectedRange;
                                 var NewRange, CanCombine: Boolean; var CombineIndex: Longint);
        procedure CalcEndRange(BkmPos: TtsBkmPos; Index: Longint; var Range: TtsSelectedRange;
                               var NewRange, CanCombine: Boolean; var CombineIndex: Longint);
        procedure InvertSelection(Range: TtsSelectedRange; FirstIndex, LastIndex: Longint);
        procedure ChangeRangeSelection(const FromRow, ToRow: TtsBkmPos; CombineRange: TtsCombineRange );
        procedure ChangeSetSelection(const FromRow, ToRow: TtsBkmPos);
        procedure ChangeRownrSelection(FromRownr, ToRownr: Longint);
        procedure AddSelectedList(List: TtsSelectedList; ClearAll, SelectAll: Boolean; var Canceled: Boolean);
        procedure DeleteSelectedList(List: TtsSelectedList; SelectAll: Boolean; var Canceled: Boolean);
        procedure ChangeBkmPosSelection(const FromRow, ToRow: TtsBkmPos; CombineRange: TtsCombineRange);
        procedure ChangeSelection(FromRow, ToRow: TBookmarkStr);
        procedure UpdateBkmPosSelection(FromRow, ToRow: TtsBkmPos; Select: Boolean);
        procedure UpdateSelection(FromRow, ToRow: TBookmarkStr; Select: Boolean);
        procedure SetSelected(DataRow: TBookmarkStr; Value: Boolean);
        function  GetSelected(DataRow: Variant): Boolean;
        function  GetFirst: Variant;
        function  GetLast: Variant;
        procedure ResetAll;
        function  GetFirstBkmPos: TtsBkmPos;
        function  GetLastBkmPos: TtsBkmPos;
        procedure SetUseRangeSelection(Value: Boolean);
        function  NextInRange(Index: Variant): Variant;
        function  PreviousInRange(Index: Variant): Variant;

        property UseRangeSelection: Boolean read FUseRangeSelection write SetUseRangeSelection;
        property AllSelected: Boolean read GetAllSelected write SetAllSelected;

    public
        constructor Create(Grid: TtsCustomDBGrid; UnboundSelection: TtsSelection);
        destructor  Destroy; override;

        function Next(Index: Variant): Variant;
        function Previous(Index: Variant): Variant;
        function RangeCount(FromIndex, ToIndex: Variant): Longint;
        function Count: Longint;

        property First: Variant read GetFirst;
        property Last: Variant read GetLast;
        property Selected[DataRow: Variant]: Boolean read GetSelected; default;
    end;

    {TtsDBCurrentCell}
    {The current cell in TtsCustomDBGrid}

    TtsDBCurrentCell = class(TtsCurrentCell)
    protected
        function  SetEditValue(const Value: Variant; ByUser, Redraw: Boolean): Boolean; override;
        procedure FetchCellValue; override;
        function  GetTextHeight: Integer; override;
        function  GetTextLines: Integer; override;
        function  GetDBDataRow: Variant;
        function  GetGrid: TtsCustomDBGrid;
        function  GetTextWidth : Integer;

        property Grid: TtsCustomDBGrid read GetGrid;

    public
	      procedure MoveTo(DataCol: Longint; DataRow : Variant);
        procedure MoveToInsertRow(DataCol: Longint); override;
        procedure PutInView; override;

        property TextWidth : Integer read GetTextWidth;
        property DataRow: Variant read GetDBDataRow;
    end;

    {TtsGridDataLink}
    {DataLink for a link with the datasource. All events from the datasource
     to the TtsCustomDBGrid notifying changes in the data come through the DataLink.}

    TtsGridDataLink = class(TDataLink)
    protected
        FGrid: TtsCustomDBGrid;
        FFieldCount: Integer;
        FFieldMapSize: Integer;
        FFieldMap: Pointer;
        FInUpdateData: Boolean;
        FSparseMap: Boolean;

        function  GetFields(DataCol: Longint): TField;
        procedure ActiveChanged; override;
        procedure CheckBrowseMode; override;
        procedure DataSetChanged; override;
        procedure DataSetScrolled(Distance: Integer); override;
        procedure EditingChanged; override;
        procedure LayoutChanged; override;
        procedure RecordChanged(Field: TField); override;
        procedure UpdateData; override;
        function  GetMappedIndex(DataCol: Longint): Integer;

    public
        constructor Create(Grid: TtsCustomDBGrid);
        destructor  Destroy; override;

        function  AddMapping(const FieldName: string; Field: TField): Boolean;
        procedure ClearMapping;
        procedure Reset;

        property  FieldCount: Integer read FFieldCount;
        property  Fields[DataCol: Longint]: TField read GetFields;
        property  SparseMap: Boolean read FSparseMap write FSparseMap;
    end;

    {TtsFieldList}
    {Class for maintaining a list of all fields currently in the dataset
     attached to the grid. These fields can, but do not have to be attached to
     a column.}

    TtsFieldList = class(TList)
    protected
        FGrid: TtsCustomDBGrid;

        procedure Reset;
        function  CreateField(Value: TField): TtsDBField;
        procedure CreateFields;
        function  FindField(FieldName: string): TtsDBField;
        function  FieldIndex(Field: TField): Integer;

        property Grid: TtsCustomDBGrid read FGrid;
    public
        constructor Create(Grid: TtsCustomDBGrid);
        destructor  Destroy; override;
    end;

    {TtsDBCellCollection}
    {TCollection class for writing and reading cell properties}

    TtsDBCellCollection = class(TtsCellCollection)
    protected
        function  CreateCell(Grid: TtsBaseGrid): TtsCell; override;
    public
        procedure ApplyProps; override;
    end;

    TtsDBCellItem = class(TCollectionItem)
    protected
        FCell: TtsDBCell;
        FDataCol: Longint;
        FDataRow: Variant;
        function  GetCell: TtsDBCell;
        procedure WriteDataRow(Writer: TWriter);
        procedure ReadDataRow(Reader: TReader);
        procedure DefineProperties(Filer: TFiler); override;
    public
        constructor Create(Collection: TCollection); override;
        destructor Destroy; override;
        property DataRow: Variant read FDataRow write FDataRow;
    published
        property DataCol: Longint read FDataCol write FDataCol;
        property Cell: TtsDBCell read GetCell write FCell;
    end;

    {TtsDBRowCollection}
    {TCollection class for writing and reading row properties}

    TtsDBRowCollection = class(TtsPropCollection)
    protected
        FRow: TtsDBRow;
        function CreateRow(Grid: TtsBaseGrid): TtsDBRow; virtual;
    public
        constructor Create(Grid: TtsBaseGrid; ItemClass: TCollectionItemClass);
        destructor Destroy; override;
        procedure ApplyProps; virtual;

        property Row: TtsDBRow read FRow write FRow;
    end;

    TtsDBRowItem = class(TCollectionItem)
    protected
        FRow: TtsDBRow;
        FDataRow: Variant;

        function  GetRow: TtsDBRow;
        procedure WriteDataRow(Writer: TWriter);
        procedure ReadDataRow(Reader: TReader);
        procedure DefineProperties(Filer: TFiler); override;
    public
        constructor Create(Collection: TCollection); override;
        destructor Destroy; override;
        property DataRow: Variant read FDataRow write FDataRow;
    published
        property Row: TtsDBRow read GetRow write FRow;
    end;

    {TtsGridData}
    {Abstract base class for access to the data in the attached dataset. There
     are two derived classes, TtsStandardDataset and TtsScrollDataset.
     TtstandardDataset is used to provide support for the standard TDataset.
     TtsScrollDataset is used to provide enhanced scrolling behaviour when