Stop Procedure on Exit Program

Question

Stop Procedure on Exit Program

Navigation

#1 by (1 votes)

2

I am using a code to ask the user if he wants to save the changes before leaving the program (Yes, No, Cancel).

The problem is that when the user clicks to save before exiting (Yes button) if it closes the SaveDialog that was opened, the program is terminated without saving anything (the correct one would be the program did not finish because the user gave up save).

I'm using the following code:

  private
    { Private declarations }
    FFileName: string;


  resourcestring
  sSaveChanges = 'Salvar alterações de %s?';


procedure TFrmMain.CheckFileSave;
var
  SaveResp: Integer;
begin
  if REdtMinhaLista.Modified = false then Exit; //se o RichEdit for modificado
  SaveResp := MessageDlg(Format(sSaveChanges, [FFileName]),
    mtConfirmation, mbYesNoCancel, 0);
  case SaveResp of
  idYes: SaveDocument; //problema: se o usuário clicar "Sim" e fechar o SaveDialog o programa fecha.
  idNo: ; //Nothing
  idCancel: Abort;
  end;
end;

procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  try
    CheckFileSave;
  except
    CanClose := False;
  end;
end;

Document save procedure:

procedure TFrmMain.SaveDocument;
begin
  if FFileName = sUntitled then
     SaveAsDocument
  else
  begin
    REdtMinhaLista.Lines.SaveToFile(FFileName);
    REdtMinhaLista.Modified := False;
    SetModified(False);
  end;
end;

How could I solve this problem?

delphi

asked by anonymous 09.10.2017 / 16:45

1 answer

Return Json in Array instead of Object How to remove a TR element from a list created with append?

score 1 · Accepted Answer

The only thing you need to do is change the values in the case I leave the example:

case SaveResp of
  6: SaveDocument; //idYes
  7: ; //Nothing   //idNo
  2: Abort;        //idCancel
end;

Complete list of match values:

mrYes      = 6
mrNo       = 7
mrOK       = 1
mrCancel   = 2
mrAbort    = 3
mrRetry    = 4
mrIgnore   = 5
mrAll      = 8
mrNoToAll  = 9
mrYesToAll = 10

You can read more information here .

EDIT1:

I made a simple example of using the message to create or not a folder in a dir, I leave an example:

//Declaro VClose como variavel global para fechar ou não o projecto 
var
  Form1: TForm1;
    VClose: Boolean;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //passo a variavel para falso para não fechar a aplicação enquanto não der permição
  VClose := False;
end;

procedure TForm1.CheckFileSave;
var SaveResp: Integer;
    sSaveChanges, FFileName: String;
begin
  sSaveChanges := 'Salvar alterações de %s?';
  FFileName := 'FileName';
  SaveResp := MessageDlg(Format(sSaveChanges, [FFileName]), mtConfirmation, mbYesNoCancel, 0);

  //usei um memo para ter a certeza que está tudo a passar no sitio correto
  if SaveResp = mrYes then
    Begin
      Memo1.Lines.Add('Yes pressed');
      SaveDocument; //vamos criar a pasta com falei acima
    End
  else if SaveResp = mrNo then
    Begin
      Memo1.Lines.Add('No pressed');
      VClose := True;  //se clicou não gravar então passo a var a true
    End
  else if SaveResp = mrCancel then
    Begin
      Memo1.Lines.Add('Cancel pressed');  //não fazemos nada
    End;
end;

procedure TForm1.SaveDocument; 
var NameDir: String;
begin
  NameDir := 'C:\TestDir';   //atribui o caminho
  if ForceDirectories(NameDir) then
    Begin
      memo1.Lines.add('Folder Created');
      VClose := True;  //se criou passo a var a true
    End
  else memo1.Lines.add('New directory failed with error : '+ IntToStr(GetLastError));
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CheckFileSave;

  CanClose := VClose; //só fecha de VClose for igual a true;
end;

I tried to drill down into the code, but there's no question, the only thing you need to do is to change the savedocument code to how you need it. But before I advised to test the code to make sure it works as intended.

The " secret " for things to work fine is in the VClose variable, assigning false there is variable it will never close the project.