TEdit扩展：做成多按钮的Edit，可用作浏览器地址栏

TEdit是经常使用的组件，但其功能不能满足开发要求，虽然高版本的Delphi已经提供一个TButtonEdit组件，但这个组件提供的按钮数量较少，于是本人模仿这个组件，做了一个支持4个按钮的TEdit扩展组件，在Delphi XE下测试通过。

主要代码如下：

unit UWSIEAddress;

interface

uses
  SysUtils, Classes, Controls, StdCtrls,ImgList,Messages,Menus,themes,Forms,
  Windows,Dialogs,RegularExpressions,Registry,ShellAPI;

const
  AltID=111;
  ShiftID=1001;
  CtrlID=11117;
  ASID=1112;
  ACID=11228;
  SCID=12118;
  ASCID=12229;

//这些值是随机定义的，用于判断那些辅助键按下

type
  TOnUrlSelectedEvent = procedure(Sender: TObject; Url: WideString; var Cancel: boolean) of object;

  TCustomUWSIEAddress = class;

  TEditButton = class(TPersistent)
  strict private
    type
      TButtonState = (bsNormal, bsHot, bsPushed);
      TGlyph = class(TCustomControl)
      private
        FButton: TEditButton;
        FState: TButtonState;
      protected
        procedure Click; override;
        procedure CreateWnd; override;
        procedure Paint; override;
        procedure WndProc(var Message: TMessage); override;
        procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
      public
        constructor Create(AButton: TEditButton); reintroduce; virtual;
      end;
  protected
    type
      TButtonPosition = (bpLeft, bpRightRight,bpRightMiddle,bpRightLeft);
  strict private
    FDisabledImageIndex: TImageIndex;
    FDropDownMenu: TPopupMenu;
    FEditControl: TCustomUWSIEAddress;
    FGlyph: TGlyph;
    FHotImageIndex: TImageIndex;
    FImageIndex: TImageIndex;
    FPosition: TButtonPosition;
    FPressedImageIndex: TImageIndex;
    function GetEnabled: Boolean;
    function GetCustomHint: TCustomHint;
    function GetHint: string;
    function GetImages: TCustomImageList;
    function GetVisible: Boolean;
    procedure SetDisabledImageIndex(const Value: TImageIndex);
    procedure SetEnabled(const Value: Boolean);
    procedure SetCustomHint(const Value: TCustomHint);
    procedure SetHint(const Value: string);
    procedure SetHotImageIndex(const Value: TImageIndex);
    procedure SetImageIndex(const Value: TImageIndex);
    procedure SetPressedImageIndex(const Value: TImageIndex);
    procedure SetVisible(const Value: Boolean);
  protected
    function GetOwner: TPersistent; override;
    procedure UpdateBounds; dynamic;
    property EditControl: TCustomUWSIEAddress read FEditControl;
    property Glyph: TGlyph read FGlyph;
    property Images: TCustomImageList read GetImages;
    property Position: TButtonPosition read FPosition;
  public
    constructor Create(EditControl: TCustomUWSIEAddress; APosition: TButtonPosition); reintroduce; virtual;
    destructor Destroy; override;
    property Visible: Boolean read GetVisible ;
  published
    property CustomHint: TCustomHint read GetCustomHint write SetCustomHint;
    property DisabledImageIndex: TImageIndex read FDisabledImageIndex write SetDisabledImageIndex default -1;
    property DropDownMenu: TPopupMenu read FDropDownMenu write FDropDownMenu;
    property Enabled: Boolean read GetEnabled write SetEnabled default True;
    property Hint: string read GetHint write SetHint;
    property HotImageIndex: TImageIndex read FHotImageIndex write SetHotImageIndex default -1;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
    property PressedImageIndex: TImageIndex read FPressedImageIndex write SetPressedImageIndex default -1;
  end;

  TEditButtonClass = class of TEditButton;

  TCustomUWSIEAddress = class(TCustomEdit)
  private
    { Private declarations }
    FShiftKeyID:Integer;
    FCanvas: TControlCanvas;
    FImages: TCustomImageList;
    FImageChangeLink: TChangeLink;
    FLeftButton: TEditButton;
    FRightButtonRight: TEditButton;
    FRightButtonMiddle: TEditButton;
    FRightButtonLeft: TEditButton;
    FFavIconsSavePath:String;
    FOneKeyAddressFile:String;
    FAddressAutoFixFile:String;
    FOneKeyAddress:TStrings;
    FAddressAutoFix:TStrings;
    FTypedUrls:TStringList;
    FOnUrlSelected: TOnUrlSelectedEvent;
    function GetOneKeyAddress: TStrings;
    function GetAddressAutoFix: TStrings;
    function AdjustTextHint(Margin: Integer; const Value: string): string;
    procedure SetOneKeyAddress(Value: TStrings);
    procedure SetAddressAutoFix(Value: TStrings);
    procedure ImageListChange(Sender: TObject);
    procedure SetImages(const Value: TCustomImageList);
    function GetOnLeftButtonClick: TNotifyEvent;
    function GetOnRightButtonRightClick: TNotifyEvent;
    function GetOnRightButtonMiddleClick: TNotifyEvent;
    function GetOnRightButtonLeftClick: TNotifyEvent;
    procedure SetLeftButton(const Value: TEditButton);
    procedure SetOnLeftButtonClick(const Value: TNotifyEvent);
    procedure SetRightButtonRight(const Value: TEditButton);
    procedure SetOnRightButtonRightClick(const Value: TNotifyEvent);
    procedure SetRightButtonMiddle(const Value: TEditButton);
    procedure SetOnRightButtonMiddleClick(const Value: TNotifyEvent);
    procedure SetRightButtonLeft(const Value: TEditButton);
    procedure SetOnRightButtonLeftClick(const Value: TNotifyEvent);
    function GetOneKeyAddressUrl(Key:String):string;
    function GetFixUrl(SrcKey,Key:String):string;
    procedure GetTypedUrls;
  protected
    { Protected declarations }
    procedure DoSetTextHint(const Value: string); override;
    function GetEditButtonClass: TEditButtonClass; dynamic;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure UpdateEditMargins; dynamic;
    procedure WndProc(var Message: TMessage); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LoadOneKeyAddressList;
    procedure LoadAddressAutoFixList;
    procedure SaveOneKeyAddressList;
    procedure SaveAddressAutoFixList;
    procedure DefaultHandler(var Message); override;
    procedure UpdateTypedUrls;
    function GetShellIcons:Cardinal;
    property Images: TCustomImageList read FImages write SetImages;
    property LeftButton: TEditButton read FLeftButton write SetLeftButton;
    property RightButtonRight: TEditButton read FRightButtonRight write SetRightButtonRight;
    property RightButtonMiddle: TEditButton read FRightButtonMiddle write SetRightButtonMiddle;
    property RightButtonLeft: TEditButton read FRightButtonLeft write SetRightButtonLeft;
    property OnLeftButtonClick: TNotifyEvent read GetOnLeftButtonClick write SetOnLeftButtonClick;
    property OnRightButtonRightClick: TNotifyEvent read GetOnRightButtonRightClick write SetOnRightButtonRightClick;
    property OnRightButtonMiddleClick: TNotifyEvent read GetOnRightButtonMiddleClick write SetOnRightButtonMiddleClick;
    property OnRightButtonLeftClick: TNotifyEvent read GetOnRightButtonLeftClick write SetOnRightButtonLeftClick;
    property FavIconsSavePath:String read FFavIconsSavePath write FFavIconsSavePath;
    property OneKeyAddressFile:String read FOneKeyAddressFile write FOneKeyAddressFile;
    property AddressAutoFixFile:String read FAddressAutoFixFile write FAddressAutoFixFile;
    Property OneKeyAddress:TStrings read GetOneKeyAddress  write SetOneKeyAddress;
    Property AddressAutoFix:TStrings read GetAddressAutoFix  write SetAddressAutoFix;
    property OnUrlSelected: TOnUrlSelectedEvent read FOnUrlSelected write FOnUrlSelected;
    property  TypedUrls:TStringList read FTypedUrls;
  published
    { Published declarations }
  end;

 TUWSIEAddress=class(TCustomUWSIEAddress )
 private

 protected

 public

 published
    property Align;
    property Alignment;
    property Anchors;
    property AutoSelect;
    property AutoSize;
    property BevelEdges;
    property BevelInner;
    property BevelKind default bkNone;
    property BevelOuter;
    property BevelWidth;
    property BiDiMode;
    property BorderStyle;
    property CharCase;
    property Color;
    property Constraints;
    property Ctl3D;
    property DoubleBuffered;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property Images;
    property ImeMode;
    property ImeName;
    property LeftButton;
    property MaxLength;
    property OEMConvert;
    property NumbersOnly;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentDoubleBuffered;
    property ParentFont;
    property ParentShowHint;
    property PasswordChar;
    property PopupMenu;
    property ReadOnly;
    property RightButtonRight;
    property RightButtonMiddle;
    property RightButtonLeft;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property TextHint;
    property Touch;
    property Visible;
    property OnChange;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnGesture;
    property OnLeftButtonClick;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnRightButtonRightClick;
    property OnRightButtonMiddleClick;
    property OnRightButtonLeftClick;
    property OnStartDock;
    property OnStartDrag;

    property FavIconsSavePath;
    property OneKeyAddressFile;
    property AddressAutoFixFile;
    Property OneKeyAddress;
    Property AddressAutoFix;
    property OnUrlSelected;
 end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Unruly Wolf Soft', [TUWSIEAddress]);
