SaveDialog mit ofoverwriteprompt

Für Fragen von Einsteigern und Programmieranfängern...
Antworten
wennerer
Beiträge: 507
Registriert: Di 19. Mai 2015, 20:05
OS, Lazarus, FPC: Linux Mint 20 Cinnamon,Lazarus 2.2.6 (rev lazarus_2_2_6) FPC 3.2.2 x86_64-linux-
CPU-Target: x86_64-linux-gtk2

SaveDialog mit ofoverwriteprompt

Beitrag von wennerer »

Hallo ins Forum,
ich kämpfe mal wieder mit einem SaveDialog. Hatte schon mal eine ähnliche Frage hier: viewtopic.php?f=55&t=11739

Mein Problem ist folgendes:
Ich möchte eine Datei mit dem SaveDialog speichern. Mit der Option ofoverwriteprompt möchte ich erreichen das mir eine Warnmeldung ausgegeben wird falls die Datei schon vorhanden ist. Mein Code funktioniert unter Windows, unter Linux habe ich aber das Problem das die Erweiterung im Eingabefeld mit drin stehen muss damit die Warnmeldung ausgegeben wird.
SaveDialog.png
SaveDialog.png (51.21 KiB) 1247 mal betrachtet
Mein Code sieht so aus. Vielleicht mache ich da ja was grundlegend falsch?

Code: Alles auswählen

unit Unit1;

{$mode objfpc}{$H+}

interface

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

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    PaintBmp  : TBitmap;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var SaveDialog : TSaveDialog;
    ext        : string;
    TempPicture: TPicture;
begin
 try
  SaveDialog              := TSaveDialog.Create(nil);
  SaveDialog.Title        := 'Ich teste Speichern unter' ;
  SaveDialog.FileName     := 'unbenannt';
  SaveDialog.DefaultExt   := '.png';
  SaveDialog.Filter       := 'PNG- Dateien (*.png)|*.png|Bitmap- Dateien (*.bmp)|*.bmp';
  SaveDialog.Options      := [ofoverwriteprompt,ofpathmustexist];

  if SaveDialog.Execute then
   begin
    ext:= ExtractFileExt(SaveDialog.FileName);

    if (ext = '.png') then
    begin
     try
      TempPicture  := TPicture.Create;
      TempPicture.Assign(PaintBmp);
      TempPicture.PNG.SaveToFile(SaveDialog.FileName);
     finally
      TempPicture.Free;
     end;
    end;

    if (ext = '.bmp') then PaintBmp.SaveToFile(SaveDialog.FileName);
   end;
 finally
   SaveDialog.Free;
 end;
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
 PaintBmp.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 PaintBmp  := TBitmap.Create;
 PaintBmp.SetSize(500,350);
 PaintBmp.Canvas.Brush.Color:=clWhite;
 PaintBmp.Canvas.FillRect(0,0,PaintBmp.Width,PaintBmp.Height);
 PaintBmp.Canvas.Brush.Color:=clLime;
 PaintBmp.Canvas.Rectangle(30,30,100,140);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
 canvas.Draw(50,50,PaintBmp);
end;

end.

Hier noch mein kleines Testprogramm.

Viele Grüße
Bernd
Dateianhänge
project1.zip
(126.55 KiB) 41-mal heruntergeladen

Benutzeravatar
fliegermichl
Lazarusforum e. V.
Beiträge: 1430
Registriert: Do 9. Jun 2011, 09:42
OS, Lazarus, FPC: Lazarus Fixes FPC Stable
CPU-Target: 32/64Bit
Wohnort: Echzell

Re: SaveDialog mit ofoverwriteprompt

Beitrag von fliegermichl »

Ich schätze, daß das mit defaultext zu tun hat. Wenn diese leer ist, dann bedeutet "unbenannt" unter Linux "unbenannt" (ohne Erweiterung)
Wenn defaultext auf ".png" gestellt wird, erscheint vermutlich die Warnung.

wennerer
Beiträge: 507
Registriert: Di 19. Mai 2015, 20:05
OS, Lazarus, FPC: Linux Mint 20 Cinnamon,Lazarus 2.2.6 (rev lazarus_2_2_6) FPC 3.2.2 x86_64-linux-
CPU-Target: x86_64-linux-gtk2

Re: SaveDialog mit ofoverwriteprompt

Beitrag von wennerer »

Hi fliegermichl,
danke für die Antwort. Ich habe es mit den folgenden 4 Varianten probiert:

Code: Alles auswählen

SaveDialog.DefaultExt   := '.png';
SaveDialog.DefaultExt   := 'png';
SaveDialog.DefaultExt   := '';
//SaveDialog.DefaultExt   := '.png';
Macht jedoch keinen Unterschied. Es erscheint keine Meldung. Die Meldung kommt nur wenn ich vor dem Erzeugen zum Beispiel
SaveDialog.FileName := 'unbenannt.png';
eingebe. Nützt mir aber nichts wenn ich dann als bmp speichern möchte. Nach dem Erzeugen des Dialogs lässt sich die Warnung nur erzeugen wenn ich im Eingabefeld die Erweiterung über die Tastatur eingebe.

Viele Grüße
Bernd

wp_xyz
Beiträge: 4869
Registriert: Fr 8. Apr 2011, 09:01

Re: SaveDialog mit ofoverwriteprompt

Beitrag von wp_xyz »

Ich vermute, dass, nachdem unter Linux die Extensions nicht DIE Rolle spielen wie bei Windows, das einfach nicht vollständig in den Widgetsets implementiert ist. Du kannst ja einen Bug-Report schreiben.

