cxmclistbox.pas

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

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

{$I cxVer.inc}

interface

uses
  Windows, Classes, Controls, ExtCtrls, Forms, Graphics, ImgList, Messages,
  StdCtrls, SysUtils, cxClasses, cxContainer, cxControls, cxDataUtils, cxCustomData,
  cxEdit, cxExtEditConsts, cxExtEditUtils, cxGraphics, cxHeader, cxLookAndFeelPainters,
  cxLookAndFeels, cxScrollBar;

type
  TcxMCInnerHeader = class;
  TcxMCListBox = class;

  { TcxMCInnerHeader }

  TcxMCInnerHeader = class(TcxHeader, IUnknown,
    IcxContainerInnerControl)
  private
    FContainer: TcxContainer;
    function GetControlContainer: TcxContainer;
    function GetControl: TWinControl;
    function GetContainer: TcxMCListBox;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  protected
    procedure AdjustSize; override;
    procedure Click; override;
//    procedure DoSectionEndResizeEvent(Section: TcxHeaderSection); override;
    function IsInnerControl: Boolean; override;
    procedure LookAndFeelChanged(Sender: TcxLookAndFeel;
      AChangedValues: TcxLookAndFeelValues); override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
//    procedure AdjustScrollWidth;
    procedure UpdateHeight;
    property Container: TcxMCListBox read GetContainer;
  public
    constructor Create(AOwner: TComponent); override;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    function UpdateAction(Action: TBasicAction): Boolean; override;
  end;

  { TcxMCInnerListBox }

  TcxMCInnerListBox = class(TcxCustomInnerListBox)
  private
    FItems: TStrings;
    FVScrollBarVisible: Boolean;
    function GetContainer: TcxMCListBox;
    function IsVScrollBarVisible: Boolean;
    procedure ItemsChanged(Sender: TStrings; AStartIndex, AEndIndex: Integer);
    procedure SetContainer(Value: TcxMCListBox);
    procedure SetItems(Value: TStrings);
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  protected
    property Container: TcxMCListBox read GetContainer write SetContainer;
    procedure Click; override;
    procedure RecalcItemRects(AStartIndex: Integer = -1;
      AEndIndex: Integer = -1); virtual;
    procedure DrawLines; virtual;
    procedure FullRepaint; virtual;
    property VScrollBarVisible: Boolean read FVScrollBarVisible;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function CanFocus: Boolean; override;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    function UpdateAction(Action: TBasicAction): Boolean; override;
  published
    property Items: TStrings read FItems write SetItems;
  end;

  { TcxMCInnerPanel }

  TcxMCInnerPanel = class(TcxControl)
  private
    function GetMCListBox: TcxMCListBox;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  protected
    procedure AdjustChildsPosition;
    procedure BoundsChanged; override;
    procedure LookAndFeelChanged(Sender: TcxLookAndFeel;
      AChangedValues: TcxLookAndFeelValues); override;
    procedure Paint; override;
    property MCListBox: TcxMCListBox read GetMCListBox;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  { TcxMCListBox }

  TcxMCListBox = class(TcxContainer)
  private
    FAlignment: TAlignment;
    FColumnLineColor: TColor;
    FDelimiter: Char;
    FInnerHeader: TcxMCInnerHeader;
    FInnerHeaderSectionRectsWithoutScrollbar: TcxHeaderSectionRects;
    FInnerHeaderSectionRectsWithScrollbar: TcxHeaderSectionRects;
    FInnerListBox:  TcxMCInnerListBox;
    FInnerPanel: TcxMCInnerPanel;
    FIntegralHeight: Boolean;
    FInternalFlagCreatedHeader: Boolean;
    FInternalPaint: Boolean;
    FIsExitProcessing: Boolean;
    FMultiLines: Boolean;
    FOverflowEmptyColumn: Boolean;
    FOverLoadList: TStringList;
    FSavedHScroll: TScrollEvent;
    FSavedIndex: Integer;
    FShowColumnLines: Boolean;
    FShowEndEllipsis: Boolean;
    FShowHeader: Boolean;
    function CalcCellTextRect(AApproximateRect: TRect; AItemIndex, AColumnIndex: Integer): TRect;
    procedure DrawCellTextEx(var ARect: TRect; AFlags, AItemIndex, AColumnIndex: Integer);
    procedure DrawCellText(ARect: TRect; AItemIndex, AColumnIndex: Integer);
    function GetCellRect(AItemIndex, AColumnIndex, ATop, ABottom: Integer;
      AVScrollBarVisible: Boolean): TRect;
    function GetCellTextRect(AItemIndex, AColumnIndex, ATop, ABottom: Integer;
      AVScrollBarVisible: Boolean): TRect;
    function GetDelimiter: Char;
    function GetImages: TCustomImageList;
    procedure SetImages(Value: TCustomImageList);
    function GetHeaderSectionRect(AIndex: Integer;
      AVScrollBarVisible: Boolean): TRect;
    function GetHeaderSections: TcxHeaderSections;
    procedure SetHeaderSections(Value: TcxHeaderSections);
    procedure SectionEndResizeHandler(HeaderControl: TcxCustomHeader;
      Section: TcxHeaderSection);
    procedure SectionTrackHandler(HeaderControl: TcxCustomHeader;
      Section: TcxHeaderSection; Width: Integer; State: TcxSectionTrackState);
    procedure SetMultiLines(Value: Boolean);
    procedure SetAlignment(Value: TAlignment);
    procedure SetShowEndEllipsis(Value: Boolean);
    procedure SetDelimiter(Value: Char);
    function GetHeaderDragReorder: Boolean;
    procedure SetHeaderDragReorder(Value: Boolean);
    procedure SetShowColumnLines(Value: Boolean);
    procedure SetShowHeader(Value: Boolean);
    procedure SetColumnLineColor(Value: TColor);
    procedure SetOverflowEmptyColumn(Value: Boolean);
    function GetTextPart(AItemIndex, AColumnIndex: Integer): string;
    procedure SectionsChangeHandler(Sender: TObject);
    procedure HScrollHandler(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: Integer);
    procedure SectionEndDragHandler(Sender: TObject);
    procedure DrawItem(Control: TWinControl; Index: Integer; ARect: TRect; State: TOwnerDrawState);
    procedure MeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
    function GetCount: Integer;
    function GetExtendedSelect: Boolean;
    function GetItemHeight: Integer;
    function GetItemIndex: Integer;
    function GetItems: TStrings;
    function GetMultiSelect: Boolean;
    function GetReadOnly: Boolean;
    function GetSelCount: Integer;
    function GetSelected(Index: Integer): Boolean;
    function GetSorted: Boolean;
    function GetTopIndex: Integer;
    procedure SetExtendedSelect(Value: Boolean);
    procedure SetItemHeight(Value: Integer);
    procedure SetItemIndex(Value: Integer);
    procedure SetItems(Value: TStrings);
    procedure SetMultiSelect(Value: Boolean);
    procedure SetReadOnly(Value: Boolean);
    procedure SetSelected(Index: Integer; Value: Boolean);
    procedure SetSorted(Value: Boolean);
    procedure SetTopIndex(Value: Integer);
    function GetAutoComplete: Boolean;
    function GetAutoCompleteDelay: Cardinal;
    procedure SetAutoComplete(Value: Boolean);
    procedure SetAutoCompleteDelay(Value: Cardinal);
    function GetScrollWidth: Integer;
    function GetTabWidth: Integer;
    procedure SetIntegralHeight(Value: Boolean);
    procedure SetScrollWidth(Value: Integer);
    procedure SetTabWidth(Value: Integer);
  protected
    FDataBinding: TcxCustomDataBinding;
    procedure CalcHeaderSectionRects;
    function CalcItemHeight(AIndex: Integer;
      AVScrollBarVisible: Boolean): Integer; virtual;
    procedure CreateWnd; override;
    procedure CursorChanged; override;
    procedure FontChanged; override;
    procedure AdjustInnerControl; override;
    procedure DataChange; override;
    procedure DoExit; 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 Loaded; override;
    function RefreshContainer(const P: TPoint; Button: TcxMouseButton; Shift: TShiftState;
      AIsMouseEvent: Boolean): Boolean; override;
    procedure UpdateData; override;
    function CanResize(var NewWidth, NewHeight: Integer): Boolean; override;
    procedure SetSize; override;
    procedure FullRepaint;
    procedure SectionSortChangedHandler(Sender: TObject;
      const Section: TcxHeaderSection; const ASortOrder: TcxHeaderSortOrder); virtual;
    procedure WndProc(var Message: TMessage); override;
    function GetDataBindingClass: TcxCustomDataBindingClass; virtual;
    procedure GetOptimalHeight(var ANewHeight: Integer);
    property DataBinding: TcxCustomDataBinding read FDataBinding;
    property InnerHeader: TcxMCInnerHeader read FInnerHeader;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
    property ScrollWidth: Integer read GetScrollWidth write SetScrollWidth default 0;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Focused: Boolean; override;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    procedure GetTabOrderList(List: TList); 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;
    property InnerListBox:  TcxMCInnerListBox read FInnerListBox write FInnerListBox;
    property ItemIndex: Integer read GetItemIndex write SetItemIndex;
    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 Alignment: TAlignment read FAlignment write SetAlignment
      default taLeftJustify;
    property AutoComplete: Boolean read GetAutoComplete write SetAutoComplete
      default True;
    property AutoCompleteDelay: Cardinal read GetAutoCompleteDelay
      write SetAutoCompleteDelay default cxDefaultAutoCompleteDelay;
    property Anchors;
    property BiDiMode;
    property ColumnLineColor: TColor read FColumnLineColor
      write SetColumnLineColor default clBtnShadow;
    property Constraints;
    property Delimiter: Char read GetDelimiter write SetDelimiter default #59;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property ExtendedSelect: Boolean read GetExtendedSelect
      write SetExtendedSelect default True;
    property HeaderDragReorder: Boolean read GetHeaderDragReorder
      write SetHeaderDragReorder default False;
    property HeaderSections: TcxHeaderSections read GetHeaderSections
      write SetHeaderSections;
    property Images: TCustomImageList read GetImages write SetImages;
    property ImeMode;
    property ImeName;
    property IntegralHeight: Boolean read FIntegralHeight
      write SetIntegralHeight default False;
    property ItemHeight: Integer read GetItemHeight write SetItemHeight
      default 16;
    property Items: TStrings read GetItems write SetItems;
    property MultiLines: Boolean read FMultiLines write SetMultiLines
      default False;
    property MultiSelect: Boolean read GetMultiSelect write SetMultiSelect
      default False;
    property OverflowEmptyColumn: Boolean read FOverflowEmptyColumn
      write SetOverflowEmptyColumn default True;
    property ParentBiDiMode;
    property ParentColor default False;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowColumnLines: Boolean read FShowColumnLines
      write SetShowColumnLines default True;
    property ShowEndEllipsis: Boolean read FShowEndEllipsis
      write SetShowEndEllipsis default True;
    property ShowHeader: Boolean read FShowHeader write SetShowHeader
      default True;
    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}
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

