From a9f24996c76030581d493e519f37313f0bf19494 Mon Sep 17 00:00:00 2001 From: mattias Date: Tue, 2 Sep 2003 21:32:56 +0000 Subject: [PATCH] implemented TOpenPictureDialog git-svn-id: trunk@4558 - --- .gitattributes | 1 + lcl/allunits.pp | 5 +- lcl/dialogs.pp | 30 ++-- lcl/extdlgs.pas | 262 +++++++++++++++++++++++++++++ lcl/filectrl.pp | 4 + lcl/graphics.pp | 25 ++- lcl/include/bitmap.inc | 111 +++++++++++- lcl/include/commondialog.inc | 14 ++ lcl/include/filectrl.inc | 12 ++ lcl/include/filedialog.inc | 185 +++++++++++--------- lcl/include/picture.inc | 85 +++++++--- lcl/include/pixmap.inc | 20 +-- lcl/include/png.inc | 116 +------------ lcl/interfaces/gtk/gtkcallback.inc | 13 +- lcl/interfaces/gtk/gtkint.pp | 18 +- lcl/interfaces/gtk/gtkobject.inc | 111 +++++++++--- lcl/interfaces/gtk/gtkproc.pp | 2 + lcl/vclglobals.pp | 5 +- localize.sh | 2 +- packager/packagesystem.pas | 1 + packager/registerlcl.pas | 3 +- 21 files changed, 735 insertions(+), 290 deletions(-) create mode 100644 lcl/extdlgs.pas diff --git a/.gitattributes b/.gitattributes index 9bd0cd8558..deac2bed6f 100644 --- a/.gitattributes +++ b/.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 diff --git a/lcl/allunits.pp b/lcl/allunits.pp index 1ca64122f4..6f0a59680e 100644 --- a/lcl/allunits.pp +++ b/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 diff --git a/lcl/dialogs.pp b/lcl/dialogs.pp index 013e92f43c..c26f07d62a 100644 --- a/lcl/dialogs.pp +++ b/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 SetFilter(Value: String); virtual; + procedure SetFileName(const 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 - // message, to inform the user, that file will be - // overwritten - ofHideReadOnly, + ofOverwritePrompt, // if selected file exists shows a message, that file + // will be overwritten + ofHideReadOnly, // hide read only file 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 diff --git a/lcl/extdlgs.pas b/lcl/extdlgs.pas new file mode 100644 index 0000000000..d1d245f9aa --- /dev/null +++ b/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. + diff --git a/lcl/filectrl.pp b/lcl/filectrl.pp index 5510576f74..30e0e80fc6 100644 --- a/lcl/filectrl.pp +++ b/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 diff --git a/lcl/graphics.pp b/lcl/graphics.pp index 713552e178..33ff0a78d5 100644 --- a/lcl/graphics.pp +++ b/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 HasPNGWriter}, FPWritePNG{$ENDIF} + {$IFDEF UseFPImage}, FPImage, FPReadPNG, FPWritePNG, IntfGraphics{$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 diff --git a/lcl/include/bitmap.inc b/lcl/include/bitmap.inc index 2fcf6561be..495353affd 100644 --- a/lcl/include/bitmap.inc +++ b/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 - ms:=TMemoryStream.Create; - try - ms.Write(res.Value[1],length(res.Value)); - ms.Position:=0; - LoadFromStream(ms); - finally - ms.Free; - end; + if (res=nil) or (res.Value='') or not LazarusResourceTypeValid(res.ValueType) + then exit; + ms:=TMemoryStream.Create; + try + ms.Write(res.Value[1],length(res.Value)); + ms.Position:=0; + LoadFromStream(ms); + finally + 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 diff --git a/lcl/include/commondialog.inc b/lcl/include/commondialog.inc index 4035df2ad1..cadb2729ba 100644 --- a/lcl/include/commondialog.inc +++ b/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 diff --git a/lcl/include/filectrl.inc b/lcl/include/filectrl.inc index 59c8a21a72..11a345d011 100644 --- a/lcl/include/filectrl.inc +++ b/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 diff --git a/lcl/include/filedialog.inc b/lcl/include/filedialog.inc index fe77b515bd..23dfcb1868 100644 --- a/lcl/include/filedialog.inc +++ b/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 diff --git a/lcl/include/picture.inc b/lcl/include/picture.inc index 5e94633fcb..a5a9c5c394 100644 --- a/lcl/include/picture.inc +++ b/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 - PicClipboardFormats: TPicClipboardFormats = nil; - PicFileFormats: TPicFileFormatsList = nil; +var + PicClipboardFormats: TPicClipboardFormats; + 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); diff --git a/lcl/include/pixmap.inc b/lcl/include/pixmap.inc index ec5f1efeab..5861c58833 100644 --- a/lcl/include/pixmap.inc +++ b/lcl/include/pixmap.inc @@ -263,22 +263,9 @@ end; { TPixmap } -procedure TPixmap.LoadFromLazarusResource(const ResName: String); -var - ms:TMemoryStream; - res:TLResource; +function TPixmap.LazarusResourceTypeValid(const ResourceType: string): boolean; begin - res:=LazarusResources.Find(ResName); - 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; + Result:=(ResourceType='XPM'); 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 diff --git a/lcl/include/png.inc b/lcl/include/png.inc index dc5534da6e..d2b1e189a7 100644 --- a/lcl/include/png.inc +++ b/lcl/include/png.inc @@ -20,128 +20,30 @@ { TPortableNetworkGraphic } -procedure TPortableNetworkGraphic.LoadFromLazarusResource(const ResName: String - ); -var - ms:TMemoryStream; - res:TLResource; +function TPortableNetworkGraphic.LazarusResourceTypeValid( + const ResourceType: string): boolean; begin - res:=LazarusResources.Find(ResName); - 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; + Result:=(ResourceType='PNG'); end; procedure TPortableNetworkGraphic.ReadStream(Stream: TStream; Size: Longint); +begin {$IFDEF UseFPImage} -var - 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; + ReadStreamWithFPImage(Stream,Size,TFPReaderPNG); {$ELSE} -begin RaiseGDBException('TPortableNetworkGraphic.ReadStream needs FPImage'); -end; {$ENDIF} +end; procedure TPortableNetworkGraphic.WriteStream(Stream: TStream; WriteSize: Boolean); +begin {$IFDEF UseFPImage} - - 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; + WriteStreamWithFPImage(Stream,WriteSize,TFPWriterPNG); {$ELSE} -begin RaiseGDBException('TPortableNetworkGraphic.WriteStream needs FPImage'); -end; {$ENDIF} +end; // included by graphics.pp diff --git a/lcl/interfaces/gtk/gtkcallback.inc b/lcl/interfaces/gtk/gtkcallback.inc index d716e91059..3a76a87fe0 100644 --- a/lcl/interfaces/gtk/gtkcallback.inc +++ b/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.OnSelectionChange(OpenDialog); + OpenDialog.DoSelectionChange; 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 diff --git a/lcl/interfaces/gtk/gtkint.pp b/lcl/interfaces/gtk/gtkint.pp index 2e6c66ffd7..98151e8640 100644 --- a/lcl/interfaces/gtk/gtkint.pp +++ b/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 diff --git a/lcl/interfaces/gtk/gtkobject.inc b/lcl/interfaces/gtk/gtkobject.inc index ee0221b1b6..1219a936f9 100644 --- a/lcl/interfaces/gtk/gtkobject.inc +++ b/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); - ParentFixed := GetFixedWidget(ParentWidget); - if GtkWidgetIsA(ParentFixed,GTK_FIXED_GET_TYPE) - or GtkWidgetIsA(ParentFixed,GTK_LAYOUT_GET_TYPE) then begin - FixedMoveControl(ParentFixed, Widget, - LCLControl.Left, LCLControl.Top); - end else begin - WinWidgetInfo:=GetWidgetInfo(Widget,false); - if (WinWidgetInfo=nil) - or (not (wwiNotOnParentsClientArea in WinWidgetInfo^.Flags)) then - WriteWarningParentWidgetNotFound; + if (LCLControl.Parent<>nil) and (LCLControl.Parent.HandleAllocated) then + begin + ParentWidget:=pgtkWidget(LCLControl.Parent.Handle); + ParentFixed := GetFixedWidget(ParentWidget); + if GtkWidgetIsA(ParentFixed,GTK_FIXED_GET_TYPE) + or GtkWidgetIsA(ParentFixed,GTK_LAYOUT_GET_TYPE) then begin + FixedMoveControl(ParentFixed, Widget, + LCLControl.Left, LCLControl.Top); + end else begin + WinWidgetInfo:=GetWidgetInfo(Widget,false); + 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); - gtk_widget_show(Frame); + FrameWidget,false,false,0); + 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 diff --git a/lcl/interfaces/gtk/gtkproc.pp b/lcl/interfaces/gtk/gtkproc.pp index 4739a75fe3..adf9fd1303 100644 --- a/lcl/interfaces/gtk/gtkproc.pp +++ b/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; diff --git a/lcl/vclglobals.pp b/lcl/vclglobals.pp index 841bfb719c..9b5febb25e 100644 --- a/lcl/vclglobals.pp +++ b/lcl/vclglobals.pp @@ -102,9 +102,10 @@ const csOpenFileDialog = 56; csSaveFileDialog = 57; csSelectDirectoryDialog = 58; + csPreviewFileControl = 59; + csPreviewFileDialog = 60; - - csNonLCL = 59; // for non LCL controls, that create their own handles + csNonLCL = 61; // for non LCL controls, that create their own handles const diff --git a/localize.sh b/localize.sh index 796a62cdd9..5f993285ba 100644 --- a/localize.sh +++ b/localize.sh @@ -1,4 +1,4 @@ -#!/bin/bash +#!/usr/bin/env bash # # Usage: sh localize.sh # diff --git a/packager/packagesystem.pas b/packager/packagesystem.pas index 4a913f3360..1f47b2e29f 100644 --- a/packager/packagesystem.pas +++ b/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 diff --git a/packager/registerlcl.pas b/packager/registerlcl.pas index f1f4d53761..6e28693459 100644 --- a/packager/registerlcl.pas +++ b/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.