aimctrls.pas

来自「delphi编程控件」· PAS 代码 · 共 1,680 行 · 第 1/4 页

unit aimctrls;
(*
 COPYRIGHT (c) RSD Software 1997 - 98
 All Rights Reserved.
*)
{$I aclver.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls{$IFDEF DELPHI4}, ImgList{$ENDIF};

type
  TAutoImageAlign = (aliLeft, aliRight);
  TVertAlignment = (tvaTop, tvaCenter, tvaBottom);
  TAutoImageDrawItemEvent = procedure(Sender : TObject; Index: Integer; Rect: TRect) of object;


TAutoCustomImageListBox = class(TCustomListBox)
private
  FImageList : TImageList;
  FChangeLink : TChangeLink;
  FAlignment : TAlignment;
  FVertAlignment : TVertAlignment;
  FImageAlign : TAutoImageAlign;
  FMultiLines : Boolean;
  FItemHeight : Integer;
  FOnDrawItem : TAutoImageDrawItemEvent;
  FDrawEdgeIndex : Integer;
  FDrawImageOnly : Boolean;
  FDeletedSt : String;
  FDeletedIndex : Integer;
  FHintWindow : THintWindow;
  FHintWindowShowing : Boolean;
  FHintIndex : Integer;
  FItemTextHeight : Integer;

  function GetImageIndex(Index : Integer) : Integer;
  function GetValue(Index : Integer) : String;
  procedure SetImageIndex(Index : Integer; Value : Integer);
  procedure SetImageList(Value : TImageList);
  procedure SetAlignment(Value : TAlignment);
  procedure SetImageAlign(Value : TAutoImageAlign);
  procedure SetItemHeight(Value : Integer);
  procedure SetMultiLines(Value : Boolean);
  procedure SetVertAlignment(Value : TVertAlignment);
  procedure SetValue(Index : Integer; const Value : String);
  procedure StringsRead(Reader: TReader);
  procedure StringsWrite(Writer: TWriter);
  procedure SetInheritedItemHeight;
  procedure OnChangeLink(Sender : TObject);
  procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
  function GetImageRect(ItemIndex : Integer) : TRect;
  procedure DrawImageFocus(Index : Integer);
protected
  FStrings : TStrings;
  procedure DrawItem(Index: Integer; Rect: TRect;
    State: TOwnerDrawState); override;
  procedure DefineProperties(Filer: TFiler); override;
  procedure Notification(AComponent: TComponent;
    Operation: TOperation); override;
//  procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;  
  procedure WndProc(var Message : TMessage); override;
  function ValuesIndexOf(Text : String) : Integer;
public
  constructor Create(AOwner : TComponent); override;
  destructor Destroy; override;
  procedure Assign(Source: TPersistent); override;
  procedure AddItem(St :String; ImageIndex : Integer);
  procedure InsertItem(Index: Integer; St :String; ImageIndex : Integer);
  procedure ExchangeItems(Index1, Index2: Integer);  
  procedure MoveItem(CurIndex, NewIndex: Integer);

  property ImageIndexes[Index : Integer] : Integer read GetImageIndex write SetImageIndex;
  property Values[Index : Integer] : String read GetValue write SetValue;
published
  property Alignment : TAlignment read FAlignment write SetAlignment;
  property ImageAlign : TAutoImageAlign read FImageAlign write SetImageAlign;
  property ItemHeight : Integer read FItemHeight write SetItemHeight;
  property ImageList : TImageList read FImageList write SetImageList;
  property MultiLines : Boolean read FMultiLines write SetMultiLines;
  property VertAlignment : TVertAlignment read FVertAlignment write SetVertAlignment;
  property OnDrawItem : TAutoImageDrawItemEvent read FOnDrawItem write FOnDrawItem;
  property Align;
  property BorderStyle;
  property Color;
  property Columns;
  property Ctl3D;
  property DragCursor;
  property DragMode;
  property Enabled;
  property Font;
  property IntegralHeight;
  property Items;
  property ParentColor;
  property ParentCtl3D;
  property ParentFont;
  property ParentShowHint;
  property PopupMenu;
  property ShowHint;
  property Sorted;
  property TabOrder;
  property TabStop;
  property TabWidth;
  property Visible;
  property OnClick;
  property OnDblClick;
  property OnDragDrop;
  property OnDragOver;
  property OnEndDrag;
  property OnEnter;
  property OnExit;
  property OnKeyDown;
  property OnKeyPress;
  property OnKeyUp;
  property OnMouseDown;
  property OnMouseMove;
  property OnMouseUp;
  property OnStartDrag;
end;

TAutoUpDownAlign = (udaBottom, udaLeft, udaRight, udaTop);
TAutoHSpinImageAlign = (hsiLeft, hsiCenter, hsiRight);
TAutoVSpinImageAlign = (vsiTop, vsiCenter, vsiBottom);

TAutoSpinImageItems = class;
TAutoCustomSpinImage = class;

TAutoSpinImageItem = class(TCollectionItem)
private
  Owner : TAutoSpinImageItems;
  FImageIndex : Integer;
  FValue : String;
  FHint : String;

  procedure SetImageIndex(Value : Integer);
  procedure SetValue(Value : String);
  procedure SetHint(Value : String);
public
  constructor Create(Collection : TCollection); override;
  procedure Assign(Source: TPersistent); override;
published
  property ImageIndex : Integer read FImageIndex write SetImageIndex;
  property Hint : String read FHint write SetHint;
  property Value : String read FValue write SetValue;
end;

TAutoSpinImageItems = class(TCollection)
private
  Owner : TAutoCustomSpinImage;

  function GetItem(Index : Integer) : TAutoSpinImageItem;
  procedure SetItem(Index : Integer; Value : TAutoSpinImageItem);
protected
  procedure Update(Item: TCollectionItem); override;
public
  constructor Create(AOwner : TAutoCustomSpinImage);

  function Add : TAutoSpinImageItem;
  function IndexOf(Value : String) : Integer;
  property Items[Index : Integer] : TAutoSpinImageItem read GetItem write SetItem; default;
end;

TASIChange = procedure(Sender: TObject; ItemIndex: Integer) of object;

TAutoCustomSpinImage = class(TCustomControl)
private
  FAutoSize : Boolean;
  FDefaultImages : Boolean;
  FUpDown : TUpDown;
  FBorderStyle: TBorderStyle;
  FChangeLink : TChangeLink;
  FItemIndex : Integer;
  FImageList : TImageList;
  FImageHAlign : TAutoHSpinImageAlign;
  FImageVAlign : TAutoVSpinImageAlign;
  FItems : TAutoSpinImageItems;
  FOnChange : TASIChange;
  FReadOnly : Boolean;
  FUseDblClick : Boolean;

  FStretch : Boolean;
  FUpDownAlign : TAutoUpDownAlign;
  FUpDownOrientation: TUDOrientation;
  FUpDownWidth : Integer;

  procedure SetAutoSize(Value : Boolean);
  procedure SetBorderStyle(Value : TBorderStyle);
  procedure SetDefaultImages(Value : Boolean);
  procedure SetItemIndex(Value : Integer);
  procedure SetImageList(Value : TImageList);
  procedure SetImageHAlign(Value : TAutoHSpinImageAlign);
  procedure SetImageVAlign(Value : TAutoVSpinImageAlign);
  procedure SetItems(Value : TAutoSpinImageItems);
  procedure SetStretch(Value : Boolean);
  procedure SetUpDownAlign(Value : TAutoUpDownAlign);
  procedure SetUpDownOrientation(Value : TUDOrientation);
  procedure SetUpDownWidth(Value : Integer);
  procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  procedure CMExit(var Message: TCMExit); message CM_EXIT;
  procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
  procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
  procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  procedure UpDownClick(Sender: TObject; Button: TUDBtnType);
  procedure OnChangeLink(Sender : TObject);
  procedure MakeAutoSize;
  procedure SetNextItem;
protected
  procedure CreateParams(var Params: TCreateParams); override;
  procedure Notification(AComponent: TComponent;
    Operation: TOperation); override;
  procedure Paint; override;
  procedure Change; virtual;
  function CanChange : Boolean; virtual;
  procedure UpdateItems; virtual;
public
  constructor Create(AOwner : TComponent); override;
  destructor Destroy; override;
published
  property AutoSize : Boolean read FAutoSize write SetAutoSize;
  property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle;
  property Color;
  property DefaultImages : Boolean read FDefaultImages write SetDefaultImages;
  property ImageList : TImageList read FImageList write SetImageList;
  property ImageHAlign : TAutoHSpinImageAlign read FImageHAlign write SetImageHAlign;
  property ImageVAlign : TAutoVSpinImageAlign read FImageVAlign write SetImageVAlign;
  property Items : TAutoSpinImageItems read FItems write SetItems;
  property ItemIndex : Integer read FItemIndex write SetItemIndex;
  property ParentColor;
  property ReadOnly : Boolean read FReadOnly write FReadOnly;
  property TabOrder;
  property TabStop;
  property Stretch : Boolean read FStretch write SetStretch;
  property UpDownAlign : TAutoUpDownAlign read FUpDownAlign write SetUpDownAlign;
  property UpDownOrientation: TUDOrientation read FUpDownOrientation
                              write SetUpDownOrientation;
  property UpDownWidth : Integer read FUpDownWidth write SetUpDownWidth;
  property UseDblClick : Boolean read FUseDblClick write FUseDblClick;
  property OnChange : TASIChange read FOnChange write FOnChange;
end;

TAutoSpinImage = class(TAutoCustomSpinImage)
published
  property Align;
  property Color;
  property Ctl3D;
  property DragCursor;
  property DragMode;
  property Enabled;
  property Font;
  property ParentColor default False;
  property ParentCtl3D;
  property ParentFont;
  property ParentShowHint;
  property PopupMenu;
  property ShowHint;
  property TabOrder;
  property TabStop default True;
  property Visible;
  property OnClick;
  property OnDblClick;
  property OnDragDrop;
  property OnDragOver;
  property OnEndDrag;
  property OnEnter;
  property OnExit;
  property OnKeyDown;
  property OnKeyPress;
  property OnKeyUp;
  property OnMouseDown;
  property OnMouseMove;
  property OnMouseUp;
  property OnStartDrag;
end;

TAutoImageListBox = class(TAutoCustomImageListBox)
published
  property ExtendedSelect;
  property MultiSelect;
end;

TAutoImageComboBox = class(TCustomComboBox)
private
  FImageList : TImageList;
  FChangeLink : TChangeLink;
  FAlignment : TAlignment;
  FVertAlignment : TVertAlignment;
  FImageAlign : TAutoImageAlign;
  FMultiLines : Boolean;
  FItemHeight : Integer;
  FOnDrawItem : TAutoImageDrawItemEvent;
  FDeletedSt : String;
  FDeletedIndex : Integer;

  function GetImageIndex(Index : Integer) : Integer;
  function GetValue(INdex : Integer) : String;
  procedure SetImageIndex(Index : Integer; Value : Integer);
  procedure SetImageList(Value : TImageList);
  procedure SetAlignment(Value : TAlignment);
  procedure SetImageAlign(Value : TAutoImageAlign);
  procedure SetItemHeight(Value : Integer);
  procedure SetMultiLines(Value : Boolean);
  procedure SetVertAlignment(Value : TVertAlignment);
  procedure SetValue(Index : Integer; const Value : String);
  procedure StringsRead(Reader: TReader);
  procedure StringsWrite(Writer: TWriter);
  procedure SetInheritedItemHeight;
  procedure OnChangeLink(Sender : TObject);
  procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
protected
  FStrings : TStrings;
  procedure DrawItem(Index: Integer; Rect: TRect;
    State: TOwnerDrawState); override;
  procedure DefineProperties(Filer: TFiler); override;
  procedure Notification(AComponent: TComponent;
    Operation: TOperation); override;
  procedure WndProc(var Message : TMessage); override;
  function ValuesIndexOf(Text : String) : Integer;
public
  constructor Create(AOwner : TComponent); override;
  destructor Destroy; override;
  procedure Assign(Source: TPersistent); override;
  procedure AddItem(St :String; ImageIndex : Integer);
  procedure InsertItem(Index: Integer; St :String; ImageIndex : Integer);
  procedure ExchangeItems(Index1, Index2: Integer);  
  procedure MoveItem(CurIndex, NewIndex: Integer);

  property Values[Index : Integer] : String read GetValue write SetValue;  
  property ImageIndexes[Index : Integer] : Integer read GetImageIndex write SetImageIndex;
published
  property Alignment : TAlignment read FAlignment write SetAlignment;
  property ImageAlign : TAutoImageAlign read FImageAlign write SetImageAlign;
  property ItemHeight : Integer read FItemHeight write SetItemHeight;
  property ImageList : TImageList read FImageList write SetImageList;
  property MultiLines : Boolean read FMultiLines write SetMultiLines;
  property VertAlignment : TVertAlignment read FVertAlignment write SetVertAlignment;
  property OnDrawItem : TAutoImageDrawItemEvent read FOnDrawItem write FOnDrawItem;
  property Color;
  property Ctl3D;
  property DragMode;
  property DragCursor;
  property DropDownCount;
  property Enabled;
  property Font;
  property Items;
  property MaxLength;
  property ParentColor;
  property ParentCtl3D;
  property ParentFont;
  property ParentShowHint;
  property PopupMenu;
  property ShowHint;
  property Sorted;
  property TabOrder;
  property TabStop;
  property Visible;
  property OnChange;
  property OnClick;
  property OnDblClick;
  property OnDragDrop;
  property OnDragOver;
  property OnDropDown;
  property OnEndDrag;
  property OnEnter;
  property OnExit;
  property OnKeyDown;
  property OnKeyPress;
  property OnKeyUp;
  property OnStartDrag;
end;


implementation

{TAutoCustomImageListBox}
constructor TAutoCustomImageListBox.Create(AOwner : TComponent);
begin
  inherited;
  FStrings := TStringList.Create;
  FChangeLink := TChangeLink.Create;
  FChangeLink.OnChange := OnChangeLink;
  FHintWindow := THintWindow.Create(self);
  FHintWindowShowing := False;
  FHintIndex := -1;


  Style :=  lbOwnerDrawFixed;
  FItemHeight := 0;
  FVertAlignment := tvaCenter;
  FDrawEdgeIndex := -1;
  FDrawImageOnly := False;
  FDeletedIndex := -1;
end;

destructor TAutoCustomImageListBox.Destroy;
begin
  FHintWindow.Free;
  FChangeLink.Free;
  FStrings.Free;
  inherited;
end;

procedure TAutoCustomImageListBox.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FImageList <> nil) and
    (AComponent = FImageList) then ImageList := nil;
end;

procedure TAutoCustomImageListBox.Assign(Source: TPersistent);
Var
  lb : TAutoImageComboBox;
  lb1 : TAutoCustomImageListBox;
begin
  if(Source is TAutoImageComboBox)