unit BtnEdit;
{ Edit line with button for invoking editor }
{
  (C) 2000 - 2002 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://www.jindrich.com
                      http://orgchem.natur.cuni.cz/Chromulan/
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}

interface

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

type
  TBtnEdit = class(TCustomEdit)
  private
    { Private declarations }
    FButton: TButton;
    FOnBtnClick: TNotifyEvent;
    FEmptyAllowed: boolean;
    FOrigText: string;

    procedure SetEditRect;
    procedure WMSize(var Message: TWMSize);message WM_SIZE;
  protected
    { Protected declarations }
    procedure UpdateBtnSize;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure DoBtnClick(Sender: TObject);
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure DoEnter; override;
    procedure Loaded;override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent);override;
    property Button: TButton read FButton;
  published
    { Published declarations }{getchildren}
    property OnBtnClick: TNotifyEvent read FOnBtnClick write FOnBtnClick;
    property ReadOnly;
    property TabOrder;
    property EmptyAllowed: boolean read FEmptyAllowed write FEmptyAllowed;
    property Enabled;
  end;

procedure Register;

implementation
{TBtnEdit private}
procedure TBtnEdit.SetEditRect;
var
  Loc: TRect;
begin
  SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
  Loc.Bottom := ClientHeight + 1;  {+1 is workaround for windows paint bug}
  Loc.Right := ClientWidth - FButton.Width - 2;
  Loc.Top := 0;
  Loc.Left := 0;
  SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
  SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));  {debug}
end;

procedure TBtnEdit.WMSize(var Message: TWMSize);
{var
  MinHeight: Integer;}
begin
  inherited;
  (*
  MinHeight := GetMinHeight;
    { text edit bug: if size to less than minheight, then edit ctrl does
      not display the text }
  if Height < MinHeight then
    Height := MinHeight
  else if FButton <> nil then
  begin
    if NewStyleControls and Ctl3D then
      FButton.SetBounds(Width - FButton.Width - 5, 0, FButton.Width, Height - 5)
    else FButton.SetBounds (Width - FButton.Width, 1, FButton.Width, Height - 3);
    SetEditRect;
  end;
  *)
  if FButton <> nil then begin
    if NewStyleControls and Ctl3D then
      FButton.SetBounds(Width - FButton.Width - 5, 0, FButton.Width, Height - 5)
    else
      FButton.SetBounds (Width - FButton.Width, 1, FButton.Width, Height - 3);
    SetEditRect;
  end;

end;
{
function TSpinEdit.GetMinHeight: Integer;
var
  DC: HDC;
  SaveFont: HFont;
  I: Integer;
  SysMetrics, Metrics: TTextMetric;
begin
  DC := GetDC(0);
  GetTextMetrics(DC, SysMetrics);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  I := SysMetrics.tmHeight;
  if I > Metrics.tmHeight then I := Metrics.tmHeight;
  Result := Metrics.tmHeight + I div 4 + GetSystemMetrics(SM_CYBORDER) * 4 + 2;
end;
}
{/TBtnEdit private}

{TBtnEdit protected}
procedure TBtnEdit.UpdateBtnSize;
begin
  FButton.Height := Height;
  FButton.Width := Height;
  FButton.Left := Width - FButton.Width;
end;

procedure TBtnEdit.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
end;

procedure TBtnEdit.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
{  Params.Style := Params.Style and not WS_BORDER;  }
  Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN;
end;

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

procedure TBtnEdit.DoEnter;
begin
  inherited;
  FOrigText := Text;
end;
{ulobjdes ulfobju}
procedure TBtnEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  {v0.50}
  if Key = vk_delete then begin
    if ReadOnly then begin
      if FEmptyAllowed then begin
        Text := '';
      end else
        Key := 0;
    end;
  end;
  {/v0.50
  if FEmptyAllowed and ReadOnly then begin
    if Key = vk_delete then begin
      Text := '';
    end;
  end;
  }
  if Key = vk_escape then begin
    Text := FOrigText;
  end;
  inherited;
end;

procedure TBtnEdit.DoBtnClick(Sender: TObject);
begin
  if Assigned(FOnBtnClick) then
    FOnBtnClick(Sender);
end;

{v0.29}
procedure TBtnEdit.Loaded;
begin
  inherited;
  if FButton <> nil then
    FButton.Enabled := Enabled;
end;
{/v0.29}

{/TBtnEdit protected}


{TBtnEdit public}
constructor TBtnEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FButton := TButton.Create(Self);
  FButton.Parent := Self;
  FButton.OnClick := DoBtnClick;
  FButton.Caption := '...';
  FButton.Name := 'Button';

  UpdateBtnSize;
end;

{/TBtnEdit public}

procedure Register;
begin
  RegisterComponents('Chromulan', [TBtnEdit]);
end;
{v0.44}
initialization
  RegisterClasses([TBtnEdit]);
{/v0.44}
end.
