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
轉載于:https://www.cnblogs.com/uws2056/archive/2012/01/08/2316437.html
總結
以上是生活随笔為你收集整理的TEdit扩展：做成多按钮的Edit，可用作浏览器地址栏的全部內容，希望文章能夠幫你解決所遇到的問題。
- 上一篇： Adobe 引入自动标记功能，帮助残障人
- 下一篇： HTML5 Canvans 常用API整