implemented TOpenPictureDialog

git-svn-id: trunk@4558 -

.gitattributes

@@ -736,6 +736,7 @@ lcl/dirsel.pas svneol=native#text/pascal
 lcl/dynamicarray.pas svneol=native#text/pascal
 lcl/dynhasharray.pp svneol=native#text/pascal
 lcl/extctrls.pp svneol=native#text/pascal
+lcl/extdlgs.pas svneol=native#text/pascal
 lcl/extendedstrings.pas svneol=native#text/pascal
 lcl/filectrl.pp svneol=native#text/pascal
 lcl/forms.pp svneol=native#text/pascal

lcl/allunits.pp

@@ -38,7 +38,7 @@ uses
   Buttons, Extctrls, Registry, Calendar, Clipbrd, Forms, LCLLinux, Spin,
   Comctrls, Graphics, StdCtrls, Arrow, Controls, ImgList, Menus, Toolwin,
   Dialogs, Messages, Clistbox, ActnList, Grids, MaskEdit,
-  Printers, PostScriptPrinter, CheckLst, PairSplitter, DirSel;
+  Printers, PostScriptPrinter, CheckLst, PairSplitter, DirSel, ExtDlgs;
 
 implementation
 
@@ -47,6 +47,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.28  2003/09/02 21:32:56  mattias
+  implemented TOpenPictureDialog
+
   Revision 1.27  2003/08/18 13:21:23  mattias
   renamed lazqueue to lazlinkedlist, patch from Jeroen
 

lcl/dialogs.pp

@@ -90,11 +90,13 @@ type
     property Title : string read FTitle write FTitle;
     property UserChoice : integer read FUserChoice write FUserChoice;
     procedure Close;
+    procedure DoShow; virtual;
+    procedure DoClose; virtual;
     function HandleAllocated: boolean;
   published
-    property OnClose : TNotifyEvent read FOnClose write FOnClose;
+    property OnClose: TNotifyEvent read FOnClose write FOnClose;
     property OnCanClose: TCloseQueryEvent read FOnCanClose write FOnCanClose;
-    property OnShow : TNotifyEvent read FOnShow write FOnShow;
+    property OnShow: TNotifyEvent read FOnShow write FOnShow;
     property HelpContext: THelpContext read FHelpContext write FHelpContext default 0;
     property Width: integer read FWidth write FWidth;
     property Height: integer read FHeight write FHeight;
@@ -117,11 +119,11 @@ type
     procedure SetDefaultExt(const AValue: string);
   protected
     function DoExecute: boolean; override;
-    procedure SetFileName(Value: String); virtual;
+    procedure SetFileName(const Value: String); virtual;
-    procedure SetFilter(Value: String); virtual;
+    procedure SetFilter(const Value: String); virtual;
     procedure SetHistoryList(const AValue: TStrings); virtual;
   public
-    constructor Create(AOwner : TComponent); override;
+    constructor Create(TheOwner: TComponent); override;
     destructor Destroy; override;
     function Execute: boolean; override;
     property Files: TStrings read FFiles;
@@ -140,10 +142,9 @@ type
   
   TOpenOption = (
     ofReadOnly,
-    ofOverwritePrompt, // tests if selected file exists and if so shows a
+    ofOverwritePrompt, // if selected file exists shows a message, that file
-                       // message, to inform the user, that file will be
+                       // will be overwritten
-                       // overwritten
+    ofHideReadOnly,    // hide read only file
-    ofHideReadOnly,
     ofNoChangeDir,     // do not change current directory
     ofShowHelp,        // show a help button
     ofNoValidate,
@@ -162,7 +163,7 @@ type
     ofEnableIncludeNotify,
     ofEnableSizing,    // dialog can be resized, e.g. via the mouse
     ofDontAddToRecent, // do not add the path to the history list
-    ofForceShowHidden, // includes in display files marked as hidden
+    ofForceShowHidden, // show hidden files
     ofViewDetail       // details are OS and interface dependent
     );
   TOpenOptions = set of TOpenOption;
@@ -172,10 +173,16 @@ type
     FOnFolderChange: TNotifyEvent;
     FOnSelectionChange: TNotifyEvent;
     FOptions: TOpenOptions;
+    FLastSelectionChangeFilename: string;
   protected
+    procedure DereferenceLinks; virtual;
+    function CheckFile(var AFilename: string): boolean; virtual;
+    function CheckAllFiles: boolean; virtual;
     function DoExecute: boolean; override;
   public
     constructor Create(AOwner: TComponent); override;
+    procedure DoFolderChange; virtual;
+    procedure DoSelectionChange; virtual;
   published
     property Options: TOpenOptions read FOptions write FOptions
       default [ofEnableSizing, ofViewDetail];
@@ -412,6 +419,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.35  2003/09/02 21:32:56  mattias
+  implemented TOpenPictureDialog
+
   Revision 1.34  2003/08/14 10:36:55  mattias
   added TSelectDirectoryDialog
 

lcl/extdlgs.pas

