xpcombo.pas

非常好的xp界面控件

unit xpCombo;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, xpReg,  xpGraphUtil, xpCtrlStyle;


type
  TComboBGStyle = (cbgsNone, cbgsGradient, cbgsTiledImage, cbgsStretchedImage);
  TxpComboButtonStyle = (cbsFlat, cbsXP);

  TxpComboBox = class;

  TxpComboStyle = class (TxpControlStyle)
  private
    FAutoSearch  : Boolean;

    FxpComboBox  : TxpComboBox;
    FHotTrack    : Boolean;
    FImageList   : TImageList;
    FButtonWidth : Integer;
    FButtonStyle : TxpComboButtonStyle;
    FAutoHeight  : Boolean;

    FBGStyle     : TComboBGStyle;
    FBGStartColor: TColor;
    FBGEndColor  : TColor;
    FBGGradientFillDir : TFillDirection;
    FBGImage     : TBitmap;
    FDefaultImageIndex : Integer;
    FActiveBorderColor : TColor;
    FInactiveBorderColor : TColor;
    FDefaultListImageIndex : Integer;

    FActiveButtonColor : TColor;
    FInActiveButtonColor : TColor;

    FSelStartColor : TColor;
    FSelEndColor : TColor;
    FSelGradientFillDir : TFillDirection;

    procedure SetImageList (AValue : TImageList);
    procedure ImageListOnChange (Sender : TObject);
    procedure SetButtonWidth (AValue : Integer);
    procedure SetButtonStyle (AValue : TxpComboButtonStyle);
    procedure SetAutoHeight (AValue : Boolean);
    procedure SetHotTrack (AValue : Boolean);
    procedure SetBGStyle (AValue : TComboBGStyle);
    procedure SetDefaultImageIndex (AValue : Integer);

    procedure SetActiveBorderColor (AValue : TColor);
    procedure SetInactiveBorderColor (AValue : TColor);

    procedure SetActiveButtonColor (AValue : TColor);
    procedure SetInActiveButtonColor (AValue : TColor);

    procedure SetSelStartColor (AValue : TColor);
    procedure SetSelEndColor (AValue : TColor);
    procedure SetSelGradientFillDir (AValue : TFillDirection);

    procedure SetBGStartColor (AValue : TColor);
    procedure SetBGEndColor (AValue : TColor);
    procedure SetBGGradientFillDir (AValue : TFillDirection);
    procedure SetBGImage (AValue : TBitmap);

    procedure SetDefaultListImageIndex (AValue : Integer);

    procedure SetAutoSearch (Value : Boolean);

  protected
    procedure SetActive (AValue : Boolean); override;
  public
    constructor Create (AOwner : TxpComboBox);
    destructor  Destroy; override;
  published
    property AutoHeight : Boolean read FAutoHeight write SetAutoHeight default False;
    property AutoSearch : Boolean read FAutoSearch write SetAutoSearch default False;
    property ButtonWidth : Integer read FButtonWidth write SetButtonWidth;
    property ButtonStyle : TxpComboButtonStyle read FButtonStyle write SetButtonStyle;
    property Images : TImageList read FImageList write SetImageList;
    property HotTrack : Boolean read FHotTrack write SetHotTrack default true;
    property BGStyle : TComboBGStyle read FBGStyle write SetBGStyle default cbgsNone;

    property ActiveBorderColor : TColor read FActiveBorderColor write SetActiveBorderColor;
    property InActiveBorderColor : TColor read FInactiveBorderColor write SetInactiveBorderColor;
    property ActiveButtonColor : TColor read FActiveButtonColor write SetActiveButtonColor;
    property InActiveButtonColor : TColor read FInActiveButtonColor write SetInActiveButtonColor;

    property BGStartColor : TColor read FBGStartColor write SetBGStartColor;
    property BGEndColor : TColor read FBGEndColor write SetBGEndColor;
    property BGGradientFillDir : TFillDirection read FBGGradientFillDir write SetBGGradientFillDir;
    property BGImage : TBitmap read FBGImage write SetBGImage;
    property DefaultImageIndex : Integer read FDefaultImageIndex write SetDefaultImageIndex default -1;
    property DefaultListImageIndex : Integer read FDefaultListImageIndex write SetDefaultListImageIndex default -1;

    property SelStartColor : TColor read FSelStartColor write SetSelStartColor;
    property SelEndColor : TColor read FSelEndColor write SetSelEndColor;
    property SelGradientFillDir : TFillDirection read FSelGradientFillDir write SetSelGradientFillDir;

  end;

  {*******************************************}

  TxpComboBox = class(TComboBox)
  private
    { Private declarations }
    FCanvas  : TControlCanvas;
    FActive  : Boolean;
    FFocused : Boolean;
    FBackground : TBitmap;
    FxpStyle : TxpComboStyle;

    FLocating : Boolean;
    FOldText  : String;
    
    function LocateItem (AStartStr : String) : Integer;
  protected
    procedure CreateParams (var Params: TCreateParams); override;

    procedure WMPaint (var Message: TWMPaint); message WM_PAINT;
    procedure WMNCPaint (var Message : TWMNCPaint); message WM_NCPAINT;
    procedure NCHitTest (var Message : TWMNCHitTest); message WM_NCHITTEST;
    procedure WMNCCalcSize (var Message : TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure MouseDown (var Message : TWMLBUTTONDOWN); message WM_LBUTTONDOWN;
    procedure MouseEnter (var Message : TMessage); message CM_MOUSEENTER;
    procedure MouseLeave (var Message : TMessage); message CM_MOUSELEAVE;
    procedure WMDrawItem (var Message : TWMDrawItem); message WM_DRAWITEM;
    procedure WMMeasureItem (var Message : TWMMeasureItem); message WM_MEASUREITEM;
    procedure WMSetFocus (var Message : TMessage); message WM_SETFOCUS;
    procedure WMKillFocus (var Message : TMessage); message WM_KILLFOCUS;
    procedure CNCommand (var Message : TWMCOMMAND); message CN_COMMAND;
    procedure WMCommand (var Message : TWMCOMMAND); message WM_COMMAND;
    procedure CMEnabledChanged (var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure WndProc (var Message: TMessage); override;


    procedure DrawBorder (DC : hDC); virtual;
    procedure DrawFlatButton (DC : hDC; AButtonRect : TRect);
    procedure DrawXPButton (DC : hDC; AButtonRect : TRect);
    procedure DrawButton (DC : hDC; AButtonRect : TRect; AStyle : TxpComboButtonStyle); virtual;
    procedure DrawEditText (ACanvas : TCanvas; ARect : TRect; AItemIndex : Integer; IsSelected : Boolean); virtual;


    procedure Notification (AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property XPStyle : TxpComboStyle read FxpStyle write FxpStyle;
  end;

procedure Register;

implementation


{******************************************************************************}

constructor TxpComboStyle.Create (AOwner : TxpComboBox);
begin
  inherited Create;

  FxpComboBox := AOwner;
  FAutoSearch := False;
  FImageList := nil;
  FHotTrack := true;
  FButtonWidth := 20;
  FButtonStyle := cbsFlat;
  FDefaultImageIndex := -1;
  FDefaultListImageIndex := -1;

  FBGStyle := cbgsNone;
  FBGStartColor := clWhite;
  FBGEndColor := $00F0E2C1;
  FBGGradientFillDir := fdLeftToRight;


  FActiveBorderColor := $00C56A31;
  FInactiveBorderColor := clBtnFace;

  FActiveButtonColor := $00EED2C1;
  FInActiveButtonColor := clBtnFace;

  FSelStartColor := $00FFAA77;
  FSelEndColor := $00EED2C1;
  FSelGradientFillDir := fdVerticalFromCenter;

  FBGImage := TBitmap.Create;
end;

destructor  TxpComboStyle.Destroy;
begin
  if Assigned (FImageList) then
  try
    FImageList.OnChange := nil;
  except
  end;
  if Assigned (FBGImage) then
  try
    FBGImage.Free;
    FBGImage := nil;
  except
  end;

  inherited;
end;

procedure TxpComboStyle.SetActive (AValue : Boolean);
begin
  inherited SetActive (AValue);
  FxpComboBox.RecreateWnd;
  FxpComboBox.Invalidate;
end;

procedure TxpComboStyle.SetImageList (AValue : TImageList);
begin
  FImageList := AValue;
  if Assigned(FImageList) then
  begin
    FImageList.OnChange := ImageListOnChange;
    FxpComboBox.RecreateWnd;
  end
  else
    FxpComboBox.Invalidate;
end;

procedure TxpComboStyle.ImageListOnChange (Sender : TObject);
begin
  FxpComboBox.Invalidate;
end;

procedure TxpComboStyle.SetHotTrack (AValue : Boolean);
begin
  if FHotTrack <> AValue then
  begin
    FHotTrack := AValue;
  end;  
end;

procedure TxpComboStyle.SetButtonWidth (AValue : Integer);
begin
  if FButtonWidth <> AValue then
  begin
    FButtonWidth := AValue;
    FxpComboBox.RecreateWnd;
  end;
end;

procedure TxpComboStyle.SetAutoHeight (AValue : Boolean);
begin
  if FAutoHeight <> AValue then
  begin
    FAutoHeight := AValue;
    FxpComboBox.RecreateWnd;
  end;
end;

procedure TxpComboStyle.SetActiveBorderColor (AValue : TColor);
begin
  if FActiveBorderColor <> AValue then
  begin
    FActiveBorderColor := AValue;
    SendMessage (FxpComboBox.Handle, WM_NCPAINT, 0, 0);
  end;
end;

procedure TxpComboStyle.SetInactiveBorderColor (AValue : TColor);
begin
  if FInActiveBorderColor <> AValue then
  begin
    FInActiveBorderColor := AValue;
    SendMessage (FxpComboBox.Handle, WM_NCPAINT, 0, 0);
  end;
end;


procedure TxpComboStyle.SetActiveButtonColor (AValue : TColor);
begin
  if FActiveButtonColor <> AValue then
  begin
    FActiveButtonColor := AValue;
    SendMessage (FxpComboBox.Handle, WM_NCPAINT, 0, 0);
  end;
end;

procedure TxpComboStyle.SetInActiveButtonColor (AValue : TColor);
begin
  if FInActiveButtonColor <> AValue then
  begin
    FInActiveButtonColor := AValue;
    SendMessage (FxpComboBox.Handle, WM_NCPAINT, 0, 0);
  end;
end;

procedure TxpComboStyle.SetSelStartColor (AValue : TColor);
begin
  if FSelStartColor <> AValue then
  begin
    FSelStartColor := AValue;
  end;
end;

procedure TxpComboStyle.SetSelEndColor (AValue : TColor);
begin
  if FSelEndColor <> AValue then
  begin
    FSelEndColor := AValue;
  end;
end;

procedure TxpComboStyle.SetSelGradientFillDir (AValue : TFillDirection);
begin
  if FSelGradientFillDir <> AValue then
  begin
    FSelGradientFillDir := AValue;
  end;
end;

procedure TxpComboStyle.SetBGStyle (AValue: TComboBGStyle);
begin
  if FBGStyle <> AValue then
  begin
    FBGStyle := AValue;
  end;
end;

procedure TxpComboStyle.SetBGStartColor (AValue : TColor);
begin
  if FBGStartColor <> AValue then
  begin
    FBGStartColor := AValue;
  end;
end;

procedure TxpComboStyle.SetBGEndColor (AValue : TColor);
begin
  if FBGEndColor <> AValue then
  begin
    FBGEndColor := AValue;
  end;
end;

procedure TxpComboStyle.SetBGGradientFillDir (AValue : TFillDirection);
begin
  if FBGGradientFillDir <> AValue then
  begin
    FBGGradientFillDir := AValue;
  end;
end;

procedure TxpComboStyle.SetBGImage (AValue : TBitmap);
begin
  if not FBGImage.Empty then
  try