end;

function CtrlDown : Boolean;
var
  State : TKeyboardState;
begin
  GetKeyboardState(State) ;
  Result := ((State[vk_Control] And 128) <> 0) ;
end;

function ShiftDown : Boolean;
var
  State : TKeyboardState;
begin
  GetKeyboardState(State) ;
  Result := ((State[vk_Shift] and 128) <> 0) ;
end;

function AltDown : Boolean;
var
  State : TKeyboardState;
begin
  GetKeyboardState(State) ;
  Result := ((State[vk_Menu] and 128) <> 0) ;
end;

{ TEditButton.TGlyph }

constructor TEditButton.TGlyph.Create(AButton: TEditButton);
begin
  inherited Create(AButton.FEditControl);
  FButton := AButton;
  FState := bsNormal;
  Parent := FButton.FEditControl;
  Visible := True;
  ShowHint:=True;
end;

procedure TEditButton.TGlyph.Click;
begin
  // Replicate from TControl to set Sender to owning TButtonedEdit control
  if Assigned(OnClick) and (Action <> nil) and not DelegatesEqual(@OnClick, @Action.OnExecute) then
    OnClick(FButton.EditControl)
  else if not (csDesigning in ComponentState) and (ActionLink <> nil) then
    ActionLink.Execute(FButton.EditControl)
  else if Assigned(OnClick) then
    OnClick(FButton.EditControl);
  FState := bsNormal;