implementation

uses
{$IFDEF DELPHI6}
  Variants,
{$ENDIF}
  cxVariants, dxThemeConsts, dxThemeManager, dxUxTheme;

type
  TMCStringList = class(TStringList)
  private
    SortOrder: TcxHeaderSortOrder;
    SortColumn: Integer;
    Delimiter: Char;
  public
{$IFDEF DELPHI5}
    procedure CustomSort(Compare: TStringListSortCompare); override;
{$ENDIF}
  end;

  TStringsChangeEvent = procedure(Sender: TStrings;
    AStartIndex, AEndIndex: Integer) of object;

  TcxMCListBoxStrings = class(TStrings)
  private
    FStorage: TStrings;
    FUpdating: Boolean;
    FOnChange: TStringsChangeEvent;
  protected
    function Get(Index: Integer): string; override;
    function GetCount: Integer; override;
    function GetObject(Index: Integer): TObject; override;
    procedure Put(Index: Integer; const S: string); override;
    procedure PutObject(Index: Integer; AObject: TObject); override;
    procedure SetUpdateState(Updating: Boolean); override;
    procedure Changed(AStartIndex: Integer = -1;
      AEndIndex: Integer = -1); virtual;
    property Storage: TStrings read FStorage;
  public
    constructor Create(AStorage: TStrings); virtual;
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Exchange(Index1, Index2: Integer); override;
    function IndexOf(const S: string): Integer; override;
    procedure Insert(Index: Integer; const S: string); override;
    procedure Move(CurIndex, NewIndex: Integer); override;
    property OnChange: TStringsChangeEvent read FOnChange write FOnChange;
  end;

