cxdbdata.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,895 行 · 第 1/5 页

  protected
    function IsCurrency(AVarType: TVarType): Boolean; override;
  public
    procedure Assign(Source: TPersistent); override;
    property DataController: TcxDBDataController read GetDBDataController;
    function DataField: TcxCustomDataField; override;
  published
    property FieldName: string read FFieldName write SetFieldName;
  end;

  { TcxDBDataModeController }

  TcxDBDataModeControllerDetailIsCurrentQueryEvent = function(Sender: TcxDBDataModeController;
    ADataSet: TDataSet; const AMasterDetailKeyFieldNames: string;
    const AMasterDetailKeyValues: Variant): Boolean of object;

  TcxDBDataModeControllerDetailFirstEvent = procedure(Sender: TcxDBDataModeController;
    ADataSet: TDataSet; const AMasterDetailKeyFieldNames: string;
    const AMasterDetailKeyValues: Variant; var AReopened: Boolean) of object;

  TcxDBDataModeController = class(TPersistent)
  private
    FDataController: TcxDBDataController;
    FDetailInSQLMode: Boolean;
    FDetailInSyncMode: Boolean;
    FGridMode: Boolean;
    FGridModeBufferCount: Integer;
    FSmartRefresh: Boolean;
    FSyncInsert: Boolean;
    FSyncMode: Boolean;
    FOnDetailFirst: TcxDBDataModeControllerDetailFirstEvent;
    FOnDetailIsCurrentQuery: TcxDBDataModeControllerDetailIsCurrentQueryEvent;
    procedure SetGridMode(Value: Boolean);
    procedure SetGridModeBufferCount(Value: Integer);
    procedure SetSmartRefresh(Value: Boolean);
    procedure SetSyncMode(Value: Boolean);
  protected
    function DetailIsCurrentQuery(const AMasterDetailKeyFieldNames: string; const AMasterDetailKeyValues: Variant): Boolean; virtual;
    procedure DoDetailFirst(const AMasterDetailKeyFieldNames: string; const AMasterDetailKeyValues: Variant; var AReopened: Boolean); virtual;
    property DetailInSyncMode: Boolean read FDetailInSyncMode write FDetailInSyncMode default True;
  public
    constructor Create(ADataController: TcxDBDataController);
    procedure Assign(Source: TPersistent); override;
    property DataController: TcxDBDataController read FDataController;
    property SyncInsert: Boolean read FSyncInsert write FSyncInsert default True;
  published
    property DetailInSQLMode: Boolean read FDetailInSQLMode write FDetailInSQLMode default False;
    property GridMode: Boolean read FGridMode write SetGridMode default False;
    property GridModeBufferCount: Integer read FGridModeBufferCount write SetGridModeBufferCount default 0;
    property SmartRefresh: Boolean read FSmartRefresh write SetSmartRefresh default False;
    property SyncMode: Boolean read FSyncMode write SetSyncMode default True;
    property OnDetailFirst: TcxDBDataModeControllerDetailFirstEvent read FOnDetailFirst write FOnDetailFirst;
    property OnDetailIsCurrentQuery: TcxDBDataModeControllerDetailIsCurrentQueryEvent read FOnDetailIsCurrentQuery write FOnDetailIsCurrentQuery;
  end;

  { TcxDBDataSelection }

  TcxDBDataSelection = class(TcxDataSelection)
  private
    FAnchorBookmark: TBookmarkStr;
    FBookmarks: TStrings;
    FInSelectAll: Boolean;
    function GetDataController: TcxDBDataController;
  protected
    procedure ClearAnchor; override;
    function CompareBookmarks(const AItem1, AItem2: TBookmarkStr): Integer;
    procedure InternalAdd(AIndex, ARowIndex, ARecordIndex, ALevel: Integer); override;
    procedure InternalClear; override;
    procedure InternalDelete(AIndex: Integer); override;
    function FindBookmark(const ABookmark: TBookmarkStr; var AIndex: Integer): Boolean;
    function GetRowBookmark(ARowIndex: Integer): TBookmarkStr;
    function RefreshBookmarks: Boolean;
    procedure SyncCount;
  public
    constructor Create(ADataController: TcxCustomDataController); override;
    destructor Destroy; override;
    function FindByRowIndex(ARowIndex: Integer; var AIndex: Integer): Boolean; override;
    procedure SelectAll;
    procedure SelectFromAnchor(AToBookmark: TBookmarkStr; AKeepSelection: Boolean);
    property DataController: TcxDBDataController read GetDataController;
  end;

  { TcxDBDataController }

  TcxDBDataDetailHasChildrenEvent = procedure(Sender: TcxDBDataController;
    ARecordIndex, ARelationIndex: Integer; const AMasterDetailKeyFieldNames: string;
    const AMasterDetailKeyValues: Variant; var HasChildren: Boolean) of object;

  TcxDBDataController = class(TcxCustomDataController)
  private
    FBookmark: TBookmarkStr;
    FCreatedDataController: TcxCustomDataController; 
    FDataModeController: TcxDBDataModeController;
    FDetailKeyFieldNames: string;
    FInCheckBrowseMode: Boolean;
    FInCheckCurrentQuery: Boolean;
    FInResetDataSetCurrent: Boolean;
    FInUnboundCopy: Boolean;
    FInUpdateGridModeBufferCount: Boolean;
    FKeyField: TcxDBDataField;
    FKeyFieldNames: string;
    FLoaded: Boolean;
    FMasterDetailKeyFields: TList;
    FMasterDetailKeyValues: Variant;
    FMasterKeyFieldNames: string;
    FResetDBFields: Boolean;
    FUpdateDataSetPos: Boolean;
    FOnDetailHasChildren: TcxDBDataDetailHasChildrenEvent;
    function AddInternalDBField: TcxDBDataField;
    function GetDataSet: TDataSet;
    function GetDataSetRecordCount: Integer;
    function GetDataSource: TDataSource;
    function GetDBField(Index: Integer): TcxDBDataField;
    function GetDBSelection: TcxDBDataSelection;
    function GetFilter: TcxDBDataFilterCriteria;
    function GetMasterDetailKeyFieldNames: string;
    function GetMasterDetailKeyFields: TList;
    function GetProvider: TcxDBDataProvider;
    function GetRecNo: Integer;
    procedure MasterDetailKeyFieldsRemoveNotification(AComponent: TComponent);
    procedure RemoveKeyField;
    procedure SetDataModeController(Value: TcxDBDataModeController);
    procedure SetDataSource(Value: TDataSource);
    procedure SetDetailKeyFieldNames(const Value: string);
    procedure SetFilter(Value: TcxDBDataFilterCriteria);
    procedure SetKeyFieldNames(const Value: string);
    procedure SetMasterKeyFieldNames(const Value: string);
    procedure SetRecNo(Value: Integer);
    procedure SyncDataSetPos;
    function SyncMasterDetail: TcxCustomDataController;
    procedure SyncMasterDetailDataSetPos;
    procedure UpdateRelationFields;
  protected
    function CanChangeDetailExpanding(ARecordIndex: Integer; AExpanded: Boolean): Boolean; override;
    function CanFocusRecord(ARecordIndex: Integer): Boolean; override;
    procedure CheckDataSetCurrent; override;
    function CheckMasterBrowseMode: Boolean; override;
    procedure ClearMasterDetailKeyFields;
    procedure CorrectAfterDelete(ARecordIndex: Integer); override;
    procedure DoDataSetCurrentChanged(AIsCurrent: Boolean); virtual;
    procedure DoDataSourceChanged; virtual;
    procedure DoInitInsertingRecord(AInsertingRecordIndex: Integer); virtual;
    function DoSearchInGridMode(const ASubText: string; AForward, ANext: Boolean): Boolean; override;
    function FindRecordIndexInGridMode(const AKeyFieldValues: Variant): Integer;
    function GetActiveRecordIndex: Integer; override;
    function GetDataProviderClass: TcxCustomDataProviderClass; override;
    function GetDataSelectionClass: TcxDataSelectionClass; override;
    function GetDefaultGridModeBufferCount: Integer; virtual;
    function GetFieldClass: TcxCustomDataFieldClass; override;
    function GetFilterCriteriaClass: TcxDataFilterCriteriaClass; override;
    procedure GetKeyFields(AList: TList); override;
    function GetRelationClass: TcxCustomDataRelationClass; override;
    function GetSummaryItemClass: TcxDataSummaryItemClass; override;
    function InternalCheckBookmark(ADeletedRecordIndex: Integer): Boolean; override;
    procedure InternalClearBookmark; override;
    procedure InternalGotoBookmark; override;
    function InternalSaveBookmark: Boolean; override;
    procedure InvalidateDataBuffer; virtual;
    function IsDataField(AField: TcxCustomDataField): Boolean; override;
    function IsKeyNavigation: Boolean; override;
    function IsOtherDetailChanged: Boolean;
    function IsOtherDetailCreating: Boolean;
    function IsProviderDataSource: Boolean; override;
    function IsSmartRefresh: Boolean; override;
    procedure LoadStorage; override;
    function LocateRecordIndex(AGetFieldsProc: TGetListProc): Integer; virtual;
    function LockOnAfterSummary: Boolean; override;
    procedure NotifyDataControllers; override;
    procedure NotifyDetailAfterFieldsRecreating(ADataController: TcxCustomDataController);
    procedure NotifyDetailsAfterFieldsRecreating(ACreatingLinkObject: Boolean);
    procedure PrepareField(AField: TcxCustomDataField); override;
    procedure RemoveNotification(AComponent: TComponent); override;
    procedure ResetDataSetCurrent(ADataController: TcxCustomDataController);
    procedure ResetDBFields;
    procedure RestructData; override;
    procedure ResyncDBFields;
    procedure RetrieveField(ADataField: TcxDBDataField; AIsLookupKeyOnly: Boolean);
    function TryFocusRecord(ARecordIndex: Integer): Boolean; virtual;
    procedure UpdateEditingRecord;
    procedure UpdateField(ADataField: TcxDBDataField; const AFieldNames: string; AIsLookup: Boolean);
    procedure UpdateFields; override;
    procedure UpdateFocused; override;
    procedure UpdateInternalKeyFields(const AFieldNames: string; var AField: TcxDBDataField);
    procedure UpdateLookupFields;
    procedure UpdateRelations(ARelation: TcxCustomDataRelation); override;
    procedure UpdateScrollBars; virtual;
    // Locate
    procedure BeginReadRecord; override;
    procedure EndReadRecord; override;

    property DBFields[Index: Integer]: TcxDBDataField read GetDBField;
    property DBSelection: TcxDBDataSelection read GetDBSelection;
    property KeyField: TcxDBDataField read FKeyField;
    property MasterDetailKeyFieldNames: string read GetMasterDetailKeyFieldNames;
    property MasterDetailKeyFields: TList read GetMasterDetailKeyFields;
    property MasterDetailKeyValues: Variant read FMasterDetailKeyValues;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    // Actions
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    function UpdateAction(Action: TBasicAction): Boolean; override;
    // Structure
    procedure ChangeFieldName(AItemIndex: Integer; const AFieldName: string);
    procedure ChangeValueTypeClass(AItemIndex: Integer; AValueTypeClass: TcxValueTypeClass); override;
    function GetItemByFieldName(const AFieldName: string): TObject;
    function GetItemField(AItemIndex: Integer): TField;
    function GetItemFieldName(AItemIndex: Integer): string;
    function IsDisplayFormatDefined(AItemIndex: Integer; AIgnoreSimpleCurrency: Boolean): Boolean; override;
    procedure Loaded; override;
    // Data
    procedure BeginLocate;
    procedure EndLocate;
    procedure DoUpdateRecord(ARecordIndex: Integer);
    function GetGroupValue(ARecordIndex: Integer; AField: TcxCustomDataField): Variant; override;
    procedure GetKeyDBFields(AList: TList);
    function GetKeyFieldsValues: Variant;
    function GetRecordId(ARecordIndex: Integer): Variant; override;
    procedure UpdateGridModeBufferCount;
    // Data Editing
    procedure CheckBrowseMode; override;
    function DataChangedNotifyLocked: Boolean; override;
    procedure RefreshExternalData; override;
    // Navigation
    procedure SetFocus; override;
    // Bookmark
    function IsBookmarkAvailable: Boolean; override;
    function IsBookmarkRow(ARowIndex: Integer): Boolean; override;
    // Filter
    function GetFilterDataValue(ARecordIndex: Integer; AField: TcxCustomDataField): Variant; override;
    function GetFilterItemFieldName(AItem: TObject): string; override;
    // Search
    function FindRecordIndexByKey(const AKeyFieldValues: Variant): Integer;
    function LocateByKey(const AKeyFieldValues: Variant): Boolean;
    // Master-Detail
    procedure CheckCurrentQuery;
    function GetDetailFilterAdapter: TcxDBProviderDetailFilterAdapter; virtual;
    procedure SetMasterRelation(AMasterRelation: TcxCustomDataRelation; AMasterRecordIndex: Integer); override;
    // MultiSelect in GridMode
    function GetRowId(ARowIndex: Integer): Variant; override;
    function GetSelectedBookmark(Index: Integer): TBookmarkStr;
    function GetSelectedRowIndex(Index: Integer): Integer; override;
    function GetSelectionAnchorBookmark: TBookmarkStr;
    function GetSelectionAnchorRowIndex: Integer; override;
    function IsSelectionAnchorExist: Boolean; override;
    procedure SelectAll; override;
    procedure SelectFromAnchor(ARowIndex: Integer; AKeepSelection: Boolean); override;
    procedure SetSelectionAnchor(ARowIndex: Integer); override;
    // Export
    function FocusSelectedRow(ASelectedIndex: Integer): Boolean; override;
    // View Data
    procedure ForEachRow(ASelectedRows: Boolean; AProc: TcxDataControllerEachRowProc); override;
    function IsSequenced: Boolean;

    property DataModeController: TcxDBDataModeController read FDataModeController write SetDataModeController;
    property DataSet: TDataSet read GetDataSet;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DetailKeyFieldNames: string read FDetailKeyFieldNames write SetDetailKeyFieldNames;
    property Filter: TcxDBDataFilterCriteria read GetFilter write SetFilter;
    property KeyFieldNames: string read FKeyFieldNames write SetKeyFieldNames;
    property MasterKeyFieldNames: string read FMasterKeyFieldNames write SetMasterKeyFieldNames;
    property Provider: TcxDBDataProvider read GetProvider;
    property RecNo: Integer read GetRecNo write SetRecNo; // Sequenced
    property DataSetRecordCount: Integer read GetDataSetRecordCount; // Sequenced
    property OnDetailHasChildren: TcxDBDataDetailHasChildrenEvent read FOnDetailHasChildren write FOnDetailHasChildren;
  end;

