cxdb.pas

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

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressDataController                                        }
{                                                                    }
{       Copyright (c) 1998-2008 Developer Express Inc.               }
{       ALL RIGHTS RESERVED                                          }
{                                                                    }
{   The entire contents of this file is protected by U.S. and        }
{   International Copyright Laws. Unauthorized reproduction,         }
{   reverse-engineering, and distribution of all or any portion of   }
{   the code contained in this file is strictly prohibited and may   }
{   result in severe civil and criminal penalties and will be        }
{   prosecuted to the maximum extent possible under the law.         }
{                                                                    }
{   RESTRICTIONS                                                     }
{                                                                    }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES            }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE     }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS    }
{   LICENSED TO DISTRIBUTE THE EXPRESSDATACONTROLLER AND ALL         }
{   ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. }
{                                                                    }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED       }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE         }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE        }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT   }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                       }
{                                                                    }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON        }
{   ADDITIONAL RESTRICTIONS.                                         }
{                                                                    }
{********************************************************************}

unit cxDB;

{$I cxVer.inc}

interface

uses
  Classes, SysUtils, {$IFDEF DELPHI6}Variants, {$ENDIF} DB,
  cxDataUtils;

type
  { TcxDBAdapterList }

  TDataSetClass = class of TDataSet;

  TcxDBAdapterItem = class
  private
    FDataSetClass: TDataSetClass;
  public
    constructor Create(ADataSetClass: TDataSetClass); virtual;
    property DataSetClass: TDataSetClass read FDataSetClass;
  end;

  TcxDBAdapterItemClass = class of TcxDBAdapterItem;

  TcxDBAdapterList = class
  private
    FItems: TList;
    function GetItem(Index: Integer): TcxDBAdapterItem;
    function GetItemCount: Integer;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    function FindAdapter(ADataSetClass: TDataSetClass; var AIndex: Integer): Boolean; virtual;
    procedure RegisterAdapter(ADataSetClass: TDataSetClass; AItemClass: TcxDBAdapterItemClass); virtual;
    procedure UnregisterAdapter(ADataSetClass: TDataSetClass; AItemClass: TcxDBAdapterItemClass); virtual;
    property ItemCount: Integer read GetItemCount;
    property Items[Index: Integer]: TcxDBAdapterItem read GetItem; default;
  end;

  { TcxCustomFieldDataLink }

  TcxCustomDBDataBinding = class;

  TcxCustomFieldDataLink = class(TDataLink)
  private
    FField: TField;
    FFieldName: string;
    FEditing: Boolean;
    FModified: Boolean;
    function GetCanModify: Boolean;
    function GetDataComponent: TComponent;
    procedure SetEditing(Value: Boolean);
    procedure SetField(Value: TField);
    procedure SetFieldName(const Value: string);
    procedure UpdateField;
  protected
    FDataBinding: TcxCustomDBDataBinding;
    procedure ActiveChanged; override;
    procedure DataEvent(Event: TDataEvent; Info: Longint); override;
    procedure EditingChanged; override;
    procedure LayoutChanged; override;
    procedure RecordChanged(Field: TField); override;
    procedure UpdateData; override;
    procedure DataComponentChanged; virtual;
    procedure UpdateRightToLeft; virtual;
    procedure VisualControlChanged; virtual;
    property DataBinding: TcxCustomDBDataBinding read FDataBinding;
    property DataComponent: TComponent read GetDataComponent;
  public
    constructor Create(ADataBinding: TcxCustomDBDataBinding); virtual;
    function Edit: Boolean;
    procedure Modified;
    procedure Reset;
    property CanModify: Boolean read GetCanModify;
    property Editing: Boolean read FEditing;
    property Field: TField read FField;
    property FieldName: string read FFieldName write SetFieldName;
  end;

  TcxCustomFieldDataLinkClass = class of TcxCustomFieldDataLink;

  { TcxCustomDBDataBinding }

  TcxCustomDBDataBinding = class(TcxCustomDataBinding)
  private
    FRefreshCount: Integer;
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    procedure InternalDataChange;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
  protected
    FDataLink: TcxCustomFieldDataLink;
    function GetModified: Boolean; override;
    function GetReadOnly: Boolean; override;
    procedure SetReadOnly(Value: Boolean); override;
    procedure VisualControlChanged; override;
    procedure DisableRefresh;
    procedure EnableRefresh;
    function GetDataLinkClass: TcxCustomFieldDataLinkClass; virtual;
    function IsRefreshDisabled: Boolean;
  public
    constructor Create(AOwner, ADataComponent: TComponent); override;
    destructor Destroy; override;
    function CanModify: Boolean; override;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    function GetStoredValue(AValueSource: TcxDataEditValueSource; AFocused: Boolean): Variant; override;
    function IsControlReadOnly: Boolean; override;
    function IsDataSourceLive: Boolean; override;
    function IsDataStorage: Boolean; override;
    procedure Reset; override;
    function SetEditMode: Boolean; override;
    procedure SetStoredValue(AValueSource: TcxDataEditValueSource; const Value: Variant); override;
    function UpdateAction(Action: TBasicAction): Boolean; override;
    procedure UpdateDataSource; override;
    property Field: TField read GetField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DataField: string read GetDataField write SetDataField;
    property DataLink: TcxCustomFieldDataLink read FDataLink;
  end;