@@ -0,0 +1,262 @@
+{
+ /***************************************************************************
+                               extdlgs.pas
+                               -----------
+                Component Library Extended dialogs Controls
+
+
+ ***************************************************************************/
+
+ *****************************************************************************
+ *                                                                           *
+ *  This file is part of the Lazarus Component Library (LCL)                 *
+ *                                                                           *
+ *  See the file COPYING.LCL, included in this distribution,                 *
+ *  for details about the copyright.                                         *
+ *                                                                           *
+ *  This program is distributed in the hope that it will be useful,          *
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
+ *                                                                           *
+ *****************************************************************************
+}
+unit ExtDlgs;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, VCLGlobals, LCLType, LCLStrConsts, Controls, Dialogs,
+  Graphics, ExtCtrls, StdCtrls, Forms, FileCtrl;
+  
+type
+
+  { TPreviewFileControl }
+
+  TPreviewFileDialog = class;
+
+  TPreviewFileControl = class(TWinControl)
+  private
+    FPreviewFileDialog: TPreviewFileDialog;
+  protected
+    procedure SetPreviewFileDialog(const AValue: TPreviewFileDialog);
+    procedure CreateParams(var Params: TCreateParams); override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    property PreviewFileDialog: TPreviewFileDialog read FPreviewFileDialog
+                                                   write SetPreviewFileDialog;
+  end;
+
+
+  { TPreviewFileDialog }
+
+  TPreviewFileDialog = class(TOpenDialog)
+  private
+    FPreviewFileControl: TPreviewFileControl;
+  protected
+    procedure CreatePreviewControl; virtual;
+    procedure InitPreviewControl; virtual;
+  public
+    function Execute: boolean; override;
+    constructor Create(TheOwner: TComponent); override;
+    property PreviewFileControl: TPreviewFileControl read FPreviewFileControl;
+  end;
+  
+  
+  { TOpenPictureDialog }
+  
+  TOpenPictureDialog = class(TPreviewFileDialog)
+  private
+    FDefaultFilter: string;
+    FImageCtrl: TImage;
+    FPictureGroupBox: TGroupBox;
+    FPreviewFilename: string;
+  protected
+    function  IsFilterStored: Boolean; virtual;
+    procedure PreviewKeyDown(Sender: TObject; var Key: word); virtual;
+    procedure PreviewClick(Sender: TObject); virtual;
+    procedure DoClose; override;
+    procedure DoSelectionChange; override;
+    procedure DoShow; override;
+    property ImageCtrl: TImage read FImageCtrl;
+    property PictureGroupBox: TGroupBox read FPictureGroupBox;
+    procedure InitPreviewControl; override;
+    procedure ClearPreview; virtual;
+    procedure UpdatePreview; virtual;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    property DefaultFilter: string read FDefaultFilter;
+  published
+    property Filter stored IsFilterStored;
+  end;
+  
+  
+  { TSavePictureDialog }
+  
+  TSavePictureDialog = class(TOpenPictureDialog)
+  public
+    constructor Create(TheOwner: TComponent); override;
+  end;
+  
+  
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+  RegisterComponents('Dialogs',[TOpenPictureDialog,TSavePictureDialog]);
+end;
+
+{ TPreviewFileControl }
+
+procedure TPreviewFileControl.SetPreviewFileDialog(
+  const AValue: TPreviewFileDialog);
+begin
+  if FPreviewFileDialog=AValue then exit;
+  FPreviewFileDialog:=AValue;
+end;
+
+procedure TPreviewFileControl.CreateParams(var Params: TCreateParams);
+begin
+  inherited CreateParams(Params);
+  Params.Style := Params.Style and not WS_CHILD;
+end;
+
+constructor TPreviewFileControl.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  FCompStyle:=csPreviewFileControl;
+  SetInitialBounds(0,0,200,200);
+end;
+
+{ TPreviewFileDialog }
+
+procedure TPreviewFileDialog.CreatePreviewControl;
+begin
+  if FPreviewFileControl<>nil then exit;
+  FPreviewFileControl:=TPreviewFileControl.Create(Self);
+  FPreviewFileControl.PreviewFileDialog:=Self;
+  InitPreviewControl;
+end;
+
+procedure TPreviewFileDialog.InitPreviewControl;
+begin
+  FPreviewFileControl.Name:='PreviewFileControl';
+end;
+
+function TPreviewFileDialog.Execute: boolean;
+begin
+  CreatePreviewControl;
+  Result:=inherited Execute;
+end;
+
+constructor TPreviewFileDialog.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  FCompStyle:=csPreviewFileDialog;
+end;
+
+{ TOpenPictureDialog }
+
+function TOpenPictureDialog.IsFilterStored: Boolean;
+begin
+  Result := (Filter<>FDefaultFilter);
+end;
+
+procedure TOpenPictureDialog.PreviewKeyDown(Sender: TObject; var Key: word);
+begin
+  if Key = VK_ESCAPE then TForm(Sender).Close;
+end;
+
+procedure TOpenPictureDialog.PreviewClick(Sender: TObject);
+begin
+
+end;
+
+procedure TOpenPictureDialog.DoClose;
+begin
+  ClearPreview;
+  inherited DoClose;
+end;
+
+procedure TOpenPictureDialog.DoSelectionChange;
+begin
+  UpdatePreview;
+  inherited DoSelectionChange;
+end;
+
+procedure TOpenPictureDialog.DoShow;
+begin
+  ClearPreview;
+  inherited DoShow;
+end;
+
+procedure TOpenPictureDialog.InitPreviewControl;
+begin
+  inherited InitPreviewControl;
+  FPictureGroupBox.Parent:=PreviewFileControl;
+end;
+
+procedure TOpenPictureDialog.ClearPreview;
+begin
+  FPictureGroupBox.Caption:='None';
+  FImageCtrl.Picture:=nil;
+end;
+
+procedure TOpenPictureDialog.UpdatePreview;
+var
+  CurFilename: String;
+  FileIsValid: boolean;
+begin
+  CurFilename := FileName;
+  if CurFilename = FPreviewFilename then exit;
+
+  FPreviewFilename := CurFilename;
+  FileIsValid := FileExists(FPreviewFilename)
+                 and (not DirectoryExists(FPreviewFilename))
+                 and FileIsReadable(FPreviewFilename);
+  if FileIsValid then
+    try
+      FImageCtrl.Picture.LoadFromFile(FPreviewFilename);
+      FPictureGroupBox.Caption := Format('(%dx%d)',
+        [FImageCtrl.Picture.Width, FImageCtrl.Picture.Height]);
+    except
+      FileIsValid := False;
+    end;
+  if not FileIsValid then
+    ClearPreview;
+end;
+
+constructor TOpenPictureDialog.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  FDefaultFilter := 'All files ('+GetAllFilesMask+')|'+GetAllFilesMask+'|'
+                    +GraphicFilter(TGraphic);
+  Filter:=FDefaultFilter;
+
+  FPictureGroupBox:=TGroupBox.Create(Self);
+  with FPictureGroupBox do begin
+    Name:='FPictureGroupBox';
+    Align:=alClient;
+  end;
+  
+  FImageCtrl:=TImage.Create(Self);
+  with FImageCtrl do begin
+    Name:='FImageCtrl';
+    Parent:=FPictureGroupBox;
+    Align:=alClient;
+  end;
+end;
+
+{ TSavePictureDialog }
+
+constructor TSavePictureDialog.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  Title:=rsfdFileSaveAs;
+end;
+
+end.
+

lcl/filectrl.pp

@@ -87,6 +87,7 @@ type
 
 function SearchFileInPath(const Filename, BasePath, SearchPath,
   Delimiter: string; Flags: TSearchFileInPathFlags): string;
+function GetAllFilesMask: string;
 
 // file actions
 function ReadFileToString(const Filename: string): string;