end;

procedure TEditButton.TGlyph.CreateWnd;
begin
  inherited;
  if Visible then
    FButton.FEditControl.UpdateEditMargins;
end;

procedure TEditButton.TGlyph.Paint;
var
  LIndex: Integer;
begin
  inherited;
  if (FButton.Images <> nil) and Visible then
  begin
    LIndex := FButton.ImageIndex;
    if Enabled then
    begin
      case FState of
        bsHot:
          if FButton.HotImageIndex <> -1 then
            LIndex := FButton.HotImageIndex;
        bsPushed:
          if FButton.PressedImageIndex <> -1 then
            LIndex := FButton.PressedImageIndex;
      end;
    end
    else
      if FButton.DisabledImageIndex <> -1 then
        LIndex := FButton.DisabledImageIndex;
    if LIndex <> -1 then
      FButton.Images.Draw(Canvas, 0, 0, LIndex);
  end;
end;

procedure TEditButton.TGlyph.WndProc(var Message: TMessage);
var
  LPoint: TPoint;
begin
  if (Message.Msg = WM_CONTEXTMENU) and (FButton.EditControl.PopupMenu = nil) then
  begin
      FState := bsNormal;
      Exit;
  end;

  inherited;
  case Message.Msg of
    CM_MOUSEENTER: FState := bsHot;
    CM_MOUSELEAVE: FState := bsNormal;
    WM_LBUTTONDOWN:
    begin
        if FButton.FDropDownMenu <> nil then
        begin
          if not (csDesigning in Parent.ComponentState) then
          begin
            LPoint := ClientToScreen(Point(0, FButton.EditControl.Height));
            FButton.FDropDownMenu.Popup(LPoint.X, LPoint.Y);
            if Assigned(OnClick) and (Action <> nil) and not DelegatesEqual(@OnClick, @Action.OnExecute) then
            OnClick(FButton.EditControl)
            else if not (csDesigning in ComponentState) and (ActionLink <> nil) then
            ActionLink.Execute(FButton.EditControl)
            else if Assigned(OnClick) then
            OnClick(FButton.EditControl);
          end;
        end
        else
        FState := bsPushed;
    end;
    WM_LBUTTONUP: FState := bsNormal;
    WM_RBUTTONUP:
    begin
      if FButton.FDropDownMenu <> nil then
        begin
          if not (csDesigning in Parent.ComponentState) then
          begin
            LPoint := ClientToScreen(Point(0, FButton.EditControl.Height));
            FButton.FDropDownMenu.Popup(LPoint.X, LPoint.Y);
            FState := bsNormal;
          end;
        end;
    end;
    CM_VISIBLECHANGED: FButton.UpdateBounds;
  else
    Exit;
  end;
  Invalidate;
end;

procedure TEditButton.TGlyph.CMHintShow(var Message: TCMHintShow);
begin
  if Hint<>''  then
  Message.HintInfo^.HintStr := Hint
end;

{ TEditButton }

constructor TEditButton.Create(EditControl: TCustomUWSIEAddress; APosition: TButtonPosition);
begin
  inherited Create;
  FEditControl := EditControl;
  FGlyph := TGlyph.Create(Self);
  FHotImageIndex := -1;
  FImageIndex := -1;
  FPosition := APosition;
  FPressedImageIndex := -1;
  FDisabledImageIndex := -1;
end;

destructor TEditButton.Destroy;
begin
  FGlyph.Parent.RemoveControl(FGlyph);
  FGlyph.Free;
  inherited;
end;

function TEditButton.GetEnabled: Boolean;
begin
  Result := FGlyph.Enabled;
end;

function TEditButton.GetCustomHint: TCustomHint;
begin
  Result := FGlyph.CustomHint;
end;

function TEditButton.GetHint: string;
begin
  Result := FGlyph.Hint;
end;

function TEditButton.GetImages: TCustomImageList;
begin
  Result := FEditControl.Images;
end;

function TEditButton.GetOwner: TPersistent;
begin
  Result := FEditControl;
end;

function TEditButton.GetVisible: Boolean;
begin
  Result := FGlyph.Visible;
end;

procedure TEditButton.SetDisabledImageIndex(const Value: TImageIndex);
begin
  if Value <> FDisabledImageIndex then
  begin
    FDisabledImageIndex := Value;
    if not Enabled then
      FGlyph.Invalidate;
  end;
end;

procedure TEditButton.SetEnabled(const Value: Boolean);
begin
  if Value <> FGlyph.Enabled then
  begin
    FGlyph.Enabled := Value;
    FGlyph.Invalidate;
  end;
end;

procedure TEditButton.SetCustomHint(const Value: TCustomHint);
begin
  if Value <> FGlyph.CustomHint then
    FGlyph.CustomHint := Value;