function CanModifyLookupField(AField: TField): Boolean;
procedure CheckFilterFieldName(var AFieldName: string);
function GetDataSetValues(ADataSet: TDataSet; AFields: TList): Variant;
function GetFilterFieldName(AField: TField; AIgnoreOrigin: Boolean): string;
function IsEqualFieldNames(const AFieldName1, AFieldName2: string): Boolean;
function IsFieldCanModify(AField: TField; AIsValueSource: Boolean): Boolean;
function IsFieldFormatted(AField: TField; AIsTextEdit: Boolean): Boolean;
function IsMultipleFieldNames(const AFieldNames: string): Boolean;
function IsSimpleCurrencyField(AField: TField): Boolean;
function GetFieldNamesCount(const AFieldNames: string): Integer;
procedure GetFieldNames(const AFieldNames: string; AList: TStrings);
function GetFieldValue(AField: TField): Variant;
procedure SetDataSetValues(ADataSet: TDataSet; AFields: TList; const AValues: Variant);
procedure SetFieldValue(AField: TField; const AValue: Variant);

implementation

uses
  cxVariants;

function CanModifyLookupField(AField: TField): Boolean;
var
  AMasterFields: TList;
  I: Integer;
begin
  Result := False;
  if Assigned(AField.DataSet) then
  begin
    AMasterFields := TList.Create;
    try
      AField.DataSet.GetFieldList(AMasterFields, AField.KeyFields);
      Result := AMasterFields.Count > 0;
      for I := 0 to AMasterFields.Count - 1 do
        Result := Result and TField(AMasterFields[I]).CanModify;
    finally
      AMasterFields.Free;
    end;
  end;
end;

procedure CheckFilterFieldName(var AFieldName: string);
begin
  if not IsValidIdent(AFieldName) then
    AFieldName := '[' + AFieldName + ']';
end;

function GetDataSetValues(ADataSet: TDataSet; AFields: TList): Variant;
var
  I: Integer;
begin
  if AFields.Count > 0 then
  begin
    if AFields.Count > 1 then
    begin
      Result := VarArrayCreate([0, AFields.Count - 1], varVariant);
      for I := 0 to AFields.Count - 1 do
        Result[I] := TField(AFields[I]).Value;
    end
    else
      Result := TField(AFields[0]).Value;
  end
  else
    Result := Null;
end;

function GetFilterFieldName(AField: TField; AIgnoreOrigin: Boolean): string;
begin
  Result := '';
  if Assigned(AField) then
  begin
    if not AIgnoreOrigin then
      Result := AField.Origin;
    if Result = '' then
    begin
      Result := AField.FieldName;
      CheckFilterFieldName(Result);
    end;
  end;
end;

function IsEqualFieldNames(const AFieldName1, AFieldName2: string): Boolean;
begin
  Result := AnsiUpperCase(AFieldName1) = AnsiUpperCase(AFieldName2);
end;

function IsFieldCanModify(AField: TField; AIsValueSource: Boolean): Boolean;
begin
  Result := AField.CanModify and
    (AIsValueSource or not (AField.DataType in ftNonTextTypes) or Assigned(AField.OnSetText));
end;