@@ -126,6 +127,9 @@ end.
 
 {
   $Log$
+  Revision 1.18  2003/09/02 21:32:56  mattias
+  implemented TOpenPictureDialog
+
   Revision 1.17  2003/08/13 16:18:58  mattias
   started check compiler options
 

lcl/graphics.pp

@@ -35,8 +35,7 @@ uses
   SysUtils, Classes,
   LCLStrConsts, vclGlobals, LMessages, LCLType, LCLProc, LCLLinux, LResources,
   GraphType, GraphMath
-  {$IFDEF UseFPImage}, FPReadPNG, IntfGraphics{$ENDIF}
+  {$IFDEF UseFPImage}, FPImage, FPReadPNG, FPWritePNG, IntfGraphics{$ENDIF}
-  {$IFDEF HasPNGWriter}, FPWritePNG{$ENDIF}
   ;
 
 type
@@ -606,6 +605,8 @@ type
     class procedure RegisterClipboardFormat(FormatID: TClipboardFormat;
       AGraphicClass: TGraphicClass);
     class procedure UnregisterGraphicClass(AClass: TGraphicClass);
+    procedure Clear; virtual;
+  public
     property Bitmap: TBitmap read GetBitmap write SetBitmap;
     property Pixmap: TPixmap read GetPixmap write SetPixmap;
     property PNG: TPortableNetworkGraphic read GetPNG write SetPNG;
@@ -880,12 +881,19 @@ type
     procedure WriteData(Stream: TStream); override;
     procedure WriteStream(Stream: TStream; WriteSize: Boolean); virtual;
     procedure StoreOriginalStream(Stream: TStream); virtual;
+    {$IFDEF UseFPImage}
+    procedure ReadStreamWithFPImage(Stream: TStream; Size: Longint;
+                               ReaderClass: TFPCustomImageReaderClass); virtual;
+    procedure WriteStreamWithFPImage(Stream: TStream; WriteSize: boolean;
+                               WriterClass: TFPCustomImageWriterClass); virtual;
+    {$ENDIF}
   public
     constructor VirtualCreate; override;
     destructor Destroy; override;
     procedure Assign(Source: TPersistent); override;
     procedure FreeImage;
     function HandleAllocated: boolean;
+    function LazarusResourceTypeValid(const ResourceType: string): boolean; virtual;
     procedure LoadFromStream(Stream: TStream); override;
     procedure LoadFromLazarusResource(const ResName: String); override;
     procedure LoadFromResourceName(Instance: THandle; const ResName: String); virtual;
@@ -915,7 +923,7 @@ type
   
   TPixmap = class(TBitmap)
   public
-    procedure LoadFromLazarusResource(const ResName: String); override;
+    function LazarusResourceTypeValid(const ResourceType: string): boolean; override;
     procedure WriteStream(Stream: TStream; WriteSize: Boolean); override;
   end;
   
@@ -923,7 +931,7 @@ type
   
   TPortableNetworkGraphic = class(TBitmap)
   public
-    procedure LoadFromLazarusResource(const ResName: String); override;
+    function LazarusResourceTypeValid(const ResourceType: string): boolean; override;
     procedure ReadStream(Stream: TStream; Size: Longint); override;
     procedure WriteStream(Stream: TStream; WriteSize: Boolean); override;
   end;
@@ -946,6 +954,10 @@ type
   // Color / Identifier mapping
   TGetColorStringProc = procedure(const s:ansistring) of object;
   
+function GraphicFilter(GraphicClass: TGraphicClass): string;
+function GraphicExtension(GraphicClass: TGraphicClass): string;
+function GraphicFileMask(GraphicClass: TGraphicClass): string;
+
 function ColorToIdent(Color: Longint; var Ident: String): Boolean;
 function IdentToColor(const Ident: string; var Color: Longint): Boolean;
 function ColorToRGB(Color: TColor): Longint;
@@ -1166,6 +1178,8 @@ end;
 
 
 initialization
+  PicClipboardFormats:=nil;
+  PicFileFormats:=nil;
   RegisterIntegerConsts(TypeInfo(TColor), @IdentToColor, @ColorToIdent);
   RegisterIntegerConsts(TypeInfo(TFontCharset), @IdentToCharset, @CharsetToIdent);
 
@@ -1180,6 +1194,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.86  2003/09/02 21:32:56  mattias
+  implemented TOpenPictureDialog
+
   Revision 1.85  2003/09/02 16:08:19  mattias
   implemented TPortableNetworkGraphic reading
 

lcl/include/bitmap.inc

@@ -134,6 +134,11 @@ begin
   Result:=(FImage<>nil) and (FImage.FHandle<>0);
 end;
 
+function TBitmap.LazarusResourceTypeValid(const ResourceType: string): boolean;
+begin
+  Result:=true;
+end;
+
 procedure TBitMap.Mask(ATransparentColor: TColor);
 begin
 
@@ -250,15 +255,15 @@ var
   res:TLResource;
 begin
   res:=LazarusResources.Find(ResName);
-  if (res<>nil) and (res.Value<>'') then begin
+  if (res=nil) or (res.Value='') or not LazarusResourceTypeValid(res.ValueType)
-    ms:=TMemoryStream.Create;
+  then exit;
-    try
+  ms:=TMemoryStream.Create;
-      ms.Write(res.Value[1],length(res.Value));
+  try
-      ms.Position:=0;
+    ms.Write(res.Value[1],length(res.Value));
-      LoadFromStream(ms);
+    ms.Position:=0;
-    finally
+    LoadFromStream(ms);
-      ms.Free;
+  finally
-    end;
+    ms.Free;
   end;
 end;
 
@@ -639,6 +644,91 @@ begin
   MemStream.Position:=0;
 end;
 
+{$IFDEF UseFPImage}
+procedure TBitmap.ReadStreamWithFPImage(Stream: TStream; Size: Longint;
+  ReaderClass: TFPCustomImageReaderClass);
+var
+  IntfImg: TLazIntfImage;
+  ImgReader: TFPCustomImageReader;
+  ImgHandle, ImgMaskHandle: HBitmap;
+begin
+  UnshareImage;
+  if Size = 0 then begin
+    Width:=0;
+    Height:=0;
+    exit;
+  end;
+  StoreOriginalStream(Stream);
+
+  IntfImg:=nil;
+  ImgReader:=nil;
+  try
+    IntfImg:=TLazIntfImage.Create(0,0);
+    IntfImg.GetDescriptionFromDevice(0);
+    ImgReader:=ReaderClass.Create;
+    FImage.SaveStream.Position:=0;
+    IntfImg.LoadFromStream(FImage.SaveStream,ImgReader);
+    IntfImg.CreateBitmap(ImgHandle,ImgMaskHandle);
+    Handle:=ImgHandle;
+    MaskHandle:=ImgMaskHandle;
+  finally
+    IntfImg.Free;
+    ImgReader.Free;
+  end;
+end;
+
+procedure TBitmap.WriteStreamWithFPImage(Stream: TStream; WriteSize: boolean;
+  WriterClass: TFPCustomImageWriterClass);
+
+  Procedure DoWriteStreamSize(DestStream: TStream; Size: longint);
+  begin
+    if WriteSize then
+      DestStream.WriteBuffer(Size, SizeOf(Size));
+  end;
+
+  procedure DoWriteOriginal;
+  begin
+    DoWriteStreamSize(Stream,FImage.SaveStream.Size);
+    FImage.SaveStream.Position:=0;
+    Stream.CopyFrom(FImage.SaveStream,FImage.SaveStream.Size);
+  end;
+
+var
+  MemStream: TMemoryStream;
+  IntfImg: TLazIntfImage;
+  ImgWriter: TFPCustomImageWriter;
+begin
+  if (FImage.SaveStream<>nil) and (FImage.SaveStream.Size>0) then begin
+    DoWriteOriginal;
+    exit;
+  end;
+
+  // write image to temporary stream
+  MemStream:=TMemoryStream.Create;
+  IntfImg:=nil;
+  ImgWriter:=nil;
+  try
+    IntfImg:=TLazIntfImage.Create(0,0);
+    IntfImg.LoadFromBitmap(Handle,0);
+    ImgWriter:=WriterClass.Create;
+    IntfImg.SaveToStream(MemStream,ImgWriter);
+    FreeAndNil(ImgWriter);
+    FreeAndNil(IntfImg);
+    // save stream, so that further saves will be fast
+    MemStream.Position:=0;
+    FreeAndNil(FImage.FSaveStream);
+    FImage.SaveStream:=MemStream;
+    MemStream:=nil;
+    // copy savestream to destination stream
+    Stream.CopyFrom(FImage.SaveStream,FImage.SaveStream.Size);
+  finally
+    MemStream.Free;
+    IntfImg.Free;
+    ImgWriter.Free;
+  end;
+end;
+{$ENDIF}
+
 procedure TBitMap.SaveToStream(Stream: TStream);
 begin
   WriteStream(Stream, False);
@@ -751,6 +841,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.42  2003/09/02 21:32:56  mattias
+  implemented TOpenPictureDialog
+
   Revision 1.41  2003/09/02 15:12:21  mattias
   TBitmap.Assign now shares image data
 

lcl/include/commondialog.inc

@@ -40,10 +40,21 @@ end;
 procedure TCommonDialog.Close;
 begin
   //writeln('TCommonDialog.Close-------------------------------------------------------',Name);
+  DoClose;
   CNSendMessage(LM_DESTROY, Self, nil);
   FHandle := 0;
 end;
 
+procedure TCommonDialog.DoShow;
+begin
+  if Assigned(FOnShow) then FOnShow(Self);
+end;
+
+procedure TCommonDialog.DoClose;
+begin
+  if Assigned(FOnClose) then FOnClose(Self);
+end;
+
 function TCommonDialog.HandleAllocated: boolean;
 begin
   Result:=FHandle<>0;
@@ -76,6 +87,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.9  2003/09/02 21:32:56  mattias
+  implemented TOpenPictureDialog
+
   Revision 1.8  2003/03/29 19:15:30  mattias
   fixed untransienting
 

lcl/include/filectrl.inc

@@ -852,6 +852,15 @@ begin
   Result:='';
 end;
 
+function GetAllFilesMask: string;
+begin
+  {$IFDEF win32}
+  Result:='*.*';
+  {$ELSE}
+  Result:='*';
+  {$ENDIF}
+end;
+
 {------------------------------------------------------------------------------
   function ReadFileToString(const Filename: string): string;
  ------------------------------------------------------------------------------}
@@ -877,6 +886,9 @@ end;
 
 {
   $Log$
+  Revision 1.28  2003/09/02 21:32:56  mattias
+  implemented TOpenPictureDialog
+
   Revision 1.27  2003/08/07 07:12:29  mattias
   fixed file description permission order
 

lcl/include/filedialog.inc

@@ -21,9 +21,9 @@
 {------------------------------------------------------------------------------}
 {  TFileDialog Create                                                          }
 {------------------------------------------------------------------------------}
-constructor TFileDialog.Create(AOwner: TComponent);
+constructor TFileDialog.Create(TheOwner: TComponent);
 begin
-  inherited Create(AOwner);
+  inherited Create(TheOwner);
   fCompStyle := csFileDialog;
   FFiles := TStringList.Create;
   FHistoryList:=TStringList.Create;
@@ -83,7 +83,7 @@ end;
 {------------------------------------------------------------------------------}
 {  TFileDialog SetFilter                                                       }
 {------------------------------------------------------------------------------}
-procedure TFileDialog.SetFilter(value : string);
+procedure TFileDialog.SetFilter(const value : string);
 begin
   FFilter := value;  // make sure this is defined first before the CNSendMessage
 end;
@@ -91,15 +91,93 @@ end;
 {------------------------------------------------------------------------------}
 {  TFileDialog SetFileName                                                     }
 {------------------------------------------------------------------------------}
-procedure TFileDialog.SetFileName(value : string);
+procedure TFileDialog.SetFileName(const value : string);
 begin
-  FFileName := value;  // make sure this is defined first before the CNSendMessage
+  FFileName := Value;  // make sure this is defined first before the CNSendMessage
 end;
 
 {******************************************************************************
                                   TOpenDialog
  ******************************************************************************}
 
+procedure TOpenDialog.DereferenceLinks;
+var i: integer;
+begin
+  if Filename<>'' then
+    Filename:=ExpandFilename(Filename);
+  if Files<>nil then begin
+    for i:=0 to Files.Count-1 do begin
+      if Files[i]<>'' then
+        Files[i]:=ExpandFilename(Files[i]);
+    end;
+  end;
+end;
+
+function TOpenDialog.CheckFile(var AFilename: string): boolean;
+begin
+  Result:=true;
+  if (DefaultExt<>'') and (ExtractFileExt(AFilename)='')
+  and (not FileExists(AFilename)) then begin
+    AFilename:=AFilename+DefaultExt;
+  end;
+  if (ofOverwritePrompt in Options) and FileExists(AFilename) then
+  begin
+    Result:=MessageDlg(rsfdOverwriteFile,
+                       Format(rsfdFileAlreadyExists,[AFileName]),
+                       mtConfirmation,[mbOk,mbCancel],0)=mrOk;
+    if not Result then exit;
+  end;
+  if (ofPathMustExist in Options)
+  and (not FileExists(ExtractFileDir(AFilename))) then begin
+    Result:=false;
+    MessageDlg(rsfdPathMustExist,
+               Format(rsfdPathNoExist,[ExtractFileDir(AFilename)]),
+               mtError,[mbCancel],0);
+    exit;
+  end;
+  if (ofFileMustExist in Options)
+  and (not FileExists(AFilename)) then begin
+    Result:=false;
+    MessageDlg(rsfdFileMustExist,
+               Format(rsfdFileNotExist,[AFileName]),mtError,
+               [mbCancel],0);
+    exit;
+  end;
+  if (ofNoReadOnlyReturn in Options)
+  and (not FileIsWritable(AFilename)) then begin
+    Result:=false;
+    MessageDlg(rsfdFileReadOnlyTitle,
+               Format(rsfdFileReadOnly,[AFileName]),
+               mtError,[mbCancel],0);
+    exit;
+  end;
+end;
+
+function TOpenDialog.CheckAllFiles: boolean;
+var
+  AFilename: String;
+  i: Integer;
+begin
+  Result:=true;
+
+  AFilename:=Filename;
+  if (AFilename<>'')
+  or (not (ofAllowMultiSelect in Options)) then begin
+    Result:=CheckFile(AFilename);
+    Filename:=AFilename;
+    if not Result then exit;
+  end;
+
+  if ofAllowMultiSelect in Options then begin
+    for i:=0 to Files.Count-1 do begin
+      AFilename:=Files[i];
+      Result:=CheckFile(AFilename);
+      Files[i]:=AFilename;
+      if not Result then exit;
+    end;
+  end;
+end;
+
 {------------------------------------------------------------------------------
   Method: TOpenDialog.DoExecute
   Params:  none
@@ -108,85 +186,6 @@ end;
   Starts dialogs and lets user choose a filename.
  ------------------------------------------------------------------------------}
 function TOpenDialog.DoExecute: boolean;
-
-  procedure DereferenceLinks;
-  var i: integer;
-  begin
-    if Filename<>'' then
-      Filename:=ExpandFilename(Filename);
-    if Files<>nil then begin
-      for i:=0 to Files.Count-1 do begin
-        if Files[i]<>'' then
-          Files[i]:=ExpandFilename(Files[i]);
-      end;
-    end;
-  end;
-  
-  function CheckFile(var AFilename: string): boolean;
-  begin
-    Result:=true;
-    if (DefaultExt<>'') and (ExtractFileExt(AFilename)='')
-    and (not FileExists(AFilename)) then begin
-      AFilename:=AFilename+DefaultExt;
-    end;
-    if (ofOverwritePrompt in Options) and FileExists(AFilename) then
-    begin
-      Result:=MessageDlg(rsfdOverwriteFile,
-                         Format(rsfdFileAlreadyExists,[AFileName]),
-                         mtConfirmation,[mbOk,mbCancel],0)=mrOk;
-      if not Result then exit;
-    end;
-    if (ofPathMustExist in Options)
-    and (not FileExists(ExtractFileDir(AFilename))) then begin
-      Result:=false;
-      MessageDlg(rsfdPathMustExist,
-                 Format(rsfdPathNoExist,[ExtractFileDir(AFilename)]),
-                 mtError,[mbCancel],0);
-      exit;
-    end;
-    if (ofFileMustExist in Options)
-    and (not FileExists(AFilename)) then begin
-      Result:=false;
-      MessageDlg(rsfdFileMustExist,
-                 Format(rsfdFileNotExist,[AFileName]),mtError,
-                 [mbCancel],0);
-      exit;
-    end;
-    if (ofNoReadOnlyReturn in Options)
-    and (not FileIsWritable(AFilename)) then begin
-      Result:=false;
-      MessageDlg(rsfdFileReadOnlyTitle,
-                 Format(rsfdFileReadOnly,[AFileName]),
-                 mtError,[mbCancel],0);
-      exit;
-    end;
-  end;
-  
-  function CheckAllFiles: boolean;
-  var
-    AFilename: String;
-    i: Integer;
-  begin
-    Result:=true;
-    
-    AFilename:=Filename;
-    if (AFilename<>'')
-    or (not (ofAllowMultiSelect in Options)) then begin
-      Result:=CheckFile(AFilename);
-      Filename:=AFilename;
-      if not Result then exit;
-    end;
-    
-    if ofAllowMultiSelect in Options then begin
-      for i:=0 to Files.Count-1 do begin
-        AFilename:=Files[i];
-        Result:=CheckFile(AFilename);
-        Files[i]:=AFilename;
-        if not Result then exit;
-      end;
-    end;
-  end;
-
 begin
   Result:=inherited DoExecute;
   if (not (ofNoDereferenceLinks in Options)) then begin
@@ -217,6 +216,21 @@ begin
   FOptions := [ofEnableSizing, ofViewDetail];
 end;
 
+procedure TOpenDialog.DoFolderChange;
+begin
+  if Assigned(OnFolderChange) then OnFolderChange(Self);
+end;
+
+procedure TOpenDialog.DoSelectionChange;
+var
+  CurFilename: String;
+begin
+  CurFilename:=Filename;
+  if FLastSelectionChangeFilename=CurFilename then exit;
+  FLastSelectionChangeFilename:=CurFilename;
+  if Assigned(OnSelectionChange) then OnSelectionChange(Self);
+end;
+
 {******************************************************************************
                                   TSaveDialog
  ******************************************************************************}
@@ -251,6 +265,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.11  2003/09/02 21:32:56  mattias
+  implemented TOpenPictureDialog
+
   Revision 1.10  2003/08/14 10:36:55  mattias
   added TSelectDirectoryDialog
 

lcl/include/picture.inc

@@ -17,6 +17,8 @@
 }
 
 type
+  { TPicFileFormatsList }
+
   PPicFileFormat = ^TPicFileFormat;
   TPicFileFormat = record
     GraphicClass: TGraphicClass;
@@ -31,12 +33,13 @@ type
     procedure Clear; override;
     procedure Delete(Index: Integer);
     procedure Add(const Ext, Desc: String; AClass: TGraphicClass);
-    function GetFormat(Index: integer): PPicFileFormat;
+    function GetFormats(Index: integer): PPicFileFormat;
     function FindExt(const Ext: string): TGraphicClass;
     function FindClassName(const AClassname: string): TGraphicClass;
     procedure Remove(AClass: TGraphicClass);
     procedure BuildFilterStrings(GraphicClass: TGraphicClass;
-      var Descriptions, Filters: string);
+                                 var Descriptions, Filters: string);
+    property Formats[Index: integer]: PPicFileFormat read GetFormats; default;
   end;
 
 constructor TPicFileFormatsList.Create;
