cxdblookupedit.pas

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

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressEditors                                               }
{                                                                    }
{       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 EXPRESSEDITORS 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 cxDBLookupEdit;

{$I cxVer.inc}

interface

uses
{$IFDEF DELPHI6}
  Variants,
{$ENDIF}
  Messages, Controls,
  SysUtils, Classes, DB,
  cxClasses, cxContainer, cxEdit, cxDBEdit, cxEditConsts,
  cxDB, cxDataUtils, cxDataStorage, cxCustomData, cxDBData, cxDropDownEdit, cxLookupEdit;

type
  TcxCustomDBLookupEditProperties = class;

  { TcxCustomDBLookupEditLookupData }

  TcxCustomDBLookupEditLookupData = class(TcxCustomLookupEditLookupData)
  private
    function GetDataController: TcxDBDataController;
    function GetProperties: TcxCustomDBLookupEditProperties;
  protected
    procedure DoSetCurrentKey(ARecordIndex: Integer); override;
    procedure DoSyncGrid; override;
    property DataController: TcxDBDataController read GetDataController;
    property Properties: TcxCustomDBLookupEditProperties read GetProperties;
  end;

  { TcxCustomDBLookupEditProperties }

  TcxCustomDBLookupEditProperties = class(TcxCustomLookupEditProperties)
  private
    FCachedLookupSource: TDataSource;
    FCaseSensitiveSearch: Boolean;
    FLockGridModeCount: Integer;
    FLookupField: TField;
    FLookupList: TcxLookupList;
    FLookupSource: TDataSource;
    FLookupSourceFreeNotificator: TcxFreeNotificator;
    FSyncLookup: Boolean;
    function GetIsUseLookupList: Boolean;
    function GetKeyFieldNames: string;
    function GetListField: TField;
    function GetListFieldIndex: Integer;
    function GetListFieldNames: string;
    procedure SetIsUseLookupList(Value: Boolean);
    procedure SetKeyFieldNames(const Value: string);
    procedure SetListFieldIndex(Value: Integer);
    procedure SetListFieldNames(const Value: string);
  protected
    // DBLookupGrid methods
    procedure DBLookupGridBeginUpdate; virtual;
    procedure DBLookupGridCheckColumnByFieldName(const AFieldName: string); virtual; // if a column does not exist, then create it with zero index
    procedure DBLookupGridCreateColumnsByFieldNames(const AFieldNames: string); virtual;
    procedure DBLookupGridEndUpdate; virtual;
    function GetDBLookupGridColumnField(AIndex: Integer): TField; virtual;
    function GetDBLookupGridColumnFieldName(AIndex: Integer): string; virtual;
    function GetDBLookupGridColumnIndexByFieldName(const AFieldName: string): Integer; virtual;
    function GetDBLookupGridDataController: TcxDBDataController; virtual;

    function CanDisplayArbitraryEditValue: Boolean;
    procedure CheckLookup; virtual;
    procedure CheckLookupColumn; virtual;
    procedure CheckLookupList;
    procedure DefaultValuesProviderDestroyed; override;
    procedure DefineByLookupError;
    function FindByText(AItemIndex: Integer; const AText: string; APartialCompare: Boolean): Integer; override;
    function GetDisplayColumnIndex: Integer; override;
    function GetDisplayLookupText(const AKey: TcxEditValue): string; override;
    function GetDefaultHorzAlignment: TAlignment; override;
    function GetDefaultMaxLength: Integer; override;
    function GetIncrementalFiltering: Boolean; override;
    function GetKeyByRecordIndex(ARecordIndex: Integer): Variant;
    class function GetLookupDataClass: TcxInterfacedPersistentClass; override;
    function GetLookupResultFieldName: string;
    function GetNullKey: Variant; override;
    function GetRecordIndexByKey(const AKey: Variant): Integer;
    function IsPickMode: Boolean; override;
    procedure LockDataChanged; override;
    procedure LookupSourceFreeNotification(Sender: TComponent); virtual;
    procedure SetDisplayColumnIndex(Value: Integer); override;
    procedure SetLookupField(ALookupField: TField);
    procedure UnlockDataChanged; override;
    property InSyncLookup: Boolean read FSyncLookup;
    property IsUseLookupList: Boolean read GetIsUseLookupList write SetIsUseLookupList;
  public
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure Changed; override;
    class function GetContainerClass: TcxContainerClass; override;
    function GetDataField: TField;
    function GetEditValueSource(AEditFocused: Boolean): TcxDataEditValueSource; override;
    function GetLookupField: TField;
    function IsLookupField: Boolean; override;
    procedure PrepareDisplayValue(const AEditValue: TcxEditValue;
      var DisplayValue: TcxEditValue; AEditFocused: Boolean); override;
    property CaseSensitiveSearch: Boolean read FCaseSensitiveSearch
      write FCaseSensitiveSearch default False;
    property DataController: TcxDBDataController read GetDBLookupGridDataController;
    property KeyFieldNames: string read GetKeyFieldNames write SetKeyFieldNames;
    property ListField: TField read GetListField;
    property ListFieldNames: string read GetListFieldNames write SetListFieldNames stored False;
    property ListFieldIndex: Integer read GetListFieldIndex write SetListFieldIndex default 0;
  end;

  { TcxCustomDBLookupEdit }

  TcxCustomDBLookupEdit = class(TcxCustomLookupEdit)
  private
    function GetProperties: TcxCustomDBLookupEditProperties;
    function GetActiveProperties: TcxCustomDBLookupEditProperties;
    procedure SetProperties(Value: TcxCustomDBLookupEditProperties);
  protected
    function GetClearValue: TcxEditValue; override;
    function IsValidChar(AChar: Char): Boolean; override;
    function ItemIndexToLookupKey(AItemIndex: Integer): TcxEditValue; override;
    function LookupKeyToEditValue(const AKey: TcxEditValue): TcxEditValue; override;
    function LookupKeyToItemIndex(const AKey: TcxEditValue): Integer; override;
    procedure PopupWindowClosed(Sender: TObject); override;
    procedure PrepareDisplayValue(const AEditValue: TcxEditValue;
      var DisplayValue: TcxEditValue; AEditFocused: Boolean); override;
  public
    class function GetPropertiesClass: TcxCustomEditPropertiesClass; override;
    property ActiveProperties: TcxCustomDBLookupEditProperties
      read GetActiveProperties;
    property Properties: TcxCustomDBLookupEditProperties read GetProperties
      write SetProperties;
  end;

  { TcxDBLookupEditDataBinding }

  TcxDBLookupEditDataBinding = class(TcxDBTextEditDataBinding)
  protected
    function IsLookupControl: Boolean; override;
  end;

function IsLinkedToDataSet(ADataSource: TDataSource{list}; ADataSet: TDataSet{data binding}): Boolean;

implementation

uses
{$IFDEF DELPHI6}
  VDBConsts,
{$ENDIF}
  Contnrs, DBConsts;

function IsLinkedToDataSet(ADataSource: TDataSource{list}; ADataSet: TDataSet{data binding}): Boolean;
var
  AListDataSet: TDataSet;
begin
  AListDataSet := ADataSource.DataSet;
  Result := True;
  while ADataSet <> nil do
  begin
    if ADataSet = AListDataSet then Exit;
    if (ADataSet.DataSetField <> nil) and
       (ADataSet.DataSetField.DataSet = AListDataSet) then Exit;
    if ADataSet.DataSource = nil then
      Break
    else
      ADataSet := ADataSet.DataSource.DataSet;
  end;
  Result := False;
end;

{ TcxCustomDBLookupEditLookupData }

procedure TcxCustomDBLookupEditLookupData.DoSetCurrentKey(ARecordIndex: Integer);
begin
  FCurrentKey := Properties.GetKeyByRecordIndex(ARecordIndex);
end;

procedure TcxCustomDBLookupEditLookupData.DoSyncGrid;
begin
  if DataController <> nil then
    try
      Properties.LockDataChanged;
      try
        DataController.LocateByKey(GetCurrentKey);
      finally
        Properties.UnlockDataChanged;
      end;
    except
      on EVariantError do;
      on EDatabaseError do;
    end;
end;

function TcxCustomDBLookupEditLookupData.GetDataController: TcxDBDataController;
begin
  Result := Properties.DataController;
end;

function TcxCustomDBLookupEditLookupData.GetProperties: TcxCustomDBLookupEditProperties;
begin
  Result := TcxCustomDBLookupEditProperties(inherited Properties);
end;

{ TcxCustomDBLookupEditProperties }

destructor TcxCustomDBLookupEditProperties.Destroy;
begin
  SetLookupField(nil);
  FreeAndNil(FLookupSourceFreeNotificator);
  FLookupList.Free;
  FLookupList := nil;
  FreeAndNil(FCachedLookupSource);
  inherited Destroy;
end;

procedure TcxCustomDBLookupEditProperties.Assign(Source: TPersistent);
begin
  if Source is TcxCustomDBLookupEditProperties then
  begin
    BeginUpdate;
    try
      inherited Assign(Source);
      CaseSensitiveSearch := TcxCustomDBLookupEditProperties(Source).CaseSensitiveSearch;
      if not IsDefinedByLookup then
        KeyFieldNames := TcxCustomDBLookupEditProperties(Source).KeyFieldNames;
    finally
      EndUpdate;
    end
  end
  else
    inherited Assign(Source);
end;

procedure TcxCustomDBLookupEditProperties.Changed;
begin
  CheckLookupList;
  CheckLookup;
  CheckLookupColumn;
  inherited Changed;
end;

class function TcxCustomDBLookupEditProperties.GetContainerClass: TcxContainerClass;
begin
  Result := TcxCustomDBLookupEdit;
end;

function TcxCustomDBLookupEditProperties.GetDataField: TField;
var
  ADefaultValuesProvider: TcxCustomEditDefaultValuesProvider;
begin
  Result := nil;
  if IDefaultValuesProvider <> nil then
  begin
    ADefaultValuesProvider := TcxCustomEditDefaultValuesProvider(IDefaultValuesProvider.GetInstance);
    if ADefaultValuesProvider is TcxCustomDBEditDefaultValuesProvider then
      Result := TcxCustomDBEditDefaultValuesProvider(ADefaultValuesProvider).Field;
  end;
end;

function TcxCustomDBLookupEditProperties.GetEditValueSource(AEditFocused: Boolean): TcxDataEditValueSource;
begin
  if GetLookupField <> nil then
  begin
    if AEditFocused then
      Result := evsKey
    else
      Result := evsText;
  end
  else
    Result := inherited GetEditValueSource(AEditFocused);
end;

function TcxCustomDBLookupEditProperties.GetLookupField: TField;
begin
  Result := GetDataField;
  if (Result <> nil) and (not Result.Lookup or (csDestroying in Result.ComponentState)) then
    Result := nil;
end;

function TcxCustomDBLookupEditProperties.IsLookupField: Boolean;
begin
  Result := GetLookupField <> nil;
end;

procedure TcxCustomDBLookupEditProperties.PrepareDisplayValue(
  const AEditValue: TcxEditValue; var DisplayValue: TcxEditValue;
  AEditFocused: Boolean);
begin
  if CanDisplayArbitraryEditValue and (DropDownListStyle <> lsEditList) and
    not AEditFocused then
      DisplayValue := VarToStr(AEditValue)
  else
    inherited PrepareDisplayValue(AEditValue, DisplayValue, AEditFocused);
end;

procedure TcxCustomDBLookupEditProperties.DBLookupGridBeginUpdate;
begin
end;

procedure TcxCustomDBLookupEditProperties.DBLookupGridCheckColumnByFieldName(const AFieldName: string);
begin
end;

procedure TcxCustomDBLookupEditProperties.DBLookupGridCreateColumnsByFieldNames(const AFieldNames: string);
begin
end;

procedure TcxCustomDBLookupEditProperties.DBLookupGridEndUpdate;
begin
end;

function TcxCustomDBLookupEditProperties.GetDBLookupGridColumnField(AIndex: Integer): TField;
begin
  Result := nil;
end;

function TcxCustomDBLookupEditProperties.GetDBLookupGridColumnFieldName(AIndex: Integer): string;
begin
  Result := '';
end;

function TcxCustomDBLookupEditProperties.GetDBLookupGridColumnIndexByFieldName(const AFieldName: string): Integer;
begin
  Result := -1;
end;

function TcxCustomDBLookupEditProperties.GetDBLookupGridDataController: TcxDBDataController;
begin
  Result := nil;
end;

function TcxCustomDBLookupEditProperties.CanDisplayArbitraryEditValue: Boolean;
var
  AKeyField: TField;
begin
  Result := False; // TODO: method in DataController?
  if (KeyFieldNames <> '') and not IsMultipleFieldNames(KeyFieldNames) and
    (DataController <> nil) and (DataController.DataSet <> nil) then
  begin
    AKeyField := DataController.DataSet.FindField(KeyFieldNames);
    if AKeyField <> nil then
      Result := (AKeyField = GetListField) and
        ((DropDownListStyle = lsEditList) or (AKeyField is TStringField));
  end;
end;

procedure TcxCustomDBLookupEditProperties.CheckLookup;

  procedure CheckListSource;
  var
    AField: TField;
  begin
    AField := GetDataField;
    if Assigned(AField) and Assigned(DataController) and Assigned(DataController.DataSource) and
//      AField.DataSet.IsLinkedTo(DataController.DataSource) then
      IsLinkedToDataSet(DataController.DataSource, AField.DataSet) then
      DatabaseError(SCircularDataLink);
  end;

begin
  SetLookupField(GetLookupField);
  CheckListSource;
end;

procedure TcxCustomDBLookupEditProperties.CheckLookupColumn;
var
  AFieldName: string;
begin
  AFieldName := GetLookupResultFieldName;
  if AFieldName <> '' then
    DBLookupGridCheckColumnByFieldName(AFieldName);
end;

procedure TcxCustomDBLookupEditProperties.CheckLookupList;
begin
  if FLookupList <> nil then
    FLookupList.Clear;
  if (DataController <> nil) then
    DataController.DataModeController.GridMode := IsUseLookupList;
end;

procedure TcxCustomDBLookupEditProperties.DefaultValuesProviderDestroyed;
begin
  inherited DefaultValuesProviderDestroyed;
  BeginUpdate;
  try
    Changed;
  finally
    EndUpdate(False);
  end;
end;

procedure TcxCustomDBLookupEditProperties.DefineByLookupError;
begin
  DatabaseError(SPropDefByLookup);
end;

function TcxCustomDBLookupEditProperties.IsPickMode: Boolean;
begin
  Result := (DropDownListStyle = lsEditList) and CanDisplayArbitraryEditValue;
end;

procedure TcxCustomDBLookupEditProperties.LockDataChanged;