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

Minor fixes for common dialogs.

Browse Source 
git-svn-id: trunk@10111 -
This commit is contained in:
sekelsenmat 2006-10-28 01:07:47 +00:00
parent 4a23f61dab
commit 1c5e0f9b2d
1 changed files with 137 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

237
lcl/interfaces/qt/qtwsdialogs.pp
View File

@ -43,7 +43,6 @@ type
protected protected
public public
class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override; class function CreateHandle(const ACommonDialog: TCommonDialog): THandle; override;
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
class procedure DestroyHandle(const ACommonDialog: TCommonDialog); override; class procedure DestroyHandle(const ACommonDialog: TCommonDialog); override;
end; end;
@ -53,6 +52,7 @@ type
private private
protected protected
public public
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
end; end;
{ TQtWSOpenDialog } { TQtWSOpenDialog }
@ -85,6 +85,7 @@ type
private private
protected protected
public public
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
end; end;
{ TQtWSColorButton } { TQtWSColorButton }
@ -101,6 +102,7 @@ type
private private
protected protected
public public
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
end; end;
@ -121,13 +123,25 @@ begin
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Function: TQtWSCommonDialog.ShowModal Function: TQtWSCommonDialog.DestroyHandle
Params: None Params: None
Returns: Nothing 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 var
Caption, Dir, Filter, selectedFilter, ReturnText: WideString; Caption, Dir, Filter, selectedFilter, ReturnText: WideString;
TmpFilter, strExtensions: string; TmpFilter, strExtensions: string;
@ -137,11 +151,16 @@ var
ReturnList: QStringListH; ReturnList: QStringListH;
ParserState, Position, i: Integer; ParserState, Position, i: Integer;
Strings: TStringList; Strings: TStringList;
ReturnFont, CurrentFont: QFontH;
ReturnBool: Boolean;
begin begin
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Initialization of the dialog´s options Initialization of variables
------------------------------------------------------------------------------}
ReturnText := '';
TmpFilter := '';
selectedFilter := '';
{------------------------------------------------------------------------------
Initialization of the dialog fields
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
if ACommonDialog.Owner is TWinControl then if ACommonDialog.Owner is TWinControl then
Parent := TQtWidget(TWinControl(ACommonDialog.Owner).Handle).Widget Parent := TQtWidget(TWinControl(ACommonDialog.Owner).Handle).Widget
@ -149,89 +168,82 @@ begin
Parent := TQtWidget(Application.MainForm.Handle).Widget Parent := TQtWidget(Application.MainForm.Handle).Widget
else Parent := nil; else Parent := nil;
ReturnText := '';
TmpFilter := '';
selectedFilter := '';
Caption := UTF8Decode(ACommonDialog.Title); 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 begin
FileDialog := TFileDialog(ACommonDialog); if Copy(FileDialog.Filter, i, 1) = '|' then
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 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 begin
ParserState := ParserState + 1; strExtensions := '(' + Copy(FileDialog.Filter, Position, i - Position) + ')';
if ParserState = 1 then if Pos(strExtensions, TmpFilter) = 0 then TmpFilter := TmpFilter + ' ' + strExtensions;
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 i <> Length(FileDialog.Filter) then Position := i + 1; TmpFilter := TmpFilter + ';;';
ParserState := 0;
end; end;
if i <> Length(FileDialog.Filter) then Position := i + 1;
end; 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; 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 Code to call the dialog
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
@ -240,17 +252,21 @@ begin
if ofOverwritePrompt in TSaveDialog(ACommonDialog).Options then if ofOverwritePrompt in TSaveDialog(ACommonDialog).Options then
options := options or QFileDialogDontConfirmOverwrite; options := options or QFileDialogDontConfirmOverwrite;
Dir := Dir + ExtractFileName(FileDialog.FileName);
QFileDialog_getSaveFileName(@ReturnText, Parent, @Caption, @Dir, @Filter, @selectedFilter, options); QFileDialog_getSaveFileName(@ReturnText, Parent, @Caption, @Dir, @Filter, @selectedFilter, options);
if ReturnText = '' then ACommonDialog.UserChoice := mrCancel if ReturnText = '' then ACommonDialog.UserChoice := mrCancel
else ACommonDialog.UserChoice := mrOK; else ACommonDialog.UserChoice := mrOK;
FileDialog.FileName := UTF8Encode(ReturnText);
end end
else if ACommonDialog is TOpenDialog then else if ACommonDialog is TOpenDialog then
begin begin
if ofAllowMultiSelect in TOpenDialog(ACommonDialog).Options then if ofAllowMultiSelect in TOpenDialog(ACommonDialog).Options then
begin begin
QFileDialog_getOpenFileNames(ReturnList, Parent, @Caption, @Dir, @Filter, @selectedFilter, options) 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 // TODO: Convert ReturnList into a WideString and then into a utf-8 string and return that
end end
else else
@ -269,33 +285,54 @@ begin
if ReturnText = '' then ACommonDialog.UserChoice := mrCancel if ReturnText = '' then ACommonDialog.UserChoice := mrCancel
else ACommonDialog.UserChoice := mrOK; 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;
end; end;
{ TQtWSColorDialog }
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Function: TQtWSCommonDialog.DestroyHandle Function: TQtWSColorDialog.ShowModal
Params: None Params: None
Returns: Nothing 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 begin
end; 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 initialization
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
@ -305,12 +342,12 @@ initialization
// which actually implement something // which actually implement something
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
RegisterWSComponent(TCommonDialog, TQtWSCommonDialog); RegisterWSComponent(TCommonDialog, TQtWSCommonDialog);
// RegisterWSComponent(TFileDialog, TQtWSFileDialog); RegisterWSComponent(TFileDialog, TQtWSFileDialog);
// RegisterWSComponent(TOpenDialog, TQtWSOpenDialog); // RegisterWSComponent(TOpenDialog, TQtWSOpenDialog);
// RegisterWSComponent(TSaveDialog, TQtWSSaveDialog); // RegisterWSComponent(TSaveDialog, TQtWSSaveDialog);
// RegisterWSComponent(TSelectDirectoryDialog, TQtWSSelectDirectoryDialog); // RegisterWSComponent(TSelectDirectoryDialog, TQtWSSelectDirectoryDialog);
// RegisterWSComponent(TColorDialog, TQtWSColorDialog); RegisterWSComponent(TColorDialog, TQtWSColorDialog);
// RegisterWSComponent(TColorButton, TQtWSColorButton); // RegisterWSComponent(TColorButton, TQtWSColorButton);
// RegisterWSComponent(TFontDialog, TQtWSFontDialog); RegisterWSComponent(TFontDialog, TQtWSFontDialog);
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
end. end.