var
  cxDetailFilterControllers: TcxDBAdapterList;

function CanCallDataSetLocate(ADataSet: TDataSet; const AKeyFieldNames: string;
  const AValue: Variant): Boolean;
function GetValueTypeClassByField(AField: TField): TcxValueTypeClass;

implementation

uses
  {$IFDEF DELPHI9}Windows, {$ENDIF}
  TypInfo, Contnrs, cxDataConsts
  ;

type
  TDataSetAccess = class(TDataSet);

var
  DBDataProviders: TList;

procedure GetInternalKeyFields(ADataField: TcxDBDataField; AList: TList);
var
  I: Integer;
begin
  if Assigned(ADataField) then
  begin
    if ADataField.FieldCount = 0 then
      AList.Add(ADataField)
    else
      for I := 0 to ADataField.FieldCount - 1 do
        AList.Add(ADataField.Fields[I]);
  end;
end;

function CanCallDataSetLocate(ADataSet: TDataSet; const AKeyFieldNames: string;
  const AValue: Variant): Boolean;

  function TryGetFieldList(ADataSet: TDataSet;
    const AFieldNames: WideString; AList: TList): Boolean;
  var
    AField: TField;
    APos: Integer;
  begin
    Result := True;
    APos := 1;
    while APos <= Length(AFieldNames) do
    begin
      AField := ADataSet.FindField(ExtractFieldName(AFieldNames, APos));
      Result := AField <> nil;
      if not Result then
        Break;
      AList.Add(AField);
    end;
  end;

  function IsNullValidToLocate(AField: TField): Boolean;
  begin
    Result := not (AField is TAutoIncField);
  end;

