unit Frmbtn;

(*******************************************************************************

 Copyright © 1998 Objective Software Technology Pty Ltd
 Functionality derived from Delphi VCL Source Code
 is Copyright © 1995-1998 Inprise Corporation

 TFormButton
 -----------

 Automatically creates and shows a form, using just the form name as a property.

 Published Properties:  FormName: TComponentName (string)
                        ShowModal: Boolean
                        AfterShow: TNotifyEvent

 Public Properties:     Form: TForm
                        FormModalResult: TModalResult

*******************************************************************************)

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, StdCtrls;

type
  TFormButton = class(TButton)
  private
    FForm: TForm;
    FFormName: TComponentName;
    FFormModalResult: TModalResult;
    FAfterShow: TNotifyEvent;
    FShowModal: Boolean;
    function GetForm: TForm;
  protected
  public
    procedure Click; override;
    property Form: TForm read GetForm;
    property FormModalResult: TModalResult read FFormModalResult;
  published
    property FormName: TComponentName read FFormName write FFormName;
    property ShowModal: Boolean read FShowModal write FShowModal default False;
    property AfterShow: TNotifyEvent read FAfterShow write FAfterShow;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TFormButton]);
end;

procedure TFormButton.Click;
var
  AClass: TPersistentClass;
  AFormClass: TFormClass;
begin
  inherited Click;
  if FFormName = '' then Exit;
  if FForm = nil then begin
    AClass := FindClass('T' + FFormName);
    AFormClass := TFormClass(AClass);
    FForm := AFormClass.Create(Self);
  end;
  if FShowModal then
    FFormModalResult := FForm.ShowModal
  else
    FForm.Show;
  if Assigned(FAfterShow) then FAfterShow(Self);
end;

function TFormButton.GetForm: TForm;
{
 Check the form hasn't already been destroyed
}
var
  I: integer;
begin
  with Application do
    for I := 0 to ComponentCount - 1 do
      if Components[I] = FForm then begin
        Result := FForm;
        Exit;
      end;
  FForm := nil;
  Result := nil;
end;

end.