paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-10 10:59:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

implemented TOpenPictureDialog

Browse Source 
git-svn-id: trunk@4558 -
This commit is contained in:
mattias 2003-09-02 21:32:56 +00:00
parent 4dda95ce6e
commit a9f24996c7
21 changed files with 735 additions and 290 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -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

5
lcl/allunits.pp
View File

@ -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

30
lcl/dialogs.pp
View File

@ -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

262
lcl/extdlgs.pas Normal file
View File

@ -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.

4
lcl/filectrl.pp
View File

@ -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

25
lcl/graphics.pp
View File

@ -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

111
lcl/include/bitmap.inc
View File

@ -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

14
lcl/include/commondialog.inc
View File

@ -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

12
lcl/include/filectrl.inc
View File

@ -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

185
lcl/include/filedialog.inc
View File

@ -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

85
lcl/include/picture.inc
View File

@ -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);

20
lcl/include/pixmap.inc
View File

@ -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

116
lcl/include/png.inc
View File

@ -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

13
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -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

18
lcl/interfaces/gtk/gtkint.pp
View File

@ -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

111
lcl/interfaces/gtk/gtkobject.inc
View File

@ -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

2
lcl/interfaces/gtk/gtkproc.pp
View File

@ -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;

5
lcl/vclglobals.pp
View File

@ -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

2
localize.sh
View File

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

1
packager/packagesystem.pas
View File

@ -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

3
packager/registerlcl.pas
View File

@ -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.