cxlookupedit.pas

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

{********************************************************************}
{                                                                    }
{       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 cxLookupEdit;

{$I cxVer.inc}

interface

uses
{$IFDEF DELPHI6}
  Variants,
{$ENDIF}
  Windows, Messages, SysUtils, Classes, Controls, Graphics, Forms,
  cxClasses, cxGraphics, cxControls, cxContainer, cxLookAndFeels,
  cxEdit, cxTextEdit, cxDropDownEdit, cxDataUtils, cxCustomData;

type
  TcxCustomLookupEdit = class;
  TcxCustomLookupEditProperties = class;

  { TcxCustomLookupEditLookupData }

  TcxLookupGridCloseUpEvent = procedure (Sender: TObject; AAccept: Boolean) of object;

  TcxCustomLookupEditLookupData = class(TcxInterfacedPersistent,
    IUnknown, IcxTextEditLookupData)
  private
    FOwner: TPersistent;
    FVisible: Boolean;
    FOnCurrentKeyChanged: TNotifyEvent;
    FOnSelectItem: TNotifyEvent;
    function GetDataController: TcxCustomDataController;
    function GetEdit: TcxCustomLookupEdit;
    function GetFocusedRecordIndex: Integer;
    function GetListIndex: Integer;
    function GetProperties: TcxCustomLookupEditProperties;
  protected
    FCurrentKey: Variant;
    function GetOwner: TPersistent; override;
    // IcxTextEditLookupData
    function CanResizeVisualArea(var NewSize: TSize;
      AMaxHeight: Integer = 0; AMaxWidth: Integer = 0): Boolean; virtual;
    procedure CloseUp; virtual;
    procedure Deinitialize; virtual;
    procedure DropDown; virtual;
    procedure DroppedDown(const AFindStr: string); virtual;
    function Find(const AText: string): Boolean; virtual;
    function GetActiveControl: TControl;
    function GetCurrentKey: TcxEditValue; virtual;
    function GetDisplayText(const AKey: TcxEditValue): string; virtual;
    function GetOnCurrentKeyChanged: TNotifyEvent;
    function GetOnSelectItem: TNotifyEvent;
    function GetVisualAreaPreferredSize(AMaxHeight: Integer; AWidth: Integer = 0): TSize;
    procedure Go(ADirection: TcxEditLookupDataGoDirection; ACircular: Boolean); virtual;
    procedure Initialize(AVisualControlsParent: TWinControl);
    function IsEmpty: Boolean; virtual;
    function IsMouseOverList(const P: TPoint): Boolean;
    function Locate(var AText, ATail: string; ANext: Boolean): Boolean; virtual;
    procedure PositionVisualArea(const AClientRect: TRect);
    procedure PropertiesChanged; virtual;
    procedure SelectItem; virtual;
    procedure SetCurrentKey(const AKey: TcxEditValue); virtual;
    procedure SetOnCurrentKeyChanged(Value: TNotifyEvent);
    procedure SetOnSelectItem(Value: TNotifyEvent);
    procedure TextChanged; virtual;

    procedure DoCurrentKeyChanged; virtual;
    procedure DoSelectItem; virtual;
    procedure DoSetCurrentKey(ARecordIndex: Integer); virtual;
    procedure DoSetKeySelection(AKeySelected: Boolean);
    procedure DoSyncGrid; virtual;
    procedure GridClick(Sender: TObject); virtual;
    procedure GridCloseUp(Sender: TObject; AAccept: Boolean); virtual;
    procedure GridFocusedRowChanged(Sender: TObject); virtual;
    function IsKeySelected: Boolean; virtual;
    function LocateText(const AText: string): Boolean; virtual;
    procedure ResetIncrementalFilter; virtual;
    procedure SyncGrid; virtual;
    procedure SyncSelected; virtual;
    procedure UpdateDropDownCount; virtual;
    property DataController: TcxCustomDataController read GetDataController;
    property Edit: TcxCustomLookupEdit read GetEdit;
    property FocusedRecordIndex: Integer read GetFocusedRecordIndex;
    property Properties: TcxCustomLookupEditProperties read GetProperties;
  public
    constructor Create(AOwner: TPersistent); override;
    procedure DisableChanging;
    procedure EnableChanging;
  end;

  { TcxCustomLookupEditProperties }

  TcxCustomLookupEditProperties = class(TcxCustomComboBoxProperties)
  private
    FDisplayColumnIndex: Integer;
    FLockCount: Integer;
    FImmediateUpdateText: Boolean;
    FInGridDataChanged: Boolean;
    FIncrementalFiltering: Boolean;
    function GetDataController: TcxCustomDataController;
    function GetDropDownAutoSize: Boolean;
    function GetDropDownHeight: Integer;
    function GetDropDownSizeable: Boolean;
    function GetDropDownWidth: Integer;
    procedure SetDropDownAutoSize(Value: Boolean);
    procedure SetDropDownHeight(Value: Integer);
    procedure SetDropDownSizeable(Value: Boolean);
    procedure SetDropDownWidth(Value: Integer);
  protected
    // LookupGrid methods
    function GetLookupGridActiveControl: TWinControl; virtual;
    function GetLookupGridCanResize: Boolean; virtual;
    function GetLookupGridColumnCount: Integer; virtual;
    function GetLookupGridControl: TWinControl; virtual;
    function GetLookupGridDataController: TcxCustomDataController; virtual;
    function GetLookupGridVisualAreaPreferredWidth: Integer; virtual;
    function GetLookupGridNearestPopupHeight(AHeight: Integer): Integer; virtual;
    function GetLookupGridPopupHeight(ADropDownRowCount: Integer): Integer; virtual;
    function IsLookupGridMouseOverList(const P: TPoint): Boolean; virtual;
    procedure LookupGridDeinitialize; virtual; // IsPopup := False
    procedure LookupGridDroppedDown(const AFindStr: string); virtual;
    procedure LookupGridInitEvents(AOnClick, AOnFocusedRowChanged: TNotifyEvent; AOnCloseUp: TcxLookupGridCloseUpEvent); virtual;
    procedure LookupGridInitialize; virtual; // IsPopup := True
    procedure LookupGridInitLookAndFeel(ALookAndFeel: TcxLookAndFeel; AColor: TColor; AFont: TFont); virtual;
    procedure LookupGridLockMouseMove; virtual;
    procedure LookupGridMakeFocusedRowVisible; virtual;
    procedure LookupGridUnlockMouseMove; virtual;

    procedure CheckDisplayColumnIndex;
    procedure DeinitializeDataController; virtual;
    function FindByText(AItemIndex: Integer; const AText: string; APartialCompare: Boolean): Integer; virtual;
    function FindLookupText(const AText: string): Boolean; override;
    function GetDisplayColumnIndex: Integer; virtual;
    function GetDisplayFormatOptions: TcxEditDisplayFormatOptions; override;
    function GetDisplayLookupText(const AKey: TcxEditValue): string; virtual;
    function GetIncrementalFiltering: Boolean; virtual;
    function GetListIndex: Integer; virtual;
    class function GetLookupDataClass: TcxInterfacedPersistentClass; override;
    function GetNullKey: Variant; virtual;
    procedure GridDataChanged(Sender: TObject); virtual;
    procedure InitializeDataController; virtual;
    function IsChangeLocked: Boolean; virtual;
    function IsDataChangedPostponed: Boolean; virtual;
    function IsEditValueConversionDependOnFocused: Boolean; override;
    function IsPickMode: Boolean; virtual;
    function IsPopupKey(Key: Word; Shift: TShiftState): Boolean; override;
    procedure LockDataChanged; virtual;
    procedure SetDisplayColumnIndex(Value: Integer); virtual;
    procedure UnlockDataChanged; virtual;
    procedure UnlinkLookupGridControlParent; virtual;
    property DataController: TcxCustomDataController read GetDataController;
    property DisplayColumnIndex: Integer read GetDisplayColumnIndex write SetDisplayColumnIndex default 0;
    property ImmediateUpdateText: Boolean read FImmediateUpdateText write FImmediateUpdateText default False;
  public
    constructor Create(AOwner: TPersistent); override;
    procedure Assign(Source: TPersistent); override;
    class function GetContainerClass: TcxContainerClass; override;
    function GetEditValueSource(AEditFocused: Boolean): TcxDataEditValueSource; override;
    function GetSupportedOperations: TcxEditSupportedOperations; override;
    function IsDefinedByLookup: Boolean; virtual;
    function IsEditValueValid(var EditValue: TcxEditValue; AEditFocused: Boolean): Boolean; override;
    function IsLookupField: Boolean; virtual;
    procedure PrepareDisplayValue(const AEditValue: TcxEditValue; var DisplayValue: TcxEditValue;
      AEditFocused: Boolean); override;
    property DropDownAutoSize: Boolean read GetDropDownAutoSize write SetDropDownAutoSize default False;
    property DropDownHeight: Integer read GetDropDownHeight write SetDropDownHeight default 0;
    property DropDownListStyle default lsEditFixedList;
    property DropDownSizeable: Boolean read GetDropDownSizeable write SetDropDownSizeable default False;
    property DropDownWidth: Integer read GetDropDownWidth write SetDropDownWidth default 0;
    property IncrementalFiltering: Boolean read FIncrementalFiltering write FIncrementalFiltering default True;
  end;

  { TcxCustomLookupEdit }

  TcxCustomLookupEdit = class(TcxCustomComboBox)
  private
    function GetILookupData: IcxTextEditLookupData;
    function GetLookupData: TcxCustomLookupEditLookupData;
    function GetProperties: TcxCustomLookupEditProperties;
    function GetActiveProperties: TcxCustomLookupEditProperties;
    procedure SetLookupData(Value: TcxCustomLookupEditLookupData);
    procedure SetProperties(Value: TcxCustomLookupEditProperties);
  protected
    procedure AfterPosting; override;
    procedure BeforePosting; override;
    procedure DoShowEdit; override;
    procedure DropDown; override;
    procedure Initialize; override;
    function InternalGetEditingValue: TcxEditValue; override;
    function NeedResetInvalidTextWhenPropertiesChanged: Boolean; override;
    procedure RepositoryItemAssigning; override;
    procedure SynchronizeDisplayValue; override;
    property ILookupData: IcxTextEditLookupData read GetILookupData;
    property LookupData: TcxCustomLookupEditLookupData read GetLookupData write SetLookupData;
  public
    class function GetPropertiesClass: TcxCustomEditPropertiesClass; override;
    procedure PrepareEditValue(const ADisplayValue: TcxEditValue; out EditValue: TcxEditValue; AEditFocused: Boolean); override;
    property ActiveProperties: TcxCustomLookupEditProperties read GetActiveProperties;
    property Properties: TcxCustomLookupEditProperties read GetProperties
      write SetProperties;
  end;

implementation

// TODO: Field.DisplayText <> Field.AsString <- DataSet.Locate

{ TcxCustomLookupEditLookupData }

constructor TcxCustomLookupEditLookupData.Create(AOwner: TPersistent);
begin
  inherited Create(nil);
  FOwner := AOwner;
  FCurrentKey := Null;
end;

procedure TcxCustomLookupEditLookupData.DisableChanging;
begin
  Inc(Properties.FLockCount);
end;

procedure TcxCustomLookupEditLookupData.EnableChanging;
begin
  Dec(Properties.FLockCount);
end;

function TcxCustomLookupEditLookupData.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

// IcxTextEditLookupData

function TcxCustomLookupEditLookupData.CanResizeVisualArea(var NewSize: TSize;
  AMaxHeight: Integer = 0; AMaxWidth: Integer = 0): Boolean;
begin
  if (AMaxHeight > 0) and (NewSize.cy > AMaxHeight) then
    NewSize.cy := AMaxHeight;
  if Properties.GetLookupGridCanResize then
    NewSize.cy := Properties.GetLookupGridNearestPopupHeight(NewSize.cy);
  Result := True;
end;

procedure TcxCustomLookupEditLookupData.CloseUp;
begin
  DisableChanging;
  try
//    if Properties.GetLookupGridControl <> nil then
//      Properties.GetLookupGridControl.Parent := nil;
    ResetIncrementalFilter;
    FVisible := False;
    Properties.LookupGridInitEvents(nil, nil, nil);
    Properties.LookupGridUnlockMouseMove;
    Properties.LookupGridDeinitialize;
    Properties.UnlockDataChanged;
  finally
    EnableChanging;
  end;
end;

procedure TcxCustomLookupEditLookupData.Deinitialize;
begin
//  if Properties.GetLookupGridControl <> nil then
//    Properties.GetLookupGridControl.Parent := nil;
  Properties.UnlinkLookupGridControlParent
end;

procedure TcxCustomLookupEditLookupData.DropDown;
begin
  DisableChanging;
  try
    Properties.LockDataChanged;
    Properties.LookupGridInitialize;
    Properties.LookupGridInitEvents(GridClick, GridFocusedRowChanged, GridCloseUp);
    Properties.LookupGridInitLookAndFeel(Edit.PopupControlsLookAndFeel,
      Edit.ActiveStyle.Color, Edit.ActiveStyle.GetVisibleFont);
    Properties.LookupGridLockMouseMove;
    FVisible := True;
    SyncGrid;
    SyncSelected;
  finally
    EnableChanging;
  end;
end;

procedure TcxCustomLookupEditLookupData.DroppedDown(const AFindStr: string);
begin
  Properties.LookupGridDroppedDown(AFindStr);
end;

function TcxCustomLookupEditLookupData.Find(const AText: string): Boolean;
begin
  Result := Properties.FindLookupText(AText);
end;

function TcxCustomLookupEditLookupData.GetActiveControl: TControl;
begin
  Result := Properties.GetLookupGridActiveControl;
end;

function TcxCustomLookupEditLookupData.GetCurrentKey: TcxEditValue;
begin
  Result := FCurrentKey;
end;

function TcxCustomLookupEditLookupData.GetDisplayText(const AKey: TcxEditValue): string;
begin
  Result := Properties.GetDisplayLookupText(AKey);
end;

function TcxCustomLookupEditLookupData.GetOnCurrentKeyChanged: TNotifyEvent;
begin
  Result := FOnCurrentKeyChanged;
end;

function TcxCustomLookupEditLookupData.GetOnSelectItem: TNotifyEvent;
begin
  Result := FOnSelectItem;
end;

function TcxCustomLookupEditLookupData.GetVisualAreaPreferredSize(AMaxHeight: Integer;
  AWidth: Integer = 0): TSize;
var
  ARowCount: Integer;
begin
  Result.cx := Properties.GetLookupGridVisualAreaPreferredWidth;
  // auto correct
  ARowCount := Properties.DropDownRows;
  if (DataController <> nil) and (DataController.GetRowCount < ARowCount) then
    ARowCount := DataController.GetRowCount;
  if ARowCount < 1 then
    ARowCount := 1;
  Result.cy := Properties.GetLookupGridPopupHeight(ARowCount);
end;

procedure TcxCustomLookupEditLookupData.Go(ADirection: TcxEditLookupDataGoDirection;
  ACircular: Boolean);
begin
  if (DataController = nil) or (DataController.RecordCount = 0) then Exit;
  DisableChanging;
  try
    ResetIncrementalFilter;
    UpdateDropDownCount;
    Properties.LockDataChanged;
    try
      if ADirection = egdBegin then
        DataController.GotoFirst
      else
        if ADirection = egdEnd then
          DataController.GotoLast
        else
        begin
          SyncGrid;
          if ADirection in [egdNext, egdPageDown] then
          begin
            if ACircular and DataController.IsEOF then
              DataController.GotoFirst
            else
              if ADirection = egdNext then
                DataController.GotoNext
              else
                DataController.MoveBy(Properties.DropDownRows);
          end
          else