mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-29 06:24:02 +02:00
537 lines
16 KiB
ObjectPascal
537 lines
16 KiB
ObjectPascal
{
|
||
*****************************************************************************
|
||
* MuiWSDialogs.pp *
|
||
* --------------- *
|
||
* *
|
||
* *
|
||
*****************************************************************************
|
||
|
||
*****************************************************************************
|
||
* *
|
||
* This file is part of the Lazarus Component Library (LCL) *
|
||
* *
|
||
* See the file COPYING.modifiedLGPL.txt, 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 MuiWSDialogs;
|
||
|
||
{$mode objfpc}{$H+}
|
||
|
||
interface
|
||
|
||
{$if defined(AROS) and defined(VER3_0)}
|
||
{$define USE_OLD_ASL}
|
||
{$endif}
|
||
{$if defined(MorphOS) or defined(Amiga68k)}
|
||
{$define USE_OLD_ASL}
|
||
{$endif}
|
||
|
||
uses
|
||
// RTL + LCL
|
||
AGraphics, SysUtils, Classes, LCLType, LCLProc, Dialogs, Controls, Forms, Graphics,
|
||
exec, asl, utility, tagsparamshelper, mui, intuition, MuibaseUnit, MUIformsunit,
|
||
AmigaDos, Math,
|
||
{$ifndef MorphOS}
|
||
workbench,
|
||
{$endif}
|
||
{$if defined(MorphOS) or defined(Amiga68K)}
|
||
amigalib,
|
||
{$endif}
|
||
muiglobal,
|
||
// Widgetset
|
||
WSDialogs, WSLCLClasses;
|
||
|
||
type
|
||
|
||
{ TMuiWSCommonDialog }
|
||
|
||
TMuiWSCommonDialog = class(TWSCommonDialog)
|
||
private
|
||
protected
|
||
published
|
||
class function CreateHandle(const ACommonDialog: TCommonDialog): TLCLHandle; override;
|
||
class procedure DestroyHandle(const ACommonDialog: TCommonDialog); override;
|
||
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
|
||
end;
|
||
|
||
{ TMuiWSFileDialog }
|
||
|
||
TMuiWSFileDialog = class(TWSFileDialog)
|
||
private
|
||
protected
|
||
published
|
||
class function CreateHandle(const ACommonDialog: TCommonDialog): TLCLHandle; override;
|
||
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
|
||
end;
|
||
|
||
{ TMuiWSOpenDialog }
|
||
|
||
TMuiWSOpenDialog = class(TWSOpenDialog)
|
||
published
|
||
end;
|
||
|
||
{ TMuiWSSaveDialog }
|
||
|
||
TMuiWSSaveDialog = class(TWSSaveDialog)
|
||
published
|
||
end;
|
||
|
||
{ TMuiWSSelectDirectoryDialog }
|
||
|
||
TMuiWSSelectDirectoryDialog = class(TWSSelectDirectoryDialog)
|
||
published
|
||
class function CreateHandle(const ACommonDialog: TCommonDialog): TLCLHandle; override;
|
||
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
|
||
end;
|
||
|
||
{ TMuiWSColorDialog }
|
||
|
||
TMuiWSColorDialog = class(TWSColorDialog)
|
||
published
|
||
class function CreateHandle(const ACommonDialog: TCommonDialog): TLCLHandle; override;
|
||
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
|
||
end;
|
||
|
||
{ TMuiWSColorButton }
|
||
|
||
TMuiWSColorButton = class(TWSColorButton)
|
||
published
|
||
end;
|
||
|
||
{ TMuiWSFontDialog }
|
||
|
||
TMuiWSFontDialog = class(TWSFontDialog)
|
||
published
|
||
class function CreateHandle(const ACommonDialog: TCommonDialog): TLCLHandle; override;
|
||
class procedure ShowModal(const ACommonDialog: TCommonDialog); override;
|
||
end;
|
||
|
||
|
||
implementation
|
||
|
||
|
||
{ TMuiWSCommonDialog }
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TMuiWSCommonDialog.CreateHandle
|
||
Params: None
|
||
Returns: Nothing
|
||
|
||
Dummy handle creator. On Qt we don´t need a Handle for common dialogs
|
||
------------------------------------------------------------------------------}
|
||
class function TMuiWSCommonDialog.CreateHandle(const ACommonDialog: TCommonDialog): TLCLHandle;
|
||
begin
|
||
Result := 0;
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TMuiWSCommonDialog.DestroyHandle
|
||
Params: None
|
||
Returns: Nothing
|
||
|
||
Dummy handle destructor. On Qt we don´t need a Handle for common dialogs
|
||
------------------------------------------------------------------------------}
|
||
class procedure TMuiWSCommonDialog.DestroyHandle(const ACommonDialog: TCommonDialog);
|
||
begin
|
||
if (ACommonDialog.HandleAllocated) then
|
||
FreeAslRequest(Pointer(ACommonDialog.Handle));
|
||
end;
|
||
|
||
class procedure TMuiWSCommonDialog.ShowModal(const ACommonDialog: TCommonDialog);
|
||
begin
|
||
|
||
end;
|
||
|
||
{ TMuiWSFileDialog }
|
||
|
||
class function TMuiWSFileDialog.CreateHandle(const ACommonDialog: TCommonDialog): TLCLHandle;
|
||
var
|
||
FileDialog: PFileRequester;
|
||
begin
|
||
FileDialog := PFileRequester(AllocFileRequest());
|
||
Result := TLCLHandle(FileDialog);
|
||
end;
|
||
|
||
//procedure IntuiMsgFunc(iMsg: PIntuiMessage; Req: PFileRequester); cdecl;
|
||
//begin
|
||
//writeln('test');
|
||
// DoMethod(MUIApp.obj, MUIM_Application_CheckRefresh, []);
|
||
//end;
|
||
{$ifdef MorphOS}
|
||
type
|
||
PWBArg = ^TWBArg;
|
||
TWBArg = record
|
||
wa_Lock: BPTR; { a lock descriptor }
|
||
wa_Name: STRPTR; { a string relative to that lock }
|
||
end;
|
||
|
||
WBArgList = Array [1..100] of tWBArg; { Only 1..smNumArgs are valid }
|
||
PWBArgList = ^WBArgList;
|
||
{$endif}
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TMuiWSFileDialog.ShowModal
|
||
Params: None
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
class procedure TMuiWSFileDialog.ShowModal(const ACommonDialog: TCommonDialog);
|
||
var
|
||
FileDialog: TFileDialog;
|
||
MuiDialog: PFileRequester;
|
||
TagsList: TATagList;
|
||
MultiSelect: Boolean;
|
||
i: LongInt;
|
||
|
||
function GetFilename(FDir, FName: string): string;
|
||
begin
|
||
FDir := Trim(FDir);
|
||
if Length(FDir) = 0 then
|
||
Result := FName
|
||
else
|
||
begin
|
||
if (FDir[Length(FDir)] = DIRECTORYSEPARATOR) or (FDir[Length(FDir)] = ':') then
|
||
Result := FDir + FName
|
||
else
|
||
Result := FDir + DIRECTORYSEPARATOR + FName;
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
{------------------------------------------------------------------------------
|
||
Initialization of variables
|
||
------------------------------------------------------------------------------}
|
||
MultiSelect:= False;
|
||
TagsList.Clear;
|
||
FileDialog := TFileDialog(ACommonDialog);
|
||
MuiDialog := PFileRequester(FileDialog.Handle);
|
||
|
||
//Win := 0;
|
||
//GetAttr(MUIA_Window_Window, MUIApp.MainWin, @Win);
|
||
|
||
|
||
TagsList.AddTags([
|
||
//ASLFR_Window, Win,
|
||
ASLFR_TitleText, NativeUInt(PChar(ACommonDialog.Title)),
|
||
ASLFR_InitialDrawer, NativeUInt(PChar(TFileDialog(ACommonDialog).InitialDir)),
|
||
ASLFR_InitialFile, NativeUInt(PChar(TFileDialog(ACommonDialog).FileName))
|
||
]);
|
||
|
||
If FileDialog.Filter <> '' then
|
||
begin
|
||
//writeln(FileDialog.Filter);
|
||
TagsList.AddTags([
|
||
ASLFR_InitialPattern, NativeUInt(PChar(FileDialog.Filter)),
|
||
ASLFR_DoPatterns, TagTrue
|
||
]);
|
||
end;
|
||
|
||
if ACommonDialog is TSaveDialog then
|
||
begin
|
||
TagsList.AddTags([ASLFR_DoSaveMode, TagTrue]);
|
||
end else
|
||
begin
|
||
if (ofAllowMultiSelect in TOpenDialog(FileDialog).Options) then
|
||
begin
|
||
MultiSelect:= True;
|
||
TagsList.AddTags([ASLFR_DoMultiSelect, TagTrue]);
|
||
end;
|
||
end;
|
||
if ACommonDialog is TSelectDirectoryDialog then
|
||
begin
|
||
TagsList.AddTags([ASLFR_DrawersOnly, TagTrue]);
|
||
end;
|
||
//
|
||
//Hook.h_Entry := NativeUInt(@IntuiMsgFunc);
|
||
//Hook.h_SubEntry := 0;
|
||
//Hook.h_Data := MuiDialog;
|
||
//TagsList.AddTags([ASLFR_UserData, NativeUInt(MUIApp), ASLFR_IntuiMsgFunc, NativeUInt(@Hook)]);//}
|
||
{$ifndef USE_OLD_ASL}
|
||
{$ifdef Amiga}
|
||
if AslRequest(MuiDialog, TagsList) then
|
||
{$else}
|
||
if MUI_AslRequest(MuiDialog, TagsList) then
|
||
{$endif}
|
||
begin
|
||
FileDialog.FileName := GetFilename(string(MuiDialog^.fr_Drawer), string(MuiDialog^.fr_file));
|
||
if MultiSelect then
|
||
begin
|
||
FileDialog.Files.Clear;
|
||
for i := 1 to MuiDialog^.fr_NumArgs do
|
||
begin
|
||
FileDialog.Files.Add(GetFilename(string(MuiDialog^.fr_Drawer), string(PWBArgList(MuiDialog^.fr_ArgList)^[i].wa_Name)));
|
||
end;
|
||
end;
|
||
FileDialog.UserChoice := mrOK;
|
||
end else
|
||
{$else}
|
||
{$ifdef Amiga}
|
||
if Boolean(AslRequest(MuiDialog, TagsList)) then
|
||
{$else}
|
||
if MUI_AslRequest(MuiDialog, TagsList) then
|
||
{$endif}
|
||
begin
|
||
FileDialog.FileName := GetFilename(string(MuiDialog^.rf_Dir), string(MuiDialog^.rf_file));
|
||
if MultiSelect then
|
||
begin
|
||
FileDialog.Files.Clear;
|
||
for i := 1 to MuiDialog^.rf_NumArgs do
|
||
begin
|
||
FileDialog.Files.Add(GetFilename(string(MuiDialog^.rf_Dir), string(PWBArgList(MuiDialog^.rf_ArgList)^[i].wa_Name)));
|
||
end;
|
||
end;
|
||
FileDialog.UserChoice := mrOK;
|
||
end else
|
||
{$endif}
|
||
FileDialog.UserChoice := mrCancel;
|
||
end;
|
||
|
||
{ TMuiWSSelectDirectoryDialog }
|
||
|
||
class function TMuiWSSelectDirectoryDialog.CreateHandle(const ACommonDialog: TCommonDialog): TLCLHandle;
|
||
begin
|
||
Result := 1;
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TMuiWSSelectDirectoryDialog.ShowModal
|
||
Params: None
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
class procedure TMuiWSSelectDirectoryDialog.ShowModal(const ACommonDialog: TCommonDialog);
|
||
begin
|
||
end;
|
||
|
||
{ TMuiWSColorDialog }
|
||
|
||
class function TMuiWSColorDialog.CreateHandle(const ACommonDialog: TCommonDialog): TLCLHandle;
|
||
begin
|
||
Result := 1;
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TMuiWSColorDialog.ShowModal
|
||
Params: None
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
|
||
function ColLongWord(c: Byte): LongWord;
|
||
begin
|
||
Result := c or (c shl 8) or (c shl 16) or (c shl 24);
|
||
end;
|
||
|
||
class procedure TMuiWSColorDialog.ShowModal(const ACommonDialog: TCommonDialog);
|
||
var
|
||
ColorDialog: TColorDialog absolute ACommonDialog;
|
||
AppTags: TATagList;
|
||
GrpTags: TATagList;
|
||
BGrpTags: TATagList;
|
||
WinTags: TATagList;
|
||
PalTags: TATagList;
|
||
SetTags: TATagList;
|
||
LocalApp: PObject_;
|
||
Win: PObject_;
|
||
Palette: PObject_;
|
||
Group: PObject_;
|
||
BGroup: PObject_;
|
||
but1, but2: PObject_;
|
||
sigs: LongWord;
|
||
Res: Integer;
|
||
r,g,b: NativeUInt;
|
||
DefWidth, DefHeight: Integer;
|
||
begin
|
||
R := ColLongWord(Red(ColorDialog.Color));
|
||
G := ColLongWord(Green(ColorDialog.Color));
|
||
B := ColLongWord(Blue(ColorDialog.Color));
|
||
//
|
||
PalTags.AddTags([
|
||
MUIA_Coloradjust_Red, R,
|
||
MUIA_Coloradjust_Green, G,
|
||
MUIA_Coloradjust_Blue, B
|
||
]);
|
||
Palette := MUI_NewObjectA(MUIC_ColorAdjust, PalTags);
|
||
|
||
but1 := MUI_MakeObject(MUIO_Button, [PtrUInt(PChar('OK'))]);
|
||
but2 := MUI_MakeObject(MUIO_Button, [PTrUInt(PChar('Cancel'))]);
|
||
|
||
BGrpTags.AddTags([
|
||
MUIA_Group_Child, NativeUInt(but1),
|
||
MUIA_Group_Child, NativeUInt(but2),
|
||
MUIA_Group_HorizSpacing, 20,
|
||
MUIA_Group_Horiz, TagTrue]);
|
||
BGroup := MUI_NewObjectA(MUIC_Group, BGrpTags);
|
||
|
||
GrpTags.AddTags([
|
||
MUIA_Group_Child, NativeUInt(Palette),
|
||
MUIA_Group_Child, NativeUInt(BGroup),
|
||
MUIA_Group_Horiz, TagFalse]);
|
||
|
||
Group := MUI_NewObjectA(MUIC_Group, GrpTags);
|
||
|
||
DefWidth := 300;
|
||
DefHeight := 300;
|
||
|
||
if ColorDialog.Width > 0 then
|
||
DefWidth := ColorDialog.Width;
|
||
if ColorDialog.Height > 0 then
|
||
DefHeight := ColorDialog.Height;
|
||
|
||
WinTags.AddTags([
|
||
MUIA_Window_Title, NativeUInt(PChar(ColorDialog.Title)),
|
||
MUIA_Window_RootObject, NativeUInt(Group),
|
||
MUIA_Window_Width, DefWidth,
|
||
MUIA_Window_Height, DefHeight]);
|
||
Win := MUI_NewObjectA(MUIC_Window, WinTags);
|
||
|
||
AppTags.AddTags([MUIA_Application_Window, NativeUInt(Win)]);
|
||
LocalApp := MUI_NewObjectA(MUIC_Application, AppTags);
|
||
|
||
DoMethod(Win, [MUIM_Notify,
|
||
PtrUInt(MUIA_Window_CloseRequest), TagTrue,
|
||
PtrUInt(LocalApp), 2, PtrUInt(MUIM_Application_ReturnID), PtrUInt(MUIV_Application_ReturnID_Quit)]);
|
||
|
||
DoMethod(but2, [MUIM_Notify,
|
||
PtrUInt(MUIA_Pressed), TagTrue,
|
||
PtrUInt(LocalApp), 2, PtrUInt(MUIM_Application_ReturnID), PtrUInt(MUIV_Application_ReturnID_Quit)]);
|
||
|
||
DoMethod(but1, [MUIM_Notify,
|
||
PtrUInt(MUIA_Pressed), TagTrue,
|
||
PtrUInt(LocalApp), 2, PtrUInt(MUIM_Application_ReturnID), 42]);
|
||
|
||
SetTags.Clear;
|
||
SetTags.AddTag(MUIA_Window_Open, TagTrue);
|
||
SetAttrsA(Win, SetTags);
|
||
Res := -1;
|
||
while true do
|
||
begin
|
||
Res := Integer(DoMethod(LocalApp, [MUIM_Application_NewInput, PtrInt(@sigs)]));
|
||
case Res of
|
||
MUIV_Application_ReturnID_Quit: begin
|
||
ACommonDialog.UserChoice := mrCancel;
|
||
Break;
|
||
end;
|
||
42: begin
|
||
ACommonDialog.UserChoice := mrOK;
|
||
Break;
|
||
end;
|
||
end;
|
||
if sigs <> 0 then
|
||
begin
|
||
sigs := Wait(sigs or SIGBREAKF_CTRL_C);
|
||
if (Sigs and SIGBREAKF_CTRL_C) <> 0 then
|
||
Break;
|
||
end;
|
||
end;
|
||
MUI_DisposeObject(LocalApp);
|
||
|
||
GetAttr(MUIA_Coloradjust_Red, Palette, @R);
|
||
GetAttr(MUIA_Coloradjust_Green, Palette, @G);
|
||
GetAttr(MUIA_Coloradjust_Blue, Palette, @B);
|
||
|
||
ColorDialog.Color := RGBToColor((R shr 24) and $FF, (G shr 24) and $FF, (B shr 24) and $FF);
|
||
end;
|
||
|
||
{ TMuiWSFontDialog }
|
||
|
||
class function TMuiWSFontDialog.CreateHandle(const ACommonDialog: TCommonDialog
|
||
): TLCLHandle;
|
||
var
|
||
MuiDialog: PFontRequester;
|
||
begin
|
||
MuiDialog := PFontRequester(AllocAslRequest(ASL_FontRequest, nil));
|
||
Result := TLCLHandle(MuiDialog);
|
||
end;
|
||
|
||
{------------------------------------------------------------------------------
|
||
Function: TMuiWSFontDialog.ShowModal
|
||
Params: None
|
||
Returns: Nothing
|
||
------------------------------------------------------------------------------}
|
||
class procedure TMuiWSFontDialog.ShowModal(const ACommonDialog: TCommonDialog);
|
||
var
|
||
FDialog: TFontDialog absolute ACommonDialog;
|
||
MuiDialog: PFontRequester;
|
||
TagsList: TATagList;
|
||
PText: string;
|
||
TitleText: string;
|
||
FontName: string;
|
||
Style: LongWord;
|
||
begin
|
||
MuiDialog := PFontRequester(FDialog.Handle);
|
||
//
|
||
PText := Trim(FDialog.PreviewText);
|
||
TitleText := Trim(FDialog.Title);
|
||
FontName := Trim(FDialog.Font.Name);
|
||
|
||
if PText <> '' then
|
||
TagsList.AddTags([ASLFO_SampleText, NativeUInt(PChar(PText))]);
|
||
if TitleText <> '' then
|
||
TagsList.AddTags([ASLFO_TitleText, NativeUInt(PChar(TitleText))]);
|
||
if FDialog.MinFontSize > 0 then
|
||
TagsList.AddTags([ASLFO_MinHeight, FDialog.MinFontSize]);
|
||
if FDialog.MaxFontSize > 0 then
|
||
TagsList.AddTags([ASLFO_MaxHeight, FDialog.MaxFontSize]);
|
||
|
||
// Style Dialog
|
||
TagsList.AddTags([ASLFO_DoStyle, IfThen(not (fdNoStyleSel in FDialog.Options), TagTrue, TagFalse)]);
|
||
// Fixed Width
|
||
TagsList.AddTags([ASLFO_FixedWidthOnly, IfThen(fdFixedPitchOnly in FDialog.Options, TagTrue, TagFalse)]);
|
||
|
||
// Initial Things
|
||
if FontName <> '' then
|
||
TagsList.AddTags([ASLFO_InitialName, NativeUInt(PChar(FontName))]);
|
||
if FDialog.Font.Size > 0 then
|
||
TagsList.AddTags([ASLFO_InitialSize, FDialog.Font.Size]);
|
||
// Styles
|
||
Style := FS_NORMAL;
|
||
if fsBold in FDialog.Font.Style then
|
||
Style := Style or FSF_BOLD;
|
||
if fsItalic in FDialog.Font.Style then
|
||
Style := Style or FSF_ITALIC;
|
||
if fsUnderline in FDialog.Font.Style then
|
||
Style := Style or FSF_UNDERLINED;
|
||
TagsList.AddTags([
|
||
ASLFO_InitialStyle, Style,
|
||
ASLFO_DoFrontPen, TagFalse
|
||
]);
|
||
//
|
||
{$ifdef Amiga}
|
||
if Boolean(AslRequest(MuiDialog, TagsList)) then
|
||
{$else}
|
||
if MUI_AslRequest(MuiDialog, TagsList) then
|
||
{$endif}
|
||
begin
|
||
FontName := string(MuiDialog^.fo_Attr.ta_Name);
|
||
FDialog.Font.Name := stringreplace(Fontname, '.font', '', [rfIgnoreCase, rfReplaceAll]);
|
||
if not (fdNoSizeSel in FDialog.Options) then
|
||
FDialog.Font.Size := MUIDialog^.fo_Attr.ta_YSize;
|
||
if not (fdNoStyleSel in FDialog.Options) then
|
||
begin
|
||
FDialog.Font.Style := [];
|
||
Style := MUIDialog^.fo_Attr.ta_Style;
|
||
if (Style and FSF_BOLD) <> 0 then
|
||
FDialog.Font.Style := FDialog.Font.Style + [fsBold];
|
||
if (Style and FSF_ITALIC) <> 0 then
|
||
FDialog.Font.Style := FDialog.Font.Style + [fsItalic];
|
||
if (Style and FSF_UNDERLINED) <> 0 then
|
||
FDialog.Font.Style := FDialog.Font.Style + [fsUnderline];
|
||
end;
|
||
if (MuiDialog^.fo_Attr.ta_Flags and FPF_PROPORTIONAL) <> 0 then
|
||
FDialog.Font.Pitch := fpDefault
|
||
else
|
||
FDialog.Font.Pitch := fpFixed;
|
||
ACommonDialog.UserChoice := mrOk;
|
||
end else
|
||
begin
|
||
ACommonDialog.UserChoice := mrCancel;
|
||
end;
|
||
|
||
end;
|
||
|
||
end.
|