mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-29 09:50:31 +02:00
Minor fixes for common dialogs.
git-svn-id: trunk@10111 -
This commit is contained in:
sekelsenmat
parent
4a23f61dab
commit
1c5e0f9b2d
@ -43,7 +43,6 @@ type
|
||||
protected
|
||||
public
|
||||
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
|
||||
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
|
||||
class procedure DestroyHandle(const ACommonDialog: TCommonDialog); override;
|
||||
end;
|
||||
|
||||
@ -53,6 +52,7 @@ type
|
||||
private
|
||||
protected
|
||||
public
|
||||
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
|
||||
end;
|
||||
|
||||
{ TQtWSOpenDialog }
|
||||
@ -85,6 +85,7 @@ type
|
||||
private
|
||||
protected
|
||||
public
|
||||
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
|
||||
end;
|
||||
|
||||
{ TQtWSColorButton }
|
||||
@ -101,6 +102,7 @@ type
|
||||
private
|
||||
protected
|
||||
public
|
||||
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
|
||||
end;
|
||||
|
||||
|
||||
@ -121,13 +123,25 @@ begin
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: TQtWSCommonDialog.ShowModal
|
||||
Function: TQtWSCommonDialog.DestroyHandle
|
||||
Params: None
|
||||
Returns: Nothing
|
||||
|
||||
Shows a common dialog
|
||||
Dummy handle destructor. On Qt we don´t need a Handle for common dialogs
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TQtWSCommonDialog.ShowModal(const ACommonDialog: TCommonDialog);
|
||||
class procedure TQtWSCommonDialog.DestroyHandle(const ACommonDialog: TCommonDialog);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
{ TQtWSFileDialog }
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: TQtWSFileDialog.ShowModal
|
||||
Params: None
|
||||
Returns: Nothing
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TQtWSFileDialog.ShowModal(const ACommonDialog: TCommonDialog);
|
||||
var
|
||||
Caption, Dir, Filter, selectedFilter, ReturnText: WideString;
|
||||
TmpFilter, strExtensions: string;
|
||||
@ -137,11 +151,16 @@ var
|
||||
ReturnList: QStringListH;
|
||||
ParserState, Position, i: Integer;
|
||||
Strings: TStringList;
|
||||
ReturnFont, CurrentFont: QFontH;
|
||||
ReturnBool: Boolean;
|
||||
begin
|
||||
{------------------------------------------------------------------------------
|
||||
Initialization of the dialog´s options
|
||||
Initialization of variables
|
||||
------------------------------------------------------------------------------}
|
||||
ReturnText := '';
|
||||
TmpFilter := '';
|
||||
selectedFilter := '';
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Initialization of the dialog fields
|
||||
------------------------------------------------------------------------------}
|
||||
if ACommonDialog.Owner is TWinControl then
|
||||
Parent := TQtWidget(TWinControl(ACommonDialog.Owner).Handle).Widget
|
||||
@ -149,89 +168,82 @@ begin
|
||||
Parent := TQtWidget(Application.MainForm.Handle).Widget
|
||||
else Parent := nil;
|
||||
|
||||
ReturnText := '';
|
||||
TmpFilter := '';
|
||||
selectedFilter := '';
|
||||
|
||||
Caption := UTF8Decode(ACommonDialog.Title);
|
||||
|
||||
if ACommonDialog is TFileDialog then
|
||||
FileDialog := TFileDialog(ACommonDialog);
|
||||
|
||||
Dir := UTF8Decode(FileDialog.InitialDir);
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
This is a parser that converts LCL filter strings to Qt filter strings
|
||||
|
||||
The parses states are:
|
||||
|
||||
0 - Initial state, is reading a string to be displayed on the filter
|
||||
1 - Is reading the extensions to be filtered
|
||||
2 - Reached the end of extensions text, now it will write
|
||||
|
||||
A LCL filter string looks like this:
|
||||
|
||||
Text files (*.txt *.pas)|*.txt *.pas|Binaries (*.exe)|*.exe
|
||||
|
||||
And a Qt filter string looks like this
|
||||
|
||||
Text files (*.txt *.pas)
|
||||
Binaries (*.exe)
|
||||
|
||||
The following LCL filter simply cannot be represented under Qt, because Qt
|
||||
always appends a string with the extensions on the combo box
|
||||
|
||||
Text files|*.txt *.pas|Binaries|*.exe
|
||||
|
||||
To solve this this algorithm will try to find (*.txt) or similar on the display text
|
||||
and will remove it. This algorithm is far from perfect and may cause trouble on some
|
||||
special cases, but should work 99% of the time.
|
||||
------------------------------------------------------------------------------}
|
||||
|
||||
ParserState := 0;
|
||||
Position := 1;
|
||||
|
||||
for i := 1 to Length(FileDialog.Filter) do
|
||||
begin
|
||||
FileDialog := TFileDialog(ACommonDialog);
|
||||
|
||||
Dir := UTF8Decode(FileDialog.InitialDir);
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
This is a parser that converts LCL filter strings to Qt filter strings
|
||||
|
||||
The parses states are:
|
||||
|
||||
0 - Initial state, is reading a string to be displayed on the filter
|
||||
1 - Is reading the extensions to be filtered
|
||||
2 - Reached the end of extensions text, now it will write
|
||||
|
||||
A LCL filter string looks like this:
|
||||
|
||||
Text files (*.txt *.pas)|*.txt *.pas|Binaries (*.exe)|*.exe
|
||||
|
||||
And a Qt filter string looks like this
|
||||
|
||||
Text files (*.txt *.pas)
|
||||
Binaries (*.exe)
|
||||
|
||||
The following LCL filter simply cannot be represented under Qt, because Qt
|
||||
always appends a string with the extensions on the combo box
|
||||
|
||||
Text files|*.txt *.pas|Binaries|*.exe
|
||||
|
||||
To solve this this algorithm will try to find (*.txt) or similar on the display text
|
||||
and will remove it. This algorithm is far from perfect and may cause trouble on some
|
||||
special cases, but should work 99% of the time.
|
||||
------------------------------------------------------------------------------}
|
||||
|
||||
ParserState := 0;
|
||||
Position := 1;
|
||||
|
||||
for i := 1 to Length(FileDialog.Filter) do
|
||||
if Copy(FileDialog.Filter, i, 1) = '|' then
|
||||
begin
|
||||
if Copy(FileDialog.Filter, i, 1) = '|' then
|
||||
ParserState := ParserState + 1;
|
||||
|
||||
if ParserState = 1 then
|
||||
TmpFilter := TmpFilter + Copy(FileDialog.Filter, Position, i - Position)
|
||||
else if ParserState = 2 then
|
||||
begin
|
||||
ParserState := ParserState + 1;
|
||||
strExtensions := '(' + Copy(FileDialog.Filter, Position, i - Position) + ')';
|
||||
|
||||
if ParserState = 1 then
|
||||
TmpFilter := TmpFilter + Copy(FileDialog.Filter, Position, i - Position)
|
||||
else if ParserState = 2 then
|
||||
begin
|
||||
strExtensions := '(' + Copy(FileDialog.Filter, Position, i - Position) + ')';
|
||||
|
||||
if Pos(strExtensions, TmpFilter) = 0 then TmpFilter := TmpFilter + ' ' + strExtensions;
|
||||
|
||||
TmpFilter := TmpFilter + ';;';
|
||||
|
||||
ParserState := 0;
|
||||
end;
|
||||
if Pos(strExtensions, TmpFilter) = 0 then TmpFilter := TmpFilter + ' ' + strExtensions;
|
||||
|
||||
if i <> Length(FileDialog.Filter) then Position := i + 1;
|
||||
TmpFilter := TmpFilter + ';;';
|
||||
|
||||
ParserState := 0;
|
||||
end;
|
||||
|
||||
if i <> Length(FileDialog.Filter) then Position := i + 1;
|
||||
end;
|
||||
|
||||
strExtensions := '(' + Copy(FileDialog.Filter, Position, i + 1 - Position) + ')';
|
||||
|
||||
if Pos(strExtensions, TmpFilter) = 0 then TmpFilter := TmpFilter + ' ' + strExtensions;
|
||||
|
||||
{$ifdef VerboseQt}
|
||||
WriteLn('[TQtWSCommonDialog.ShowModal] Parsed Filter: ', TmpFilter);
|
||||
{$endif}
|
||||
|
||||
Filter := UTF8Decode(TmpFilter);
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Qt doesn´t have most of the dialog options available on LCL
|
||||
------------------------------------------------------------------------------}
|
||||
|
||||
options := 0;
|
||||
end;
|
||||
|
||||
|
||||
strExtensions := '(' + Copy(FileDialog.Filter, Position, i + 1 - Position) + ')';
|
||||
|
||||
if Pos(strExtensions, TmpFilter) = 0 then TmpFilter := TmpFilter + ' ' + strExtensions;
|
||||
|
||||
{$ifdef VerboseQt}
|
||||
WriteLn('[TQtWSCommonDialog.ShowModal] Parsed Filter: ', TmpFilter);
|
||||
{$endif}
|
||||
|
||||
Filter := UTF8Decode(TmpFilter);
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Qt doesn´t have most of the dialog options available on LCL
|
||||
------------------------------------------------------------------------------}
|
||||
|
||||
options := 0;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Code to call the dialog
|
||||
------------------------------------------------------------------------------}
|
||||
@ -240,17 +252,21 @@ begin
|
||||
if ofOverwritePrompt in TSaveDialog(ACommonDialog).Options then
|
||||
options := options or QFileDialogDontConfirmOverwrite;
|
||||
|
||||
Dir := Dir + ExtractFileName(FileDialog.FileName);
|
||||
|
||||
QFileDialog_getSaveFileName(@ReturnText, Parent, @Caption, @Dir, @Filter, @selectedFilter, options);
|
||||
|
||||
if ReturnText = '' then ACommonDialog.UserChoice := mrCancel
|
||||
else ACommonDialog.UserChoice := mrOK;
|
||||
|
||||
FileDialog.FileName := UTF8Encode(ReturnText);
|
||||
end
|
||||
else if ACommonDialog is TOpenDialog then
|
||||
begin
|
||||
if ofAllowMultiSelect in TOpenDialog(ACommonDialog).Options then
|
||||
begin
|
||||
QFileDialog_getOpenFileNames(ReturnList, Parent, @Caption, @Dir, @Filter, @selectedFilter, options)
|
||||
|
||||
|
||||
// TODO: Convert ReturnList into a WideString and then into a utf-8 string and return that
|
||||
end
|
||||
else
|
||||
@ -269,33 +285,54 @@ begin
|
||||
|
||||
if ReturnText = '' then ACommonDialog.UserChoice := mrCancel
|
||||
else ACommonDialog.UserChoice := mrOK;
|
||||
end
|
||||
else if ACommonDialog is TColorDialog then
|
||||
begin
|
||||
end
|
||||
else if ACommonDialog is TFontDialog then
|
||||
begin
|
||||
CurrentFont := TQtFont(TFontDialog(ACommonDialog).Font.Handle).Widget;
|
||||
|
||||
QFontDialog_getFont(ReturnFont, @ReturnBool, CurrentFont, Parent);
|
||||
|
||||
if ReturnBool then ACommonDialog.UserChoice := mrOk
|
||||
else ACommonDialog.UserChoice := mrCancel;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TQtWSColorDialog }
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: TQtWSCommonDialog.DestroyHandle
|
||||
Function: TQtWSColorDialog.ShowModal
|
||||
Params: None
|
||||
Returns: Nothing
|
||||
|
||||
Dummy handle destructor. On Qt we don´t need a Handle for common dialogs
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TQtWSCommonDialog.DestroyHandle(const ACommonDialog: TCommonDialog);
|
||||
class procedure TQtWSColorDialog.ShowModal(const ACommonDialog: TCommonDialog);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
{ TQtWSFontDialog }
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Function: TQtWSFontDialog.ShowModal
|
||||
Params: None
|
||||
Returns: Nothing
|
||||
------------------------------------------------------------------------------}
|
||||
class procedure TQtWSFontDialog.ShowModal(const ACommonDialog: TCommonDialog);
|
||||
var
|
||||
Parent: QWidgetH;
|
||||
ReturnFont, CurrentFont: QFontH;
|
||||
ReturnBool: Boolean;
|
||||
begin
|
||||
{------------------------------------------------------------------------------
|
||||
Initialization of options
|
||||
------------------------------------------------------------------------------}
|
||||
if ACommonDialog.Owner is TWinControl then
|
||||
Parent := TQtWidget(TWinControl(ACommonDialog.Owner).Handle).Widget
|
||||
else if Assigned(Application.MainForm) then
|
||||
Parent := TQtWidget(Application.MainForm.Handle).Widget
|
||||
else Parent := nil;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Code to call the dialog
|
||||
------------------------------------------------------------------------------}
|
||||
CurrentFont := TQtFont(TFontDialog(ACommonDialog).Font.Handle).Widget;
|
||||
|
||||
QFontDialog_getFont(ReturnFont, @ReturnBool, CurrentFont, Parent);
|
||||
|
||||
if ReturnBool then ACommonDialog.UserChoice := mrOk
|
||||
else ACommonDialog.UserChoice := mrCancel;
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
////////////////////////////////////////////////////
|
||||
@ -305,12 +342,12 @@ initialization
|
||||
// which actually implement something
|
||||
////////////////////////////////////////////////////
|
||||
RegisterWSComponent(TCommonDialog, TQtWSCommonDialog);
|
||||
// RegisterWSComponent(TFileDialog, TQtWSFileDialog);
|
||||
RegisterWSComponent(TFileDialog, TQtWSFileDialog);
|
||||
// RegisterWSComponent(TOpenDialog, TQtWSOpenDialog);
|
||||
// RegisterWSComponent(TSaveDialog, TQtWSSaveDialog);
|
||||
// RegisterWSComponent(TSelectDirectoryDialog, TQtWSSelectDirectoryDialog);
|
||||
// RegisterWSComponent(TColorDialog, TQtWSColorDialog);
|
||||
RegisterWSComponent(TColorDialog, TQtWSColorDialog);
|
||||
// RegisterWSComponent(TColorButton, TQtWSColorButton);
|
||||
// RegisterWSComponent(TFontDialog, TQtWSFontDialog);
|
||||
RegisterWSComponent(TFontDialog, TQtWSFontDialog);
|
||||
////////////////////////////////////////////////////
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user