tsdbgrid.pas

企业进销存管理系统

{*******************************************************}
{                                                       }
{       ObjectSight Visual Components                   }
{       TopGrid data bound grid component TtsDBGrid     }
{                                                       }
{       Copyright (c) 1997 - 2002, ObjectSight          }
{                                                       }
{*******************************************************}

unit TSDBGrid;

{$INCLUDE TSCmpVer}

interface

uses
    Windows, SysUtils, Messages, Classes, Controls, DB, DBTables,
    TSCommon, TSGrid, TSDateTimeDef, Bde, Grids_ts, TSSetLib, TSGLib, StdCtrls, Graphics,
    Mask, Dialogs
    {$IFDEF TSVER_V6}, FmtBcd, Variants, MaskUtils {$ENDIF};

type
    TtsFieldState          = (fsDefault, fsCustomized);
    TtsAssignedValue       = (avAlignment, avWidth, avVisible, avMaxLength,
                              avControlType, avAllowGrayed);
    TtsAssignedValues      = set of TtsAssignedValue;
    TtsDataPosition        = (dpCurrent, dpTop, dpBottom);
    TtsCursorPosition      = (cpBof, cpNormal, cpEof);
    TtsCountDirection      = (cdForward, cdBackward, cdNone);
    TtsDataEditMode        = (demNone, demEdit, demAppend, demInsert);
    TtsCompare             = (cpUnknown, cpLess, cpEqual, cpGreater);
    TtsDatasetType         = (dstStandard, dstBDE);
    TtsBkmPosOffset        = (bpoBof, bpoPrior, bpoCurrent, bpoNext, bpoEof);
    TtsCombineRange        = (crPrior, crNext, crBoth);
    TtsBookmarkType        = (bmtDefault, bmtNonOrdered);
    TtsBookmarkCompareType = (bctDefault, bctAsString);
    TtsScanState           = (sstStart, sstScan, sstSave, sstEnd);
    TtsRecordSelection     = (rseBookmarkRange, rseBookmarkSet);

