Stop/Abort Form creation..

[Ian Branch 128]

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

[dummzeuch 1517]

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 April 19, 2023 by dummzeuch

[Ian Branch 128]

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 April 19, 2023 by Ian Branch

[David Heffernan 2354]

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 April 19, 2023 by David Heffernan

[Lajos Juhász 295]

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;

 

[Dalija Prasnikar 1405]

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. 

 

 

[programmerdelphi2k 237]

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 April 19, 2023 by programmerdelphi2k

[dummzeuch 1517]

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 April 20, 2023 by dummzeuch

[programmerdelphi2k 237]

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

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

Edited April 19, 2023 by programmerdelphi2k

[Ian Branch 128]

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.. 😞

 

Thoughts/suggestions?

 

Regards,

Ian

 

[Ian Branch 128]

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.

[Ian Branch 128]

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

 

Ian

[programmerdelphi2k 237]

@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 April 20, 2023 by programmerdelphi2k

[Ian Branch 128]

P2k.  Tks for the suggestion.  I think I will quit while I am ahead.  🙂

[programmerdelphi2k 237]

17 hours ago, dummzeuch said:

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

sorry any thing.