var
  AArrayLowBound, I: Integer;
  AField: TField;
  AFieldList: TObjectList;
begin
  if VarIsArray(AValue) then
  begin
    AFieldList := TObjectList.Create(False);
    try
      AArrayLowBound := VarArrayLowBound(AValue, 1);
      Result := TryGetFieldList(ADataSet, AKeyFieldNames, AFieldList) and
        (AFieldList.Count = VarArrayHighBound(AValue, 1) - AArrayLowBound + 1);
      if Result then
        for I := 0 to AFieldList.Count - 1 do
        begin
          Result := not VarIsNull(AValue[I + AArrayLowBound]) or
            IsNullValidToLocate(TField(AFieldList[I]));
          if not Result then
            Break;
        end;
    finally
      AFieldList.Free;
    end;
  end
  else
  begin
    AField := nil;
    if Pos(';', AKeyFieldNames) = 0 then
      AField := ADataSet.FindField(AKeyFieldNames);
    Result := (AField <> nil) and (not VarIsNull(AValue) or
      IsNullValidToLocate(AField));
  end;
end;

function GetValueTypeClassByField(AField: TField): TcxValueTypeClass;
begin
  if AField = nil then
    Result := TcxStringValueType
  else
  begin
    case AField.DataType of
      ftString:
        Result := TcxStringValueType;
      ftWideString:
        Result := TcxWideStringValueType;
      ftSmallint:
        Result := TcxSmallintValueType;
      ftInteger, ftAutoInc:
        Result := TcxIntegerValueType;
      ftWord:
        Result := TcxWordValueType;