end;

procedure TEditButton.SetHint(const Value: string);
begin
  if Value <> FGlyph.Hint then
    FGlyph.Hint := Value;
end;

procedure TEditButton.SetHotImageIndex(const Value: TImageIndex);
begin
  if Value <> FHotImageIndex then
  begin
    FHotImageIndex := Value;
    if FGlyph.FState = bsHot then
      FGlyph.Invalidate;
  end;
end;

procedure TEditButton.SetImageIndex(const Value: TImageIndex);
begin
  if Value <> FImageIndex then
  begin
    FImageIndex := Value;
    if FGlyph.FState = bsNormal then
      FGlyph.Invalidate;
  end;
end;

procedure TEditButton.SetPressedImageIndex(const Value: TImageIndex);
begin
  if Value <> FPressedImageIndex then
  begin
    FPressedImageIndex := Value;
    if FGlyph.FState = bsPushed then
      FGlyph.Invalidate;
  end;
end;

procedure TEditButton.SetVisible(const Value: Boolean);
begin
  if Value <> FGlyph.Visible then
  begin
    FGlyph.Visible := Value;
    FEditControl.UpdateEditMargins;
  end;
end;

procedure TEditButton.UpdateBounds;
var
  EdgeSize, NewLeft: Integer;
begin
  if FGlyph <> nil then
  begin
    if Images <> nil then
    begin
      FGlyph.Width := Images.Width;
      FGlyph.Height := Images.Height;
    end
    else
    begin
      FGlyph.Width := 0;
      FGlyph.Height := 0;
    end;
    FGlyph.Top := (FEditControl.Height-FGlyph.Height) div 2-1;
    NewLeft := FGlyph.Left;

    if not ThemeServices.ThemesEnabled then
      FGlyph.Top :=(FEditControl.Height-FGlyph.Height) div 2;

    case FPosition of
      bpLeft:
        begin
          if ThemeServices.ThemesEnabled then
            NewLeft := 0
          else
            NewLeft := 1;
        end;
      bpRightRight:
        begin
          NewLeft := FEditControl.Width - FGlyph.Width-2;
          if FEditControl.BorderStyle <> bsNone then
            Dec(NewLeft, 4);
          if FEditControl.BevelKind <> bkNone then
          begin
            EdgeSize := 0;
            if FEditControl.BevelInner <> bvNone then
              Inc(EdgeSize, FEditControl.BevelWidth);
            if FEditControl.BevelOuter <> bvNone then
              Inc(EdgeSize, FEditControl.BevelWidth);
            if beRight in FEditControl.BevelEdges then
              Dec(NewLeft, EdgeSize);
            if beLeft in FEditControl.BevelEdges then
              Dec(NewLeft, EdgeSize);
          end;
          if not ThemeServices.ThemesEnabled then
            Dec(NewLeft);
        end;
      bpRightMiddle:
        begin
          NewLeft := FEditControl.Width - FGlyph.Width*2-4;
          if FEditControl.BorderStyle <> bsNone then
            Dec(NewLeft, 4);
          if FEditControl.BevelKind <> bkNone then
          begin
            EdgeSize := 0;
            if FEditControl.BevelInner <> bvNone then
              Inc(EdgeSize, FEditControl.BevelWidth);
            if FEditControl.BevelOuter <> bvNone then
              Inc(EdgeSize, FEditControl.BevelWidth);
            if beRight in FEditControl.BevelEdges then
              Dec(NewLeft, EdgeSize);
            if beLeft in FEditControl.BevelEdges then
              Dec(NewLeft, EdgeSize);
          end;
          if not ThemeServices.ThemesEnabled then
            Dec(NewLeft);
        end;

        bpRightLeft:
          begin
            NewLeft := FEditControl.Width - FGlyph.Width*3-8;
            if FEditControl.BorderStyle <> bsNone then
            Dec(NewLeft, 4);
            if FEditControl.BevelKind <> bkNone then
            begin
              EdgeSize := 0;
              if FEditControl.BevelInner <> bvNone then
              Inc(EdgeSize, FEditControl.BevelWidth);
              if FEditControl.BevelOuter <> bvNone then
              Inc(EdgeSize, FEditControl.BevelWidth);
              if beRight in FEditControl.BevelEdges then
              Dec(NewLeft, EdgeSize);
              if beLeft in FEditControl.BevelEdges then
              Dec(NewLeft, EdgeSize);
            end;
            if not ThemeServices.ThemesEnabled then
            Dec(NewLeft);
        end;
    end;

    if (not FEditControl.Ctl3D) and (FEditControl.BorderStyle <> bsNone) then
    begin
      FGlyph.Top := (FEditControl.Height-FGlyph.Height) div 2;
      Inc(NewLeft, 2);
    end;

    FGlyph.Left := NewLeft;

    if (csDesigning in FEditControl.ComponentState) and not Visible then
      FGlyph.Width := 0;
  end;
end;

