browseedit.pas

Delphi 开发的的热键操作 很值得看的

unit BrowseEdit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons;

type
  TBrowseEdit = class;

  TBrowseButton = class(TSpeedButton)
  private
    FEdit : TBrowseEdit;
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;

    procedure Click; override;
  end;

  TBrowseEdit = class(TCustomEdit)
  private
    FButton: TBrowseButton;
    FDialog: TOpenDialog;
    FOnButtonClick: TNotifyEvent;
  protected
    procedure cmEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
    procedure wmChar(var Msg: TWMChar); message WM_CHAR;
    procedure wmSize(var Msg: TWMSize); message WM_SIZE;
    procedure wmSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
    procedure ButtonClick;
    procedure SetEditRect;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CreateWnd; override;

    procedure CreateParams(var Params: TCreateParams); override;
    procedure WndProc(var Message: TMessage); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    property Button: TBrowseButton read FButton;
  published
    property AutoSelect;
    property AutoSize;
    property CharCase;
    property Color;
    property Ctl3D;
    property Dialog: TOpenDialog read FDialog write FDialog;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property ImeMode;
    property ImeName;
    property MaxLength;
    property OEMConvert;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PasswordChar;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
    property OnChange;
    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;

procedure Register;

implementation

constructor TBrowseButton.Create(AOwner: TComponent);
begin
  inherited;
  FEdit := TBrowseEdit(AOwner);
  ControlStyle := ControlStyle - [csDoubleClicks];
end;

procedure TBrowseButton.Paint;
var
  i,
  XPos,
  YPos   : Integer;
  Color1,
  Color2 : TColor;
begin
  XPos := 4;
  YPos := Height-5;
  with Canvas do
   begin
     Brush.Color := GetSysColor(COLOR_3DFACE);
     if FState in [bsDown, bsExclusive] then
      begin
        Pen.Color := GetSysColor(COLOR_3DSHADOW);
        Rectangle(0, 0, Width, Height);
        inc(XPos); inc(YPos);
      end
     else
      begin
        FillRect(ClientRect);
        Pen.Color := GetSysColor(COLOR_3DLIGHT);
        PolyLine([Point(0, Height-1), Point(0, 0), Point(Width-1, 0)]);
        Pen.Color := GetSysColor(COLOR_3DHILIGHT);
        PolyLine([Point(1, Height-1), Point(1, 1), Point(Width-1, 1)]);
        Pen.Color := GetSysColor(COLOR_3DDKSHADOW);
        PolyLine([Point(0, Height-1), Point(Width-1, Height-1), Point(Width-1, -1)]);
        Pen.Color := GetSysColor(COLOR_3DSHADOW);
        PolyLine([Point(1, Height-2), Point(Width-2, Height-2), Point(Width-2, 0)]);
      end;
     Color2 := GetSysColor(COLOR_3DHIGHLIGHT);
     if FEdit.Enabled then Color1 := GetSysColor(COLOR_BTNTEXT) else Color1 := GetSysColor(COLOR_3DSHADOW);
     for i:=0 to 2 do
      begin
        Pixels[XPos+3*i, YPos] := Color1;
        if not FEdit.Enabled then Pixels[XPos+3*i+1, YPos+1] := Color2;
      end;
   end;
end;

procedure TBrowseButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if FEdit.CanFocus then FEdit.SetFocus;
end;

procedure TBrowseButton.Click;
begin
  inherited;
  FEdit.ButtonClick;
end;

{ TBrowseEdit }
constructor TBrowseEdit.Create(AOwner: TComponent);
begin
  inherited;
  FButton := TBrowseButton.Create(Self);
  with FButton do
   begin
     Parent := Self;
     Cursor := crArrow;
     Visible := True;
   end;
end;

destructor TBrowseEdit.Destroy;
begin
  FButton.Free;
  inherited;
end;

procedure TBrowseEdit.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do Style := Style or ES_MULTILINE or ES_LEFT;
end;

procedure TBrowseEdit.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if (Operation=opRemove) and (AComponent=FDialog) then FDialog := nil;
  inherited;
end;

procedure TBrowseEdit.wmChar(var Msg: TWMChar);
var
  Key: Char;
begin
  if Msg.CharCode=VK_RETURN then
   begin
     MessageBeep(0);
     Msg.CharCode := 0;
     Key := #13;
     KeyPress(Key);
   end;
  inherited;
end;

procedure TBrowseEdit.CreateWnd;
begin
  inherited;
  SetEditRect;
end;

procedure TBrowseEdit.SetEditRect;
var
  Rect: TRect;
begin
  Rect := ClientRect;
  FButton.SetBounds(Rect.Right-16, 0, 16, Rect.Bottom);
  Rect.right := Rect.right - 16;
  Perform(EM_SETRECTNP, 0, lParam(@Rect));
end;

procedure TBrowseEdit.wmSize(var Msg: TWMSize);
begin
  inherited;
  SetEditRect;
end;

procedure TBrowseEdit.WndProc(var Message: TMessage);
begin
  with Message do
    case Msg of
      WM_WINDOWPOSCHANGING: SetEditRect;
    end;
  inherited WndProc(Message);
end; { WndProc }

procedure TBrowseEdit.wmSetFocus(var Msg: TWMSetFocus);
begin
  inherited;
  CreateCaret(Handle, 0, 1, ClientHeight-4);
  ShowCaret(Handle);
end;

procedure TBrowseEdit.cmEnabledChanged(var Msg: TMessage);
begin
  FButton.Paint;
end;

procedure TBrowseEdit.ButtonClick;
begin
  if Assigned(FDialog) then
   begin
     with FDialog do
      if Execute then
       begin
         Text := FileName;
         if AutoSelect then Perform(EM_SETSEL, 0, Length(Text));
       end;
   end
  else
   if Assigned(FOnButtonClick) then FOnButtonClick(Self);
end;

procedure Register;
begin
  RegisterComponents('SheAr', [TBrowseEdit]);
end;

end.