mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-03 17:17:39 +02:00
gtk1 intf: added check if user choose a directory in TOpenDialog
git-svn-id: trunk@11195 -
This commit is contained in:
parent
5cc700d456
commit
128e9c88d9
@ -69,9 +69,6 @@ type
|
||||
function DialogChar(var Message: TLMKey): boolean; override;
|
||||
procedure DoHide; dynamic;
|
||||
procedure DoShow; dynamic;
|
||||
{$IFDEF EnableSizePatch}
|
||||
procedure DoSendBoundsToInterface; override;
|
||||
{$ENDIF}
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
procedure AdjustClientRect(var ARect: TRect); override;
|
||||
|
@ -200,13 +200,6 @@ begin
|
||||
FOnShow(Self);
|
||||
end;
|
||||
|
||||
{$IFDEF EnableSizePatch}
|
||||
procedure TCustomPage.DoSendBoundsToInterface;
|
||||
begin
|
||||
// a page is only sized by the interface
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
function TCustomPage.IsControlVisible: Boolean;
|
||||
begin
|
||||
if Parent is TCustomNotebook then
|
||||
|
@ -1833,8 +1833,47 @@ var
|
||||
//SelectedFont: PGdkFont;
|
||||
|
||||
function CheckOpenedFilename(const AFilename: string): boolean;
|
||||
var
|
||||
MenuWidget: PGtkWidget;
|
||||
AFilterEntry: PFileSelFilterEntry;
|
||||
begin
|
||||
Result:=true;
|
||||
{$IFNDEF GTK2}
|
||||
// check if entered file are a real directory
|
||||
if DirectoryExists(AFileName) then
|
||||
begin
|
||||
// if allowed then jump to that directory
|
||||
if not (ofNoChangeDir in TOpenDialog(TheDialog).Options) then
|
||||
begin
|
||||
// change dir
|
||||
gtk_file_selection_set_filename(PGtkFileSelection(FPointer),
|
||||
PChar(AppendPathDelim(AFileName)));
|
||||
// populate file list
|
||||
MenuWidget := gtk_object_get_data(PGtkObject(PGtkFileSelection(FPointer)), 'LCLFilterMenu');
|
||||
if (MenuWidget <> nil) then begin
|
||||
AFilterEntry := gtk_object_get_data(PGtkObject(gtk_menu_get_active(
|
||||
PGtkMenu(MenuWidget))), 'LCLIsFilterMenuItem');
|
||||
if ((AFilterEntry<>nil) and (AFilterEntry^.Mask<>nil)) then
|
||||
PopulateFileAndDirectoryLists(PGtkFileSelection(FPointer), AFilterEntry^.Mask);
|
||||
end;
|
||||
end;
|
||||
// wait for correct input
|
||||
result:=False;
|
||||
Exit;
|
||||
end;
|
||||
// maybe user entered nonexistent dir
|
||||
if ((AFileName<>'') and (IsPathDelimiter(AFileName, Length(AFileName)))) then
|
||||
begin
|
||||
// cant jump to nonexistent dir
|
||||
if not (ofNoChangeDir in TOpenDialog(TheDialog).Options) then
|
||||
MessageDlg(rsfdDirectoryMustExist, Format(rsfdDirectoryNotExist,[AFileName]),
|
||||
mtError, [mbCancel], 0); // GTK2 shows "The folder contents could not be displayed"
|
||||
// wait for correct input
|
||||
result:=False;
|
||||
Exit;
|
||||
end;
|
||||
{$ENDIF}
|
||||
// maybe file already exists
|
||||
if (ofOverwritePrompt in TOpenDialog(theDialog).Options)
|
||||
and FileExists(AFilename) then
|
||||
begin
|
||||
|
@ -45,6 +45,7 @@ type
|
||||
protected
|
||||
public
|
||||
class procedure UpdateProperties(const ACustomPage: TCustomPage); override;
|
||||
class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override;
|
||||
end;
|
||||
|
||||
{ TGtkWSCustomNotebook }
|
||||
@ -226,6 +227,12 @@ begin
|
||||
UpdateNotebookPageTab(nil, ACustomPage);
|
||||
end;
|
||||
|
||||
class procedure TGtkWSCustomPage.SetBounds(const AWinControl: TWinControl;
|
||||
const ALeft, ATop, AWidth, AHeight: Integer);
|
||||
begin
|
||||
// ignore resizes from the LCL
|
||||
end;
|
||||
|
||||
{ TGtkWSCustomNotebook }
|
||||
|
||||
class function TGtkWSCustomNotebook.CreateHandle(const AWinControl: TWinControl;
|
||||
|
@ -2,7 +2,9 @@ How to create the fpc_crosswin32 deb
|
||||
|
||||
This deb was only tested under linux.
|
||||
|
||||
For configuration see below.
|
||||
The base directory is $BuildRoot. Default value is ~/freepascal
|
||||
To change it use for example:
|
||||
[]$ export BuildRoot=/home/user/freepascal
|
||||
|
||||
First get the FPC sources and the binutils.
|
||||
|
||||
@ -27,10 +29,3 @@ Then build the fpc_crosswin32 deb and install it:
|
||||
|
||||
Now you can cross compile from linux to win32.
|
||||
|
||||
|
||||
================================================================================
|
||||
|
||||
The following environment variables are handled:
|
||||
The base directory BuildRoot. Default value is ~/freepascal
|
||||
[]$ export BuildRoot=/home/user/freepascal
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user