@@ -57,7 +60,7 @@ var i: integer;
   P: PPicFileFormat;
 begin
   for i:=0 to Count-1 do begin
-    P:=GetFormat(i);
+    P:=GetFormats(i);
     Dispose(P);
   end;
   inherited Clear;
@@ -66,7 +69,7 @@ end;
 procedure TPicFileFormatsList.Delete(Index: Integer);
 var P: PPicFileFormat;
 begin
-  P:=GetFormat(Index);
+  P:=GetFormats(Index);
   Dispose(P);
   inherited Delete(Index);
 end;
@@ -85,7 +88,7 @@ begin
   inherited Add(NewFormat);
 end;
 
-function TPicFileFormatsList.GetFormat(Index: integer): PPicFileFormat;
+function TPicFileFormatsList.GetFormats(Index: integer): PPicFileFormat;
 begin
   Result:=PPicFileFormat(Items[Index]);
 end;
@@ -111,7 +114,7 @@ var
 begin
   // search backwards so that new formats will be found first
   for I := Count-1 downto 0 do begin
-    Result := GetFormat(I)^.GraphicClass;
+    Result := GetFormats(I)^.GraphicClass;
     if AnsiCompareText(Result.ClassName,AClassname)=0 then
       Exit;
   end;
@@ -125,7 +128,7 @@ var
   P: PPicFileFormat;
 begin
   for I := Count-1 downto 0 do begin