wennerer
Beiträge: 507
Registriert: Di 19. Mai 2015, 20:05
OS, Lazarus, FPC: Linux Mint 20 Cinnamon,Lazarus 2.2.6 (rev lazarus_2_2_6) FPC 3.2.2 x86_64-linux-
CPU-Target: x86_64-linux-gtk2

Re: SaveDialog mit ofoverwriteprompt

Beitrag von wennerer »

Hallo wp_xyz,
ich habe es mal eingetragen. https://bugs.freepascal.org/view.php?id=38885
Hoffentlich habe ich dabei nicht zu viel falsch gemacht.
Viele Grüße
Bernd

Benutzeravatar
theo
Beiträge: 10467
Registriert: Mo 11. Sep 2006, 19:01

Re: SaveDialog mit ofoverwriteprompt

Beitrag von theo »

Zur Not kann man ja auch selber etwas basteln. Z.B.

Code: Alles auswählen

var
  ButtonSelected: TModalResult;
begin
  repeat
    if SaveDialog1.Execute then
    begin
      ButtonSelected := mrYes;
      if FileExists(SaveDialog1.FileName) then
        ButtonSelected := MessageDlg(ExtractFileName(SaveDialog1.FileName) +
          ' überschreiben?', mtCustom, [mbYes, mbNo], 0);
    end else buttonSelected := mrYes;
    until ButtonSelected = mrYes;
end;  

wennerer
Beiträge: 507
Registriert: Di 19. Mai 2015, 20:05
OS, Lazarus, FPC: Linux Mint 20 Cinnamon,Lazarus 2.2.6 (rev lazarus_2_2_6) FPC 3.2.2 x86_64-linux-
CPU-Target: x86_64-linux-gtk2

Re: SaveDialog mit ofoverwriteprompt

Beitrag von wennerer »

Hallo Theo,
herzlichen Dank für deine Lösung. Ich kannte bis jetzt ModalResult gar nicht. Werde ich mir aber bestimmt merken!
Jedenfalls habe ich es jetzt in mein Mini Beispiel eingebaut und das läuft jetzt ohne Probleme!
Kann man vielleicht noch verbessern aber hier mein Vorschlag der meine Test's bestanden hat:

Code: Alles auswählen

unit Unit1;

{$mode objfpc}{$H+}

interface

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

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    PaintBmp  : TBitmap;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var SaveDialog : TSaveDialog;
    ext        : string;
    TempPicture: TPicture;
    ButtonSelected: TModalResult;
begin
 try
  SaveDialog              := TSaveDialog.Create(nil);
  SaveDialog.Title        := 'Ich teste Speichern unter' ;
  SaveDialog.FileName     := 'unbenannt';
  SaveDialog.DefaultExt   := '.png';
  SaveDialog.Filter       := 'PNG- Dateien (*.png)|*.png|Bitmap- Dateien (*.bmp)|*.bmp';
  //SaveDialog.Options      := [ofoverwriteprompt,ofpathmustexist];

  if SaveDialog.Execute then
   begin
    ext:= ExtractFileExt(SaveDialog.FileName);

    repeat
        if FileExists(SaveDialog.FileName) then
        ButtonSelected := MessageDlg(ExtractFileName(SaveDialog.FileName) +
          ' überschreiben?', mtCustom, [mbYes, mbNo], 0)
     else buttonSelected := mrYes;
    until (ButtonSelected = mrYes) or (ButtonSelected = mrNo);
    if ButtonSelected = mrNo then exit;



    if (ext = '.png') then
    begin
     try
      TempPicture  := TPicture.Create;
      TempPicture.Assign(PaintBmp);
      TempPicture.PNG.SaveToFile(SaveDialog.FileName);
     finally
      TempPicture.Free;
     end;
    end;

    if (ext = '.bmp') then PaintBmp.SaveToFile(SaveDialog.FileName);
   end;
 finally
   SaveDialog.Free;
 end;
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
 PaintBmp.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 PaintBmp  := TBitmap.Create;
 PaintBmp.SetSize(500,350);
 PaintBmp.Canvas.Brush.Color:=clWhite;
 PaintBmp.Canvas.FillRect(0,0,PaintBmp.Width,PaintBmp.Height);
 PaintBmp.Canvas.Brush.Color:=clLime;
 PaintBmp.Canvas.Rectangle(30,30,100,140);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
 canvas.Draw(50,50,PaintBmp);
end;

end.

Viele Grüße
Bernd

wp_xyz
Beiträge: 4869
Registriert: Fr 8. Apr 2011, 09:01

Re: SaveDialog mit ofoverwriteprompt

Beitrag von wp_xyz »

Zur Not ja, ist im Detail aber anders, denn eigentlich sollte die Meldung, dass die Datei schon existiert, kommen, solange der Dialog noch offen ist.

wennerer
Beiträge: 507
Registriert: Di 19. Mai 2015, 20:05
OS, Lazarus, FPC: Linux Mint 20 Cinnamon,Lazarus 2.2.6 (rev lazarus_2_2_6) FPC 3.2.2 x86_64-linux-
CPU-Target: x86_64-linux-gtk2

Re: SaveDialog mit ofoverwriteprompt

Beitrag von wennerer »

Naja ist schon klar. Theo schreibt ja zur Not.
Mal sehen vielleicht kommt ja durch den Bugreport noch was heraus.
Aber erstmal hilfts mir weiter und noch besser ich hab was neues gelernt!

Viele Grüße
Bernd

Antworten