constructor TCustomUWSIEAddress.Create(AOwner: TComponent);
begin
  inherited;
  FCanvas := TControlCanvas.Create;
  FCanvas.Control := Self;
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
  FLeftButton := GetEditButtonClass.Create(Self, bpLeft);
  FRightButtonRight := GetEditButtonClass.Create(Self, bpRightRight);
  FRightButtonMiddle := GetEditButtonClass.Create(Self, bpRightMiddle);
  FRightButtonLeft := GetEditButtonClass.Create(Self, bpRightLeft);
  font.Size:=12;
  FShiftKeyID:=0;
  FFavIconsSavePath:='';
  FOneKeyAddressFile:='';
  FAddressAutoFixFile:='';

  FOneKeyAddress:=TStringlist.Create ;
  FAddressAutoFix:=TStringlist.Create ;
  FTypedUrls:=TStringlist.Create ;

  LoadOneKeyAddressList;
  LoadAddressAutoFixList;
  GetTypedUrls;
end;

destructor TCustomUWSIEAddress.Destroy;
begin
  FreeAndNil(FCanvas);
  FreeAndNil(FImageChangeLink);
  FreeAndNil(FLeftButton);
  FreeAndNil(FRightButtonRight);
  FreeAndNil(FRightButtonMiddle);
  FreeAndNil(FRightButtonLeft);

  SaveOneKeyAddressList;
  SaveAddressAutoFixList;
  FOneKeyAddress.Free ;
  FAddressAutoFix.Free;
  FTypedUrls.Free ;
  inherited;
end;

function TCustomUWSIEAddress.AdjustTextHint(Margin: Integer; const Value: string): string;
var
  LWidth, Count: Integer;
begin
  if (Margin = 0) or (Win32MajorVersion >= 6) then
    inherited DoSetTextHint(Value)
  else
  begin
    // This is a hack!! Due to a presumed bug in Windows XP any text hint
    // set with EM_SETCUEBANNER does not respect left margins set with
    // EM_SETMARGINS. The following works around the issue.
    FCanvas.Font := Font;
    LWidth := FCanvas.TextWidth(' '); // do not localize
    Count := Margin div LWidth;
    if (Margin mod LWidth) > 0 then
      Inc(Count);
    inherited DoSetTextHint(StringOfChar(' ', Count) + Value);
  end;
end;

procedure TCustomUWSIEAddress.DoSetTextHint(const Value: string);
begin
  AdjustTextHint(0, Value);
end;

function TCustomUWSIEAddress.GetEditButtonClass: TEditButtonClass;
begin
  Result := TEditButton;
end;

function TCustomUWSIEAddress.GetOnLeftButtonClick: TNotifyEvent;
begin
  Result := LeftButton.Glyph.OnClick;
end;

function TCustomUWSIEAddress.GetOnRightButtonRightClick: TNotifyEvent;
begin
  Result := RightButtonRight.Glyph.OnClick;
end;

function TCustomUWSIEAddress.GetOnRightButtonMiddleClick: TNotifyEvent;
begin
  Result := RightButtonMiddle.Glyph.OnClick;
end;

function TCustomUWSIEAddress.GetOnRightButtonLeftClick: TNotifyEvent;
begin
  Result := RightButtonLeft.Glyph.OnClick;
end;

procedure TCustomUWSIEAddress.ImageListChange(Sender: TObject);
begin
  if HandleAllocated then
  begin
    FLeftButton.UpdateBounds;
    FRightButtonRight.UpdateBounds;
    FRightButtonMiddle.UpdateBounds;
    FRightButtonLeft.UpdateBounds;
    UpdateEditMargins;
  end;
end;

procedure TCustomUWSIEAddress.DefaultHandler(var Message);
{$IF DEFINED(CLR)}
var
  LMessage: TMessage;
{$IFEND}
begin
  inherited;
{$IF DEFINED(CLR)}
  LMessage := UnwrapMessage(TObject(Message));
  case LMessage.Msg of
{$ELSE}
  case TMessage(Message).Msg of
{$IFEND}
    CN_CTLCOLOREDIT:
      begin
        FLeftButton.Glyph.Invalidate;
        FRightButtonRight.Glyph.Invalidate;
        FRightButtonMiddle.Glyph.Invalidate;
        FRightButtonLeft.Glyph.Invalidate;
      end;
    WM_SIZE:
      begin
        FRightButtonRight.UpdateBounds;
        FRightButtonMiddle.UpdateBounds;
        FRightButtonLeft.UpdateBounds;
      end;
  end;
end;

procedure TCustomUWSIEAddress.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = FImages then
    begin
      FImages := nil;
      FLeftButton.UpdateBounds;
      FRightButtonRight.UpdateBounds;
      FRightButtonMiddle.UpdateBounds;
      FRightButtonLeft.UpdateBounds;
      UpdateEditMargins;
    end
    else if (LeftButton <> nil) and (AComponent = LeftButton.DropDownMenu) then
      LeftButton.DropDownMenu := nil
    else if (RightButtonRight <> nil) and (AComponent = RightButtonRight.DropDownMenu) then
      RightButtonRight.DropDownMenu := nil
    else if (RightButtonMiddle <> nil) and (AComponent = RightButtonMiddle.DropDownMenu) then
      RightButtonMiddle.DropDownMenu := nil
    else if (RightButtonLeft <> nil) and (AComponent = RightButtonLeft.DropDownMenu) then
      RightButtonLeft.DropDownMenu := nil;
  end;
end;