-    P := GetFormat(I);
+    P := GetFormats(I);
     if P^.GraphicClass.InheritsFrom(AClass) then
       Delete(I);
   end;
@@ -141,7 +144,7 @@ begin
   Filters := '';
   C := 0;
   for I := Count-1 downto 0 do begin
-    P := GetFormat(I);
+    P := GetFormats(I);
     if P^.GraphicClass.InheritsFrom(GraphicClass) and (P^.Extension <> '') then
       with P^ do begin
         if C <> 0 then begin
@@ -156,7 +159,7 @@ begin
   end;
   if C > 1 then
     FmtStr(Descriptions, '%s (%s)|%1:s|%s',
-     ['All files', Filters, Descriptions]);
+     ['Graphic', Filters, Descriptions]);
 end;
 
 //------------------------------------------------------------------------------
@@ -169,17 +172,24 @@ type
   end;
 
   TPicClipboardFormats = class(TList)
-    // list of TPicClipboarFormat
+    // list of TPicClipboardFormat
+  private
+    function GetFormats(Index: integer): PPicClipboardFormat;
   public
     constructor Create;
     procedure Clear; override;
     procedure Delete(Index: Integer);
-    function GetFormat(Index: integer): PPicClipboardFormat;
     procedure Add(AFormatID: TClipboardFormat; AClass: TGraphicClass);
     function FindFormat(FormatID: TClipboardFormat): TGraphicClass;
     procedure Remove(AClass: TGraphicClass);
+    property Formats[Index: integer]: PPicClipboardFormat read GetFormats; default;
   end;
 
+function TPicClipboardFormats.GetFormats(Index: integer): PPicClipboardFormat;
+begin
+  Result:=PPicClipboardFormat(Items[Index]);
+end;
+
 constructor TPicClipboardFormats.Create;
 begin
   inherited Create;
@@ -193,7 +203,7 @@ var i: integer;
   P: PPicClipboardFormat;
 begin
   for i:=0 to Count-1 do begin
-    P:=GetFormat(i);
+    P:=GetFormats(i);
     Dispose(P);
   end;
   inherited Clear;
@@ -202,16 +212,11 @@ end;
 procedure TPicClipboardFormats.Delete(Index: Integer);
 var P: PPicClipboardFormat;
 begin
-  P:=GetFormat(Index);
+  P:=GetFormats(Index);
   Dispose(P);
   inherited Delete(Index);
 end;
 
-function TPicClipboardFormats.GetFormat(Index: integer): PPicClipboardFormat;
-begin
-  Result:=PPicClipboardFormat(Items[Index]);
-end;
-
 procedure TPicClipboardFormats.Add(AFormatID: TClipboardFormat;
   AClass: TGraphicClass);
 var NewFormat: PPicClipboardFormat;
@@ -231,7 +236,7 @@ var
   P: PPicClipboardFormat;
 begin
   for I := Count-1 downto 0 do begin
-    P:=GetFormat(i);
+    P:=GetFormats(i);
     if P^.FormatID=FormatID then begin
       Result := P^.GraphicClass;
       Exit;
@@ -245,15 +250,15 @@ var
   I: Integer;
 begin
   for I := Count-1 downto 0 do
-    if GetFormat(i)^.GraphicClass.InheritsFrom(AClass) then
+    if GetFormats(i)^.GraphicClass.InheritsFrom(AClass) then
       Delete(i);
 end;
 
 //------------------------------------------------------------------------------
 
-const
+var
-  PicClipboardFormats: TPicClipboardFormats = nil;
+  PicClipboardFormats: TPicClipboardFormats;
-  PicFileFormats: TPicFileFormatsList = nil;
+  PicFileFormats: TPicFileFormatsList;
 
 function GetPicFileFormats: TPicFileFormatsList;
 begin
@@ -269,6 +274,33 @@ begin
   Result := PicClipboardFormats;
 end;
 
+function GraphicFilter(GraphicClass: TGraphicClass): string;
+var
+  Filters: string;
+begin
+  GetPicFileFormats.BuildFilterStrings(GraphicClass,Result,Filters);
+end;
+
+function GraphicExtension(GraphicClass: TGraphicClass): string;
+var
+  I: Integer;
+  PicFormats: TPicFileFormatsList;
+begin
+  PicFormats := GetPicFileFormats;
+  for I := PicFormats.Count-1 downto 0 do
+    if PicFormats[I]^.GraphicClass.ClassName = GraphicClass.ClassName then begin
+      Result := PicFormats[I]^.Extension;
+      Exit;
+    end;
+  Result := '';
+end;
+
+function GraphicFileMask(GraphicClass: TGraphicClass): string;
+var
+  Descriptions: string;
+begin
+  GetPicFileFormats.BuildFilterStrings(GraphicClass,Descriptions,Result);
+end;
 
 //--TPicture--------------------------------------------------------------------
 
@@ -356,7 +388,7 @@ var
   NewGraphic: TGraphic;
   ok: boolean;
 begin
-  if (Value=FGraphic) or (Value=nil) then exit;
+  if (Value=FGraphic) then exit;
   NewGraphic := nil;
   ok:=false;
   try
@@ -485,6 +517,11 @@ begin
   if PicClipboardFormats <> nil then PicClipboardFormats.Remove(AClass);
 end;
 
+procedure TPicture.Clear;
+begin
+  SetGraphic(nil);
+end;
+
 procedure TPicture.Changed(Sender: TObject);
 begin
   if Assigned(FOnChange) then FOnChange(Self);

lcl/include/pixmap.inc