function IsFieldFormatted(AField: TField; AIsTextEdit: Boolean): Boolean;
begin
  Result := Assigned(AField.OnGetText) or (AField.EditMask <> '');
  if not Result then
  begin
    if AField.DataType in ftNonTextTypes  then 
      Result := AIsTextEdit // Field.DisplayText!
    else
      if AField is TBooleanField then
        Result := AIsTextEdit // TODO: compare DisplayValues
      else
        if AField is TNumericField then
        begin
          Result := ((AField as TNumericField).DisplayFormat <> '') or
            ((AField as TNumericField).EditFormat <> '');
          if not Result then
          begin
            if AField is TFloatField then
              Result := (AField as TFloatField).Currency
            else
              if AField is TBCDField then
                Result := (AField as TBCDField).Currency
              {$IFDEF DELPHI6}
              else
                if AField is TFMTBCDField then
                  Result := (AField as TFMTBCDField).Currency
              {$ENDIF}
          end;
        end
        else
          if AField is TDateTimeField then
            Result := (AField as TDateTimeField).DisplayFormat <> ''
          else
            {$IFDEF DELPHI5}
            if AField is TAggregateField then
              Result := ((AField as TAggregateField).DisplayFormat <> '') or
                (AField as TAggregateField).Currency
            else
              {$IFDEF DELPHI6}
              if AField is TSQLTimeStampField then
                Result := (AField as TSQLTimeStampField).DisplayFormat <> '';
              {$ENDIF}
            {$ENDIF}
  end;
end;

function IsMultipleFieldNames(const AFieldNames: string): Boolean;
var
  APos: Integer;
begin
  APos := 1;
{$WARNINGS OFF}
  ExtractFieldName(AFieldNames, APos);
{$WARNINGS ON}
  Result := APos <= Length(AFieldNames);
end;

function IsSimpleCurrencyField(AField: TField): Boolean;
begin
  Result := False;
  if AField is TNumericField then
  begin
    if AField is TFloatField then
      Result := (AField as TFloatField).Currency
    else
    begin
      if AField is TBCDField then
        Result := (AField as TBCDField).Currency
      {$IFDEF DELPHI6}
      else
        if AField is TFMTBCDField then
          Result := (AField as TFMTBCDField).Currency;
      {$ENDIF}
    end;
    if Result then
    begin
      if ((AField as TNumericField).DisplayFormat <> '') or Assigned(AField.OnGetText) then
        Result := False;
    end;
  end;
end;

function GetFieldNamesCount(const AFieldNames: string): Integer;
var
  APos: Integer;
begin
  Result := 0; // TODO: use GetFieldNames?
  APos := 1;
  while APos <= Length(AFieldNames) do
  begin
    Inc(Result);
  {$WARNINGS OFF}
    ExtractFieldName(AFieldNames, APos);
  {$WARNINGS ON}
  end;
end;

procedure GetFieldNames(const AFieldNames: string; AList: TStrings);
var
  APos: Integer;
begin
  AList.Clear;
  APos := 1;
  while APos <= Length(AFieldNames) do
  {$WARNINGS OFF}
    AList.Add(ExtractFieldName(AFieldNames, APos))
  {$WARNINGS ON}
end;

function GetFieldValue(AField: TField): Variant;
begin
  if AField is TAggregateField then // bug in Delphi (IsNull = True!)
    Result := AField.Value
  else
    if AField.IsNull then
      Result := Null
    else
    begin
    {$IFDEF DELPHI5}
      if AField is TWideStringField then // bug in Delphi
        Result := TWideStringField(AField).Value
      else
    {$ENDIF}  
        Result := AField.Value;
    end;
end;

procedure SetDataSetValues(ADataSet: TDataSet; AFields: TList;
  const AValues: Variant);
var
  I: Integer;
begin
  if AFields.Count > 0 then
  begin
    if AFields.Count > 1 then
    begin
      for I := 0 to AFields.Count - 1 do
        TField(AFields[I]).Value := AValues[I];
    end
    else
      TField(AFields[0]).Value := AValues;
  end;
end;

procedure SetFieldValue(AField: TField; const AValue: Variant);
begin
  if (AField is TDateTimeField) and (VarType(AValue) = varDouble) then // bug in Delphi
    TDateTimeField(AField).Value := AValue
  else
    AField.Value := AValue;
end;

{ TcxDBAdapterItem }

constructor TcxDBAdapterItem.Create(ADataSetClass: TDataSetClass);
begin
  inherited Create;
  FDataSetClass := ADataSetClass;
end;

{ TcxDBAdapterList }

constructor TcxDBAdapterList.Create;
begin
  inherited Create;
  FItems := TList.Create;
end;

destructor TcxDBAdapterList.Destroy;
begin
  Clear;
  FItems.Free;
  FItems := nil;
  inherited Destroy;
end;

procedure TcxDBAdapterList.Clear;
var
  I: Integer;
begin
  for I := 0 to FItems.Count - 1 do
    TObject(FItems[I]).Free;
  FItems.Clear;
end;

function TcxDBAdapterList.FindAdapter(ADataSetClass: TDataSetClass;
  var AIndex: Integer): Boolean;