Jump to content
Ian Branch

Stop/Abort Form creation..

Recommended Posts

Hi Team,

Win 11, D11.3.1.

I have the following form create code..

procedure TChangesLogForm.FormCreate(Sender: TObject);
begin
  //
  IndexOrd.ItemIndex := 0;
  //
  case JSDialog1.Execute of
    100: ttChangesLog.SQL.Text := 'SELECT  * from dbiworkflow.changeslog order by DateTime';
    200: ttChangesLog.SQL.Text := 'SELECT  * from dbiarchive.achangeslog order by DateTime';
    300:
      begin
        TaskMessageDlg('Warning!', 'You have selected to view both databases.' + #13 + 'This will take some time to produce the view!' + #13 +
          'Please be patient.', mtInformation, [mbOK], 0);
        ttChangesLog.SQL.Text := 'SELECT * FROM vAllChangesLog order by DateTime';
      end;
    400: //  Stop creating and abort the form.
  end;
  //
end;

the '400:' selection is to Cancel the form and return to the calling form.

How do I achieve this please?

I tried 400:  PostMessage(Handle, WM_CLOSE, 0, 0);, but that didn't work.  😞

 

Regards & TIA,

Ian

Share this post


Link to post

Exceptions won't work inside the FormCreate method, but if you move that code into the Create constructor you could simply call SysUtils.Abort (or raise any other custom exception). Note though that this will immediately calls the destructor, so make sure that destructor works with a partially initialized instance.

 

I never use FormCreate (or FormDestroy for that matter) but always put the code into the constructor / destructor of a form. This saved me from the OldCreateOrder apocalypse when Delphi 11 removed that field from TCustomForm.

Edited by dummzeuch

Share this post


Link to post

Hi Thomas,

I'm afraid I don't know where/how to do that.

Can you show me an example or two please?

 

Regards & TIA,

Ian

Edited by Ian Branch

Share this post


Link to post
34 minutes ago, dummzeuch said:

Exceptions won't work inside the FormCreate method

What happens to an exception raised in OnCreate? 

 

EDIT: I was curious. This is what happens:

 

procedure TCustomForm.DoCreate;
begin
  if Assigned(FOnCreate) then
  try
    FOnCreate(Self);
  except
    if not HandleCreateException then
      raise;
  end;
  if fsVisible in FFormState then Visible := True;
end;

function TCustomForm.HandleCreateException: Boolean;
begin
  Application.HandleException(Self);
  Result := True;
end;

 

So exceptions are handled by a top level handler, and then excecution continues.

 

This feels like quite a strange design choice to me. Swallowing exceptions feels odd.

 

You can change this behaviour by overriding the dynamic method HandleCreateException to return False.

 

Like @dummzeuch I never use OnCreate or OnDestroy.

Edited by David Heffernan

Share this post


Link to post

You should move this code to a class procedure in that case you can execute the dialog before you create the form. 

 

If it's a modalform before wm_close you have to set the modalresult. I've tested in Delphi 11.2:

 

procedure TForm2.FormCreate(Sender: TObject);
begin
  if not OpenDialog1.Execute then
  begin
    modalResult:=mrCancel;
    PostMessage(handle, wm_close, 0, 0);
  end;
end;

 

  • Like 1

Share this post


Link to post
3 hours ago, Ian Branch said:

How do I achieve this please?

Your code logic sounds backward. You should run code in FormCreate inside the calling form and then depending on the result create TChangesLogForm or not. Or if the code really belongs to TChangesLogForm, you should not run that code within FormCreate, but after the form is shown (along with some indication that there is a work in progress) and then if there is an error retrieving the data, you can show error message and close the form in that moment. 

 

 

  • Like 3

Share this post


Link to post

this way can do it ...

procedure TForm1.Button2Click(Sender: TObject);
begin
  //try
    Form2 := TForm2.Create(nil); // form2 can be closed now...
    try
      Form2.ShowModal;
    finally
      Form2.Free;
    end;
  //except
    // ? avoid exception leaks to ancestral, if using "raise exception...in form2"
  //end;
end;

 

type
  TForm2 = class(TForm)
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormShow(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    procedure CloseMeForced;
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}
{ TForm2 }

procedure TForm2.CloseMeForced;
var
  CloseMe: Boolean;
begin
  CloseMe := Label1.Caption = ''; // some logic...
  //
  ShowMessage('hello');
  //
  if CloseMe then
    Abort; // raise Exception.Create('hello');
  //
  Label1.Caption := 'still have a dreams...';
end;

constructor TForm2.Create(AOwner: TComponent); // called before "FormCreate()"
begin
  inherited;
  //
  CloseMeForced;