procedure TCustomUWSIEAddress.SetImages(const Value: TCustomImageList);
begin
  if Value <> FImages then
  begin
    if FImages <> nil then
      FImages.UnRegisterChanges(FImageChangeLink);
    FImages := Value;
    if FImages <> nil then
    begin
      FImages.RegisterChanges(FImageChangeLink);
      FImages.FreeNotification(Self);
    end;
    FLeftButton.UpdateBounds;
    FRightButtonRight.UpdateBounds;
    FRightButtonMiddle.UpdateBounds;
    FRightButtonLeft.UpdateBounds;
    UpdateEditMargins;
  end;
end;

procedure TCustomUWSIEAddress.SetLeftButton(const Value: TEditButton);
begin
  FLeftButton.Assign(Value);
end;

procedure TCustomUWSIEAddress.SetOnLeftButtonClick(const Value: TNotifyEvent);
begin
  LeftButton.Glyph.OnClick := Value;
end;

procedure TCustomUWSIEAddress.SetOnRightButtonRightClick(const Value: TNotifyEvent);
begin
  RightButtonRight.Glyph.OnClick := Value;
end;

procedure TCustomUWSIEAddress.SetOnRightButtonMiddleClick(const Value: TNotifyEvent);
begin
  RightButtonMiddle.Glyph.OnClick := Value;
end;

procedure TCustomUWSIEAddress.SetOnRightButtonLeftClick(const Value: TNotifyEvent);
begin
  RightButtonLeft.Glyph.OnClick := Value;
end;

procedure TCustomUWSIEAddress.SetRightButtonRight(const Value: TEditButton);
begin
  FRightButtonRight.Assign(Value);
end;

procedure TCustomUWSIEAddress.SetRightButtonMiddle(const Value: TEditButton);
begin
  FRightButtonMiddle.Assign(Value);
end;

procedure TCustomUWSIEAddress.SetRightButtonLeft(const Value: TEditButton);
begin
  FRightButtonLeft.Assign(Value);
end;

procedure TCustomUWSIEAddress.UpdateEditMargins;
var
  LMargin, RMargin: Integer;
begin
  if HandleAllocated then
  begin
    LMargin := 0;
    RMargin := 0;
    if (Images <> nil) then
    begin
      if LeftButton.Visible then
        LMargin := Images.Width + 2;
      if RightButtonLeft.Visible then
        RMargin := 3*Images.Width+16;
    end;
    SendMessage(Handle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, MakeLong(LMargin, RMargin));
    AdjustTextHint(LMargin, TextHint);
    Invalidate;
  end;
end;

procedure TCustomUWSIEAddress.WndProc(var Message: TMessage);
var
  LLeft, LTop: Integer;
begin
  case Message.Msg of
    CN_CTLCOLORSTATIC,
    CN_CTLCOLOREDIT:
      if FImages <> nil then
      begin
        if LeftButton.Visible then
        begin
          LLeft := LeftButton.Glyph.Left;
          LTop := (Height-LeftButton.Glyph.Height) div 2-1;
          if ThemeServices.ThemesEnabled and Ctl3D then
          begin
            Inc(LLeft);
            Inc(LTop);
          end;
          ExcludeClipRect(Message.WParam, LLeft + 1, LTop + 1,
            LeftButton.Glyph.Width + LeftButton.Glyph.Left, LeftButton.Glyph.Height);
        end;

        if RightButtonRight.Visible then
        begin
          LTop := (Height-RightButtonRight.Glyph.Height) div 2-1;
          if ThemeServices.ThemesEnabled and Ctl3D then
            Inc(LTop);
          ExcludeClipRect(Message.WParam, RightButtonRight.Glyph.Left, LTop + 1,
            RightButtonRight.Glyph.Width + RightButtonRight.Glyph.Left, RightButtonRight.Glyph.Height);
        end;

        if RightButtonMiddle.Visible then
        begin
          LTop := (Height-RightButtonMiddle.Glyph.Height) div 2-1;
          if ThemeServices.ThemesEnabled and Ctl3D then
            Inc(LTop);
          ExcludeClipRect(Message.WParam, RightButtonMiddle.Glyph.Left, LTop + 1,
            RightButtonMiddle.Glyph.Width + RightButtonMiddle.Glyph.Left, RightButtonMiddle.Glyph.Height);
        end;

        if RightButtonLeft.Visible then
        begin
          LTop :=(Height-RightButtonLeft.Glyph.Height) div 2-1;
          if ThemeServices.ThemesEnabled and Ctl3D then
            Inc(LTop);
          ExcludeClipRect(Message.WParam, RightButtonLeft.Glyph.Left, LTop + 1,
            RightButtonLeft.Glyph.Width + RightButtonLeft.Glyph.Left, RightButtonLeft.Glyph.Height);
        end;
      end;
  end;

  inherited;

  case Message.Msg of
    CM_BORDERCHANGED,
    CM_CTL3DCHANGED:
      begin
        if not (csLoading in ComponentState) then
        begin
          LeftButton.UpdateBounds;
          RightButtonRight.UpdateBounds;
          RightButtonMiddle.UpdateBounds;
          RightButtonLeft.UpdateBounds;
        end;
      end;
    CM_FONTCHANGED:
      if not (csLoading in ComponentState) then
        UpdateEditMargins;
  end;
end;

