{ /*************************************************************************** dialogs.pp ---------- Component Library Standard dialogs Controls ***************************************************************************/ ***************************************************************************** This file is part of the Lazarus Component Library (LCL) See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** } unit Dialogs; {$mode objfpc}{$H+} interface uses // RTL + FCL Types, TypInfo, Classes, SysUtils, System.UITypes, // LCL LMessages, LResources, LCLIntf, InterfaceBase, LCLStrConsts, LCLType, Forms, Controls, Themes, Graphics, Buttons, ButtonPanel, StdCtrls, ExtCtrls, LCLClasses, ClipBrd, Menus, {LCLTaskDialog,} DialogRes, ComCtrls, // LazUtils GraphType, FileUtil, LazFileUtils, LazStringUtils, LazLoggerBase; type // Aliases for types in UITypes. TMsgDlgType = System.UITypes.TMsgDlgType; TMsgDlgBtn = System.UITypes.TMsgDlgBtn; TMsgDlgButtons = System.UITypes.TMsgDlgButtons; const // Aliases for enum values in UITypes. mtWarning = System.UITypes.TMsgDlgType.mtWarning; mtError = System.UITypes.TMsgDlgType.mtError; mtInformation = System.UITypes.TMsgDlgType.mtInformation; mtConfirmation = System.UITypes.TMsgDlgType.mtConfirmation; mtCustom = System.UITypes.TMsgDlgType.mtCustom; mbYes = System.UITypes.TMsgDlgBtn.mbYes; mbNo = System.UITypes.TMsgDlgBtn.mbNo; mbOK = System.UITypes.TMsgDlgBtn.mbOK; mbCancel = System.UITypes.TMsgDlgBtn.mbCancel; mbAbort = System.UITypes.TMsgDlgBtn.mbAbort; mbRetry = System.UITypes.TMsgDlgBtn.mbRetry; mbIgnore = System.UITypes.TMsgDlgBtn.mbIgnore; mbAll = System.UITypes.TMsgDlgBtn.mbAll; mbNoToAll = System.UITypes.TMsgDlgBtn.mbNoToAll; mbYesToAll = System.UITypes.TMsgDlgBtn.mbYesToAll; mbHelp = System.UITypes.TMsgDlgBtn.mbHelp; mbClose = System.UITypes.TMsgDlgBtn.mbClose; // Combinations of buttons. mbYesNoCancel = [mbYes, mbNo, mbCancel]; mbYesNo = [mbYes, mbNo]; mbOKCancel = [mbOK, mbCancel]; mbAbortRetryIgnore = [mbAbort, mbRetry, mbIgnore]; MsgDlgBtnToBitBtnKind: array[TMsgDlgBtn] of TBitBtnKind = ( bkYes, bkNo, bkOK, bkCancel, bkAbort, bkRetry, bkIgnore, bkAll, bkNoToAll, bkYesToAll, bkHelp, bkClose ); BitBtnKindToMsgDlgBtn: array[TBitBtnKind] of TMsgDlgBtn = ( mbOk, mbOK, mbCancel, mbHelp, mbYes, mbNo, mbClose, mbAbort, mbRetry, mbIgnore, mbAll, mbNoToALl, mbYesToAll ); type { TCommonDialog } TCDWSEventCapability = (cdecWSPerformsDoShow, cdecWSPerformsDoCanClose, cdecWSPerformsDoClose, cdecWSNOCanCloseSupport); TCDWSEventCapabilities = set of TCDWSEventCapability; TDialogResultEvent = procedure(Sender: TObject; Success: Boolean) of object; TCommonDialog = class(TLCLComponent) private FAttachTo: TCustomForm; FHandle : TLCLHandle; FHeight: Integer; FOnDialogResult: TDialogResultEvent; FWidth: Integer; FOnCanClose: TCloseQueryEvent; FOnShow, FOnClose : TNotifyEvent; FTitle : string; FUserChoice: Integer; FHelpContext: THelpContext; FDoCanCloseCalled: Boolean; FDoShowCalled: Boolean; FDoCloseCalled: Boolean; FClosing: Boolean; FWSEventCapabilities :TCDWSEventCapabilities; procedure SetHandle(const AValue: TLCLHandle); function IsTitleStored: Boolean; protected class procedure WSRegisterClass; override; function DoExecute : Boolean; virtual; function DefaultTitle: string; virtual; function GetHeight: Integer; virtual; function GetWidth: Integer; virtual; procedure SetHeight(const AValue: Integer); virtual; procedure SetWidth(const AValue: Integer); virtual; procedure ResetShowCloseFlags; property AttachTo: TCustomForm read FAttachTo write FAttachTo; platform; property OnDialogResult:TDialogResultEvent read FOnDialogResult write FOnDialogResult; platform; public FCompStyle : LongInt; constructor Create(TheOwner: TComponent); override; function Execute: Boolean; virtual; property Handle: TLCLHandle read FHandle write SetHandle; property UserChoice: Integer read FUserChoice write FUserChoice; procedure Close; virtual; procedure DoShow; virtual; procedure DoCanClose(var CanClose: Boolean); virtual; procedure DoClose; virtual; function HandleAllocated: Boolean; property Width: Integer read GetWidth write SetWidth; property Height: Integer read GetHeight write SetHeight; published property OnClose: TNotifyEvent read FOnClose write FOnClose; property OnCanClose: TCloseQueryEvent read FOnCanClose write FOnCanClose; property OnShow: TNotifyEvent read FOnShow write FOnShow; property HelpContext: THelpContext read FHelpContext write FHelpContext default 0; property Title: TTranslateString read FTitle write FTitle stored IsTitleStored nodefault; end; { TFileDialog } TFileDialog = class(TCommonDialog) private FInternalFilterIndex: Integer; FDefaultExt: string; FFileName : string; FFiles: TStrings; FFilter: string; FFilterIndex: Integer; FHistoryList: TStrings; FInitialDir: string; FOnHelpClicked: TNotifyEvent; FOnTypeChange: TNotifyEvent; procedure SetDefaultExt(const AValue: string); procedure SetFilterIndex(const AValue: Integer); protected class procedure WSRegisterClass; override; function GetFilterIndex: Integer; virtual; procedure SetFileName(const Value: string); virtual; procedure SetFilter(const Value: string); virtual; procedure SetHistoryList(const AValue: TStrings); virtual; public constructor Create(TheOwner: TComponent); override; destructor Destroy; override; procedure DoCanClose(var CanClose: Boolean); override; procedure DoTypeChange; virtual; property Files: TStrings read FFiles; property HistoryList: TStrings read FHistoryList write SetHistoryList; procedure IntfFileTypeChanged(NewFilterIndex: Integer); class function FindMaskInFilter(aFilter, aMask: string): Integer; class function ExtractAllFilterMasks(aFilter: string; SkipAllFilesMask: Boolean = true): string; published property Title; property DefaultExt: string read FDefaultExt write SetDefaultExt; property FileName: string read FFileName write SetFileName; property Filter: string read FFilter write SetFilter; property FilterIndex: Integer read GetFilterIndex write SetFilterIndex default 1; property InitialDir: string read FInitialDir write FInitialDir; property OnHelpClicked: TNotifyEvent read FOnHelpClicked write FOnHelpClicked; property OnTypeChange: TNotifyEvent read FOnTypeChange write FOnTypeChange; end; { TOpenDialog } TOpenOption = ( ofReadOnly, // Causes the Read Only check box to be selected initially when the dialog box is created. This flag indicates the state of the Read Only check box when the dialog box is closed. ofOverwritePrompt, // If selected file exists show a message, that file will be overwritten. ofHideReadOnly, // Hides the Read Only check box. ofNoChangeDir, // Do not change current directory. ofShowHelp, // Show a help button. ofNoValidate, // Disable file name validation using OFN_NOVALIDATE on the Windows platform. Allow file names with invalid characters. ofAllowMultiSelect, // Allow multi-selection in dialog. ofExtensionDifferent, // Option is set after the dialog is executed (so, don't set it yourself) if DefaultExt<>'' and Extension<>DefaultExt. ofPathMustExist, // Show an error message if selected path does not exist. ofFileMustExist, // Show an error message if selected file does not exist. ofCreatePrompt, // Enable a verification prompt when a file or directory needs to be created for a file dialog. ofShareAware, // Include the OFN_SHAREAWARE flag on the Windows platform. ofNoReadOnlyReturn, // Do not return file names that are read-only. ofNoTestFileCreate, // Include the OFN_NOTESTFILECREATE flag on the Windows platform. ofNoNetworkButton, // Disable and hide the Network button on the Windows platform. ofNoLongNames, // Disable long file names on the Windows platform. Used in classic-style dialogs to force use of file names using the 8.3 format. ofOldStyleDialog, // Prevents use of the OFN_EXPLORER and dependent flags in dialogs on the Windows platform. ofNoDereferenceLinks, // Do not resolve links while dialog is shown (only on Windows, see OFN_NODEREFERENCELINKS). ofNoResolveLinks, // Do not resolve links after Execute. ofEnableIncludeNotify, // Not used in the current LCL version. ofEnableSizing, // Dialog can be resized, e.g. via the mouse. ofDontAddToRecent, // Do not add the path to the history list. ofForceShowHidden, // Show hidden files. ofViewDetail, // Details are OS and interface dependent. ofAutoPreview // OS and interface dependent. ); TOpenOptions = set of TOpenOption; // WS specific options that cannot be (more or less) mapped to the standard TOpenOptions // Currently just Windows Vista+ (IFileDialog) options TOpenOptionEx = ( ofHidePinnedPlaces, // Windows Vista+: Hide items shown by default in the view's navigation pane. ofForcePreviewPaneOn, // Windows Vista+: Indicate to the Open dialog box that the preview pane should always be displayed. ofStrictFileTypes, // Windows Vista+: In the Save dialog, only allow the user to choose a file that has one of the file name extensions specified through Filter property. ofPickFolders, // Windows Vista+: Turns the dialog into a TSelectDirectoryDialog. ofOkButtonNeedsInteraction, // Windows Vista+: The OK button will be disabled until the user navigates the view or edits the filename (if applicable). ofForceFileSystem, // Windows Vista+: Ensures that returned items are file system items. ofAllNonStorageItems, // Windows Vista+: Enables the user to choose any item in the Shell namespace, not just those with SFGAO_STREAM or SFAGO_FILESYSTEM attributes. Flag cannot be combined with ofForceFileSystem. ofUseXPStyleAsFallBack // Windows Vista+: Use XP-style dialog if creating Vista-style dialog fails (e.g. when running under Windows Recovery). // Intentionally not supported: ofDefaultNoMiniMode, ofHideMruPlaces: these values are not supported as of Windows 7. ); TOpenOptionsEx = set of TOpenOptionEx; //Old Delpi OpenOptionEx, mapped to ofHidePinnedPlaces const ofExNoPlacesBar = ofHidePinnedPlaces; const DefaultOpenDialogOptions = [ofEnableSizing, ofViewDetail]; type TOpenDialog = class(TFileDialog) private FOnFolderChange: TNotifyEvent; FOnSelectionChange: TNotifyEvent; FOptions: TOpenOptions; FOptionsEx: TOpenOptionsEx; FLastSelectionChangeFilename: string; protected class procedure WSRegisterClass; override; procedure ResolveLinks; virtual; function CheckFile(var AFilename: string): Boolean; virtual; function CheckFileMustExist(const AFileName: string): Boolean; virtual; function CheckAllFiles: Boolean; virtual; function DoExecute: Boolean; override; function DefaultTitle: string; override; public constructor Create(TheOwner: TComponent); override; procedure DoCanClose(var CanClose: Boolean); override; procedure DoFolderChange; virtual; procedure DoSelectionChange; virtual; procedure IntfSetOption(const AOption: TOpenOption; const AValue: Boolean); published property Options: TOpenOptions read FOptions write FOptions default DefaultOpenDialogOptions; property OptionsEx: TOpenOptionsEx read FOptionsEx write FOptionsEx default []; property OnFolderChange: TNotifyEvent read FOnFolderChange write FOnFolderChange; property OnSelectionChange: TNotifyEvent read FOnSelectionChange write FOnSelectionChange; end; { TSaveDialog } TSaveDialog = class(TOpenDialog) protected class procedure WSRegisterClass; override; function DefaultTitle: string; override; public constructor Create(AOwner: TComponent); override; end; { TSelectDirectoryDialog } TSelectDirectoryDialog = class(TOpenDialog) protected class procedure WSRegisterClass; override; function CheckFileMustExist(const AFilename: string): Boolean; override; function DefaultTitle: string; override; public constructor Create(AOwner: TComponent); override; end; TColorDialogOption = ( cdFullOpen, // Causes the dialog box to display the additional controls that allow the user to create custom colors. cdPreventFullOpen, // Disables the Define Custom Color button. cdShowHelp, // Causes the dialog box to display the Help button. cdSolidColor, // Causes the dialog box to display only solid colors in the set of basic colors. cdAnyColor, // Causes the dialog box to display all available colors in the set of basic colors. cdShowAlphaChannel, // Shows the AlphaChannel control (GTK2, Qt, Qt5, Qt6, Cocoa). cdNoButtons, // Removes the buttons from the dialog (Qt, Qt5, Qt6). cdDontUseNativeDialog, // Use Qt dialog, not the dialog of the OS (Qt, Qt5, Qt6). cdNoEyeDropperButton // Hide the Eye Dropper button (Qt6.6+). ); TColorDialogOptions = set of TColorDialogOption; const DefaultColorDialogOptions = [cdFullOpen, cdShowAlphaChannel]; //for backwards compatibility, probably not Delphi compatible { TColorDialog } type TColorDialog = class(TCommonDialog) private FAlphaChannel: Byte; FColor: TColor; FCustomColors: TStrings; FOptions: TColorDialogOptions; procedure SetCustomColors(const AValue: TStrings); procedure AddDefaultColor(const s: AnsiString); protected class procedure WSRegisterClass; override; function DefaultTitle: string; override; public constructor Create(TheOwner: TComponent); override; destructor Destroy; override; published property Title; property AlphaChannel: Byte read FAlphaChannel write FAlphaChannel default 255; property Color: TColor read FColor write FColor; // entry looks like ColorA = FFFF00 ... ColorX = C0C0C0 property CustomColors: TStrings read FCustomColors write SetCustomColors; property Options: TColorDialogOptions read FOptions write FOptions default DefaultColorDialogOptions; end; { TColorButton } TColorButton = class(TCustomSpeedButton) private FBorderWidth: Integer; FButtonColorAutoSize: Boolean; FButtonColorSize: Integer; FButtonColor: TColor; FColorDialog: TColorDialog; FOnColorChanged: TNotifyEvent; FDisabledPattern: TBitmap; function IsButtonColorAutoSizeStored: Boolean; procedure SetBorderWidth(const AValue: Integer); procedure SetButtonColor(const AValue: TColor); procedure SetButtonColorAutoSize(const AValue: Boolean); procedure SetButtonColorSize(const AValue: Integer); protected class procedure WSRegisterClass; override; procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); override; function DrawGlyph(ACanvas: TCanvas; const AClient: TRect; const AOffset: TPoint; AState: TButtonState; ATransparent: Boolean; BiDiFlags: Longint): TRect; override; function GetDisabledPattern: TBitmap; virtual; function GetGlyphSize(Drawing: Boolean; PaintRect: TRect): TSize; override; class function GetControlClassDefaultSize: TSize; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure ShowColorDialog; virtual; public constructor Create(AnOwner: TComponent); override; destructor Destroy; Override; procedure Click; override; published property Action; property Align; property Anchors; property AllowAllUp; property BorderSpacing; property BorderWidth: Integer read FBorderWidth write SetBorderWidth; property ButtonColorAutoSize: Boolean read FButtonColorAutoSize write SetButtonColorAutoSize stored IsButtonColorAutoSizeStored; property ButtonColorSize: Integer read FButtonColorSize write SetButtonColorSize; property ButtonColor: TColor read FButtonColor write SetButtonColor; property ColorDialog: TColorDialog read FColorDialog write FColorDialog; property Constraints; property Caption; property Color; property Down; property Enabled; property Flat; property Font; property GroupIndex; property Hint; property Layout; property Margin; property Spacing; property Transparent; property Visible; property OnClick; property OnColorChanged: TNotifyEvent read FOnColorChanged write FOnColorChanged; property OnDblClick; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnMouseWheel; property OnMouseWheelDown; property OnMouseWheelUp; property OnPaint; property OnResize; property OnChangeBounds; property ShowHint; property ParentFont; property ParentShowHint; property PopupMenu; end; { TFontDialog } TFontDialogOption = (fdAnsiOnly, fdTrueTypeOnly, fdEffects, fdFixedPitchOnly, fdForceFontExist, fdNoFaceSel, fdNoOEMFonts, fdNoSimulations, fdNoSizeSel, fdNoStyleSel, fdNoVectorFonts, fdShowHelp, fdWysiwyg, fdLimitSize, fdScalableOnly, fdApplyButton); TFontDialogOptions = set of TFontDialogOption; TFontDialog = class(TCommonDialog) private FFont: TFont; FMaxFontSize: Integer; FMinFontSize: Integer; FOnApplyClicked: TNotifyEvent; FOptions: TFontDialogOptions; FPreviewText: string; procedure SetFont(const AValue: TFont); protected class procedure WSRegisterClass; override; function DefaultTitle: string; override; public procedure ApplyClicked; virtual; constructor Create (AOwner : TComponent); override; destructor Destroy; override; published property Title; property Font: TFont read FFont write SetFont; property MinFontSize: Integer read FMinFontSize write FMinFontSize; property MaxFontSize: Integer read FMaxFontSize write FMaxFontSize; property Options: TFontDialogOptions read FOptions write FOptions default [fdEffects]; property OnApplyClicked: TNotifyEvent read FOnApplyClicked write FOnApplyClicked; property PreviewText: string read FPreviewText write FPreviewText; end; { TFindDialog } TFindOption = (frDown, frFindNext, frHideMatchCase, frHideWholeWord, frHideUpDown, frMatchCase, frDisableMatchCase, frDisableUpDown, frDisableWholeWord, frReplace, frReplaceAll, frWholeWord, frShowHelp, frEntireScope, frHideEntireScope, frPromptOnReplace, frHidePromptOnReplace, frButtonsAtBottom); TFindOptions = set of TFindOption; TFindDialog = class(TCommonDialog) private FFormLeft: Integer; FFormTop: Integer; function GetReplaceText: string; function GetFindText: string; function GetLeft: Integer; function GetPosition: TPoint; function GetTop: Integer; procedure SetFindText(const AValue: string); procedure SetLeft(const AValue: Integer); procedure SetOptions(AValue: TFindOptions); procedure SetPosition(const AValue: TPoint); procedure SetTop(const AValue: Integer); procedure SetReplaceText(const AValue: string); protected FFindForm: TForm; FOnReplace: TNotifyEvent; FOnFind: TNotifyEvent; FOptions: TFindOptions; FOnHelpClicked: TNotifyEvent; FReplaceText: string; FFindText: string; function DefaultTitle: string; override; procedure FindClick(Sender: TObject); procedure HelpClick(Sender: TObject); procedure CancelClick(Sender: TObject); function GetHeight: Integer; override; function GetWidth: Integer; override; procedure DoCloseForm(Sender: TObject; var CloseAction: TCloseAction); virtual; procedure DoShowForm(Sender: TObject); virtual; procedure Find; virtual; procedure Help; virtual; procedure Replace; virtual; function CreateForm:TForm; virtual; procedure SetFormValues; virtual; procedure GetFormValues; virtual; Procedure CalcPosition(aForm:Tform); property ReplaceText: string read GetReplaceText write SetReplaceText; property OnReplace: TNotifyEvent read FOnReplace write FOnReplace; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure CloseDialog; function Execute: Boolean; override; property Left: Integer read GetLeft write SetLeft; property Position: TPoint read GetPosition write SetPosition; property Top: Integer read GetTop write SetTop; published property FindText: string read GetFindText write SetFindText; property Options: TFindOptions read FOptions write SetOptions default [frDown]; property OnFind: TNotifyEvent read FOnFind write FOnFind; property OnHelpClicked: TNotifyEvent read FOnHelpClicked write FOnHelpClicked; end; { TReplaceDialog } TReplaceDialog = class(TFindDialog) protected function DefaultTitle: string; override; procedure ReplaceClick(Sender: TObject); procedure ReplaceAllClick(Sender: TObject); function CreateForm: TForm; override; procedure SetFormValues; override; procedure GetFormValues; override; public constructor Create(AOwner: TComponent); override; published property ReplaceText; property OnReplace; end; { TPrinterSetupDialog } TCustomPrinterSetupDialog = class(TCommonDialog) end; { TPrintDialog } TPrintRange = (prAllPages, prSelection, prPageNums, prCurrentPage); TPrintDialogOption = (poPrintToFile, poPageNums, poSelection, poWarning, poHelp, poDisablePrintToFile, poBeforeBeginDoc); TPrintDialogOptions = set of TPrintDialogOption; TCustomPrintDialog = class(TCommonDialog) private FFromPage: Integer; FToPage: Integer; FCollate: Boolean; FOptions: TPrintDialogOptions; FPrintToFile: Boolean; FPrintRange: TPrintRange; FMinPage: Integer; FMaxPage: Integer; FCopies: Integer; public constructor Create(TheOwner: TComponent); override; public property Collate: Boolean read FCollate write FCollate default False; property Copies: Integer read FCopies write FCopies default 1; property FromPage: Integer read FFromPage write FFromPage default 0; property MinPage: Integer read FMinPage write FMinPage default 0; property MaxPage: Integer read FMaxPage write FMaxPage default 0; property Options: TPrintDialogOptions read FOptions write FOptions default []; property PrintToFile: Boolean read FPrintToFile write FPrintToFile default False; property PrintRange: TPrintRange read FPrintRange write FPrintRange default prAllPages; property ToPage: Integer read FToPage write FToPage default 0; end; { TTaskDialog } type TCustomTaskDialog = class; TTaskDialogFlag = ( tfEnableHyperlinks, //Native Vista+ only tfUseHiconMain, tfUseHiconFooter, tfAllowDialogCancellation, tfUseCommandLinks, tfUseCommandLinksNoIcon, tfExpandFooterArea, tfExpandedByDefault, tfVerificationFlagChecked, tfShowProgressBar, //Native Vista+ only, not fully functional tfShowMarqueeProgressBar, //Native Vista+ only, not fully functional tfCallbackTimer, tfPositionRelativeToWindow, tfRtlLayout, //Native Vista+ only tfNoDefaultRadioButton, tfCanBeMinimized, tfNoSetForeGround, //Native Vista+ only tfSizeToContent, //Native Vista+ only tfForceNonNative, tfEmulateClassicStyle, //this and following flags: Emulated dialog only tfQuery, tfSimpleQuery, tfQueryFixedChoices, tfQueryFocused); TTaskDialogFlags = set of TTaskDialogFlag; TTaskDialogCommonButton = (tcbOk, tcbYes, tcbNo, tcbCancel, tcbRetry, tcbClose); TTaskDialogCommonButtons = set of TTaskDialogCommonButton; TTaskDlgClickEvent = procedure(Sender: TObject; AModalResult: TModalResult; var ACanClose: Boolean) of object; TTaskDlgTimerEvent = procedure(Sender: TObject; TickCount: Cardinal; var Reset: Boolean) of object; TTaskDialogIcon = (tdiNone, tdiWarning, tdiError, tdiInformation, tdiShield, tdiQuestion); TTaskDialogButtons = class; { TTaskDialogBaseButtonItem } TTaskDialogBaseButtonItem = class(TCollectionItem) private FCaption: TTranslateString; FClient: TCustomTaskDialog; FCommandLinkHint: TTranslateString; FModalResult: TModalResult; function GetDefault: Boolean; procedure SetCaption(const ACaption: TTranslateString); procedure SetDefault(const Value: Boolean); protected property Client: TCustomTaskDialog read FClient; function GetDisplayName: TTranslateString; override; function TaskButtonCollection: TTaskDialogButtons; public constructor Create(ACollection: TCollection); override; property ModalResult: TModalResult read FModalResult write FModalResult; property CommandLinkHint: TTranslateString read FCommandLinkHint write FCommandLinkHint; published property Caption: TTranslateString read FCaption write SetCaption; property Default: Boolean read GetDefault write SetDefault default False; end; TTaskDialogButtonItem = class(TTaskDialogBaseButtonItem) public constructor Create(ACollection: TCollection); override; published property CommandLinkHint; property ModalResult; end; TTaskDialogRadioButtonItem = class(TTaskDialogBaseButtonItem) public constructor Create(ACollection: TCollection); override; end; TTaskDialogButtonsEnumerator = class private FIndex: Integer; FCollection: TTaskDialogButtons; public constructor Create(ACollection: TTaskDialogButtons); function GetCurrent: TTaskDialogBaseButtonItem; function MoveNext: Boolean; property Current: TTaskDialogBaseButtonItem read GetCurrent; end; TTaskDialogButtons = class(TOwnedCollection) private FDefaultButton: TTaskDialogBaseButtonItem; function GetItem(Index: Integer): TTaskDialogBaseButtonItem; procedure SetDefaultButton(const Value: TTaskDialogBaseButtonItem); procedure SetItem(Index: Integer; const Value: TTaskDialogBaseButtonItem); public function Add: TTaskDialogBaseButtonItem; function FindButton(AModalResult: TModalResult): TTaskDialogBaseButtonItem; function GetEnumerator: TTaskDialogButtonsEnumerator; property DefaultButton: TTaskDialogBaseButtonItem read FDefaultButton write SetDefaultButton; property Items[Index: Integer]: TTaskDialogBaseButtonItem read GetItem write SetItem; default; end; TProgressBarState = ComCtrls.TProgressBarState; //it's where Delphi defines this type, so we need to follow { TTaskDialogProgressBar } const PBST_NORMAL = $0001; PBST_ERROR = $0002; PBST_PAUSED = $0003; PB_DEFMIN = 0; //needed in TLCTaskDialog as well PB_DEFMAX = 100; TDE_CONTENT = 0; //TTaskDialog.Text TDE_EXPANDED_INFORMATION = 1; //TTaskDialog.ExpandedText TDE_FOOTER = 2; //TTaskDialog.FooterText TDE_MAIN_INSTRUCTION = 3; //TTaskDialog.Title Type TTaskDialogProgressBar = class(TPersistent) private const ProgressBarStateValues: array[TProgressBarState] of Integer = (PBST_NORMAL,PBST_ERROR,PBST_PAUSED); private Dlg: TCustomTaskDialog; FMarqueeSpeed: Cardinal; FMax: Integer; FMin: Integer; FPosition: Integer; FState: TProgressBarState; procedure SetMarqueeSpeed(AValue: Cardinal); procedure SetMax(AValue: Integer); procedure SetMin(AValue: Integer); procedure SetPosition(AValue: Integer); procedure SetState(AValue: TProgressBarState); public constructor Create(ADialog: TCustomTaskDialog); procedure Initialize; //call after dialog has been instatiated to send message to the dialog window procedure SetRange(AMin, AMax: Integer); published property MarqueeSpeed: Cardinal read FMarqueeSpeed write SetMarqueeSpeed default 0; //Vista+ native dialog only property Max: Integer read FMax write SetMax default 100; property Min: Integer read FMin write SetMin default 0; property Position: Integer read FPosition write SetPosition default 0; property State: TProgressBarState read FState write SetState default pbsNormal; //Vista+ native dialog only end; { TCustomTaskDialog } TCustomTaskDialog = class(TLCLComponent) private FButton: TTaskDialogButtonItem; FButtons: TTaskDialogButtons; FCaption: TTranslateString; FCollapseButtonCaption: TTranslateString; FCommonButtons: TTaskDialogCommonButtons; FCustomFooterIcon: TIcon; FCustomMainIcon: TIcon; FDefaultButton: TTaskDialogCommonButton; FExpandButtonCaption: TTranslateString; FExpanded: Boolean; FExpandedText: TTranslateString; FFlags: TTaskDialogFlags; FFooterIcon: TTaskDialogIcon; FFooterText: TTranslateString; FHandle: THandle; FMainIcon: TTaskDialogIcon; FModalResult: TModalResult; FOnDialogConstructed: TNotifyEvent; FOnDialogCreated: TNotifyEvent; FOnDialogDestroyed: TNotifyEvent; FOnExpanded: TNotifyEvent; FOnHelp: TNotifyEvent; FOnHyperlinkClicked: TNotifyEvent; FOnNavigated: TNotifyEvent; FOnRadioButtonClicked: TNotifyEvent; FOnTimer: TTaskDlgTimerEvent; FOnVerificationClicked: TNotifyEvent; FProgressBar: TTaskDialogProgressBar; FQueryChoices: TStrings; FQueryResult: String; FQueryItemIndex: Integer; FRadioButton: TTaskDialogRadioButtonItem; FRadioButtons: TTaskDialogButtons; FSimpleQuery: String; FSimpleQueryPasswordChar: Char; FText: TTranslateString; FTitle: TTranslateString; FURL: String; FVerificationText: TTranslateString; FWidth: Integer; FOnButtonClicked: TTaskDlgClickEvent; function IsCustomFooterIconStored: Boolean; function IsCustomMainIconStored: Boolean; procedure SetButtons(const Value: TTaskDialogButtons); procedure SetCustomFooterIcon(AValue: TIcon); procedure SetCustomMainIcon(AValue: TIcon); procedure SetFlags(AValue: TTaskDialogFlags); procedure SetQueryChoices(AValue: TStrings); procedure SetRadioButtons(const Value: TTaskDialogButtons); protected class procedure WSRegisterClass; override; function DoExecute(ParentWnd: HWND): Boolean; dynamic; procedure DoOnButtonClicked(AModalResult: Integer; var ACanClose: Boolean); dynamic; procedure DoOnRadioButtonClicked(ButtonID: Integer); dynamic; procedure DoOnDialogConstructed; dynamic; procedure DoOnDialogCreated; dynamic; procedure DoOnDialogDestroyed; dynamic; procedure DoOnExpandButtonClicked(Expanded: Boolean); dynamic; procedure DoOnTimer(TickCount: Cardinal; var Reset: Boolean); dynamic; procedure DoOnVerificationClicked(Checked: Boolean); dynamic; procedure DoOnHelp; dynamic; procedure DoOnHyperlinkClicked(const AURL: string); dynamic; //requires that a TaskDialog has pages, (see: https://learn.microsoft.com/en-us/dotnet/api/system.windows.forms.taskdialogpage.navigate?view=windowsdesktop-7.0) //which might be implemented in a derived class, but the event handler must be in base class for Delphi compatibility. procedure DoOnNavigated; dynamic; procedure InternalSetDialogHandle(AHandle: THandle); //only to be called from the dialog window procedure SetRadioButtonFromRadioIndex(AIndex: Integer); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function ButtonIDToModalResult(const AButtonID: Integer): TModalResult; function Execute: Boolean; overload; dynamic; function Execute(ParentWnd: HWND): Boolean; overload; dynamic; property Button: TTaskDialogButtonItem read FButton write FButton; property Buttons: TTaskDialogButtons read FButtons write SetButtons; property Caption: TTranslateString read FCaption write FCaption; property CustomFooterIcon: TIcon read FCustomFooterIcon write SetCustomFooterIcon stored IsCustomFooterIconStored; property CustomMainIcon: TIcon read FCustomMainIcon write SetCustomMainIcon stored IsCustomMainIconStored; property CommonButtons: TTaskDialogCommonButtons read FCommonButtons write FCommonButtons default [tcbOk, tcbCancel]; property CollapseButtonCaption: TTranslateString read FCollapseButtonCaption write FCollapseButtonCaption; property DefaultButton: TTaskDialogCommonButton read FDefaultButton write FDefaultButton default tcbOk; property ExpandButtonCaption: TTranslateString read FExpandButtonCaption write FExpandButtonCaption; property ExpandedText: TTranslateString read FExpandedText write FExpandedText; property Flags: TTaskDialogFlags read FFlags write SetFlags default [tfAllowDialogCancellation]; property FooterIcon: TTaskDialogIcon read FFooterIcon write FFooterIcon default tdiNone; property FooterText: TTranslateString read FFooterText write FFooterText; property MainIcon: TTaskDialogIcon read FMainIcon write FMainIcon default tdiInformation; property Handle: THandle read FHandle; //Handle to the dialog window property ModalResult: TModalResult read FModalResult write FModalResult; property ProgressBar: TTaskDialogProgressBar read FProgressBar write FProgressBar; property QueryChoices: TStrings read FQueryChoices write SetQueryChoices; property QueryItemIndex: Integer read FQueryItemIndex write FQueryItemIndex; property QueryResult: String read FQueryResult write FQueryResult; property RadioButton: TTaskDialogRadioButtonItem read FRadioButton; property RadioButtons: TTaskDialogButtons read FRadioButtons write SetRadioButtons; property SimpleQuery: String read FSimpleQuery write FSimpleQuery; property SimpleQueryPasswordChar: Char read FSimpleQueryPasswordChar write FSimpleQueryPasswordChar default #0; property Text: TTranslateString read FText write FText; property Title: TTranslateString read FTitle write FTitle; property VerificationText: TTranslateString read FVerificationText write FVerificationText; property Width: Integer read FWidth write FWidth default 0; property URL: String read FURL; property Expanded: Boolean read FExpanded; property OnButtonClicked: TTaskDlgClickEvent read FOnButtonClicked write FOnButtonClicked; property OnDialogConstructed: TNotifyEvent read FOnDialogConstructed write FOnDialogConstructed; property OnDialogCreated: TNotifyEvent read FOnDialogCreated write FOnDialogCreated; property OnDialogDestroyed: TNotifyEvent read FOnDialogDestroyed write FOnDialogDestroyed; property OnVerificationClicked: TNotifyEvent read FOnVerificationClicked write FOnVerificationClicked; property OnExpanded: TNotifyEvent read FOnExpanded write FOnExpanded; property OnTimer: TTaskDlgTimerEvent read FOnTimer write FOnTimer; property OnRadioButtonClicked: TNotifyEvent read FOnRadioButtonClicked write FOnRadioButtonClicked; property OnHyperlinkClicked: TNotifyEvent read FOnHyperlinkClicked write FOnHyperlinkClicked; property OnNavigated: TNotifyEvent read FOnNavigated write FOnNavigated; property OnHelp: TNotifyEvent read FOnHelp write FOnHelp; end; TTaskDialog = class(TCustomTaskDialog) published property Buttons; property Caption; property CommonButtons; property CollapseButtonCaption; property CustomFooterIcon; property CustomMainIcon; property DefaultButton; property ExpandButtonCaption; property ExpandedText; property Flags; property FooterIcon; property FooterText; property MainIcon; property ProgressBar; property RadioButtons; property QueryChoices; property QueryItemIndex; property SimpleQuery; property SimpleQueryPasswordChar; property Text; property Title; property VerificationText; property Width; property OnButtonClicked; property OnDialogConstructed; property OnDialogCreated; property OnDialogDestroyed; property OnVerificationClicked; property OnExpanded; property OnTimer; property OnRadioButtonClicked; property OnHyperlinkClicked; end; const TaskDialogFirstButtonIndex = 100; TaskDialogFirstRadioButtonIndex = 200; var MinimumDialogButtonWidth: Integer = 75; MinimumDialogButtonHeight: Integer = 25; { MessageDlg } function MessageDlg(const aMsg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint): TModalResult; overload; function MessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint): TModalResult; overload; function MessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): TModalResult; overload; function MessageDlg(const aMsg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): TModalResult; overload; function MessageDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; const HelpKeyword: string): TModalResult; overload; function MessageDlgPos(const aMsg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): TModalResult; overload; function MessageDlgPosHelp(const aMsg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer; const HelpFileName: string): TModalResult; overload; function CreateMessageDialog(const aMsg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): TForm; overload; function CreateMessageDialog(const aCaption, aMsg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): TForm; overload; function DefaultPromptDialog(const DialogCaption, DialogMessage: string; DialogType: longint; Buttons: PLongint; ButtonCount, DefaultIndex, EscapeResult: Longint; UseDefaultPos: Boolean; X, Y: Longint): Longint;// widgetset independent implementation, see PromptDialogFunction function QuestionDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType; Buttons: array of const; HelpCtx: Longint): TModalResult; overload; function QuestionDlg(const aCaption, aMsg: string; DlgType: TMsgDlgType; Buttons: array of const; const HelpKeyword: string): TModalResult; overload; function DefaultQuestionDialog(const aCaption, aMsg: string; DlgType: LongInt; Buttons: TDialogButtons; HelpCtx: Longint): LongInt;// widgetset independent implementation, see QuestionDialogFunction procedure ShowMessage(const aMsg: string); procedure ShowMessageFmt(const aMsg: string; Params: array of const); procedure ShowMessagePos(const aMsg: string; X, Y: Integer); function DefaultMessageBox(Text, Caption: PChar; Flags: Longint) : Integer;// widgetset independent implementation, see MessageBoxFunction function InputBox(const ACaption, APrompt, ADefault : string) : string; function PasswordBox(const ACaption, APrompt : string) : string; function PromptForFileName(var AFileName: string; const AFilter: string = ''; const ADefaultExt: string = ''; const ATitle: string = ''; const AInitialDir: string = ''; AIsSaveDialog: Boolean = False): Boolean; function TaskDlg(const aCaption, aMsg, aInfo: string; DlgIcon: TTaskDialogIcon; AButtons: TMsgDlgButtons; const aFooter: string = ''; const aDetails: string = ''; AFlags: TTaskDialogFlags = [tfAllowDialogCancellation] ): TModalResult; overload; function TaskDlg(const aCaption, aMsg, aInfo: string; DlgIcon: TTaskDialogIcon; AButtons: TMsgDlgButtons; ADefaultButton: TMsgDlgBtn; const aFooter: string = ''; const aDetails: string = ''; AFlags: TTaskDialogFlags = [tfAllowDialogCancellation] ): TModalResult; overload; // RadioButtons function TaskDlg(const aCaption, aMsg, aInfo: string; DlgIcon: TTaskDialogIcon; AButtons: TMsgDlgButtons; const ARadioButtons: array of string; out RadioIndex: integer; ADefaultRadio: Integer = -1; const aFooter: string = ''; const aDetails: string = ''; AFlags: TTaskDialogFlags = [tfAllowDialogCancellation] ): TModalResult; overload; function TaskDlg(const aCaption, aMsg, aInfo: string; DlgIcon: TTaskDialogIcon; AButtons: TMsgDlgButtons; ADefaultButton: TMsgDlgBtn; const ARadioButtons: array of string; out RadioIndex: integer; ADefaultRadio: Integer = -1; const aFooter: string = ''; const aDetails: string = ''; AFlags: TTaskDialogFlags = [tfAllowDialogCancellation] ): TModalResult; overload; // CheckBox function TaskDlg(const aCaption, aMsg, aInfo: string; DlgIcon: TTaskDialogIcon; AButtons: TMsgDlgButtons; const ACheckBoxText: string; out Checked: boolean; const aFooter: string = ''; const aDetails: string = ''; AFlags: TTaskDialogFlags = [tfAllowDialogCancellation] ): TModalResult; overload; function TaskDlg(const aCaption, aMsg, aInfo: string; DlgIcon: TTaskDialogIcon; AButtons: TMsgDlgButtons; ADefaultButton: TMsgDlgBtn; const ACheckBoxText: string; out Checked: boolean; const aFooter: string = ''; const aDetails: string = ''; AFlags: TTaskDialogFlags = [tfAllowDialogCancellation] ): TModalResult; overload; // CheckBox + RadioButtons function TaskDlg(const aCaption, aMsg, aInfo: string; DlgIcon: TTaskDialogIcon; AButtons: TMsgDlgButtons; const ACheckBoxText: string; out Checked: boolean; const ARadioButtons: array of string; out RadioIndex: integer; ADefaultRadio: Integer = -1; const aFooter: string = ''; const aDetails: string = ''; AFlags: TTaskDialogFlags = [tfAllowDialogCancellation] ): TModalResult; overload; function TaskDlg(const aCaption, aMsg, aInfo: string; DlgIcon: TTaskDialogIcon; AButtons: TMsgDlgButtons; ADefaultButton: TMsgDlgBtn; const ACheckBoxText: string; out Checked: boolean; const ARadioButtons: array of string; out RadioIndex: integer; ADefaultRadio: Integer = -1; const aFooter: string = ''; const aDetails: string = ''; AFlags: TTaskDialogFlags = [tfAllowDialogCancellation] ): TModalResult; overload; // All Options function TaskDlg(const aCaption, aMsg, aInfo: string; DlgIcon: TTaskDialogIcon; AButtons: TMsgDlgButtons; const ACustomButtons: array of string; ADefaultButton: Integer; const ACheckBoxText: string; out Checked: boolean; const ARadioButtons: array of string; out RadioIndex: integer; ADefaultRadio: Integer = -1; const aFooter: string = ''; const aDetails: string = ''; const aShowDetails: string = ''; const aHideDetails: string = ''; AFlags: TTaskDialogFlags = [tfAllowDialogCancellation] ): TModalResult; overload; type TCustomCopyToClipboardDialog = class(TForm) protected procedure DoCreate; override; public function GetMessageText: string; virtual; abstract; end; procedure RegisterDialogForCopyToClipboard(const ADlg: TCustomForm); procedure DialogCopyToClipboard(Self, Sender: TObject; var Key: Word; Shift: TShiftState); const cInputQueryEditSizePixels: Integer = 260; // Edit size in pixels cInputQueryEditSizePercents: Integer = 25; // Edit size in % of monitor width cInputQuerySpacingSize: Integer = 6; type TSelectDirOpt = (sdAllowCreate, sdPerformCreate, sdPrompt); TSelectDirOpts = set of TSelectDirOpt; TInputCloseQueryEvent = procedure(Sender: TObject; const AValues: array of string; var ACanClose: Boolean) of object; function SelectDirectory(const Caption, InitialDirectory: string; out Directory: string): Boolean; function SelectDirectory(const Caption, InitialDirectory: string; out Directory: string; ShowHidden: Boolean; HelpCtx: Longint = 0): Boolean; function SelectDirectory(out Directory: string; Options: TSelectDirOpts; HelpCtx: Longint): Boolean; function InputQuery(const ACaption, APrompt : string; MaskInput : Boolean; var Value : string) : Boolean; function InputQuery(const ACaption, APrompt : string; var Value : string) : Boolean; function InputQuery(const ACaption: string; const APrompts: array of string; var AValues: array of string; ACloseEvent: TInputCloseQueryEvent = nil): Boolean; function DefaultInputDialog(const InputCaption, InputPrompt : string; MaskInput : Boolean; var Value : string) : Boolean;// widgetset independent implementation, see InputDialogFunction function InputCombo(const ACaption, APrompt: string; const AList: TStrings): Integer; function InputCombo(const ACaption, APrompt: string; const AList : Array of string): Integer; function InputComboEx(const ACaption, APrompt: string; const AList: TStrings; AllowCustomText: Boolean = False): string; function InputComboEx(const ACaption, APrompt: string; const AList : Array of string; AllowCustomText: Boolean = False): string; function ExtractColorIndexAndColor(const AColorList: TStrings; const AIndex: Integer; out ColorIndex: Integer; out ColorValue: TColor): Boolean; // helper functions (search LCLType for idDiag) function GetDialogCaption(idDiag: Integer): string; function GetDialogIcon(idDiag: Integer): TCustomBitmap; deprecated 'Use DialogRes.DialogGlyphs'; function dbgs(Option: TOpenOption): string; overload; function dbgs(Options: TOpenOptions): string; overload; function DbgS(aFlag: TTaskDialogFlag): String; overload; function DbgS(Flags: Dialogs.TTaskDialogFlags): String; overload; procedure Register; implementation uses Math, WSDialogs; const // //TODO: all the constants below should be replaced in the future // their only purpose is to overcome some current design flaws & // missing features in the GTK libraries // cBitmapX = 10; // x-position for bitmap in messagedialog cBitmapY = 10; // y-position for bitmap in messagedialog cLabelSpacing = 10; // distance between icon & label DialogResult : Array[mrNone..mrLast] of Longint = ( -1, // mrNone idButtonOK, idButtonCancel, idButtonAbort, idButtonRetry, idButtonIgnore, idButtonYes, idButtonNo, idButtonAll, idButtonNoToAll, idButtonYesToAll, {$IF FPC_FULLVERSION>=30203} idButtonContinue, idButtonTryAgain, {$ENDIF} idButtonClose); DialogButtonKind : Array[idButtonOK..idButtonNoToAll] of TBitBtnKind = ( bkOk, bkCancel, bkHelp, bkYes, bkNo, bkClose, bkAbort, bkRetry, bkIgnore, bkAll, bkYesToAll, bkNoToAll); DialogResName: array[idDialogWarning..idDialogShield] of string = ( {idDialogWarning} 'dialog_warning', {idDialogError } 'dialog_error', {idDialogInfo } 'dialog_information', {idDialogConfirm} 'dialog_confirmation', {idDialogShield } 'dialog_shield' ); type TBitBtnAccess = class(TBitBtn); function dbgs(Option: TOpenOption): string; begin Result:=GetEnumName(typeinfo(TOpenOption),ord(Option)); end; function dbgs(Options: TOpenOptions): string; var o: TOpenOption; begin Result:=''; for o in Options do Result:=Result+dbgs(o)+','; Result:='['+LeftStr(Result,length(Result)-1)+']'; end; procedure Register; begin RegisterComponents('Dialogs',[TOpenDialog,TSaveDialog,TSelectDirectoryDialog, TColorDialog,TFontDialog, TFindDialog,TReplaceDialog, TTaskDialog]); RegisterComponents('Misc',[TColorButton]); end; function DefaultMessageBox(Text, Caption: PChar; Flags: Longint) : Integer; var DlgType : TMsgDlgType; Buttons : TMsgDlgButtons; CurBtn, DefButton: TMsgDlgBtn; DefButtonIndex: Integer; begin //This uses TMessageBox class in MessageDialogs.inc if (Flags and MB_RETRYCANCEL) = MB_RETRYCANCEL then Buttons := [mbRetry, mbCancel] else if (Flags and MB_YESNO) = MB_YESNO then Buttons := [mbYes, mbNo] else if (Flags and MB_YESNOCANCEL) = MB_YESNOCANCEL then Buttons := [mbYes, mbNo, mbCancel] else if (Flags and MB_ABORTRETRYIGNORE) = MB_ABORTRETRYIGNORE then Buttons := [mbAbort, mbRetry, mbIgnore] else if (Flags and MB_OKCANCEL) = MB_OKCANCEL then Buttons := [mbOK,mbCancel] //else //if (Flags and MB_OK) = MB_OK then <-- MB_OK = 0, the test would always be true. // Buttons := [mbOK] else Buttons := [mbOK]; if (Flags and MB_ICONINFORMATION) = MB_ICONINFORMATION then DlgTYpe := mtInformation else if (Flags and MB_ICONWARNING) = MB_ICONWARNING then DlgTYpe := mtWarning else if (Flags and MB_ICONQUESTION) = MB_ICONQUESTION then DlgTYpe := mtConfirmation else if (Flags and MB_ICONERROR) = MB_ICONERROR then DlgTYpe := mtError else DlgTYpe := mtCustom; if (Flags and MB_DEFBUTTON2) = MB_DEFBUTTON2 then DefButtonIndex := 2 else if (Flags and MB_DEFBUTTON3) = MB_DEFBUTTON3 then DefButtonIndex := 3 else if (Flags and MB_DEFBUTTON4) = MB_DEFBUTTON4 then DefButtonIndex := 4 else DefButtonIndex := 1; DefButton := Low(TMsgDlgBtn); for CurBtn := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do begin DefButton := CurBtn; if CurBtn in Buttons then Dec(DefButtonIndex); if DefButtonIndex = 0 then break; end; Result := MessageDlg(Caption, Text, DlgType, Buttons, 0, DefButton); end; {** Return the localized or not title of dialog} function GetDialogCaption(idDiag: Integer): string; begin case idDiag of idDialogWarning : Result := rsMtWarning; idDialogError : Result := rsMtError; idDialogInfo : Result := rsMtInformation; idDialogConfirm : Result := rsMtConfirmation; idDialogShield : Result := rsMtAuthentication; else Result := '?'; end; end; function GetDialogIcon(idDiag: Integer): TCustomBitmap; var BitmapHandle, MaskHandle: HBitmap; begin if ThemeServices.GetStockImage(idDiag, BitmapHandle, MaskHandle) then begin Result := TBitmap.Create; Result.Handle := BitmapHandle; if MaskHandle <> 0 then Result.MaskHandle := MaskHandle; end else if (idDiag < Low(DialogResName)) or (idDiag > High(DialogResName)) then Result := nil else begin Result := TPortableNetworkGraphic.Create; Result.LoadFromResourceName(hInstance, DialogResName[idDiag]); end; end; {$I lclcolordialog.inc} {$I commondialog.inc} {$I filedialog.inc} {$I finddialog.inc} {$I replacedialog.inc} {$I fontdialog.inc} {$I inputdialog.inc} {$I messagedialogs.inc} {$I promptdialog.inc} {$I colorbutton.inc} {$I taskdialog.inc} { TCustomPrintDialog } constructor TCustomPrintDialog.Create(TheOwner: TComponent); begin inherited Create(TheOwner); FPrintRange:=prAllPages; FCopies:=1; end; { TCustomCopyToClipboardDialog } procedure TCustomCopyToClipboardDialog.DoCreate; begin inherited DoCreate; RegisterDialogForCopyToClipboard(Self); end; initialization Forms.MessageBoxFunction := @DefaultMessageBox; InterfaceBase.InputDialogFunction := @DefaultInputDialog; InterfaceBase.PromptDialogFunction := @DefaultPromptDialog; InterfaceBase.QuestionDialogFunction := @DefaultQuestionDialog; finalization InterfaceBase.InputDialogFunction := nil; InterfaceBase.QuestionDialogFunction := nil; end.