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. 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.
Viele Grüße
Bernd