function TCustomUWSIEAddress.GetOneKeyAddress: TStrings;
begin
  Result:=FOneKeyAddress;
end;

function TCustomUWSIEAddress.GetAddressAutoFix: TStrings;
begin
    Result:=FAddressAutoFix;
end;

procedure TCustomUWSIEAddress.SetOneKeyAddress(Value: TStrings);
begin
  FOneKeyAddress.Assign(Value);
end;

procedure TCustomUWSIEAddress.SetAddressAutoFix(Value: TStrings);
begin
  FAddressAutoFix.Assign(Value);
end;

procedure TCustomUWSIEAddress.LoadOneKeyAddressList;
begin
    if (csDesigning in ComponentState) then Exit;
    if FOneKeyAddressFile='' then
    FOneKeyAddressFile:=Format('%s\OneKeyAddress.dat',[ExtractFileDir(Application.ExeName)]);
    if fileExists(FOneKeyAddressFile) then
    FOneKeyAddress.LoadFromFile(FOneKeyAddressFile);
    if FOneKeyAddress.Count=0 then
    begin
       FOneKeyAddress.Add('123=www.hao123.com');
       FOneKeyAddress.Add('d123=123.duba.net');
       FOneKeyAddress.Add('baidu=www.baidu.com');
       FOneKeyAddress.Add('b=www.baidu.com');
       FOneKeyAddress.Add('百度=www.baidu.com');
       FOneKeyAddress.Add('g=www.google.com');
       FOneKeyAddress.Add('google=www.google.com');
       FOneKeyAddress.Add('谷歌=www.google.com');
       FOneKeyAddress.Add('k=www.kingsoft.com');
       FOneKeyAddress.Add('kingsoft=www.kingsoft.com');
       FOneKeyAddress.Add('金山=www.kingsoft.com');
       FOneKeyAddress.Add('i=www.ijinshan.com');
       FOneKeyAddress.Add('duba=www.ijinshan.com');
       FOneKeyAddress.Add('毒霸=www.ijinshan.com');
       FOneKeyAddress.Add('金山毒霸=www.ijinshan.com');
       FOneKeyAddress.Add('金山卫士=www.ijinshan.com');
       FOneKeyAddress.Add('卫士=www.ijinshan.com');
       FOneKeyAddress.Add('wps=www.wps.cn');
       FOneKeyAddress.Add('q=www.qq.com');
       FOneKeyAddress.Add('sina=www.sina.com');
       FOneKeyAddress.Add('新浪=www.sina.com');
    end;
end;

procedure TCustomUWSIEAddress.LoadAddressAutoFixList;
begin
    if (csDesigning in ComponentState) then Exit;
    if FAddressAutoFixFile='' then
    FAddressAutoFixFile:=Format('%s\AddressAutoFix.dat',[ExtractFileDir(Application.ExeName)]);
    if FileExists(FAddressAutoFixFile) then
    FAddressAutoFix.LoadFromFile(FAddressAutoFixFile);
    if FAddressAutoFix.Count=0 then
    begin
      FAddressAutoFix.Add('Ctrl+Enter=www. .com');
      FAddressAutoFix.Add('Alt+Enter=www. .cn');
      FAddressAutoFix.Add('Shift+Enter=www. .com.cn');
      FAddressAutoFix.Add('Ctrl+Alt+Enter=www. .net');
      FAddressAutoFix.Add('Ctrl+Shift+Enter=www. .org');
      FAddressAutoFix.Add('Alt+Shift+Enter=www. .cc');
      FAddressAutoFix.Add('Ctrl+Shift+Alt+Enter=http://www.baidu.com/s?wd=');
    end;
end;

procedure TCustomUWSIEAddress.SaveOneKeyAddressList;
begin
    if FOneKeyAddressFile='' then
    FOneKeyAddressFile:=Format('%s\OneKeyAddress.dat',[ExtractFileDir(Application.ExeName)]);
    FOneKeyAddress.SavetoFile(FOneKeyAddressFile);
end;

procedure TCustomUWSIEAddress.SaveAddressAutoFixList;
begin
    if FAddressAutoFixFile='' then
    FAddressAutoFixFile:=Format('%s\AddressAutoFix.dat',[ExtractFileDir(Application.ExeName)]);
    FAddressAutoFix.SavetoFile(FAddressAutoFixFile);
end;

function TCustomUWSIEAddress.GetOneKeyAddressUrl(Key:String):string;
begin
   Result:=Key;
   if (FOneKeyAddress.Count>0) and (Key<>'') then
   begin
      Result:=FOneKeyAddress.Values[Key];
      if Result='' then
      Result:=Key ;
   end;
end;

function TCustomUWSIEAddress.GetFixUrl(SrcKey,Key:String):string;
var
  SubUrlList:TStringList;
  I,K:Integer;
  SubUrls:TArray<string>;
  SubUrl,TempResult:string;
begin
   Result:=key;
   if (SrcKey<>'') and (Key<>'') then
   begin
     SubUrlList:=TStringList.Create ;
     try
       SubUrls:=TRegEx.Split(SrcKey,'[  ]');
       for SubUrl in SubUrls do
       SubUrlList.Add(SubUrl);
       K:=SubUrlList.Count;
       if k>0 then
       begin
          TempResult:=SubUrlList[0]+Key;
          if K>1 then
          TempResult:=TempResult+SubUrlList[1];
       end
       else
       TempResult:=Key ;
     finally
       SubUrlList.Free ;
     end;
     Result:=TempResult ;
   end;