type
    TtsDBField = class;
    TtsCustomDBGrid = class;
    TtsDBGrid = class;
    TtsDBCol = class;
    TtsScrollDataset = class;
    TtsDBCombo = class;
    TtsDBComboGrid = class;

    TtsDBRowLoadedEvent       = procedure (Sender: TObject; DataRow: Variant) of object;
    TtsDBCellLoadedEvent      = procedure (Sender: TObject; DataCol: Longint;
                                           DataRow: Variant; var Value: Variant) of object;
    TtsDBPaintCellEvent       = procedure (Sender: TObject; DataCol: Longint; DataRow: Variant; ARect: TRect;
                                           State: TtsPaintCellState; var Cancel: Boolean) of object;
    TtsDBDeleteRowEvent       = procedure(Sender: TObject; DataRow: Variant; ByUser: Boolean) of object;
    TtsDBInsertRowEvent       = procedure(Sender: TObject; DataRow: Variant; ByUser: Boolean) of object;
    TtsDBTopLeftChangedEvent  = procedure (Sender: TObject; OldCol: Longint; OldRow: Variant;
                                           NewCol: Longint; NewRow: Variant; ByUser: Boolean) of object;
    TtsDBCellEditingEvent     = procedure (Sender: TObject; DataCol: Longint; DataRow: Variant; var Cancel: Boolean) of object;
    TtsDBRowEditingEvent      = procedure (Sender: TObject; DataRow: Variant;
                                           var Cancel: Boolean) of object;
    TtsDBShowEditorEvent      = procedure (Sender: TObject; DataCol: Longint; DataRow: Variant; var Cancel: Boolean) of object;
    TtsDBCellEditEvent        = procedure (Sender: TObject; DataCol: Longint; DataRow: Variant; ByUser: Boolean) of object;
    TtsDBRowEditEvent         = procedure (Sender: TObject; DataRow: Variant; ByUser: Boolean) of object;
    TtsDBUndoCellEditEvent    = procedure (Sender: TObject; DataCol: Longint; DataRow: Variant; ByUser: Boolean; var Cancel: Boolean) of object;
    TtsDBUndoRowEditEvent     = procedure (Sender: TObject; DataRow: Variant; ByUser: Boolean; var Cancel: Boolean) of object;
    TtsDBCellChangedEvent     = procedure (Sender: TObject; OldCol, NewCol: Longint; OldRow, NewRow: Variant) of object;
    TtsDBRowChangedEvent      = procedure (Sender: TObject; OldRow, NewRow: Variant) of object;
    TtsDBButtonEvent          = procedure (Sender: TObject; DataCol: Longint; DataRow: Variant) of object;
    TtsDBSpinButtonEvent      = procedure (Sender: TObject; DataCol: Longint; DataRow: Variant; SpinButton: TtsSpinButton) of object;
    TtsDBSpinRepeatEvent      = procedure (Sender: TObject; DataCol: Longint; DataRow: Variant; Count: Integer; SpinButton: TtsSpinButton) of object;
    TtsDBSpinIncrementEvent   = procedure (Sender: TObject; DataCol: Longint; DataRow: Variant; SpinButton: TtsSpinButton; var Value: Variant; var Pos, Len: Integer; var Accept: Boolean) of object;
    TtsDBClickCellEvent       = procedure (Sender: TObject; DataColDown: Longint; DataRowDown: Variant;
                                           DataColUp: Longint; DataRowUp: Variant; DownPos, UpPos: TtsClickPosition) of object;
    TtsDBDblClickCellEvent    = procedure (Sender: TObject; DataCol: Longint; DataRow: Variant; Pos: TtsClickPosition) of object;
    TtsDBUpdateFieldEvent     = procedure(Sender: TObject; DataCol: Longint; DataRow: Variant;
                                          var Value: Variant; var Cancel: Boolean) of object;
    TtsDBComboCellEvent       = procedure (Sender: TObject; Combo: TtsDBComboGrid; DataCol: Longint; DataRow: Variant) of object;
    TtsDBComboCellLoadedEvent = procedure (Sender: TObject; Combo: TtsDBComboGrid; DataCol: Longint; DataRow: Variant;
                                           var Value: Variant) of object;
    TtsDBComboGetValueEvent   = procedure (Sender: TObject; Combo: TtsDBComboGrid; GridDataCol: Longint;
                                           GridDataRow, ComboDataRow: Variant; var Value: Variant) of object;
    TtsDBDateTimeCellEvent    = procedure (Sender: TObject; DateTimeDef: TtsDateTimeDefComponent; DataCol: Longint; DataRow: Variant) of object;
    TtsDBDateTimeGetValueEvent= procedure (Sender: TObject; DateTimeDef: TtsDateTimeDefComponent; DataCol: Longint; DataRow: Variant; var Value: Variant) of object;
    TtsDBGetRecordIDEvent     = procedure (Sender: TObject; DataRow: Variant; var RecordID: Variant) of object;
    TtsDBCompareRecordIDEvent = procedure (Sender: TObject; RecordID1, RecordID2: Variant; var CompRes: Integer) of object;
    TtsDBGetDrawInfoEvent     = procedure (Sender: TObject; DataCol: Longint; DataRow: Variant; var DrawInfo: TtsDrawInfo) of object;
    TtsDBScanRecordsEvent     = procedure (Sender: TObject; ScanAll: Boolean; State: TtsScanState; Count: Longint; var Cancel: Boolean) of object;
    TtsDBInvalidCellValueEvent= procedure (Sender: TObject; DataCol: Longint; DataRow: Variant; var Accept: Boolean) of object;
    TtsDBInvalidCellEditEvent = procedure (Sender: TObject; Keys: string; DataCol: Longint; DataRow: Variant; var Accept: Boolean) of object;

    TtsDBPrintRowEvent        = procedure(Sender : TObject; DataRow : Variant; var Cancel : Boolean) of object;
    TtsDBPrintCellEvent       = procedure(Sender : TObject; DataCol : Longint; DataRow : Variant; var Cancel : Boolean) of object;


    {TtsDBRect}

    TtsDBRect = record
        Left, Right: Longint;
        Top, Bottom: Variant;
    end;

    {TtsBkmPos}

    TtsBkmPos = record
        Bkm: TBookmarkStr;
        Offset: TtsBkmPosOffset;
    end;

    {TtsDatasetPosition}
    {Record type for storing the current position of the data in the grid}
    
    TtsDatasetPosition = record
        TopBkm: TBookmarkStr;
        ActiveRow: Integer;
    end;

    {TtsDBField}
    {Base field class for column fields in TtsCustomDBGrid. This class corresponds
     to the TField class for the TDBGrid component with.}

    TtsDBField = class(TPersistent)
    protected
        FGrid: TtsCustomDBGrid;
        FCol: TtsDBCol;
        FDatasetField: TField;
        FLookupOffset: Integer;

        function  IsEditField: Boolean;
        function  FieldEditOk: Boolean;
        function  GetDataSize: Word;
        function  GetSize: Word;
        procedure SetSize(Value: Word);
        procedure ClearLookup;                    
        function  GetLookupData(Buffer: Pointer): Boolean;
        procedure SetLookupData(Buffer: Pointer);
        procedure GetLookupValue;
        function  GetData(Buffer: Pointer): Boolean;
        function  GetText(DisplayText: Boolean): string; virtual;
        function  GetAsBoolean: Boolean; virtual;
        function  GetAsCurrency: Currency; virtual;
        function  GetAsDateTime: TDateTime; virtual;
        function  GetAsFloat: Double; virtual;
        function  GetAsInteger: Longint; virtual;
        function  GetAsString: string; virtual;
        function  GetAsVariant: Variant; virtual;
        function  IsBooleanField: Boolean; virtual;
        function  IsIntegerField: Boolean; virtual;

        procedure SetAsBoolean(Value: Boolean); virtual;
        procedure SetAsCurrency(Value: Currency); virtual;
        procedure SetAsDateTime(Value: TDateTime); virtual;
        procedure SetAsFloat(Value: Double); virtual;
        procedure SetAsInteger(Value: Longint); virtual;
        procedure SetAsString(const Value: string); virtual;
        procedure SetAsVariant(const Value: Variant); virtual;
        procedure SetLookupVarValue(Value: Variant); virtual;
        procedure SetLookupValue(const Value: Variant); virtual;
        function  SetField(RecBuf: PChar; Value: string): Boolean; virtual;

        function  GetDisplayText: string; virtual;
        function  GetFieldClass: TClass;
        function  GetDisplayLabel: string;
        procedure SetDisplayLabel(Value: string);
        function  GetDisplayName: string;
        function  GetFieldName: string;
        function  GetReadOnly: Boolean;
        procedure SetReadOnly(Value: Boolean);
        function  GetAlignment: TAlignment;
        procedure SetAlignment(Value: TAlignment);
        function  GetFieldNo: Integer;
        function  GetDataType: TFieldType;
        function  GetDisplayFormat: string; virtual;
        function  GetEditFormat: string; virtual;
        function  GetVisible: Boolean;
        procedure SetVisible(Value: Boolean);
        function  GetDisplayWidth: Integer;
        procedure SetDisplayWidth(Value: Integer);
        function  CanModify: Boolean;
        function  IsBlobField: Boolean;
        procedure SetEditText(Value: string); virtual;
        function  GetEditText: string; virtual;
        function  GetTransliterate: Boolean; virtual;
        procedure SetTransliterate(Value: Boolean); virtual;
        function  GetEditMask: string;
        procedure SetEditMask(Value: string);
        function  GetControlType: TtsControlType; virtual;
        function  GetMaxLength: Integer; virtual;
        function  GetIsNull: Boolean;
        function  GetLookup: Boolean;

        property FieldClass: TClass read GetFieldClass;
        property DisplayLabel: string read GetDisplayLabel write SetDisplayLabel;
        property DisplayName: string read GetDisplayName;
        property FieldName: string read GetFieldName;
        property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
        property Alignment: TAlignment read GetAlignment write SetAlignment;
        property FieldNo: Integer read GetFieldNo;
        property DataType: TFieldType read GetDataType;
        property DisplayFormat: string read GetDisplayFormat;
        property EditFormat: string read GetEditFormat;
        property Visible: Boolean read GetVisible write SetVisible;
        property DisplayWidth: Integer read GetDisplayWidth write SetDisplayWidth;
        property Transliterate: Boolean read GetTransliterate write SetTransliterate;
        property EditMask: string read GetEditMask write SetEditMask;
        property DataSize: Word read GetDataSize;
        property Size: Word read GetSize write SetSize;
        property ControlType: TtsControlType read GetControlType;
        property MaxLength: Integer read GetMaxLength;
        property Lookup: Boolean read GetLookup;
        property LookupValue: Variant read GetAsVariant write SetLookupValue;

    public
        constructor Create(Grid: TtsCustomDBGrid; Col: TtsDBCol; Field: TField); virtual;
        destructor Destroy; override;

        property Text: string read GetEditText write SetEditText;
        property DisplayText: string read GetDisplayText;
        property AsString: string read GetAsString write SetAsString;
        property Value: Variant read GetAsVariant write SetAsVariant;
        property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
        property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
        property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
        property AsFloat: Double read GetAsFloat write SetAsFloat;
        property AsInteger: Longint read GetAsInteger write SetAsInteger;
        property AsVariant: Variant read GetAsVariant write SetAsVariant;
        property IsNull: Boolean read GetIsNull;

        property Col: TtsDBCol read FCol;
        property DatasetField: TField read FDatasetField;
    end;

    {TtsDBStringField}
    {String field for columns in TtsCustomDBGrid. Corresponds to TStringField.}

    TtsDBStringField = class(TtsDBField)
    protected
        function  GetAsBoolean: Boolean; override;
        function  GetAsDateTime: TDateTime; override;
        function  GetAsFloat: Double; override;
        function  GetAsInteger: Longint; override;
        function  GetAsString: string; override;
        function  GetAsVariant: Variant; override;
        function  GetMaxLength: Integer; override;

        function  GetValue(var Value: string): Boolean;
        function  GetText(DisplayText: Boolean): string; override;
        function  GetTransliterate: Boolean; override;
        procedure SetTransliterate(Value: Boolean); override;
        procedure SetLookupVarValue(Value: Variant); override;
        function  SetField(RecBuf: PChar; Value: string): Boolean; override;
    end;

    {TtsDBNumericField}
    {Numeric field for columns in TtsCustomDBGrid. Corresponds to TNumericField.}

    TtsDBNumericField = class(TtsDBField)
    protected
        function GetDisplayFormat: string; override;
        function GetEditFormat: string; override;
    end;

    {TtsDBIntegerField}
    {Integer field for columns in TtsCustomDBGrid. Corresponds to TIntegerField.}

    TtsDBIntegerField = class(TtsDBNumericField)
    protected
        function  GetAsFloat: Double; override;
        function  GetAsInteger: Longint; override;
        function  GetAsString: string; override;
        function  GetAsVariant: Variant; override;

        function  GetValue(var Value: Longint): Boolean;
        function  GetText(DisplayText: Boolean): string; override;
        procedure SetLookupVarValue(Value: Variant); override;
        function  SetField(RecBuf: PChar; Value: string): Boolean; override;
        function  IsIntegerField: Boolean; override;
    end;