@@ -263,22 +263,9 @@ end;
 
 { TPixmap }
 
-procedure TPixmap.LoadFromLazarusResource(const ResName: String);
+function TPixmap.LazarusResourceTypeValid(const ResourceType: string): boolean;
-var
-  ms:TMemoryStream;
-  res:TLResource;
 begin
-  res:=LazarusResources.Find(ResName);
+  Result:=(ResourceType='XPM');
-  if (res<>nil) and (res.Value<>'') and (res.ValueType='XPM') then begin
-    ms:=TMemoryStream.Create;
-    try
-      ms.Write(res.Value[1],length(res.Value));
-      ms.Position:=0;
-      LoadFromStream(ms);
-    finally
-      ms.Free;
-    end;
-  end;
 end;
 
 procedure TPixmap.WriteStream(Stream: TStream; WriteSize: Boolean);
@@ -344,6 +331,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.21  2003/09/02 21:32:56  mattias
+  implemented TOpenPictureDialog
+
   Revision 1.20  2003/08/20 17:03:48  mattias
   implemented TPixmap and TPortableNetworkGraphic with fpImage
 

lcl/include/png.inc

@@ -20,128 +20,30 @@
 
 { TPortableNetworkGraphic }
 
-procedure TPortableNetworkGraphic.LoadFromLazarusResource(const ResName: String
+function TPortableNetworkGraphic.LazarusResourceTypeValid(
-  );
+  const ResourceType: string): boolean;
-var
-  ms:TMemoryStream;
-  res:TLResource;
 begin
-  res:=LazarusResources.Find(ResName);
+  Result:=(ResourceType='PNG');
-  if (res<>nil) and (res.Value<>'') and (res.ValueType='PNG') then begin
-    ms:=TMemoryStream.Create;
-    try
-      ms.Write(res.Value[1],length(res.Value));
-      ms.Position:=0;
-      LoadFromStream(ms);
-    finally
-      ms.Free;
-    end;
-  end;
 end;
 
 procedure TPortableNetworkGraphic.ReadStream(Stream: TStream; Size: Longint);
+begin
 {$IFDEF UseFPImage}
-var
+  ReadStreamWithFPImage(Stream,Size,TFPReaderPNG);
-  IntfImg: TLazIntfImage;
-  PNGReader: TFPReaderPNG;
-  ImgHandle, ImgMaskHandle: HBitmap;
-begin
-  UnshareImage;
-  if Size = 0 then begin
-    Width:=0;
-    Height:=0;
-    exit;
-  end;
-  StoreOriginalStream(Stream);
-
-  IntfImg:=nil;
-  PNGReader:=nil;
-  try
-    IntfImg:=TLazIntfImage.Create(0,0);
-    IntfImg.GetDescriptionFromDevice(0);
-    PNGReader:=TFPReaderPNG.Create;
-    FImage.SaveStream.Position:=0;
-    IntfImg.LoadFromStream(FImage.SaveStream,PNGReader);
-    IntfImg.CreateBitmap(ImgHandle,ImgMaskHandle);
-    Handle:=ImgHandle;
-    MaskHandle:=ImgMaskHandle;
-  finally
-    IntfImg.Free;
-    PNGReader.Free;
-  end;
-end;
 {$ELSE}
-begin
   RaiseGDBException('TPortableNetworkGraphic.ReadStream needs FPImage');
-end;
 {$ENDIF}
+end;
 
 procedure TPortableNetworkGraphic.WriteStream(Stream: TStream;
   WriteSize: Boolean);
+begin
 {$IFDEF UseFPImage}
-
+  WriteStreamWithFPImage(Stream,WriteSize,TFPWriterPNG);
-  Procedure DoWriteStreamSize(DestStream: TStream; Size: longint);
-  begin
-    if WriteSize then
-      DestStream.WriteBuffer(Size, SizeOf(Size));
-  end;
-
-  procedure DoWriteOriginal;
-  begin
-    DoWriteStreamSize(Stream,FImage.SaveStream.Size);
-    FImage.SaveStream.Position:=0;
-    Stream.CopyFrom(FImage.SaveStream,FImage.SaveStream.Size);
-  end;
-
-var
-  MemStream: TMemoryStream;
-  IntfImg: TLazIntfImage;
-  {$IFDEF HasPNGWriter}
-  PNGWriter: TFPWriterPNG;
-  {$ENDIF}
-begin
-  if (FImage.SaveStream<>nil) and (FImage.SaveStream.Size>0) then begin
-    DoWriteOriginal;
-    exit;
-  end;
-
-  RaiseGDBException('TPortableNetworkGraphic.WriteStream png writer not implemented yet');
-
-  // write image in XPM format to temporary stream
-  MemStream:=TMemoryStream.Create;
-  IntfImg:=nil;
-  {$IFDEF HasPNGWriter}
-  PNGWriter:=nil;
-  {$ENDIF}
-  try
-    IntfImg:=TLazIntfImage.Create(0,0);
-    IntfImg.LoadFromBitmap(Handle,0);
-    {$IFDEF HasPNGWriter}
-    PNGWriter:=TFPWriterPNG.Create;
-    IntfImg.SaveToStream(MemStream,PNGWriter);
-    FreeAndNil(PNGWriter);
-    {$ENDIF}
-    FreeAndNil(IntfImg);
-    // save stream, so that further saves will be fast
-    MemStream.Position:=0;
-    FreeAndNil(FImage.FSaveStream);
-    FImage.SaveStream:=MemStream;
-    MemStream:=nil;
-    // copy savestream to destination stream
-    Stream.CopyFrom(FImage.SaveStream,FImage.SaveStream.Size);
-  finally
-    MemStream.Free;
-    IntfImg.Free;
-    {$IFDEF HasPNGWriter}
-    PNGWriter.Free;
-    {$ENDIF}
-  end;
-end;
 {$ELSE}
-begin
   RaiseGDBException('TPortableNetworkGraphic.WriteStream needs FPImage');
-end;
 {$ENDIF}
+end;
 
 
 // included by graphics.pp

lcl/interfaces/gtk/gtkcallback.inc

@@ -1781,11 +1781,10 @@ begin
   if Filename=OldFilename then exit;
   OpenDialog.Filename:=Filename;
   // tell application, that selection has changed
-  if OpenDialog.OnSelectionChange<>nil then
+  OpenDialog.DoSelectionChange;
-    OpenDialog.OnSelectionChange(OpenDialog);
   if (OpenDialog.OnFolderChange<>nil)
   and (ExtractFilePath(Filename)<>ExtractFilePath(OldFilename)) then
-    OpenDialog.OnFolderChange(OpenDialog);
+    OpenDialog.DoFolderChange;
   // show some information
   FileDetailLabel:=gtk_object_get_data(PGtkObject(OpenDialog.Handle),
                                        'FileDetailLabel');
@@ -1841,11 +1840,16 @@ end;
   This function is called, whenever a commondialog window is realized
 -------------------------------------------------------------------------------}
 function GTKDialogRealizeCB(Widget: PGtkWidget; Data: Pointer): GBoolean; cdecl;
+var
+  LCLComponent: TObject;
 begin
   if (Data=nil) then ;
   gdk_window_set_events(GetControlWindow(Widget),
     gdk_window_get_events(GetControlWindow(Widget))
       or GDK_KEY_RELEASE_MASK or GDK_KEY_PRESS_MASK);
+  LCLComponent:=GetLCLObject(Widget);
+  if LCLComponent is TCommonDialog then
+    TCommonDialog(LCLComponent).DoShow;
   Result:=true;
 end;
 
@@ -2845,6 +2849,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.186  2003/09/02 21:32:56  mattias
+  implemented TOpenPictureDialog
+
   Revision 1.185  2003/08/30 18:53:07  mattias
   using default colors, when theme does not define them
 

lcl/interfaces/gtk/gtkint.pp

@@ -54,7 +54,7 @@ uses
   glib, gdk, gtk, {$Ifndef NoGdkPixbufLib}gdkpixbuf,{$EndIf}
   {$ENDIF}
   xlib,