{$IFDEF DELPHI5}
function ListCompare(List: TStringList; Index1, Index2: Integer): Integer;

  function InternalCompareText(const S1, S2: string): Integer;
  begin
    Result := AnsiCompareText(S1, S2);
  end;

var
  s1, s2: string;
  FDelimiter: Char;
begin
  FDelimiter := TMCStringList(List).Delimiter;

  s1 := GetWord(TMCStringList(List).SortColumn, List[Index1], FDelimiter);
  s2 := GetWord(TMCStringList(List).SortColumn, List[Index2], FDelimiter);

  if TMCStringList(List).SortOrder = soAscending then
    Result := InternalCompareText(s1, s2)
  else
    Result := InternalCompareText(s2, s1);
end;

procedure TMCStringList.CustomSort(Compare: TStringListSortCompare);
begin
  inherited CustomSort(ListCompare);
end;
{$ENDIF}

{ TcxMCListBoxStrings }

constructor TcxMCListBoxStrings.Create(AStorage: TStrings);
begin
  inherited Create;
  FStorage := AStorage;
end;

procedure TcxMCListBoxStrings.Clear;
begin
  Storage.Clear;
end;

procedure TcxMCListBoxStrings.Delete(Index: Integer);
begin
  Storage.Delete(Index);
  Changed;