cxlistbox.pas

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

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressCommonLibrary                                         }
{                                                                    }
{       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 EXPRESSCOMMONLIBRARY 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 cxListBox;

{$I cxVer.inc}

interface

uses
  Windows, Messages,
  Classes, Controls, Forms, Menus, StdCtrls, SysUtils, cxClasses, cxControls,
  cxContainer, cxDataUtils, cxGraphics, cxLookAndFeels, cxScrollBar;

type
  TcxListBox = class;

  { TcxInnerListBox }

  TcxInnerListBox = class(TcxCustomInnerListBox)
  private
    function GetContainer: TcxListBox;
    procedure SetContainer(Value: TcxListBox);
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  protected
    procedure Click; override;
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    property Container: TcxListBox read GetContainer write SetContainer;
  public
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    function UpdateAction(Action: TBasicAction): Boolean; override;
{$IFDEF DELPHI5}
    function CanFocus: Boolean; override;
{$ENDIF}
  end;

  TcxInnerListBoxClass = class of TcxInnerListBox;

  { TcxListBox }

  TcxListBoxDrawItemEvent = procedure(AControl: TcxListBox; ACanvas: TcxCanvas;
    AIndex: Integer; ARect: TRect; AState: TOwnerDrawState) of object;
  TcxListBoxMeasureItemEvent = procedure(AControl: TcxListBox; AIndex: Integer;
    var Height: Integer) of object;

  TcxListBox = class(TcxContainer)
  private
    FInnerListBox: TcxInnerListBox;
    FIntegralHeight: Boolean;
    FIsExitProcessing: Boolean;
    FOnDrawItem: TcxListBoxDrawItemEvent;
    FOnMeasureItem: TcxListBoxMeasureItemEvent;
    procedure DoMeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
    function GetAutoComplete: Boolean;
    function GetAutoCompleteDelay: Cardinal;
    function GetColumns: Integer;
    function GetCount: Integer;
    function GetExtendedSelect: Boolean;
    function GetInnerListBox: TListBox;
    function GetItemHeight: Integer;
    function GetItemIndex: Integer;
    function GetItemObject: TObject;
    function GetItems: TStrings;
    function GetListStyle: TListBoxStyle;
    function GetMultiSelect: Boolean;
    function GetReadOnly: Boolean;
    function GetSelCount: Integer;
    function GetSelected(Index: Integer): Boolean;
    function GetSorted: Boolean;
    function GetTopIndex: Integer;
    procedure SetAutoComplete(Value: Boolean);
    procedure SetAutoCompleteDelay(Value: Cardinal);
    procedure SetColumns(Value: Integer);
    procedure SetExtendedSelect(Value: Boolean);
    procedure SetItemHeight(Value: Integer);
    procedure SetItemIndex(Value: Integer);
    procedure SetItemObject(Value: TObject);
    procedure SetItems(Value: TStrings);
    procedure SetListStyle(Value: TListBoxStyle);
    procedure SetMultiSelect(Value: Boolean);
    procedure SetOnMeasureItem(Value: TcxListBoxMeasureItemEvent);
    procedure SetReadOnly(Value: Boolean);
    procedure SetSelected(Index: Integer; Value: Boolean);
    procedure SetSorted(Value: Boolean);
    procedure SetTopIndex(Value: Integer);
  {$IFDEF DELPHI6}
    function GetOnData: TLBGetDataEvent;
    function GetOnDataFind: TLBFindDataEvent;
    function GetOnDataObject: TLBGetDataObjectEvent;
    procedure SetCount(Value: Integer);
    procedure SetOnData(Value: TLBGetDataEvent);
    procedure SetOnDataFind(Value: TLBFindDataEvent);
    procedure SetOnDataObject(Value: TLBGetDataObjectEvent);
  {$ENDIF}
    function GetScrollWidth: Integer;
    function GetTabWidth: Integer;
    procedure SetIntegralHeight(Value: Boolean);
    procedure SetScrollWidth(Value: Integer);
    procedure SetTabWidth(Value: Integer);
  protected
    FDataBinding: TcxCustomDataBinding;
    procedure DataChange; override;
    procedure DoExit; override;
    procedure FontChanged; override;
    function IsInternalControl(AControl: TControl): Boolean; override;
    function IsReadOnly: Boolean; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure UpdateData; override;
    function CanResize(var NewWidth, NewHeight: Integer): Boolean; override;
    procedure SetSize; override;
    procedure WndProc(var Message: TMessage); override;
    function DrawItem(ACanvas: TcxCanvas; AIndex: Integer; const ARect: TRect;
      AState: TOwnerDrawState): Boolean; virtual;
    function GetDataBindingClass: TcxCustomDataBindingClass; virtual;
    function GetInnerListBoxClass: TcxInnerListBoxClass; virtual;
    procedure GetOptimalHeight(var ANewHeight: Integer);
    property DataBinding: TcxCustomDataBinding read FDataBinding;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    function UpdateAction(Action: TBasicAction): Boolean; override;
    procedure AddItem(AItem: string; AObject: TObject);
    procedure Clear;
    procedure ClearSelection;
    procedure DeleteSelected;
    function ItemAtPos(const APos: TPoint; AExisting: Boolean): Integer;
    function ItemRect(Index: Integer): TRect;
    function ItemVisible(Index: Integer): Boolean;
    procedure SelectAll;
{$IFDEF DELPHI6}
    procedure CopySelection(ADestination: TCustomListControl);
    procedure MoveSelection(ADestination: TCustomListControl);
{$ENDIF}
    property Count: Integer read GetCount{$IFDEF DELPHI6} write SetCount{$ENDIF};
    property InnerListBox: TListBox read GetInnerListBox;
    property ItemIndex: Integer read GetItemIndex write SetItemIndex;
    property ItemObject: TObject read GetItemObject write SetItemObject;
    property SelCount: Integer read GetSelCount;
    property Selected[Index: Integer]: Boolean read GetSelected write SetSelected;
    property TopIndex: Integer read GetTopIndex write SetTopIndex;
  published
    property Align;
    property Anchors;
    property AutoComplete: Boolean read GetAutoComplete write SetAutoComplete
      default True;
    property AutoCompleteDelay: Cardinal read GetAutoCompleteDelay
      write SetAutoCompleteDelay default cxDefaultAutoCompleteDelay;
    property BiDiMode;
    property Columns: Integer read GetColumns write SetColumns default 0;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property ExtendedSelect: Boolean read GetExtendedSelect
      write SetExtendedSelect default True;
    property ImeMode;
    property ImeName;
    property IntegralHeight: Boolean read FIntegralHeight
      write SetIntegralHeight default False;
    property ItemHeight: Integer read GetItemHeight write SetItemHeight;
    property Items: TStrings read GetItems write SetItems;
    property ListStyle: TListBoxStyle read GetListStyle write SetListStyle
      default lbStandard;
    property MultiSelect: Boolean read GetMultiSelect write SetMultiSelect
      default False;
    property ParentBiDiMode;
    property ParentColor default False;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property ScrollWidth: Integer read GetScrollWidth write SetScrollWidth
      default 0;
    property ShowHint;
    property Sorted: Boolean read GetSorted write SetSorted default False;
    property Style;
    property StyleDisabled;
    property StyleFocused;
    property StyleHot;
    property TabOrder;
    property TabStop;
    property TabWidth: Integer read GetTabWidth write SetTabWidth default 0;
    property Visible;
    property OnClick;
  {$IFDEF DELPHI5}
    property OnContextPopup;
  {$ENDIF}
  {$IFDEF DELPHI6}
    property OnData: TLBGetDataEvent read GetOnData write SetOnData;
    property OnDataFind: TLBFindDataEvent read GetOnDataFind write SetOnDataFind;
    property OnDataObject: TLBGetDataObjectEvent read GetOnDataObject
      write SetOnDataObject;
  {$ENDIF}
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem: TcxListBoxDrawItemEvent read FOnDrawItem
      write FOnDrawItem;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem: TcxListBoxMeasureItemEvent read FOnMeasureItem
      write SetOnMeasureItem;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

implementation

uses
{$IFDEF DELPHI6}
  Variants,
{$ENDIF}
  Graphics, cxEdit;

type
  TWinControlAccess = class(TWinControl);

{ TcxInnerListBox }

function TcxInnerListBox.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or
    Container.FDataBinding.ExecuteAction(Action);
end;

function TcxInnerListBox.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or
    Container.FDataBinding.UpdateAction(Action);
end;

{$IFDEF DELPHI5}
function TcxInnerListBox.CanFocus: Boolean;
begin
  Result := Container.CanFocusEx;
end;
{$ENDIF}

procedure TcxInnerListBox.Click;
begin
  if Container.DataBinding.SetEditMode then
    inherited Click;
end;

procedure TcxInnerListBox.CreateWindowHandle(const Params: TCreateParams);
begin
  inherited CreateWindowHandle(Params);
  SetExternalScrollBarsParameters;
end;

procedure TcxInnerListBox.DrawItem(Index: Integer; Rect: TRect;
  State: TOwnerDrawState);
begin
  if not Container.DrawItem(Canvas, Index, Rect, State) then
    inherited DrawItem(Index, Rect, State);
end;

function TcxInnerListBox.GetContainer: TcxListBox;
begin
  Result := TcxListBox(Owner);
end;

procedure TcxInnerListBox.SetContainer(Value: TcxListBox);
begin
  FContainer := Value;
end;

procedure TcxInnerListBox.WMLButtonDown(var Message: TWMLButtonDown);
begin
  if Container.DataBinding.SetEditMode then
    inherited
  else
  begin
    SetFocus;
    with Message do
      MouseDown(mbLeft, KeysToShiftState(Keys), XPos, YPos);
  end;
end;

{ TcxListBox }

constructor TcxListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataBinding := GetDataBindingClass.Create(Self, Self);
  with FDataBinding do
  begin
    OnDataChange := Self.DataChange;
    OnDataSetChange := Self.DataSetChange;
    OnUpdateData := Self.UpdateData;
  end;
  FInnerListBox := GetInnerListBoxClass.Create(Self);
  FInnerListBox.BorderStyle := bsNone;
  FInnerListBox.Parent := Self;
  FInnerListBox.Container := Self;
  InnerControl := FInnerListBox;
  FInnerListBox.LookAndFeel.MasterLookAndFeel := Style.LookAndFeel;
  Width := 121;
  Height := 97;
end;

destructor TcxListBox.Destroy;
begin
  FreeAndNil(FInnerListBox);
  FreeAndNil(FDataBinding);
  inherited Destroy;
end;

function TcxListBox.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or
    FDataBinding.ExecuteAction(Action);
end;

function TcxListBox.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or
    FDataBinding.UpdateAction(Action);
end;

procedure TcxListBox.AddItem(AItem: string; AObject: TObject);
begin
  FInnerListBox.AddItem(AItem, AObject);
end;

procedure TcxListBox.Clear;
begin
  FInnerListBox.Clear;
end;

procedure TcxListBox.ClearSelection;
begin
  FInnerListBox.ClearSelection;
end;

procedure TcxListBox.DeleteSelected;
begin
  FInnerListBox.DeleteSelected;
end;

function TcxListBox.ItemAtPos(const APos: TPoint; AExisting: Boolean): Integer;
begin
  with FInnerListBox do
    Result := ItemAtPos(Point(APos.X - Left, APos.Y - Top), AExisting);
end;

function TcxListBox.ItemRect(Index: Integer): TRect;
begin
  Result := FInnerListBox.ItemRect(Index);
  OffsetRect(Result, FInnerListBox.Left, FInnerListBox.Top);
end;

function TcxListBox.ItemVisible(Index: Integer): Boolean;
begin
  Result := FInnerListBox.ItemVisible(Index);
end;

procedure TcxListBox.SelectAll;
begin
  FInnerListBox.SelectAll;
end;

{$IFDEF DELPHI6}
procedure TcxListBox.CopySelection(ADestination: TCustomListControl);
begin
  FInnerListBox.CopySelection(ADestination);
end;

procedure TcxListBox.MoveSelection(ADestination: TCustomListControl);
begin
  FInnerListBox.MoveSelection(ADestination);
end;
{$ENDIF}

procedure TcxListBox.DataChange;
begin
  if DataBinding.IsDataSourceLive then
    ItemIndex := Items.IndexOf(VarToStr(DataBinding.GetStoredValue(evsText, Focused)))
  else
    ItemIndex := -1;
end;

procedure TcxListBox.DoExit;
begin
  if IsDestroying or FIsExitProcessing then
    Exit;
  FIsExitProcessing := True;
  try
    try
      DataBinding.UpdateDataSource;
    except
      SetFocus;