-  SysUtils, LMessages, Classes, Controls, Forms, LCLStrConsts,
+  SysUtils, Classes, ExtDlgs, Dialogs, Controls, Forms, LCLStrConsts, LMessages,
   VclGlobals, LCLProc, LCLLinux, LCLType, gtkDef, DynHashArray, gtkMsgQueue,
   GraphType, GraphMath, Graphics;
 
@@ -191,6 +191,17 @@ type
     procedure ShowModal(Sender: TObject); virtual;
     procedure UpdateTransientWindows; virtual;
     procedure UntransientWindow(GtkWindow: PGtkWindow);
+    procedure InitializeCommonDialog(ADialog: TObject; AWindow: PGtkWidget);
+    procedure CreateOpenDialogFilter(OpenDialog: TOpenDialog;
+      SelWidget: PGtkWidget);
+    procedure CreatePreviewDialogControl(PreviewDialog: TPreviewFileDialog;
+      SelWidget: PGtkWidget);
+    procedure InitializeOpenDialog(OpenDialog: TOpenDialog;
+      SelWidget: PGtkWidget);
+    procedure InitializeFileDialog(FileDialog: TFileDialog;
+      var SelWidget: PGtkWidget; Title: PChar);
+    procedure InitializeFontDialog(FontDialog: TFontDialog;
+      var SelWidget: PGtkWidget; Title: PChar);
 
     // misc
     Function GetCaption(Sender : TObject) : String; virtual;
@@ -254,7 +265,7 @@ type
 implementation
 
 uses
-  Buttons, Menus, StdCtrls, PairSplitter, Dialogs, Math,
+  Buttons, Menus, StdCtrls, PairSplitter, Math,
   GTKWinApiWindow, ComCtrls, CListBox, KeyMap, Calendar, Arrow, Spin, CommCtrl,
   ExtCtrls, FileCtrl, LResources, gtkglobals, gtkproc;
 
@@ -349,6 +360,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.141  2003/09/02 21:32:56  mattias
+  implemented TOpenPictureDialog
+
   Revision 1.140  2003/08/28 09:10:00  mattias
   listbox and comboboxes now set sort and selection at handle creation
 

lcl/interfaces/gtk/gtkobject.inc

@@ -759,17 +759,20 @@ procedure TgtkObject.SendCachedLCLMessages;
         RealizeWidgetSize(Widget,LCLWidth, LCLHeight);
 
         // move widget on the fixed widget of parent control
-        ParentWidget:=pgtkWidget(LCLControl.Parent.Handle);
+        if (LCLControl.Parent<>nil) and (LCLControl.Parent.HandleAllocated) then
-        ParentFixed := GetFixedWidget(ParentWidget);
+        begin
-        if GtkWidgetIsA(ParentFixed,GTK_FIXED_GET_TYPE)
+          ParentWidget:=pgtkWidget(LCLControl.Parent.Handle);
-        or GtkWidgetIsA(ParentFixed,GTK_LAYOUT_GET_TYPE) then begin
+          ParentFixed := GetFixedWidget(ParentWidget);
-          FixedMoveControl(ParentFixed, Widget,
+          if GtkWidgetIsA(ParentFixed,GTK_FIXED_GET_TYPE)
-                         LCLControl.Left, LCLControl.Top);
+          or GtkWidgetIsA(ParentFixed,GTK_LAYOUT_GET_TYPE) then begin
-        end else begin
+            FixedMoveControl(ParentFixed, Widget,
-          WinWidgetInfo:=GetWidgetInfo(Widget,false);
+                           LCLControl.Left, LCLControl.Top);
-          if (WinWidgetInfo=nil)
+          end else begin
-          or (not (wwiNotOnParentsClientArea in WinWidgetInfo^.Flags)) then
+            WinWidgetInfo:=GetWidgetInfo(Widget,false);
-            WriteWarningParentWidgetNotFound;
+            if (WinWidgetInfo=nil)
+            or (not (wwiNotOnParentsClientArea in WinWidgetInfo^.Flags)) then
+              WriteWarningParentWidgetNotFound;
+          end;
         end;
       end
       else begin
@@ -3667,6 +3670,7 @@ begin
 
   csForm, 
   csFileDialog, csOpenFileDialog, csSaveFileDialog, csSelectDirectoryDialog,
+  csPreviewFileDialog,
   csColorDialog,
   csFontDialog  : gtk_window_set_title(pGtkWindow(p),PLabel);
 
@@ -4593,13 +4597,13 @@ begin
 end;
 
 {------------------------------------------------------------------------------
-  procedure InitializeCommonDialog
+  procedure TGTKObject.InitializeCommonDialog
   Params: ADialog: TCommonDialog; AWindow: PGtkWidget
   Result: none
 
   Initializes a TCommonDialog window.
 ------------------------------------------------------------------------------}