end;

procedure TForm2.FormActivate(Sender: TObject);
begin
  ShowMessage('FormActivate never called... if CloseMe=true');
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ShowMessage('FormClose never called... if CloseMe=true');
end;

procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  ShowMessage('CloseQuery never called... if CloseMe=true');
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  ShowMessage('FormCreate never called... if CloseMe=true');
end;

procedure TForm2.FormDeactivate(Sender: TObject);
begin
  ShowMessage('FormDeactivate never called... if CloseMe=true');
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
  ShowMessage('FormDestroy never called... if CloseMe=true');
end;

procedure TForm2.FormPaint(Sender: TObject);
begin
  ShowMessage('FormPaint never called... if CloseMe=true');
end;

procedure TForm2.FormResize(Sender: TObject);
begin
  ShowMessage('FormResize never called... if CloseMe=true');
end;

procedure TForm2.FormShow(Sender: TObject);
begin
  ShowMessage('FormShow never called... if CloseMe=true');
end;

.end

 

Edited by programmerdelphi2k

Share this post


Link to post

Hm, where did my answer with the code example, that I posted this morning, go? I'm sure I pressed submit before closing the browser ...

 

Edit: OK, seems to be gone. Not sure what happened

 

 

@programmerdelphi2k In case your answer was addressed to me and wasn't meant as a joke:

10 hours ago, programmerdelphi2k said:

I did some hour ago, not copy from you I swear!!!

I didn't mean to accuse you of anything. Your code is totally different from what I posted anyway.

Edited by dummzeuch

Share this post


Link to post

I did some hour ago, not copy from you I swear!!!

I just forgot put other events to test as above...  😏

Edited by programmerdelphi2k

Share this post


Link to post

Hi Team,

Getting there..

I have the following calling code..

procedure TMainForm.actEmailsLogExecute(Sender: TObject);
begin
  //
  if IsFormOpen('EmailsLogForm') then Exit;
  //
  Screen.Cursor := crHourGlass;
  //
  var EmailsLogForm := TEmailsLogForm.Create(Self);
  //
  EmailsLogForm.Show;
  //
  Screen.Cursor := crDefault;
  //
end;

And the following Create in the called form..

constructor TChangesLogForm.Create(AOwner: TComponent); // called before "FormCreate()"
begin
  inherited;
  //
  var lCloseForm := False;
  //
  case JSDialog1.Execute of
    100: ttChangesLog.SQL.Text := 'SELECT  * from dbiworkflow.changeslog order by DateTime';
    200:
      begin
        TaskMessageDlg('Warning!', 'You have selected to view records from the Archive database.' + #13 + 'This will take some time to produce the view!' + #13 +
          'Please be patient.', mtInformation, [mbOK], 0);
        ttChangesLog.SQL.Text := 'SELECT  * from dbiarchive.achangeslog order by DateTime';
      end;
    300:
      begin
        TaskMessageDlg('Warning!', 'You have selected to view records from both databases.' + #13 + 'This will take some time to produce the view!' + #13 +
          'Please be patient.', mtInformation, [mbOK], 0);
        ttChangesLog.SQL.Text := 'SELECT * FROM vAllChangesLog order by DateTime';
      end;
    400: lCloseForm := True;
    //
  end;
  //
  if lCloseForm then Abort;
  //
end;

The Abort works fine, I return to the calling form, however, I end up with a spinning cursor.. 😞

image.png.ad86e83fd14f5bc06b94ea8b55faa66d.png

 

Thoughts/suggestions?

 

Regards,

Ian

 

Share this post


Link to post

Cured it!

I did this..

procedure TMainForm.actChangesLogExecute(Sender: TObject);
begin
  //
  if IsFormOpen('ChangesLogForm') then Exit;
  //
  Screen.Cursor := crHourGlass;
  //
  try
    //
  var ChangesLogForm := TChangesLogForm.Create(Self);
    //
    ChangesLogForm.Show;
    //
  finally
    Screen.Cursor := crDefault;
  end;
  //
end;

No more spinning cursor.

Share this post


Link to post

My thanks to all.  I have a working solution and a new methodology for future use.

 

Ian

Share this post


Link to post

@Ian Branch   

have you try override "DoDestroy" on Form?

like DoCreate you can use it to change your cursor automatically...

 

https://docwiki.embarcadero.com/Libraries/Sydney/en/Vcl.Forms.TCustomForm.DoDestroy

 

Quote

protected

procedure Destroy; override;

...

procedure TForm2.Destroy;

begin;

   Screen.Cursor := crDefault;

...

  inherited;

end;

 

Edited by programmerdelphi2k

Share this post


Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×