View Issue Details

IDProjectCategoryView StatusLast Update
0038885LazarusWidgetsetpublic2021-05-13 16:12
ReporterBernd Hübner Assigned To 
PrioritynormalSeverityminorReproducibilityalways
Status confirmedResolutionopen 
OSLinux 
Product Version2.0.10 
Summary0038885: TSaveDialog with ofOverwritePrompt does not show OverwritePrompt if filename is typed without extension (only in Linux)
DescriptionI want to save a file with the SaveDialog. With the option ofoverwriteprompt I want to get a warning message if the file already exists. My code works under Windows, but under Linux I have the problem that the extension has to be included in the input field so that the warning message is output. Please see the example.
Please excuse my bad English.
Additional Informationunit 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 kle
TagsNo tags attached.
Fixed in Revision
LazTarget-
WidgetsetGTK 2
Attached Files

Activities

Bernd Hübner

2021-05-13 13:52

reporter  

project1.zip (129,590 bytes)

Issue History

Date Modified Username Field Change
2021-05-13 13:52 Bernd Hübner New Issue
2021-05-13 13:52 Bernd Hübner File Added: project1.zip
2021-05-13 16:12 Bart Broersma Status new => confirmed
2021-05-13 16:12 Bart Broersma LazTarget => -