-procedure InitializeCommonDialog(ADialog: TObject;
+procedure TGTKObject.InitializeCommonDialog(ADialog: TObject;
   AWindow: PGtkWidget);
 var NewWidth, NewHeight: integer;
 begin
@@ -4838,13 +4842,13 @@ begin
 end;
 
 {------------------------------------------------------------------------------
-  Function: CreateOpenDialogFilter
+  Function: TGTKObject.CreateOpenDialogFilter
   Params: OpenDialog: TOpenDialog; SelWidget: PGtkWidget
   Returns: -
 
   Adds a Filter pulldown to a gtk file selection dialog.
  ------------------------------------------------------------------------------}
-procedure CreateOpenDialogFilter(OpenDialog: TOpenDialog;
+procedure TGTKObject.CreateOpenDialogFilter(OpenDialog: TOpenDialog;
   SelWidget: PGtkWidget);
 var
   FilterList: TList;
@@ -4919,7 +4923,48 @@ begin
 end;
 
 {------------------------------------------------------------------------------
-  Function: InitializeOpenDialog
+  Function: TGTKObject.CreatePreviewDialogControl
+  Params: PreviewDialog: TPreviewFileDialog; SelWidget: PGtkWidget
+  Returns: -
+
+  Adds a preview control to a gtk file selection dialog.
+ ------------------------------------------------------------------------------}
+procedure TGTKObject.CreatePreviewDialogControl(
+  PreviewDialog: TPreviewFileDialog; SelWidget: PGtkWidget);
+var
+  PreviewWidget: PGtkWidget;
+  list_hbox: PGtkWidget;
+  DirListWidget: PGtkWidget;
+  ScrolledWin: PGtkWidget;
+  AControl: TPreviewFileControl;
+begin
+  AControl:=PreviewDialog.PreviewFileControl;
+  if AControl=nil then exit;
+  // find the hbox widget of the file and directory dialog
+  DirListWidget:=PGtkFileSelection(SelWidget)^.dir_list;
+  ScrolledWin:=DirListWidget^.parent;
+  if not GtkWidgetIsA(ScrolledWin,GTK_SCROLLED_WINDOW_TYPE) then begin
+    writeln('NOTE: CreatePreviewDialogControl ',
+      'parent widget of dir_list widget is not a scrolled window');
+    exit;
+  end;
+  list_hbox:=ScrolledWin^.parent;
+  if not GtkWidgetIsA(list_hbox,GTK_HBOX_TYPE) then begin
+    writeln('NOTE: CreatePreviewDialogControl ',
+      'parent widget of scrolled window is not a hbox');
+    exit;
+  end;
+  // create the preview widget
+  PreviewWidget:=PGtkWidget(AControl.Handle);
+  gtk_object_set_data(PGtkObject(PreviewWidget),'LCLPreviewFixed',
+                      PreviewWidget);
+  gtk_box_pack_start(GTK_BOX(list_hbox),PreviewWidget,true,true,0);
+
+  gtk_widget_show(PreviewWidget);
+end;
+
+{------------------------------------------------------------------------------
+  Function: TGTKObject.InitializeOpenDialog
   Params: OpenDialog: TOpenDialog; SelWidget: PGtkWidget
   Returns: -
 
@@ -4930,11 +4975,12 @@ end;
   - file information
   - history pulldown
   - filter pulldown
+  - preview control
  ------------------------------------------------------------------------------}
-procedure InitializeOpenDialog(OpenDialog: TOpenDialog;
+procedure TGTKObject.InitializeOpenDialog(OpenDialog: TOpenDialog;
   SelWidget: PGtkWidget);
 var
-  FileDetailLabel, HBox, Frame: PGtkWidget;
+  FileDetailLabel, HBox, FrameWidget: PGtkWidget;
 begin
   // Multiselection
   if ofAllowMultiSelect in OpenDialog.Options then
@@ -4992,13 +5038,13 @@ begin
   // Details - a frame with a label
   if (ofViewDetail in OpenDialog.Options) then begin
     // create the frame around the information
-    Frame:=gtk_frame_new(PChar(rsFileInformation));
+    FrameWidget:=gtk_frame_new(PChar(rsFileInformation));
     gtk_box_pack_start(GTK_BOX(GTK_FILE_SELECTION(SelWidget)^.main_vbox),
-                       Frame,false,false,0);
+                       FrameWidget,false,false,0);
-    gtk_widget_show(Frame);
+    gtk_widget_show(FrameWidget);
     // create a HBox, so that the information is left justified
     HBox:=gtk_hbox_new(false,0);
-    gtk_container_add(GTK_CONTAINER(Frame), HBox);
+    gtk_container_add(GTK_CONTAINER(FrameWidget), HBox);
     // create the label for the file information
     FileDetailLabel:=gtk_label_new(PChar(rsDefaultFileInfoValue));
     gtk_box_pack_start(GTK_BOX(HBox),FileDetailLabel,false,false,5);
@@ -5007,6 +5053,10 @@ begin
     FileDetailLabel:=nil;
   gtk_object_set_data(PGtkObject(SelWidget), 'FileDetailLabel',
                       FileDetailLabel);
+                      
+  // preview
+  if (OpenDialog is TPreviewFileDialog) then
+    CreatePreviewDialogControl(TPreviewFileDialog(OpenDialog),SelWidget);
 
   // set initial filename
   if OpenDialog.Filename<>'' then
@@ -5015,13 +5065,13 @@ begin
 end;
 
 {------------------------------------------------------------------------------
-  Function: InitializeFileDialog
+  Function: TGTKObject.InitializeFileDialog
   Params: FileDialog: TFileDialog; var SelWidget: PGtkWidget
   Returns: -
 
   Creates a new TFile/Open/SaveDialog
  ------------------------------------------------------------------------------}
-procedure InitializeFileDialog(FileDialog: TFileDialog;
+procedure TGTKObject.InitializeFileDialog(FileDialog: TFileDialog;
   var SelWidget: PGtkWidget; Title: PChar);
 begin
   SelWidget := gtk_file_selection_new(Title);
@@ -5048,13 +5098,13 @@ begin
 end;
 
 {------------------------------------------------------------------------------
-  Function: InitializeFontDialog
+  Function: TGTKObject.InitializeFontDialog
   Params: FontDialog: TFontialog; var SelWidget: PGtkWidget
   Returns: -
 
   Creates a new TFontDialog
  ------------------------------------------------------------------------------}
-procedure InitializeFontDialog(FontDialog: TFontDialog;
+procedure TGTKObject.InitializeFontDialog(FontDialog: TFontDialog;
   var SelWidget: PGtkWidget; Title: PChar);
 begin
   SelWidget := gtk_font_selection_dialog_new(Title);
@@ -5536,7 +5586,8 @@ begin
   csEdit :
     p :=  gtk_entry_new();
 
-  csFileDialog, csOpenFileDialog, csSaveFileDialog, csSelectDirectoryDialog:
+  csFileDialog, csOpenFileDialog, csSaveFileDialog, csSelectDirectoryDialog,
+  csPreviewFileDialog:
     InitializeFileDialog(TFileDialog(Sender),p,StrTemp);
 
   csFontDialog :
@@ -5729,6 +5780,9 @@ begin
     with (TPopupMenu(Sender)) do
       P := gtk_menu_new();
 
+  csPreviewFileControl:
+    P:=CreateSimpleClientAreaWidget(Sender);
+
   csProgressBar:
     with (TProgressBar (Sender)) do
     begin
@@ -8068,6 +8122,9 @@ end;
  { =============================================================================
 
   $Log$
+  Revision 1.403  2003/09/02 21:32:56  mattias
+  implemented TOpenPictureDialog
+
   Revision 1.402  2003/08/30 18:53:07  mattias
   using default colors, when theme does not define them
 

lcl/interfaces/gtk/gtkproc.pp

@@ -118,6 +118,7 @@ function gtkMouseBtnRelease(widget: PGtkWidget; event : pgdkEventButton;
 function gtkMouseBtnReleaseAfter(widget: PGtkWidget; event : pgdkEventButton;
   data: gPointer) : GBoolean; cdecl;
 function gtkclickedCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
+
 function gtkOpenDialogRowSelectCB( widget : PGtkWidget; row : gint;
   column : gint; event : pgdkEventButton; data : gPointer ) : GBoolean; cdecl;
 function gtkDialogOKclickedCB( widget: PGtkWidget;
@@ -135,6 +136,7 @@ function GTKDialogSelectRowCB(widget: PGtkWidget; Row, Column: gInt;
   bevent: pgdkEventButton; data: gPointer): GBoolean; cdecl;
 function GTKDialogMenuActivateCB(widget: PGtkWidget; data: gPointer): GBoolean; cdecl;
 function gtkDialogDestroyCB(widget: PGtkWidget; data: gPointer): GBoolean; cdecl;
+
 function gtkPressedCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
 function gtkEnterCB(widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
 function gtkLeaveCB(widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;

lcl/vclglobals.pp

@@ -102,9 +102,10 @@ const
   csOpenFileDialog = 56;
   csSaveFileDialog = 57;
   csSelectDirectoryDialog = 58;
+  csPreviewFileControl = 59;
+  csPreviewFileDialog = 60;
 
-
+  csNonLCL = 61; // for non LCL controls, that create their own handles
-  csNonLCL = 59; // for non LCL controls, that create their own handles
 
 
 const

localize.sh

@@ -1,4 +1,4 @@
-#!/bin/bash
+#!/usr/bin/env bash
 #
 # Usage: sh localize.sh
 #

packager/packagesystem.pas

@@ -878,6 +878,7 @@ begin
     AddFile('arrow.pp','Arrow',pftUnit,[pffHasRegisterProc],cpBase);
     AddFile('calendar.pp','Calendar',pftUnit,[pffHasRegisterProc],cpBase);
     AddFile('pairsplitter.pas','PairSplitter',pftUnit,[pffHasRegisterProc],cpBase);
+    AddFile('extdlgs.pp','ExtDlgs',pftUnit,[pffHasRegisterProc],cpBase);
     // increase priority by one, so that the LCL components are inserted to the
     // left in the palette
     for i:=0 to FileCount-1 do

packager/registerlcl.pas

@@ -40,7 +40,7 @@ interface
 uses
   LazarusPackageIntf,
   Menus, Buttons, StdCtrls, ExtCtrls, ComCtrls, Forms, Grids, Controls,
-  Dialogs, Spin, Arrow, Calendar, MaskEdit, CheckLst, PairSplitter;
+  Dialogs, Spin, Arrow, Calendar, MaskEdit, CheckLst, PairSplitter, ExtDlgs;
   
 procedure Register;
 
@@ -63,6 +63,7 @@ begin
   RegisterUnit('Arrow',@Arrow.Register);
   RegisterUnit('Calendar',@Calendar.Register);
   RegisterUnit('PairSplitter',@PairSplitter.Register);
+  RegisterUnit('ExtDlgs',@ExtDlgs.Register);
 end;
 
 end.