end;

procedure TCustomUWSIEAddress.GetTypedUrls;
var
  Reg:TRegistry;
  Urls:TStringList;
  I:Integer ;
  TmpUrl:string;
begin
   Reg:=TRegistry.Create;
   Urls:=TStringList.Create;
   try
     Reg.RootKey:=HKEY_CURRENT_USER;
     if Reg.OpenKey('Software\Microsoft\Internet Explorer\TypedURLs', False) then
     begin
        Reg.GetValueNames(Urls);
        if Urls.Count>0 then
        for I:=0 to Urls.Count-1 do
        begin
          TmpUrl:=Reg.ReadString(Urls[I]);
          TmpUrl:=Trim(TmpUrl);
          if (TmpUrl<>'') and (FTypedUrls.IndexOf(TmpUrl)=-1) then
          FTypedUrls.Add(TmpUrl);
        end;
        Reg.CloseKey ;
     end;
     if Reg.OpenKey('Software\Microsoft\Internet Explorer\TypedAddress', false) then
     begin
        Reg.GetValueNames(Urls);
        if Urls.Count>0 then
        for I:=0 to Urls.Count-1 do
        begin
          TmpUrl:=Reg.ReadString(Urls[I]);
          TmpUrl:=Trim(TmpUrl);
          if (TmpUrl<>'') and (FTypedUrls.IndexOf(TmpUrl)=-1) then
          FTypedUrls.Add(TmpUrl);
        end;
        Reg.CloseKey ;
     end;
   finally
     Reg.Free;
     Urls.Free;
   end;
end;

procedure TCustomUWSIEAddress.UpdateTypedUrls;
var
  reg:TRegistry ;
begin
   GetTypedUrls ;
   if Text='' then Exit;
   if FTypedUrls.IndexOf(Text)=-1 then
   begin
     reg:=TRegistry.Create ;
     try
       if Reg.OpenKey('Software\Microsoft\Internet Explorer\TypedURLs', False) then
       begin
          reg.WriteString(Format('url%d',[FTypedUrls.Count+1]),Text);
       end;
       reg.CloseKey ;
     finally
       reg.Free;
     end;
   end;
end;

function TCustomUWSIEAddress.GetShellIcons:Cardinal;
var
 sfi: TShFileInfo;
 aHandle: Cardinal;
begin
  Result:=0;
  aHandle := ShGetFileInfo('', 0, sfi, sizeOf(sfi), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  if (aHandle <> 0) then
  Result:= aHandle;
end;

procedure TCustomUWSIEAddress.KeyDown(var Key: Word; Shift: TShiftState);
begin
  FShiftKeyID:=0;
  if CtrlDown then
  FShiftKeyID:=FShiftKeyID+ctrlID;
  if ShiftDown then
  FShiftKeyID:=FShiftKeyID+ShiftID;
  if AltDown then
  FShiftKeyID:=FShiftKeyID+AltID;

  inherited;
end;

procedure TCustomUWSIEAddress.KeyUp(var Key: Word; Shift: TShiftState);
var
  SrcKey:string;
  bCancel:Boolean ;
begin
  bCancel:=False ;
  if Key=13 then
  begin
    case FShiftKeyID of
      0:begin
          Text:=GetOneKeyAddressUrl(Text);
        end;
      CtrlID:begin
               SrcKey:=FAddressAutoFix.Values['Ctrl+Enter'];
               Text:=GetFixUrl(SrcKey,Text);
             end;
      AltID:begin
              SrcKey:=FAddressAutoFix.Values['Alt+Enter'];
              Text:=GetFixUrl(SrcKey,Text);
            end;
      ShiftID:begin
                SrcKey:=FAddressAutoFix.Values['Shift+Enter'];
                Text:=GetFixUrl(SrcKey,Text);
              end;
      ACID:begin
             SrcKey:=FAddressAutoFix.Values['Ctrl+Alt+Enter'];
             Text:=GetFixUrl(SrcKey,Text);
           end;
      SCID:begin
             SrcKey:=FAddressAutoFix.Values['Ctrl+Shift+Enter'];
             Text:=GetFixUrl(SrcKey,Text);
           end;
      ASID:begin
             SrcKey:=FAddressAutoFix.Values['Alt+Shift+Enter'];
             Text:=GetFixUrl(SrcKey,Text);
           end;
      ASCID:begin
              SrcKey:=FAddressAutoFix.Values['Ctrl+Shift+Alt+Enter'];
              Text:=GetFixUrl(SrcKey,Text);
            end;
    end;
    if Text='' then
    Text:='about:blank'
    {else if (Pos('.',Text)=0) and (not FileExists(Text)) and
       (not DirectoryExists(Text)) then
    Text:='http://www.baidu.com/s?wd='+Text};
    UpdateTypedUrls;
    if Assigned(FOnUrlSelected) then
    FOnUrlSelected(Self, Text, bCancel);
  end;
  FShiftKeyID:=0;

  inherited;
end;

end.

代码没有整理，习惯没养好

完整组件这里下载

http://files.cnblogs.com/uws2056/UWSIEAddress.rar