Archivado/Componentes.Terceros.TMSSoftware
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
78a1ac5647
Componentes.Terceros.TMSSof.../TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialog.pas

4817 lines
152 KiB
ObjectPascal
Raw Blame History

{***************************************************************************}
{ TTaskDialog component }
{ for Delphi & C++Builder }
{ }
{ written by TMS Software }
{ copyright © 2006 - 2009 }
{ Email : info@tmssoftware.com }
{ Web : http://www.tmssoftware.com }
{ }
{ The source code is given as is. The author is not responsible }
{ for any possible damage done due to the use of this code. }
{ The component can be freely used in any application. The complete }
{ source code remains property of the author and may not be distributed, }
{ published, given or sold in any form as such. No parts of the source }
{ code can be included in any other component or application without }
{ written authorization of the author. }
{***************************************************************************}
unit TaskDialog;
{$R TASKDIALOG.RES}
{$I TMSDEFS.INC}
interface
uses
Classes, Windows, Messages, Forms, Dialogs, SysUtils, StdCtrls, Graphics, Consts, Math,
ExtCtrls, Controls, ComCtrls, PictureContainer, ComObj, ShellAPI, CommCtrl, ClipBrd, ImgList;
const
{$IFNDEF DELPHI6_LVL}
sLineBreak = #13#10;
{$ENDIF}
MAJ_VER = 1; // Major version nr.
MIN_VER = 5; // Minor version nr.
REL_VER = 1; // Release nr.
BLD_VER = 6; // Build nr.
// version history
// 1.0.0.0 : First release
// 1.0.1.0 : Added support for Information icon
// : Fixed issue with radiobutton initialization
// 1.0.2.0 : Various cosmetic fixes for emulated dialog
// : Design time preview
// 1.0.3.0 : Improved wordwrapped content display
// 1.0.4.0 : Added support to display shield icon on non Vista operating systems
// 1.0.5.0 : Fixed issue with tiError icon for non Vista operating systems
// 1.0.5.1 : Fixed issue with tiBlank icon for non Vista operating systems
// 1.0.5.2 : Removed Close button from dialog caption for non Vista operating systems
// 1.0.5.3 : Fixed issue with blank FooterIcon
// : Fixed issue with content height
// 1.0.5.4 : Improved : content sizing for non Vista operating systems dialogs
// 1.0.5.5 : Fixed issue with progress bar for non Vista operating systems dialogs
// 1.0.5.6 : Fixed issue with Expanded Text size calculation for non Vista operating systems dialogs
// 1.0.5.7 : Fixed issue with default button for non Vista operating systems dialogs
// 1.0.5.8 : Fixed issue with Expanded Text size calculation for non Vista operating systems dialogs
// : Fixed issue with FooterIcon drawing
// 1.0.6.0 : New : property DialogPosition added , only applicable for non Vista OS
// : Fixed : issue with ESC key handling
// 1.1.0.0 : Improved : Reflect properties change at run time
// : Fixed issues with Footer and its FooterIcon size
// : Added ShortCut support in CommandLinks
// 1.2.0.0 : New : support added for Hyperlinks in expanded text
// : New : option to show no default radiobutton added
// : New : capability to update instruction, content, expanded text, footer while dialog is displayed
// : New : option to allow cancelling the dialog with ESC added
// : Improved : text wrapping for verify text
// : New : TAdvTaskDialogEx component created using TAdvGlowButton on non Vista emulation
// : New : property ApplicationIsParent added
// : New : support for custom icons
// 1.2.1.0 : New : support for Information & Shield footer icon
// : Improved : border drawing on Vista in XP compatibility mode
// : New : added support for \n linebreaks in Vista emulation mode
// 1.2.1.1 : Fixed : issue with DefaultRadioButton initialization
// 1.2.1.2 : Fixed : issue with \n linebreaks with doHyperlinks style
// 1.2.2.0 : Improved : keyboard handling for CommandLinks dialog on non Vista emulation
// : Improved : DefaultButton handling for CommandLinks dialog on non Vista emulation
// 1.2.2.1 : Fixed : issue with noCommandLinksIcon on non Vista emulation
// 1.2.2.2 : Fixed : hot painting issue on taskdialog button on non Vista emulation
// 1.2.3.0 : Improved : allow using \n line separators in footer text on non Vista emulation
// : Fixed : issue with doAllowDialogCancel on non Vista emulation
// : Fixed : issue with doAllowMinimize on non Vista emulation
// 1.2.4.0 : Improved : removed limitation on text length of Content, Title, ... in Vista native mode
// : Improved : handling of linefeed character on non Vista emulation
// : Improved : handling of anchors in Vista native mode
// : Improved : handling of ESC with common buttons
// 1.2.4.1 : Improved : prevent that Alt-F4 can close the dialog
// 1.2.5.0 : New : support for hotkeys on expand/contract text on non-Vista emulation
// 1.2.5.1 : Fixed : issue with identical accelerator key for expand/collaps
// 1.2.6.0 : Improved : taskdialog does not size beyond screen width
// : Improved : DefaultButton can be set to -1 to have no default button
// 1.2.7.0 : New: NonNativeDialog property added
// : New: NonNativeMinFormWidth public property added
// 1.2.8.0 : Improved : display of disabled task button
// 1.2.8.1 : Fixed : display of long text in non native taskdialog
// 1.2.8.2 : Fixed : issue with DefaultButton = IdYes, IdNo
// 1.5.0.0 : New : replacement functions for ShowMessage , MessageDlg
// : New : TAdvInputTaskDialog
// : New : ElevateButton method added
// : Improved : message label set transparent
// : Improved : Ctrl-C puts taskdialog text on clipboard
// 1.5.0.1 : Fixed : Delphi 5 issue with TAdvInputTaskDialog
// 1.5.0.2 : Fixed : issue with use of TAdvTaskDialog on topmost forms
// 1.5.0.3 : Improved : automatic height adaption of custom input control
// 1.5.0.4 : Fixed : issue with removing InputControl at designtime
// 1.5.0.5 : Improved : width control of custom editor in TAdvInputTaskDialog
// 1.5.0.6 : Improved : AdvShowMessageBox() handling of ESC key for cancel button
// 1.5.0.7 : Improved : handling of \n linefeed sequence
// 1.5.0.8 : Improved : use of dialog constants in AdvMessageDlg procs
// 1.5.0.9 : Improved : use of question icon in mtConfirmation dialog type
// 1.5.1.0 : Improved : support for F1 help handling
// : Improved : support for HelpContext in message dialog replacements
// : New : various new AdvMessageDlg() function overloads to set Title & Caption separately
// 1.5.1.1 : Fixed : issue with use of dialog on modal StayOnTop forms
// 1.5.1.2 : Improved : handling of button disabling for non native dialog
// 1.5.1.3 : Improved : Clear method clears InputText field too
// 1.5.1.4 : Fixed : issue with handling OnDialogClose and custom input controls in TAdvInputTaskDialog
// 1.5.1.5 : Fixed : close button shown on emulated dialog when doAllowDialogCancel is set
// 1.5.1.6 : Improved : when custom input control is wider than taskdialog, adapt width of taskdialog
type
{$IFNDEF DELPHI6_LVL}
PBoolean = ^Boolean;
{$ENDIF}
TTaskDialogResult = (trNone, trOk, trCancel);
TNonNativeDialog = (nndAuto, nndAlways);
TTaskDialogOption = (doHyperlinks, doCommandLinks, doCommandLinksNoIcon, doExpandedDefault,
doExpandedFooter, doAllowMinimize, doVerifyChecked, doProgressBar, doProgressBarMarquee,
doTimer, doNoDefaultRadioButton, doAllowDialogCancel);
TTaskDialogOptions = set of TTaskDialogOption;
TTaskDialogIcon = (tiBlank, tiWarning, tiQuestion, tiError, tiInformation,tiNotUsed,tiShield);
//(mtWarning, mtError, mtInformation, mtConfirmation, mtCustom);
TTaskDialogFooterIcon = (tfiBlank, tfiWarning, tfiQuestion, tfiError, tfiInformation,
tfiShield);
TTaskDialogProgressState = (psNormal, psError, psPaused);
TTaskDialogPosition = (dpScreenCenter, dpOwnerFormCenter);
TCommonButton = (cbOK, cbYes, cbNo, cbCancel, cbRetry, cbClose);
TTaskDialogButtonClickEvent = procedure(Sender: TObject; ButtonID: integer) of object;
TTaskDialogHyperlinkClickEvent = procedure(Sender: TObject; HRef: string) of object;
TTaskDialogVerifyClickEvent = procedure(Sender: TObject; Checked: boolean) of object;
TTaskDialogCloseEvent = procedure(Sender: TObject; var CanClose: boolean) of object;
TTaskDialogProgressEvent = procedure(Sender: TObject; var Pos: integer; var State: TTaskDialogProgressState) of object;
TCommonButtons = set of TCommonButton;
TAdvMessageForm = class;
TInputType = (itEdit, itMemo, itComboEdit, itComboList, itDate, itCustom, itNone);
TInputGetTextEvent = procedure(Sender: TObject; var Text: string) of object;
TInputSetTextEvent = procedure(Sender: TObject; Text: string) of object;
TCustomAdvTaskDialog = class(TComponent)
private
FTitle: string;
FContent: string;
FFooter: string;
FInstruction: string;
FCommonButtons: TCommonButtons;
FExpandedText: string;
FCollapsControlText: string;
FExpandControlText: string;
FButtonResult: integer;
FVerifyResult: boolean;
FVerifyText: string;
FCustomButtons: TStringList;
FCustomIcon: TIcon;
FOptions: TTaskDialogOptions;
FRadioButtons: TStringList;
FhWnd: THandle;
FOnCreated: TNotifyEvent;
FOnTimer: TNotifyEvent;
FHelpContext: longint;
FProgressBarMin: integer;
FProgressBarMax: integer;
FOnDialogHyperlinkClick: TTaskDialogHyperlinkClickEvent;
FOnDialogClick: TTaskDialogButtonClickEvent;
FOnDialogRadioClick: TTaskDialogButtonClickEvent;
FOnDialogVerifyClick: TTaskDialogVerifyClickEvent;
FOnDialogProgress: TTaskDialogProgressEvent;
FOnDialogClose: TTaskDialogCloseEvent;
FOnDialogInputGetText: TInputGetTextEvent;
FOnDialogInputSetText: TInputSetTextEvent;
FIcon: TTaskDialogIcon;
FFooterIcon: TTaskDialogFooterIcon;
FDefaultButton: integer;
FDefaultRadioButton: integer;
FDialogForm: TAdvMessageForm;
FDlgPosition: TTaskDialogPosition;
FApplicationIsParent: Boolean;
FModalParent: THandle;
FMinFormWidth: Integer;
FNonNativeDialog: TNonNativeDialog;
FInputType: TInputType;
FInputText: string;
FInputItems: TStrings;
FInputControl: TWinControl;
function GetVersion: string;
procedure SetVersion(const Value: string);
function GetVersionNr: Integer;
procedure SetCustomButtons(const Value: TStringList);
procedure SetRadioButtons(const Value: TStringList);
procedure SetContent(const Value: string);
procedure SetInstruction(const Value: string);
procedure SetFooter(const Value: string);
procedure SetExpandedText(const Value: string);
procedure SetCustomIcon(const Value: TIcon);
procedure SetInputItems(const Value: TStrings);
protected
function CreateButton(AOwner: TComponent): TWinControl; virtual;
function CreateRadioButton(AOwner: TComponent): TWinControl; virtual;
procedure InitRadioButton(AOwner: TForm; Btn: TWinControl; btnIndex: Integer; OnClickEvent : TNotifyEvent); virtual;
procedure SetRadioButtonState(Btn: TWinControl; Checked: boolean); virtual;
procedure SetRadioButtonCaption(Btn: TWinControl; Value: string); virtual;
procedure SetButtonCaption(aButton: TWinControl; Value: TCaption); virtual;
procedure SetButtonCancel(aButton: TWinControl; Value: Boolean); virtual;
procedure SetButtonDefault(aButton: TWinControl; Value: Boolean); virtual;
procedure SetButtonModalResult(aButton: TWinControl; Value: Integer); virtual;
function GetButtonModalResult(aButton: TWinControl): Integer; virtual;
procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
procedure TaskDialogFormCreated(Sender: TObject);
property CustomButtons: TStringList read FCustomButtons write SetCustomButtons;
property CustomIcon: TIcon read FCustomIcon write SetCustomIcon;
property RadioButtons: TStringList read FRadioButtons write SetRadioButtons;
property CommonButtons: TCommonButtons read FCommonButtons write FCommonButtons;
property DefaultButton: integer read FDefaultButton write FDefaultButton;
property DefaultRadioButton: integer read FDefaultRadioButton write FDefaultRadioButton;
property DialogPosition: TTaskDialogPosition read FDlgPosition write FDlgPosition default dpScreenCenter;
property ExpandedText: string read FExpandedText write SetExpandedText;
property Footer: string read FFooter write SetFooter;
property FooterIcon: TTaskDialogFooterIcon read FFooterIcon write FFooterIcon default tfiBlank;
property HelpContext: longint read FHelpContext write FHelpContext default 0;
property Icon: TTaskDialogIcon read FIcon write FIcon default tiBlank;
property InputText: string read FInputText write FInputText;
property InputType: TInputType read FInputType write FInputType;
property InputItems: TStrings read FInputItems write SetInputItems;
property InputControl: TWinControl read FInputControl write FInputControl;
property Title: string read FTitle write FTitle;
property Instruction: string read FInstruction write SetInstruction;
property Content: string read FContent write SetContent;
property ExpandControlText: string read FExpandControlText write FExpandControlText;
property CollapsControlText: string read FCollapsControlText write FCollapsControlText;
property Options: TTaskDialogOptions read FOptions write FOptions;
property ApplicationIsParent: boolean read FApplicationIsParent write FApplicationIsParent default true;
property VerificationText: string read FVerifyText write FVerifyText;
property NonNativeDialog: TNonNativeDialog read FNonNativeDialog write FNonNativeDialog default nndAuto;
property NonNativeMinFormWidth: integer read FMinFormWidth write FMinFormWidth default 350;
property ProgressBarMin: integer read FProgressBarMin write FProgressBarMin default 0;
property ProgressBarMax: integer read FProgressBarMax write FProgressBarMax default 100;
property Version: string read GetVersion write SetVersion;
property OnDialogCreated: TNotifyEvent read FOnCreated write FOnCreated;
property OnDialogClose: TTaskDialogCloseEvent read FOnDialogClose write FOnDialogClose;
property OnDialogButtonClick: TTaskDialogButtonClickEvent read FOnDialogClick write FOnDialogClick;
property OnDialogInputSetText: TInputSetTextEvent read FOnDialogInputSetText write FOnDialogInputSetText;
property OnDialogInputGetText: TInputGetTextEvent read FOnDialogInputGetText write FOnDialogInputGetText;
property OnDialogRadioClick: TTaskDialogButtonClickEvent read FOnDialogRadioClick write FOnDialogRadioClick;
property OnDialogHyperlinkClick: TTaskDialogHyperlinkClickEvent read FOnDialogHyperlinkClick write FOnDialogHyperLinkClick;
property OnDialogTimer: TNotifyEvent read FOnTimer write FOnTimer;
property OnDialogVerifyClick: TTaskDialogVerifyClickEvent read FOnDialogVerifyClick write FOnDialogVerifyClick;
property OnDialogProgress: TTaskDialogProgressEvent read FOnDialogProgress write FOnDialogProgress;
public
property hWnd: THandle read FhWnd write FhWnd;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Execute: integer; virtual;
procedure Clear;
procedure EnableButton(ButtonID: integer; Enabled: boolean);
procedure ElevateButton(ButtonID: integer; Enabled: boolean);
procedure ClickButton(ButtonID: integer);
property RadioButtonResult: integer read FButtonResult write FButtonResult;
property VerifyResult: boolean read FVerifyResult write FVerifyResult;
property ModalParent: THandle read FModalParent write FModalParent;
end;
TAdvTaskDialog = class(TCustomAdvTaskDialog)
published
property CustomButtons;
property CustomIcon;
property RadioButtons;
property CommonButtons;
property DefaultButton;
property DefaultRadioButton;
property DialogPosition;
property ExpandedText;
property Footer;
property FooterIcon;
property HelpContext;
property Icon;
property Title;
property Instruction;
property Content;
property ExpandControlText;
property CollapsControlText;
property Options;
property ApplicationIsParent;
property VerificationText;
property NonNativeDialog;
property NonNativeMinFormWidth;
property ProgressBarMin;
property ProgressBarMax;
property Version;
property OnDialogCreated;
property OnDialogClose;
property OnDialogButtonClick;
property OnDialogRadioClick;
property OnDialogHyperlinkClick;
property OnDialogTimer;
property OnDialogVerifyClick;
property OnDialogProgress;
end;
TAdvInputTaskDialog = class(TCustomAdvTaskDialog)
public
constructor Create(AOwner: TComponent); override;
function Execute: integer; override;
published
property ApplicationIsParent;
property CustomButtons;
property CustomIcon;
property CommonButtons;
property DefaultButton;
property DialogPosition;
property ExpandedText;
property Footer;
property FooterIcon;
property Icon;
property InputControl;
property InputType;
property InputText;
property InputItems;
property Instruction;
property Title;
property Content;
property ExpandControlText;
property CollapsControlText;
property VerificationText;
property OnDialogCreated;
property OnDialogClose;
property OnDialogButtonClick;
property OnDialogVerifyClick;
property OnDialogInputSetText;
property OnDialogInputGetText;
end;
TTaskDialogButton = class(TCustomControl)
private
FOnMouseLeave: TNotifyEvent;
FOnMouseEnter: TNotifyEvent;
FGlyph: TBitmap;
FGlyphDisabled: TBitmap;
FGlyphDown: TBitmap;
FGlyphHot: TBitmap;
FMouseInControl: Boolean;
FMouseDown: Boolean;
FBorderColorDown: TColor;
FBorderColorHot: TColor;
FBorderColor: TColor;
FModalResult: TModalResult;
FHeadingFont: TFont;
FAutoFocus: boolean;
procedure OnPictureChanged(Sender: TObject);
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure SetGlyph(const Value: TBitmap);
procedure SetGlyphDisabled(const Value: TBitmap);
procedure SetGlyphDown(const Value: TBitmap);
procedure SetGlyphHot(const Value: TBitmap);
procedure SetHeadingFont(const Value: TFont);
protected
procedure Paint; override;
procedure KeyPress(var Key: char); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Click; override;
procedure DoEnter; override;
procedure DoExit; override;
property AutoFocus: boolean read FAutoFocus write FAutoFocus;
published
property Anchors;
property BorderColor: TColor read FBorderColor write FBorderColor;
property BorderColorHot: TColor read FBorderColorHot write FBorderColorHot;
property BorderColorDown: TColor read FBorderColorDown write FBorderColorDown;
property Constraints;
property Enabled;
property HeadingFont: TFont read FHeadingFont write SetHeadingFont;
property ModalResult: TModalResult read FModalResult write FModalResult default 0;
property Picture: TBitmap read FGlyph write SetGlyph;
property PictureHot: TBitmap read FGlyphHot write SetGlyphHot;
property PictureDown: TBitmap read FGlyphDown write SetGlyphDown;
property PictureDisabled: TBitmap read FGlyphDisabled write SetGlyphDisabled;
property Visible;
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;
TAdvMessageForm = class(TForm)
private
Message: TLabel;
FHorzMargin: Integer;
FVertMargin: Integer;
FHorzSpacing: Integer;
FVertSpacing: Integer;
FExpandButton: TTaskDialogButton;
FExpanded: Boolean;
//FExpandLabel: TLabel;
FExpandControlText: String;
FCollapsControlText: String;
FcmBtnList: TList;
FcsBtnList: TList;
FTaskDialog: TCustomAdvTaskDialog;
FFooterIcon: TImage;
FFooterIconID: PChar;
FRadioList: TList;
FVerificationCheck: TCheckBox;
FProgressBar: TProgressBar;
FIcon: TImage;
FFooterXSize: Integer;
FFooterYSize: Integer;
FContentXSize: Integer;
FContentYSize: Integer;
FExpTextXSize: Integer;
FExpTextYSize: Integer;
FExpTextTop: Integer;
FAnchor: String;
FTimer: TTimer;
FWhiteWindowHeight: Integer;
FHorzParaMargin: Integer;
FMinFormWidth: Integer;
FInputEdit: TEdit;
FInputCombo: TComboBox;
FInputDate: TDateTimePicker;
FInputMemo: TMemo;
FOldParent: TWinControl;
procedure WMActivate(var M: TWMActivate); message WM_ACTIVATE;
procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
procedure OnTimer(Sender: TObject);
procedure OnExpandButtonClick(Sender: TObject);
procedure OnVerifyClick(Sender: TObject);
procedure OnRadioClick(Sender: TObject);
procedure OnButtonClick(Sender: TObject);
procedure SetExpandButton(const Value: TTaskDialogButton);
procedure GetTextSize(Canvas: TCanvas; Text: string;var W, H: Integer);
//procedure GetMultiLineTextSize(Canvas: TCanvas; Text: string; HeadingFont, ParaFont: TFont; var W, H: Integer);
//procedure HelpButtonClick(Sender: TObject);
protected
procedure SetExpanded(Value: Boolean);
procedure CustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure WriteToClipBoard(Text: String);
function GetFormText: String;
procedure Paint; override;
procedure KeyDown(var Key:Word;Shift:TShiftSTate); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure DoClose(var Action: TCloseAction); override;
function GetButton(ButtonID: Integer; var TaskButton: TTaskDialogButton): TButton;
procedure EnableButton(ButtonID: integer; Enabled: boolean);
procedure ClickButton(ButtonID: integer);
function IsAnchor(x, y: integer): string;
function GetFooterRect: TRect;
function GetContentRect: TRect;
function GetExpTextRect: TRect;
procedure DrawExpandedText;
procedure DrawContent;
procedure DrawFooter;
property Expanded: Boolean read FExpanded default true;
property ExpandButton: TTaskDialogButton read FExpandButton write SetExpandButton;
procedure DoShow; override;
public
constructor CreateNew(AOwner: TComponent; Dummy: Integer); {$IFNDEF BCB} reintroduce; {$ENDIF}
destructor Destroy; override;
procedure BuildTaskDialog(TaskDialog: TCustomAdvTaskDialog);
procedure SetPositions;
procedure UpdateDialog;
property MinFormWidth: Integer Read FMinFormWidth Write FMinFormWidth;
end;
function AdvMessageDlgPos(TaskDialog: TCustomAdvTaskDialog; X, Y: Integer): Integer;
function AdvShowMessage(const Instruction: string): boolean; overload;
function AdvShowMessage(const Title, Instruction: string): boolean; overload;
function AdvShowmessage(const Title, Instruction: string; tiIcon: tTaskDialogIcon): boolean; overload;
function AdvShowMessage(const Title, Instruction, content, verify: string;
tiIcon: tTaskDialogIcon): boolean; overload;
function AdvMessageBox(hWnd: HWND; lpInstruction, lpTitle: PChar; flags: UINT): Integer;
function AdvShowMessageFmt(const Instruction: string; Parameters: array of const): boolean;
function AdvMessageDlg(const Instruction: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer; overload;
function AdvMessageDlg(const Instruction: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): Integer; overload;
function AdvTaskMessageDlg(const Title, Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer; overload;
function AdvTaskMessageDlg(const Title, Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): Integer; overload;
function AdvTaskMessageDlgPos(const Title, Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): Integer; overload;
function AdvTaskMessageDlgPos(const Title, Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
DefaultButton: TMsgDlgBtn): Integer; overload;
function AdvTaskMessageDlgPosHelp(const Title, Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
const HelpFileName: string): Integer; overload;
function AdvTaskMessageDlgPosHelp(const Title, Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
const HelpFileName: string; DefaultButton: TMsgDlgBtn): Integer; overload;
function AdvInputQueryDlg(ACaption, APrompt: string; var Value: string): boolean;
var
DRAWBORDER: Boolean = True;
ButtonNames: array[TCommonButton] of string = ('OK', 'Yes', 'No', 'Cancel', 'Retry', 'Abort');
ButtonCaptions: array[TCommonButton] of Pointer;
procedure Register;
implementation
uses SpanishConsts;
{$I HTMLENGO.PAS}
const
TDE_CONTENT = 0;
TDE_EXPANDED_INFORMATION = 1;
TDE_FOOTER = 2;
TDE_MAIN_INSTRUCTION = 3;
TDF_ENABLE_HYPERLINKS = $0001;
TDF_USE_HICON_MAIN = $0002;
TDF_USE_HICON_FOOTER = $0004;
TDF_ALLOW_DIALOG_CANCELLATION = $0008;
TDF_USE_COMMAND_LINKS = $0010;
TDF_USE_COMMAND_LINKS_NO_ICON = $0020;
TDF_EXPAND_FOOTER_AREA = $0040;
TDF_EXPANDED_BY_DEFAULT = $0080;
TDF_VERIFICATION_FLAG_CHECKED = $0100;
TDF_SHOW_PROGRESS_BAR = $0200;
TDF_SHOW_MARQUEE_PROGRESS_BAR = $0400;
TDF_CALLBACK_TIMER = $0800;
TDF_POSITION_RELATIVE_TO_WINDOW = $1000;
TDF_RTL_LAYOUT = $2000;
TDF_NO_DEFAULT_RADIO_BUTTON = $4000;
TDF_CAN_BE_MINIMIZED = $8000;
TDM_NAVIGATE_PAGE = WM_USER+101;
TDM_CLICK_BUTTON = WM_USER+102; // wParam = Button ID
TDM_SET_MARQUEE_PROGRESS_BAR = WM_USER+103; // wParam = 0 (nonMarque) wParam != 0 (Marquee)
TDM_SET_PROGRESS_BAR_STATE = WM_USER+104; // wParam = new progress state
TDM_SET_PROGRESS_BAR_RANGE = WM_USER+105; // lParam = MAKELPARAM(nMinRange, nMaxRange)
TDM_SET_PROGRESS_BAR_POS = WM_USER+106; // wParam = new position
TDM_SET_PROGRESS_BAR_MARQUEE = WM_USER+107; // wParam = 0 (stop marquee), wParam != 0 (start marquee), lparam = speed (milliseconds between repaints)
TDM_SET_ELEMENT_TEXT = WM_USER+108; // wParam = element (TASKDIALOG_ELEMENTS), lParam = new element text (LPCWSTR)
TDM_CLICK_RADIO_BUTTON = WM_USER+110; // wParam = Radio Button ID
TDM_ENABLE_BUTTON = WM_USER+111; // lParam = 0 (disable), lParam != 0 (enable), wParam = Button ID
TDM_ENABLE_RADIO_BUTTON = WM_USER+112; // lParam = 0 (disable), lParam != 0 (enable), wParam = Radio Button ID
TDM_CLICK_VERIFICATION = WM_USER+113; // wParam = 0 (unchecked), 1 (checked), lParam = 1 (set key focus)
TDM_UPDATE_ELEMENT_TEXT = WM_USER+114; // wParam = element (TASKDIALOG_ELEMENTS), lParam = new element text (LPCWSTR)
TDM_SET_BUTTON_ELEVATION_REQUIRED_STATE = WM_USER+115; // wParam = Button ID, lParam = 0 (elevation not required), lParam != 0 (elevation required)
TDM_UPDATE_ICON = WM_USER+116; // wParam = icon element (TASKDIALOG_ICON_ELEMENTS), lParam = new icon (hIcon if TDF_USE_HICON_* was set, PCWSTR otherwise)
TDN_CREATED = 0;
TDN_NAVIGATED = 1;
TDN_BUTTON_CLICKED = 2; // wParam = Button ID
TDN_HYPERLINK_CLICKED = 3; // lParam = (LPCWSTR)pszHREF
TDN_TIMER = 4; // wParam = Milliseconds since dialog created or timer reset
TDN_DESTROYED = 5;
TDN_RADIO_BUTTON_CLICKED = 6; // wParam = Radio Button ID
TDN_DIALOG_CONSTRUCTED = 7;
TDN_VERIFICATION_CLICKED = 8; // wParam = 1 if checkbox checked, 0 if not, lParam is unused and always 0
TDN_HELP = 9;
TDN_EXPANDO_BUTTON_CLICKED = 10; // wParam = 0 (dialog is now collapsed), wParam != 0 (dialog is now expanded)
TDCBF_OK_BUTTON = $0001; // selected control return value IDOK
TDCBF_YES_BUTTON = $0002; // selected control return value IDYES
TDCBF_NO_BUTTON = $0004; // selected control return value IDNO
TDCBF_CANCEL_BUTTON = $0008; // selected control return value IDCANCEL
TDCBF_RETRY_BUTTON = $0010; // selected control return value IDRETRY
TDCBF_CLOSE_BUTTON = $0020; // selected control return value IDCLOSE
PBST_NORMAL = $0001;
PBST_ERROR = $0002;
PBST_PAUSED = $0003;
{
TD_ICON_BLANK = 100;
TD_ICON_WARNING = 101;
TD_ICON_QUESTION = 102;
TD_ICON_ERROR = 103;
TD_ICON_INFORMATION = 104;
TD_ICON_BLANK_AGAIN = 105;
TD_ICON_SHIELD = 106;
}
// Well, Microsoft did it again, incorrect TD_ICON_xxx values in the SDK
// and changing values just between last beta2 & RTM... Gotta love them.
// These values were obtained emperically by the lack of proper documentation
TD_ICON_BLANK = 17;
TD_ICON_WARNING = 84;
TD_ICON_QUESTION = 99;
TD_ICON_ERROR = 98;
TD_ICON_INFORMATION = 81;
TD_ICON_BLANK_AGAIN = 0;
TD_ICON_SHIELD = 78;
type
TProControl = class(TControl);
PTASKDIALOG_BUTTON = ^TTASKDIALOG_BUTTON;
TTASKDIALOG_BUTTON = record
nButtonID: integer;
pszButtonText: pwidechar;
end;
TTaskDialogWideString = array[0..1023] of widechar;
TTaskDialogButtonArray = array of TTASKDIALOG_BUTTON;
TTaskDialogWideStringArray = array of TTaskDialogWideString;
PTASKDIALOGCONFIG = ^TTASKDIALOGCONFIG;
TTASKDIALOGCONFIG = record
cbSize: integer;
hwndParent: THandle;
hInstance: THandle;
dwFlags: integer; // TASKDIALOG_FLAGS dwFlags;
dwCommonButtons: integer; // TASKDIALOG_COMMON_BUTTON_FLAGS
pszWindowTitle: pwidechar;
hMainIcon: integer;
pszMainInstruction: pwidechar;
pszContent: pwidechar;
cButtons: integer;
pbuttons: pinteger; // const TASKDIALOG_BUTTON* pButtons;
nDefaultButton: integer;
cRadioButtons: integer;
pRadioButtons: pinteger; //const TASKDIALOG_BUTTON* pRadioButtons;
nDefaultRadioButton: integer;
pszVerificationText: pwidechar;
pszExpandedInformation: pwidechar;
pszExpandedControlText: pwidechar;
pszCollapsedControlText: pwidechar;
case Integer of
0: (hFooterIcon: HICON);
1: (pszFooterIcon: pwidechar;
pszFooter: pwidechar;
pfCallback: pinteger;
pData: pointer;
cxWidth: integer // width of the Task Dialog's client area in DLU's.
// If 0, Task Dialog will calculate the ideal width.
);
{
hFooterIcon: integer;
pszFooter: pwidechar;
pfCallBack: pinteger; // PFTASKDIALOGCALLBACK pfCallback;
pData: pointer;
cxWidth: integer;
}
end;
//------------------------------------------------------------------------------
procedure RunElevated(HWND: THandle; pszPath, pszParameters, pszDirectory: string);
var
shex : SHELLEXECUTEINFO;
begin
fillchar(shex, sizeof(shex),0);
shex.cbSize := sizeof( SHELLEXECUTEINFO );
shex.fMask := 0;
shex.wnd := hwnd;
shex.lpVerb := 'runas';
shex.lpFile := pchar(pszPath);
shex.lpParameters := pchar(pszParameters);
shex.lpDirectory := nil;
shex.nShow := SW_NORMAL;
ShellExecuteEx(@shex);
end;
//------------------------------------------------------------------------------
function IsVista: boolean;
var
hKernel32: HMODULE;
begin
hKernel32 := GetModuleHandle('kernel32');
if (hKernel32 > 0) then
begin
Result := GetProcAddress(hKernel32, 'GetLocaleInfoEx') <> nil;
end
else
Result := false;
end;
//------------------------------------------------------------------------------
procedure VistaShellOpen(HWND: THandle; Command, Param: string);
begin
if IsVista then
RunElevated(HWND, Command, Param, '')
else
ShellExecute(HWND, 'open', pchar(Param), nil, nil, SW_NORMAL);
end;
//------------------------------------------------------------------------------
function GetFileVersion(const AFileName: string): Cardinal;
var
FileName: string;
InfoSize, Wnd: DWORD;
VerBuf: Pointer;
FI: PVSFixedFileInfo;
VerSize: DWORD;
begin
Result := Cardinal(-1);
// GetFileVersionInfo modifies the filename parameter data while parsing.
// Copy the string const into a local variable to create a writeable copy.
FileName := AFileName;
UniqueString(FileName);
InfoSize := GetFileVersionInfoSize(PChar(FileName), Wnd);
if InfoSize <> 0 then
begin
GetMem(VerBuf, InfoSize);
try
if GetFileVersionInfo(PChar(FileName), Wnd, InfoSize, VerBuf) then
if VerQueryValue(VerBuf, '\', Pointer(FI), VerSize) then
Result:= FI.dwFileVersionMS;
finally
FreeMem(VerBuf);
end;
end;
end;
function TaskDialogCallbackProc(hWnd: THandle; msg, wParam, lparam: integer; refData: pointer): integer; stdcall;
var
td: TAdvTaskDialog;
SPos: integer;
State: TTaskDialogProgressState;
Res: integer;
CanClose: boolean;
Anchor: string;
procedure ShowHelpException(E: Exception);
var
Msg: string;
Flags: Integer;
begin
Flags := MB_OK or MB_ICONSTOP;
if Application.UseRightToLeftReading then
Flags := Flags or MB_RTLREADING;
Msg := E.Message;
if (Msg <> '') and (AnsiLastChar(Msg) > '.') then
Msg := Msg + '.';
MessageBox(0, PChar(Msg), PChar(Application.Title), Flags);
end;
begin
td := nil;
if Assigned(refdata) then
td := TAdvTaskDialog(refdata);
Res := 0;
if Assigned(td) then
td.hWnd := hWnd;
case msg of
TDN_CREATED:
begin
if Assigned(td) and Assigned(td.OnDialogCreated) then
begin
td.OnDialogCreated(td);
if (doProgressBar in td.Options) then
begin
SendMessage(hWnd, TDM_SET_PROGRESS_BAR_RANGE, 0, MakeLParam(td.ProgressBarMin,td.ProgressBarMax));
end;
end;
end;
TDN_BUTTON_CLICKED:
begin
if Assigned(td) and Assigned(td.OnDialogButtonClick) then
begin
td.OnDialogButtonClick(td, wParam);
end;
if Assigned(td) and Assigned(td.OnDialogClose) then
begin
CanClose := true;
td.OnDialogClose(td, CanClose);
if not CanClose then
Res := 1;
end;
end;
TDN_RADIO_BUTTON_CLICKED:
begin
if Assigned(td) and Assigned(td.OnDialogRadioClick) then
begin
td.OnDialogRadioClick(td, wParam);
end;
end;
TDN_HYPERLINK_CLICKED:
begin
if Assigned(td) then
begin
Anchor := WideCharToString(PWideChar(lparam));
if not Assigned(td.OnDialogHyperlinkClick) then
begin
if (Pos('://', Anchor) > 0) then
VistaShellOpen(0, 'iexplore.exe', Anchor);
end;
if Assigned(td.OnDialogHyperlinkClick) then
begin
td.OnDialogHyperlinkClick(td, Anchor);
end;
end;
end;
TDN_VERIFICATION_CLICKED:
begin
if Assigned(td) and Assigned(td.OnDialogVerifyClick) then
begin
td.OnDialogVerifyClick(td, bool(wparam));
end;
end;
TDN_HELP:
begin
if Assigned(td) then
if td.HelpContext <> 0 then
try
Application.HelpContext(td.HelpContext);
except
on E: Exception do
ShowHelpException(E);
end;
end;
TDN_TIMER:
begin
if Assigned(td) and Assigned(td.OnDialogTimer) then
begin
td.OnDialogTimer(td);
end;
if Assigned(td) and Assigned(td.OnDialogProgress) then
begin
td.OnDialogProgress(td, SPos, State);
SendMessage(hWnd,TDM_SET_PROGRESS_BAR_POS,SPos,0);
case State of
psNormal: SendMessage(hWnd,TDM_SET_PROGRESS_BAR_STATE, PBST_NORMAL, 0);
psError: SendMessage(hWnd,TDM_SET_PROGRESS_BAR_STATE, PBST_ERROR, 0);
psPaused: SendMessage(hWnd,TDM_SET_PROGRESS_BAR_STATE, PBST_PAUSED, 0);
end;
end;
end;
end;
Result := Res;
end;
//------------------------------------------------------------------------------
function RemoveSpaces(S: String): String;
var
i: Integer;
begin
Result := S;
for i := 1 to Length(s) do
begin
if (s[i] = ' ') then
Result := copy(S, 2, Length(S)-1)
else
Break;
end;
for i := Length(s) downto 1 do
begin
if (s[i] = ' ') then
Result := copy(S, 1, Length(S)-1)
else
Break;
end;
end;
//------------------------------------------------------------------------------
function HasLf(s:string): boolean;
var
i,j: integer;
begin
Result := false;
i := pos('\n', s);
if i > 0 then
begin
j := pos(':\n',s);
if (j = -1) or (j <> i - 1) then
Result := true;
end;
end;
//------------------------------------------------------------------------------
procedure SplitInToLines(Text: string; sl: TStrings);
var
i, j: Integer;
s, rs: string;
begin
if (Text <> '') and Assigned(sl) then
begin
rs := #13;
if HasLf(Text) or (pos(rs, Text) > 0) then
begin
Text := RemoveSpaces(Text);
while (Length(Text) > 0) do
begin
i := Pos('\n', Text);
j := 2;
if (i <= 0) then
begin
i := pos(rs, Text);
j := 2;
end;
if (i <= 0) then
begin
i := Length(Text)+1;
j := 0;
end;
s := copy(Text, 1, i-1);
Delete(Text, 1, i-1+j);
s := RemoveSpaces(s);
sl.Add(s);
Text := RemoveSpaces(Text);
end;
end
else
sl.Add(Text);
end;
end;
//------------------------------------------------------------------------------
procedure GetMultiLineTextSize(Canvas: TCanvas; Text: string; HeadingFont, ParaFont: TFont; DrawTextBiDiModeFlagsReadingOnly: Longint; var W, H: Integer; WithSpace: Boolean = True);
var
R: TRect;
i, tw, th: Integer;
s: string;
OldFont: TFont;
SL: TStringList;
begin
if Assigned(Canvas) then
begin
OldFont := TFont.Create;
OldFont.Assign(Canvas.Font);
if HasLf(Text) or (pos(#13, Text) > 0) then
begin
tw := 0;
th := 0;
SL := TStringList.Create;
SplitInToLines(Text, SL);
s := RemoveSpaces(SL[0]);
if (s <> '') then
begin
Canvas.Font.Assign(HeadingFont);
SetRect(R, 0, 0, 0, 0);
Windows.DrawText( Canvas.handle, PChar(s), -1, R,
DT_CALCRECT or DT_LEFT or DT_SINGLELINE or DrawTextBiDiModeFlagsReadingOnly);
tw := R.Right;
th := R.Bottom;
if WithSpace then
begin
tw := tw + 8;
th := th + 10;
end;
end;
Canvas.Font.Assign(ParaFont);
for i:= 1 to SL.Count-1 do
begin
s := SL[i];
if (s <> '') then
begin
SetRect(R, 0, 0, 0, 0);
Windows.DrawText( Canvas.handle, PChar(s), -1, R,
DT_CALCRECT or DT_LEFT or DT_SINGLELINE or DrawTextBiDiModeFlagsReadingOnly);
if WithSpace then
begin
tw := Max(tw, R.Right + 8);
th := th + R.Bottom + 2;
end
else
begin
tw := Max(tw, R.Right);
th := th + R.Bottom;
end;
end;
end;
W := tw;
H := th;
SL.Free;
end
else
begin
Canvas.Font.Assign(HeadingFont);
SetRect(R, 0, 0, 0, 0);
Windows.DrawText( Canvas.handle, PChar(Text), -1, R,
DT_CALCRECT or DT_LEFT or DT_SINGLELINE or DrawTextBiDiModeFlagsReadingOnly);
W := R.Right;
H := R.Bottom;
end;
Canvas.Font.Assign(OldFont);
OldFont.Free;
end;
end;
//------------------------------------------------------------------------------
{ TAdvTaskDialog }
procedure TCustomAdvTaskDialog.Clear;
begin
CommonButtons := [];
RadioButtons.Clear;
CustomButtons.Clear;
Icon := tiBlank;
FooterIcon := tfiBlank;
Instruction := '';
Title := '';
Content := '';
Footer := '';
VerificationText := '';
ExpandControlText := '';
CollapsControlText := '';
ExpandedText := '';
DefaultRadioButton := 200;
DefaultButton := 0;
Options := [];
VerifyResult := false;
InputText := '';
end;
//------------------------------------------------------------------------------
procedure TCustomAdvTaskDialog.ClickButton(ButtonID: integer);
begin
SendMessage(hWnd, TDM_CLICK_BUTTON, ButtonID, 0);
if Assigned(FDialogForm) then
FDialogForm.ClickButton(ButtonID);
end;
//------------------------------------------------------------------------------
constructor TCustomAdvTaskDialog.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCustomButtons := TStringList.Create;
FRadioButtons := TStringList.Create;
FProgressBarMin := 0;
FProgressBarMax := 100;
FDialogForm := nil;
FApplicationIsParent := true;
FModalParent := 0;
FCustomIcon := TIcon.Create;
FDefaultRadioButton := 200;
FMinFormWidth := 350;
FNonNativeDialog := nndAuto;
FInputType := itNone;
FInputItems := TStringList.Create;
end;
//------------------------------------------------------------------------------
destructor TCustomAdvTaskDialog.Destroy;
begin
FRadioButtons.Free;
FCustomButtons.Free;
FCustomIcon.Free;
FInputItems.Free;
inherited;
end;
//------------------------------------------------------------------------------
function TCustomAdvTaskDialog.CreateButton(AOwner: TComponent): TWinControl;
begin
Result := TButton.Create(AOwner);
end;
//------------------------------------------------------------------------------
function TCustomAdvTaskDialog.CreateRadioButton(AOwner: TComponent): TWinControl;
begin
Result := TRadioButton.Create(AOwner);
end;
procedure TCustomAdvTaskDialog.SetRadioButtonState(Btn: TWinControl; Checked: boolean);
begin
TRadioButton(Btn).Checked := Checked;
end;
//------------------------------------------------------------------------------
procedure TCustomAdvTaskDialog.InitRadioButton(AOwner: TForm; Btn: TWinControl; btnIndex: Integer; OnClickEvent : TNotifyEvent);
begin
with TRadioButton(Btn) do
begin
Name := 'Radio' + inttostr(btnIndex);
Parent := AOwner;
Font.Name := AOwner.Canvas.Font.Name;
Font.Size := 8;
BiDiMode := AOwner.BiDiMode;
OnClick := OnClickEvent;
{
BoundsRect := TextRect;
Left := FHorzParaMargin + FHorzMargin; //ALeft + FHorzMargin;
Top := Y;
Width := Self.Width - Left - 4;
GetTextSize(Canvas, Caption, k, l);
w := Max(w, Left + k + FHorzMargin + 20);
}
end;
end;
//------------------------------------------------------------------------------
procedure TCustomAdvTaskDialog.TaskDialogFormCreated(Sender: TObject);
begin
if Assigned(OnDialogCreated) then
OnDialogCreated(Self);
end;
//------------------------------------------------------------------------------
procedure TCustomAdvTaskDialog.Notification(AComponent: TComponent;
AOperation: TOperation);
begin
inherited;
if not (csDestroying in ComponentState) then
begin
if (AOperation = opRemove) then
begin
if (AComponent = FInputControl) then
FInputControl := nil;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomAdvTaskDialog.ElevateButton(ButtonID: integer;
Enabled: boolean);
begin
SendMessage(hWnd, TDM_SET_BUTTON_ELEVATION_REQUIRED_STATE, ButtonID, integer(Enabled));
end;
procedure TCustomAdvTaskDialog.EnableButton(ButtonID: integer; Enabled: boolean);
begin
SendMessage(hWnd, TDM_ENABLE_BUTTON, ButtonID, integer(Enabled));
if Assigned(FDialogForm) then
FDialogForm.EnableButton(ButtonID, Enabled);
end;
//------------------------------------------------------------------------------
function ConvertNL(s: string): string;
begin
if Pos('\\n', s) > 0 then
Result := StringReplace(s, '\\n', '\n', [rfReplaceAll])
else
begin
if pos('\n',s) > 0 then
Result := StringReplace(s,'\n',#10,[rfReplaceAll])
else
Result := s;
end;
end;
//------------------------------------------------------------------------------
function TCustomAdvTaskDialog.Execute: integer;
var
verinfo: TOSVersionInfo;
DLLHandle: THandle;
res,radiores: integer;
verify: boolean;
TaskDialogConfig : TTASKDIALOGCONFIG;
TaskDialogIndirectProc : function(AConfig: PTASKDIALOGCONFIG; Res: pinteger; ResRadio: pinteger; VerifyFLag: pboolean): integer cdecl stdcall;
{
wTitle: TTaskDialogWideString;
wDesc: TTaskDialogWideString;
wContent: TTaskDialogWideString;
wExpanded: TTaskDialogWideString;
wExpandedControl: TTaskDialogWideString;
wCollapsedControl: TTaskDialogWideString;
wFooter: TTaskDialogWideString;
wVerifyText: TTaskDialogWideString;
}
TBA: TTaskDialogButtonArray;
TBWS: TTaskDialogWideStringArray;
i: integer;
TRA: TTaskDialogButtonArray;
TRWS: TTaskDialogWideStringArray;
ComCtlVersion: integer;
begin
Result := -1;
VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(verinfo);
ComCtlVersion := GetFileVersion('COMCTL32.DLL');
ComCtlVersion := (ComCtlVersion shr 16) and $FF;
if (verinfo.dwMajorVersion >= 6) and (ComCtlVersion > 5) and (FNonNativeDialog = nndAuto) then
begin
// check COMCTL version ...
DLLHandle := LoadLibrary('comctl32.dll');
if DLLHandle >= 32 then
begin
@TaskDialogIndirectProc := GetProcAddress(DLLHandle,'TaskDialogIndirect');
if Assigned(TaskDialogIndirectProc) then
begin
FillChar(TaskDialogConfig, sizeof(TTASKDIALOGCONFIG),0);
TaskDialogConfig.cbSize := sizeof(TTASKDIALOGCONFIG);
if ModalParent <> 0 then
begin
TaskDialogConfig.hwndParent := ModalParent
end
else
begin
if Assigned(Self.Owner) and not ApplicationIsParent then
TaskDialogConfig.hwndParent := (Self.Owner as TWinControl).Handle
else
TaskDialogConfig.hwndParent := Application.Handle;
end;
if FCustomButtons.Count > 0 then
begin
SetLength(TBA, FCustomButtons.Count);
SetLength(TBWS, FCustomButtons.Count);
for i := 0 to FCustomButtons.Count - 1 do
begin
StringToWideChar(ConvertNL(FCustomButtons.Strings[i]), TBWS[i], sizeof(TBWS[i]));
TBA[i].pszButtonText := TBWS[i];
TBA[i].nButtonID := i + 100;
end;
TaskDialogConfig.cButtons := FCustomButtons.Count;
TaskDialogConfig.pbuttons := @TBA[0];
end;
if FRadioButtons.Count > 0 then
begin
SetLength(TRA, FRadioButtons.Count);
SetLength(TRWS, FRadioButtons.Count);
for i := 0 to FRadioButtons.Count - 1 do
begin
StringToWideChar(ConvertNL(FRadioButtons.Strings[i]), TRWS[i], sizeof(TRWS[i]));
TRA[i].pszButtonText := TRWS[i];
TRA[i].nButtonID := i + 200;
end;
TaskDialogConfig.cRadioButtons := FRadioButtons.Count;
TaskDialogConfig.pRadioButtons := @TRA[0];
end;
if FTitle <> '' then
begin
TaskDialogConfig.pszWindowTitle := PWideChar(WideString(ConvertNL(FTitle)));
end;
if FInstruction <> '' then
begin
TaskDialogConfig.pszMainInstruction := PWideChar(WideString(ConvertNL(FInstruction)));
end;
if FContent <> '' then
begin
TaskDialogConfig.pszContent := PWideChar(WideString(ConvertNL(FContent)));
end;
if FFooter <> '' then
begin
TaskDialogConfig.pszFooter := PWideChar(WideString(ConvertNL(FFooter)));
end;
if FExpandControlText <> '' then
begin
TaskDialogConfig.pszExpandedControlText := PWideChar(WideString(FExpandControlText));
end;
if FCollapsControlText <> '' then
begin
TaskDialogConfig.pszCollapsedControlText := PWideChar(WideString(FCollapsControlText));
end;
if FExpandedText <> '' then
begin
TaskDialogConfig.pszExpandedInformation := PWideChar(WideString(FExpandedText))
end;
if FVerifyText <> '' then
begin
TaskDialogConfig.pszVerificationText := PWideChar(WideString(FVerifyText));
end;
if cbOk in FCommonButtons then
TaskDialogConfig.dwCommonButtons := TaskDialogConfig.dwCommonButtons or TDCBF_OK_BUTTON;
if cbYes in FCommonButtons then
TaskDialogConfig.dwCommonButtons := TaskDialogConfig.dwCommonButtons or TDCBF_YES_BUTTON;
if cbNo in FCommonButtons then
TaskDialogConfig.dwCommonButtons := TaskDialogConfig.dwCommonButtons or TDCBF_NO_BUTTON;
if cbCancel in FCommonButtons then
TaskDialogConfig.dwCommonButtons := TaskDialogConfig.dwCommonButtons or TDCBF_CANCEL_BUTTON;
if cbClose in FCommonButtons then
TaskDialogConfig.dwCommonButtons := TaskDialogConfig.dwCommonButtons or TDCBF_CLOSE_BUTTON;
if cbRetry in FCommonButtons then
TaskDialogConfig.dwCommonButtons := TaskDialogConfig.dwCommonButtons or TDCBF_RETRY_BUTTON;
if doCommandLinks in FOptions then
TaskDialogConfig.dwFlags := TDF_USE_COMMAND_LINKS;
if doCommandLinksNoIcon in FOptions then
TaskDialogConfig.dwFlags := TDF_USE_COMMAND_LINKS_NO_ICON;
if doHyperlinks in FOptions then
TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_ENABLE_HYPERLINKS;
if doExpandedDefault in FOptions then
TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_EXPANDED_BY_DEFAULT;
if doExpandedFooter in FOptions then
TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_EXPAND_FOOTER_AREA;
if doAllowMinimize in FOptions then
TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_CAN_BE_MINIMIZED;
if doVerifyChecked in FOptions then
TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_VERIFICATION_FLAG_CHECKED;
if doProgressBar in FOptions then
TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_SHOW_PROGRESS_BAR;
if doProgressBarMarquee in FOptions then
TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_SHOW_MARQUEE_PROGRESS_BAR;
if (doProgressBarMarquee in FOptions) or
(doProgressBar in FOptions) or
(doTimer in FOptions) then
TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_CALLBACK_TIMER;
if (DialogPosition = dpOwnerFormCenter) then
TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_POSITION_RELATIVE_TO_WINDOW;
if doNoDefaultRadioButton in FOptions then
TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_NO_DEFAULT_RADIO_BUTTON;
if doAllowDialogCancel in FOptions then
TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_ALLOW_DIALOG_CANCELLATION;
TaskDialogConfig.hInstance := 0;
if not CustomIcon.Empty then
begin
TaskDialogConfig.hMainIcon := CustomIcon.Handle;
TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_USE_HICON_MAIN;
end
else
begin
case Icon of
tiWarning: TaskDialogConfig.hMainIcon := TD_ICON_WARNING;
tiQuestion: TaskDialogConfig.hMainIcon := TD_ICON_QUESTION;
tiError: TaskDialogConfig.hMainIcon := TD_ICON_ERROR;
tiShield: TaskDialogConfig.hMainIcon := TD_ICON_SHIELD;
tiBlank: TaskDialogConfig.hMainIcon := TD_ICON_BLANK;
tiInformation: TaskDialogConfig.hMainIcon := TD_ICON_INFORMATION;
end;
end;
case FooterIcon of
tfiWarning: TaskDialogConfig.hFooterIcon := TD_ICON_WARNING;
tfiQuestion: TaskDialogConfig.hFooterIcon := TD_ICON_QUESTION;
tfiError: TaskDialogConfig.hFooterIcon := TD_ICON_ERROR;
tfiInformation: TaskDialogConfig.hFooterIcon := THandle(MAKEINTRESOURCEW(Word(-3)));
tfiShield: TaskDialogConfig.hFooterIcon := THandle(MAKEINTRESOURCEW(Word(-4)));
end;
TaskDialogConfig.pfCallBack := @TaskDialogCallbackProc;
TaskDialogConfig.pData := Self;
TaskDialogConfig.nDefaultButton := DefaultButton;
TaskDialogConfig.nDefaultRadioButton := DefaultRadioButton;
TaskDialogIndirectProc(@TaskDialogConfig, @res, @radiores, @verify);
RadioButtonResult := radiores;
VerifyResult := verify;
Result := res;
end;
end;
end
else
Result := AdvMessageDlgPos(Self, -1, -1);
end;
//------------------------------------------------------------------------------
function TCustomAdvTaskDialog.GetVersion: string;
var
vn: Integer;
begin
vn := GetVersionNr;
Result := IntToStr(Hi(Hiword(vn))) + '.' + IntToStr(Lo(Hiword(vn))) + '.' +
IntToStr(Hi(Loword(vn))) + '.' + IntToStr(Lo(Loword(vn)));
end;
//------------------------------------------------------------------------------
function TCustomAdvTaskDialog.GetVersionNr: Integer;
begin
Result := MakeLong(MakeWord(BLD_VER, REL_VER), MakeWord(MIN_VER, MAJ_VER));
end;
//------------------------------------------------------------------------------
procedure TCustomAdvTaskDialog.SetContent(const Value: string);
begin
if (FContent <> Value) then
begin
FContent := Value;
SendMessage(hWnd, TDM_UPDATE_ELEMENT_TEXT, TDE_CONTENT, Integer(PWideChar(WideString(FContent))));
if Assigned(FDialogForm) then
FDialogForm.UpdateDialog;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomAdvTaskDialog.SetCustomButtons(const Value: TStringList);
begin
FCustomButtons.Assign(Value);
end;
procedure TCustomAdvTaskDialog.SetCustomIcon(const Value: TIcon);
begin
FCustomIcon.Assign(Value);
end;
//------------------------------------------------------------------------------
procedure TCustomAdvTaskDialog.SetExpandedText(const Value: string);
begin
if (FExpandedText <> Value) then
begin
FExpandedText := Value;
SendMessage(hWnd, TDM_UPDATE_ELEMENT_TEXT, TDE_EXPANDED_INFORMATION, Integer(PWideChar(WideString(FExpandedText))));
if Assigned(FDialogForm) then
FDialogForm.UpdateDialog;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomAdvTaskDialog.SetFooter(const Value: string);
begin
if (FFooter <> Value) then
begin
FFooter := Value;
SendMessage(hWnd, TDM_UPDATE_ELEMENT_TEXT, TDE_FOOTER, Integer(PWideChar(WideString(FFooter))));
if Assigned(FDialogForm) then
FDialogForm.UpdateDialog;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomAdvTaskDialog.SetInputItems(const Value: TStrings);
begin
FInputItems.Assign(Value);
end;
procedure TCustomAdvTaskDialog.SetInstruction(const Value: string);
begin
if (FInstruction <> Value) then
begin
FInstruction := Value;
SendMessage(hWnd, TDM_UPDATE_ELEMENT_TEXT, TDE_MAIN_INSTRUCTION, Integer(PWideChar(WideString(FInstruction))));
if Assigned(FDialogForm) then
FDialogForm.UpdateDialog;
end;
end;
//------------------------------------------------------------------------------
procedure TCustomAdvTaskDialog.SetRadioButtonCaption(Btn: TWinControl;
Value: string);
begin
TRadioButton(Btn).Caption := Value;
end;
//------------------------------------------------------------------------------
procedure TCustomAdvTaskDialog.SetRadioButtons(const Value: TStringList);
begin
FRadioButtons.Assign(Value);
end;
//------------------------------------------------------------------------------
procedure TCustomAdvTaskDialog.SetVersion(const Value: string);
begin
end;
//------------------------------------------------------------------------------
procedure TCustomAdvTaskDialog.SetButtonCancel(aButton: TWinControl; Value: Boolean);
begin
if not Assigned(aButton) or not (aButton is TButton) then
Exit;
TButton(aButton).Cancel := Value;
end;
//------------------------------------------------------------------------------
procedure TCustomAdvTaskDialog.SetButtonDefault(aButton: TWinControl; Value: Boolean);
begin
if not Assigned(aButton) or not (aButton is TButton) then
Exit;
TButton(aButton).Default := Value;
end;
//------------------------------------------------------------------------------
procedure TCustomAdvTaskDialog.SetButtonModalResult(aButton: TWinControl; Value: Integer);
begin
if not Assigned(aButton) or not (aButton is TButton) then
Exit;
TButton(aButton).ModalResult := Value;
end;
//------------------------------------------------------------------------------
function TCustomAdvTaskDialog.GetButtonModalResult(
aButton: TWinControl): Integer;
begin
Result := mrNone;
if not Assigned(aButton) or not (aButton is TButton) then
Exit;
Result := TButton(aButton).ModalResult;
end;
//------------------------------------------------------------------------------
procedure TCustomAdvTaskDialog.SetButtonCaption(aButton: TWinControl;
Value: TCaption);
begin
if not Assigned(aButton) or not (aButton is TButton) then
Exit;
TButton(aButton).Caption := Value;
end;
//------------------------------------------------------------------------------
{ TTaskDialogButton }
constructor TTaskDialogButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FGlyph := TBitmap.Create;
FGlyph.OnChange := OnPictureChanged;
FGlyphHot := TBitmap.Create;
FGlyphDown := TBitmap.Create;
FGlyphDisabled := TBitmap.Create;
FGlyphDisabled.OnChange := OnPictureChanged;
FHeadingFont := TFont.Create;
SetBounds(0, 0, 23, 22);
ShowHint := False;
FBorderColorDown := clNone;
FBorderColorHot := clNone;
FBorderColor := clNone;
end;
//------------------------------------------------------------------------------
destructor TTaskDialogButton.Destroy;
begin
FGlyph.Free;
FGlyphHot.Free;
FGlyphDown.Free;
FGlyphDisabled.Free;
FHeadingFont.Free;
inherited;
end;
procedure TTaskDialogButton.DoEnter;
begin
inherited;
Invalidate;
end;
procedure TTaskDialogButton.DoExit;
begin
inherited;
Invalidate;
end;
procedure TTaskDialogButton.KeyPress(var Key: char);
begin
inherited;
if (Key = #32) or (Key = #13) then
begin
Click;
end;
end;
//------------------------------------------------------------------------------
procedure TTaskDialogButton.Paint;
var
Pic: TBitmap;
x, y, bw, bh, i: Integer;
R, TR: TRect;
BrClr: TColor;
SL: TStringList;
begin
inherited;
R := ClientRect;
BrClr := clNone;
if FMouseDown then
BrClr := BorderColorDown
else if FMouseInControl then
BrClr := BorderColorHot;
if not Enabled then
BrClr := clNone;
if GetFocus = Handle then
BrClr := BorderColorDown;
Pic := Picture;
if FMouseDown and not FGlyphDown.Empty then
Pic := FGlyphDown
else if FMouseInControl and not FGlyphHot.Empty then
Pic := FGlyphHot;
if not Enabled and not PictureDisabled.Empty then
Pic := PictureDisabled;
if Assigned(Pic) and not Pic.Empty then
begin
Pic.Transparent := True;
if (Caption = '') then
begin
x := (Width - Pic.Width) div 2;
y := (Height - Pic.Height) div 2;
end
else
begin
x := 4;
y := (Height - Pic.Height) div 2;
end;
Canvas.Draw(x, y, Pic);
R.Left := x + Pic.Width + 3;
end
else
R.Left := R.Left + 2;
if (Caption <> '') then
begin
if HasLf(Caption) or (pos(#13, Caption) > 0) then
begin
TR := R;
SL := TStringList.Create;
SplitInToLines(Caption, SL);
GetMultiLineTextSize(Canvas, Caption, HeadingFont, Self.Font, DrawTextBiDiModeFlagsReadingOnly, bw, bh);
TR.Top := 2 + (Height - bh) div 2;
Canvas.Brush.Style := bsClear;
if (SL[0] <> '') then
begin
Canvas.Font.Assign(HeadingFont);
if not Enabled then
Canvas.Font.Color := clSilver;
DrawText(Canvas.Handle, PChar(SL[0]),Length(SL[0]), TR, DT_LEFT or DT_TOP or DT_SINGLELINE);
TR.Top := TR.Top + Canvas.TextHeight('gh') + 4;
end;
Canvas.Font.Assign(Self.Font);
if not Enabled then
Canvas.Font.Color := clSilver;
for i:= 1 to SL.Count - 1 do
begin
DrawText(Canvas.Handle, PChar(SL[i]),Length(SL[i]), TR, DT_LEFT or DT_TOP or DT_SINGLELINE);
TR.Top := TR.Top + Canvas.TextHeight('gh') + 2;
end;
SL.Free;
end
else
begin
Canvas.Brush.Style := bsClear;
Canvas.Font.Assign(HeadingFont);
if not Enabled then
Canvas.Font.Color := clSilver;
DrawText(Canvas.Handle,PChar(Caption),Length(Caption), R, DT_LEFT or DT_VCENTER or DT_SINGLELINE);
end;
end;
if (BrClr <> clNone) then
begin
R := ClientRect;
Canvas.Pen.Color := BrClr;
Canvas.Brush.Style := bsClear;
Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, 2, 2);
end;
end;
//------------------------------------------------------------------------------
procedure TTaskDialogButton.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
inherited;
if (ssLeft in Shift) then
begin
FMouseDown := True;
Invalidate;
end;
end;
//------------------------------------------------------------------------------
procedure TTaskDialogButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
end;
//------------------------------------------------------------------------------
procedure TTaskDialogButton.MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
inherited;
FMouseDown := False;
Invalidate;
end;
//------------------------------------------------------------------------------
procedure TTaskDialogButton.SetGlyph(const Value: TBitmap);
begin
FGlyph.Assign(Value);
Invalidate;
end;
//------------------------------------------------------------------------------
procedure TTaskDialogButton.SetGlyphDown(const Value: TBitmap);
begin
FGlyphDown.Assign(Value);
end;
//------------------------------------------------------------------------------
procedure TTaskDialogButton.SetGlyphHot(const Value: TBitmap);
begin
FGlyphHot.Assign(Value);
end;
//------------------------------------------------------------------------------
procedure TTaskDialogButton.SetGlyphDisabled(const Value: TBitmap);
begin
FGlyphDisabled.Assign(Value);
Invalidate;
end;
//------------------------------------------------------------------------------
procedure TTaskDialogButton.OnPictureChanged(Sender: TObject);
begin
Invalidate;
end;
//------------------------------------------------------------------------------
procedure TTaskDialogButton.CMMouseEnter(var Message: TMessage);
begin
inherited;
FMouseInControl := True;
if AutoFocus then
SetFocus;
Invalidate;
if Assigned(FOnMouseEnter) then
FOnMouseEnter(Self);
end;
//------------------------------------------------------------------------------
procedure TTaskDialogButton.CMMouseLeave(var Message: TMessage);
begin
inherited;
FMouseInControl := False;
Invalidate;
if Assigned(FOnMouseLeave) then
FOnMouseLeave(Self);
end;
//------------------------------------------------------------------------------
procedure TTaskDialogButton.SetHeadingFont(const Value: TFont);
begin
FHeadingFont.Assign(Value);
end;
//------------------------------------------------------------------------------
function GetAveCharSize(Canvas: TCanvas): TPoint;
var
I: Integer;
Buffer: array[0..51] of Char;
begin
for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
Result.X := Result.X div 52;
end;
//------------------------------------------------------------------------------
var
ButtonWidths : array[TCommonButton] of integer; // initialized to zero
//tiBlank, tiWarning, tiQuestion, tiError, tiInformation,tiNotUsed,tiShield
IconIDs: array[TTaskDialogIcon] of PChar = (IDI_ASTERISK, IDI_EXCLAMATION, IDI_QUESTION, IDI_ERROR, IDI_INFORMATION, nil, IDI_HAND);
FooterIconIDs: array[TTaskDialogFooterIcon] of PChar = (nil, IDI_EXCLAMATION, IDI_QUESTION, IDI_HAND, IDI_INFORMATION, IDI_WINLOGO);
Captions: array[TTaskDialogIcon] of Pointer;
// = (nil, @SMsgDlgWarning, @SMsgDlgConfirm, @SMsgDlgError, @SMsgDlgInformation);
ModalResults: array[TCommonButton] of Integer = (mrOk, mrYes, mrNo, mrCancel, mrRetry, mrAbort);
//(tiBlank, tiWarning, tiQuestion, tiError, tiShield);
//(mtWarning, mtError, mtInformation, mtConfirmation, mtCustom);
function CreateAdvMessageDlg(TaskDialog: TCustomAdvTaskDialog): TForm;
begin
Result := nil;
if not Assigned(TaskDialog) then
Exit;
if TaskDialog.ApplicationIsParent then
Result := TAdvMessageForm.CreateNew(Application,0)
else
Result := TAdvMessageForm.CreateNew((TaskDialog.Owner) as TCustomForm,0);
with Result do
begin
BiDiMode := Application.BiDiMode;
BorderIcons := [];
if doAllowMinimize in TaskDialog.Options then
begin
BorderStyle := bsSingle;
BorderIcons := [biSystemMenu,biMinimize]
end
else
begin
BorderStyle := bsDialog;
end;
if cbCancel in TaskDialog.CommonButtons then
TaskDialog.Options := TaskDialog.Options + [doAllowDialogCancel];
if doAllowDialogCancel in TaskDialog.Options then
begin
BorderIcons := BorderIcons + [biSystemMenu];
end;
if not TaskDialog.ApplicationIsParent then
begin
if ((TaskDialog.Owner) is TForm) then
if ((TaskDialog.Owner) as TForm).FormStyle = fsStayOnTop then
FormStyle := fsStayOnTop;
end;
Canvas.Font := Font;
KeyPreview := True;
OnKeyDown := TAdvMessageForm(Result).CustomKeyDown;
end;
//TaskDialog.Options := TaskDialog.Options + [doAllowDialogCancel];
TAdvMessageForm(Result).MinFormWidth := TaskDialog.NonNativeMinFormWidth;
TAdvMessageForm(Result).BuildTaskDialog(TaskDialog);
end;
//------------------------------------------------------------------------------
function AdvMessageDlgPos(TaskDialog: TCustomAdvTaskDialog; X, Y: Integer): Integer;
var
DlgForm: TAdvMessageForm;
begin
Result := -1;
if not Assigned(TaskDialog) then
Exit;
DlgForm := TAdvMessageForm(CreateAdvMessageDlg(TaskDialog));
DlgForm.OnShow := TaskDialog.TaskDialogFormCreated;
TaskDialog.FDialogForm := DlgForm;
with DlgForm do
try
Color := clWhite;
//HelpContext := HelpCtx;
//HelpFile := HelpFileName;
if X >= 0 then Left := X;
if Y >= 0 then Top := Y;
{$IFDEF DELPHI5_LVL}
if TaskDialog.DialogPosition = dpOwnerFormCenter then
begin
if (Y < 0) and (X < 0) then
Position := poOwnerFormCenter;
end
else
begin
DefaultMonitor := dmMainForm;
if (Y < 0) and (X < 0) then
Position := poScreenCenter;
end;
{$ELSE}
{$ENDIF}
Result := ShowModal;
{$IFNDEF DELPHI6_LVL}
Close;
{$ENDIF}
finally
TaskDialog.FDialogForm := nil;
Free;
end;
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.GetTextSize(Canvas: TCanvas; Text: string;var W, H: Integer);
var
R: TRect;
begin
if (Text = '') then
begin
W := 0;
H := 0;
Exit;
end;
if Assigned(Canvas) then
begin
if W = 0 then
SetRect(R, 0, 0, 1000, 100)
else
SetRect(R, 0, 0, W, 100);
DrawText(Canvas.Handle, PChar(Text), Length(Text)+1, R,
DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or DT_NOPREFIX or
DrawTextBiDiModeFlagsReadingOnly);
W := R.Right;
H := R.Bottom;
end;
end;
//------------------------------------------------------------------------------
const
mcHorzMargin = 8;
mcVertMargin = 8;
mcHorzSpacing = 10;
mcVertSpacing = 10;
mcButtonWidth = 50;
mcButtonHeight = 14;
mcButtonSpacing = 4;
function GetExeName: string;
var
s: string;
fe: string;
begin
s := ExtractFileName(Application.EXEName);
fe := ExtractFileExt(s);
if (Length(fe) > 0) then
delete(s, length(s) - Length(fe) + 1, length(fe));
Result := s;
end;
procedure TAdvMessageForm.BuildTaskDialog(TaskDialog: TCustomAdvTaskDialog);
var
DialogUnits: TPoint;
ButtonWidth, ButtonHeight, ButtonSpacing, ButtonCount, ButtonGroupWidth,
IconTextWidth, IconTextHeight, X, Y, ALeft: Integer;
B, DefaultButton, CancelButton: TCommonButton;
IconID: PChar;
TextRect, FR: TRect;
Msg: string;
DlgType: TTaskDialogIcon;
Buttons: TCommonButtons;
i, bw, bh, h, w, j, FooterIconTextWidth, FooterIconTextHeight: Integer;
CmBtnGroupWidth, CsBtnGroupWidth: Integer;
r, re: trect;
anchor, stripped: string;
HyperLinks,MouseLink, k, l, n: Integer;
Focusanchor: string;
OldFont, hf, pf: TFont;
verifTextWidth: Integer;
v: Boolean;
szContent,szExpandedText,szFooterText: string;
defIdx: integer;
begin
if not Assigned(TaskDialog) then
Exit;
FTaskDialog := TaskDialog;
Msg := TaskDialog.Instruction;
DlgType := TaskDialog.Icon;
Buttons := TaskDialog.CommonButtons;
OldFont := TFont.Create;
OldFont.Assign(Canvas.Font);
DialogUnits := GetAveCharSize(Canvas);
FHorzMargin := MulDiv(mcHorzMargin, DialogUnits.X, 4);
FVertMargin := MulDiv(mcVertMargin, DialogUnits.Y, 8);
FHorzSpacing := MulDiv(mcHorzSpacing, DialogUnits.X, 4);
FVertSpacing := MulDiv(mcVertSpacing, DialogUnits.Y, 8);
w := 0;
if TaskDialog.Title <> '' then
Caption := TaskDialog.Title
else
Caption := GetExeName;
if (Caption <> '') then
begin
w := 1000;
GetTextSize(Canvas, Caption, w, l);
w := w + 50;
end;
ButtonWidth := MulDiv(mcButtonWidth, DialogUnits.X, 4);
ButtonHeight := MulDiv(mcButtonHeight, DialogUnits.Y, 8);
ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X, 4);
CmBtnGroupWidth := 0;
CsBtnGroupWidth := 0;
ButtonCount := 0;
FHorzParaMargin := FHorzMargin;
Y := FVertMargin;
FcmBtnList.Clear;
DefaultButton := cbOk;
if TaskDialog.DefaultButton <> -1 then
begin
if TaskDialog.DefaultButton = 0 then
begin
if (cbOk in Buttons) then DefaultButton := cbOk else
if cbYes in Buttons then DefaultButton := cbYes else
DefaultButton := cbRetry;
if cbCancel in Buttons then CancelButton := cbCancel else
if cbNo in Buttons then CancelButton := cbNo else
CancelButton := cbOk;
end
else
begin
case TaskDialog.DefaultButton of
1: if (cbOk in Buttons) then DefaultButton := cbOK
else
DefaultButton := cbYes;
2: if (cbCancel in Buttons) then DefaultButton := cbCancel
else
DefaultButton := cbNo;
6: if (cbYes in Buttons) then DefaultButton := cbYes;
7: if (cbNo in Buttons) then DefaultButton := cbNo;
end;
end;
end;
for B := Low(TCommonButton) to High(TCommonButton) do
begin
if B in Buttons then
begin
if ButtonWidths[B] = 0 then
begin
TextRect := Rect(0,0,0,0);
Windows.DrawText( Canvas.Handle,
PChar(LoadResString(ButtonCaptions[B])), -1,
TextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or
DrawTextBiDiModeFlagsReadingOnly);
with TextRect do
ButtonWidths[B] := Right - Left + 16;
end;
if ButtonWidths[B] > ButtonWidth then
ButtonWidth := ButtonWidths[B];
i := FcmBtnList.Add(TaskDialog.CreateButton(Self));
with TWinControl(FcmBtnList.Items[i]) do
begin
Name := ButtonNames[B];
Parent := Self;
TaskDialog.SetButtonCaption(TWinControl(FcmBtnList.Items[i]), LoadResString(ButtonCaptions[B]));
TaskDialog.SetButtonModalResult(TWinControl(FcmBtnList.Items[i]), ModalResults[B]);
//ModalResult := ModalResults[B];
if (TaskDialog.GetButtonModalResult(TWinControl(FcmBtnList.Items[i])) = mrCancel) and
(doAllowDialogCancel in TaskDialog.Options) then
TaskDialog.SetButtonCancel(TWinControl(FcmBtnList.Items[i]), True);
//Cancel := true;
if (TaskDialog.DefaultButton <> -1) then
begin
if (B = DefaultButton) then
begin
//Default := True;
TaskDialog.SetButtonDefault(TWinControl(FcmBtnList.Items[i]), True);
TabOrder := 0;
end;
end;
if (B = CancelButton) and (doAllowDialogCancel in TaskDialog.Options) then
TaskDialog.SetButtonCancel(TWinControl(FcmBtnList.Items[i]), True);
Width := Max(60, ButtonWidths[B]);
Height := ButtonHeight;
cmBtnGroupWidth := cmBtnGroupWidth + Width + ButtonSpacing;
//if B = mbHelp then
//OnClick := TMessageForm(Result).HelpButtonClick;
if TaskDialog.DefaultButton = -1 then
TabStop := false;
end;
//Inc(ButtonCount);
end;
end;
FcsBtnList.Clear;
if not (docommandLinks in TaskDialog.Options) then
begin
for i := 0 to TaskDialog.CustomButtons.Count - 1 do
begin
TextRect := Rect(0,0,0,0);
Windows.DrawText( Canvas.Handle,
PChar(TaskDialog.CustomButtons[i]), -1,
TextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or
DrawTextBiDiModeFlagsReadingOnly);
with TextRect do
bw := Right - Left + 16;
if bw > ButtonWidth then
ButtonWidth := bw;
j := FcsBtnList.Add(TaskDialog.CreateButton(Self));
with TWinControl(FcsBtnList.Items[j]) do
begin
Name := 'Button'+inttostr(i);
Parent := Self;
TaskDialog.SetButtonCaption(TWinControl(FcsBtnList.Items[j]), TaskDialog.CustomButtons[i]);
//ModalResult := i + 100; //mrAbort;
TaskDialog.SetButtonModalResult(TWinControl(FcsBtnList.Items[j]), i + 100);
v := (TaskDialog.GetButtonModalResult(TWinControl(FcsBtnList.Items[j])) = TaskDialog.DefaultButton);
TaskDialog.SetButtonDefault(TWinControl(FcsBtnList.Items[j]), V);
//Default := (ModalResult = TaskDialog.DefaultButton);
//if V then
// TabOrder := 0;
//if B = DefaultButton then Default := True;
//if B = CancelButton then Cancel := True;
Width := Max(60, bw);
Height := ButtonHeight;
TProControl(FcsBtnList.Items[j]).OnClick := OnButtonClick;
CsBtnGroupWidth := CsBtnGroupWidth + Width + ButtonSpacing;
if TaskDialog.DefaultButton = -1 then
TabStop := false;
end;
end;
end
else
begin
n := 0;
hf := TFont.Create;
pf := TFont.Create;
hf.Assign(Canvas.Font);
hf.Size := 11;
hf.Style := [fsBold];
pf.Assign(Canvas.Font);
for i := 0 to TaskDialog.CustomButtons.Count-1 do
begin
Canvas.Font.Size := 10;
Canvas.Font.Style := [];
bw := 0;
bh := 0;
GetMultiLineTextSize(Canvas, TaskDialog.CustomButtons[i], Hf, Pf, DrawTextBiDiModeFlagsReadingOnly, bw, bh);
{TextRect := Rect(0,0,0,0);
Windows.DrawText( Canvas.handle,
PChar(TaskDialog.CustomButtons[i]), -1,
TextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or
DrawTextBiDiModeFlagsReadingOnly);
with TextRect do bw := (Right - Left) + 8 + 18;}
bw := bw + 26;
if bw > ButtonWidth then
ButtonWidth := bw;
if bw > n then
n := bw;
if not (doCommandLinksNoIcon in TaskDialog.Options) then
w := Max(w, n + FHorzMargin*2 + FHorzSpacing + 32)
else
w := Max(w, n + FHorzMargin);
j := FcsBtnList.Add(TTaskDialogButton.Create(Self));
with TTaskDialogButton(FcsBtnList.Items[j]) do
begin
Name := 'Button'+inttostr(i);
Parent := Self;
Caption := TaskDialog.CustomButtons[i];
Font.Assign(pf);
Font.Color := RGB(0, 83, 196);
HeadingFont.Assign(hf);
HeadingFont.Color := RGB(0, 83, 196);//RGB(21, 28, 85);
ModalResult := i + 100; //mrAbort;
//Default := (ModalResult = TaskDialog.DefaultButton);
BorderColorHot := RGB(108, 225, 255);
BorderColorDown := RGB(108, 225, 255);
Width := Max(60, n);
if TaskDialog.DefaultButton <> -1 then
AutoFocus := true;
Height := Max(bh, Max(ButtonHeight, Canvas.TextHeight('gh') + 20));
if not (doCommandLinksNoIcon in TaskDialog.Options) then
begin
Picture.LoadFromResourceName(HInstance, 'TD_ARW');
Picture.TransparentColor := clFuchsia;
PictureHot.LoadFromResourceName(HInstance, 'TD_ARWHOT');
PictureHot.TransparentColor := clFuchsia;
PictureDown.LoadFromResourceName(HInstance, 'TD_ARWDOWN');
PictureDown.TransparentColor := clFuchsia;
PictureDisabled.LoadFromResourceName(HInstance, 'TD_ARWDIS');
PictureDisabled.TransparentColor := clFuchsia;
end;
if TaskDialog.DefaultButton = -1 then
TabStop := false
else
TabStop := true;
OnClick := OnButtonClick;
//CsBtnGroupWidth := CsBtnGroupWidth + Width + ButtonSpacing;
end;
end;
Canvas.Font.Assign(OldFont);
hf.Free;
pf.Free;
end;
// if no button then OK button is added
if (FcmBtnList.Count = 0) and (FcsBtnList.Count = 0) then
begin
b := cbOK;
TextRect := Rect(0,0,0,0);
Windows.DrawText( canvas.handle,
PChar(LoadResString(ButtonCaptions[B])), -1,
TextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or
DrawTextBiDiModeFlagsReadingOnly);
with TextRect do ButtonWidths[B] := Right - Left + 8;
//if ButtonWidths[B] > ButtonWidth then
//ButtonWidth := ButtonWidths[B];
i := FcmBtnList.Add(TaskDialog.CreateButton(Self));
with TWinControl(FcmBtnList.Items[i]) do
begin
Name := ButtonNames[B];
Parent := Self;
TaskDialog.SetButtonCaption(TWinControl(FcmBtnList.Items[i]), LoadResString(ButtonCaptions[B]));
TaskDialog.SetButtonModalResult(TWinControl(FcmBtnList.Items[i]), ModalResults[B]);
//ModalResult := ModalResults[B];
//Default := True;
TaskDialog.SetButtonDefault(TWinControl(FcmBtnList.Items[i]), True);
//Cancel := True; // handle ESC
if doAllowDialogCancel in TaskDialog.Options then
TaskDialog.SetButtonCancel(TWinControl(FcmBtnList.Items[i]), True);
Width := Max(60, ButtonWidths[B]);
Height := ButtonHeight;
cmBtnGroupWidth := cmBtnGroupWidth + Width + ButtonSpacing;
//if B = mbHelp then
//OnClick := TMessageForm(Result).HelpButtonClick;
end;
end;
// Instruction
Canvas.Font.Size := 11;
Canvas.Font.Style := [fsBold];
SetRect(TextRect, 0, 0, Screen.Width div 2, 0);
DrawText(Canvas.Handle, PChar(Msg), Length(Msg) + 1, TextRect,
DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or
DrawTextBiDiModeFlagsReadingOnly);
Canvas.Font.Assign(OldFont);
IconID := IconIDs[DlgType];
IconTextWidth := TextRect.Right;
IconTextHeight := TextRect.Bottom;
if IconID <> nil then
begin
Inc(IconTextWidth, 32 + FHorzSpacing);
if IconTextHeight < 32 then IconTextHeight := 32;
end;
{if DlgType <> tiBlank then
Caption := LoadResString(Captions[DlgType]) else
Caption := Application.Title;}
if ((IconID <> nil) or not (TaskDialog.CustomIcon.Empty)) {and not (doCommandLinksNoIcon in TaskDialog.Options)} then
begin
FIcon := TImage.Create(Self);
with FIcon do
begin
Name := 'Image';
Parent := Self;
if not TaskDialog.CustomIcon.Empty then
begin
Picture.Icon.Assign(TaskDialog.CustomIcon);
end
else
begin
case TaskDialog.Icon of
tiShield: Picture.Bitmap.Handle := LoadBitmap(hInstance, 'TD_SHIELD');
tiBlank:
begin
Picture.Bitmap.Height := 32;
Picture.Bitmap.Width := 32;
Picture.Bitmap.Canvas.Brush.Color := clWhite;
Picture.Bitmap.Canvas.Pen.Style := psClear;
Picture.Bitmap.Canvas.Rectangle(0,0,31,31);
end;
else
Picture.Icon.Handle := LoadIcon(0, IconID);
end;
end;
SetBounds(FHorzMargin, Y, 32, 32);
end;
end;
Message := TLabel.Create(Self);
with Message do
begin
Name := 'Instr';
Parent := Self;
{$IFDEF DELPHI7_LVL}
WordWrap := True;
{$ENDIF}
Caption := Msg;
Font.Size := 11;
Font.Color := RGB(0, 83, 196);
Font.Style := [fsBold];
BoundsRect := TextRect;
BiDiMode := Self.BiDiMode;
ShowAccelChar := false;
ALeft := IconTextWidth - TextRect.Right + FHorzMargin;
if UseRightToLeftAlignment then
ALeft := Self.ClientWidth - ALeft - Width;
SetBounds(ALeft, Y,
TextRect.Right, TextRect.Bottom);
y := Y + Height + FVertSpacing;
FHorzParaMargin := ALeft;
end;
if (doTimer in TaskDialog.Options) then
begin
FTimer := TTimer.Create(Self);
FTimer.Interval := 100;
FTimer.OnTimer := OnTimer;
FTimer.Enabled := True;
end;
if (doProgressBar in TaskDialog.Options) then
begin
FProgressBar := TProgressBar.Create(Self);
with FProgressBar do
begin
Name := 'ProgressBar';
Parent := Self;
BoundsRect := Rect(FHorzMargin, Y, Width - FHorzMargin, Y + 12);
Min := TaskDialog.ProgressBarMin;
Max := TaskDialog.ProgressBarMax;
Position := 0;
end;
if not Assigned(FTimer) then
begin
FTimer := TTimer.Create(Self);
FTimer.Interval := 100;
FTimer.OnTimer := OnTimer;
FTimer.Enabled := True;
end;
end;
if (TaskDialog.RadioButtons.Count > 0) then
begin
if (doNodefaultRadioButton in FTaskDialog.Options) then
FTaskDialog.RadioButtonResult := 0
else
FTaskDialog.RadioButtonResult := FTaskDialog.DefaultRadioButton;
for i := 0 to TaskDialog.RadioButtons.Count-1 do
begin
j := FRadioList.Add(FTaskDialog.CreateRadioButton(Self));
TaskDialog.InitRadioButton(self, TWinControl(FRadioList.Items[j]), i, OnRadioClick);
with TWinControl(FRadioList.Items[j]) do
begin
(*
Name := 'Radio' + inttostr(i);
Parent := Self;
Font.Name := Canvas.Font.Name;
Font.Size := 8;
{$IFDEF DELPHI7_LVL}
//WordWrap := False;
{$ENDIF}
OnClick := OnRadioClick;
BiDiMode := Self.BiDiMode;
*)
BoundsRect := TextRect;
Left := FHorzParaMargin + FHorzMargin; //ALeft + FHorzMargin;
Top := Y;
Width := Self.Width - Left - 4;
GetTextSize(Canvas, Caption, k, l);
w := Max(w, Left + k + FHorzMargin + 20);
end;
TaskDialog.SetRadioButtonCaption(FRadioList.Items[j],TaskDialog.RadioButtons[i]);
if doNoDefaultRadioButton in TaskDialog.Options then
TaskDialog.SetRadioButtonState(FRadioList.Items[j], False)
else
begin
if (TaskDialog.DefaultRadioButton > 0) then
TaskDialog.SetRadioButtonState(FRadioList.Items[j], (j + 200 = TaskDialog.DefaultRadioButton))
else
begin
TaskDialog.SetRadioButtonState(FRadioList.Items[j], (i = 0));
end;
end;
(*
with TRadioButton(FRadioList.Items[j]) do
begin
if doNoDefaultRadioButton in TaskDialog.Options then
Checked := False
else
begin
if (TaskDialog.DefaultRadioButton > 0) then
Checked := (j + 200 = TaskDialog.DefaultRadioButton)
else
begin
Checked := (i = 0);
end;
end;
end;
*)
end;
end;
if (TaskDialog.ExpandedText <> '') then
begin
(*FExpandLabel := TLabel.Create(Self);
with FExpandLabel do
begin
Name := 'Expand';
Parent := Self;
{$IFDEF DELPHI7_LVL}
WordWrap := True;
{$ENDIF}
ShowAccelChar := false;
BiDiMode := Self.BiDiMode;
FExpandLabel.Caption := TaskDialog.ExpandedText;
Left := ALeft;
Top := Y;
end; *)
FExpTextXSize := 0;
FExpTextYSize := 0;
r := Rect(FHorzMargin, Y, 300, Y + 26);
if (doHyperlinks in FTaskDialog.Options) then
begin
szExpandedText := StringReplace(FTaskDialog.ExpandedText,'\n','<br>',[rfReplaceAll]);
szExpandedText := StringReplace(szExpandedText,#10,'<br>',[rfReplaceAll]);
HTMLDrawEx(Canvas, szExpandedText, r, nil, x, y, -1, -1, 1, true, false, false, true, true, false, true,
1.0, clBlue, clNone, clNone, clGray, anchor, stripped, focusanchor, FExpTextXSize, FExpTextYSize, hyperlinks,
mouselink, re, nil, nil, 0);
end
else
begin
szExpandedText := StringReplace(FTaskDialog.ExpandedText,'\n',#13,[rfReplaceAll]);
FExpTextXSize := r.Right - r.Left;
//szContent := StringReplace(FTaskDialog.Content,'\n',#13,[rfReplaceAll]);
//GetTextSize(Canvas, szContent, FExpTextXSize, FExpTextYSize);
GetTextSize(Canvas, szExpandedText, FExpTextXSize, FExpTextYSize);
end;
FExpandButton := TTaskDialogButton.Create(Self);
with FExpandButton do
begin
Name := 'ExpandButton';
Parent := Self;
Caption := '';
ModalResult := mrNone;
Width := 19;
Height := 19;
OnClick := OnExpandButtonClick;
Picture.LoadFromResourceName(HInstance, 'TD_COLP');
Picture.TransparentColor := clFuchsia;
PictureHot.LoadFromResourceName(HInstance, 'TD_COLPHOT');
PictureHot.TransparentColor := clFuchsia;
PictureDown.LoadFromResourceName(HInstance, 'TD_COLPDOWN');
PictureDown.TransparentColor := clFuchsia;
end;
end;
verifTextWidth := 0;
if (TaskDialog.VerificationText <> '') then
begin
k := 0;
FVerificationCheck := TCheckBox.Create(Self);
with FVerificationCheck do
begin
Name := 'Verification';
Parent := Self;
{$IFDEF DELPHI7_LVL}
WordWrap := False;
{$ENDIF}
BoundsRect := TextRect;
BiDiMode := Self.BiDiMode;
Caption := TaskDialog.VerificationText;
Left := FHorzMargin;
Top := Y;
Color := RGB(240, 240, 240);
OnClick := OnVerifyClick;
Checked := (doVerifyChecked in TaskDialog.Options);
GetTextSize(Canvas, Caption, k, l);
verifTextWidth := k + FVertSpacing *2;
w := Max(w, Left + k);
end;
end;
FFooterXSize := 0;
FFooterYSize := 0;
if (TaskDialog.Footer <> '') then
begin
r := Rect(FHorzMargin, Y, 300, Y + 26);
szFooterText := StringReplace(FTaskDialog.Footer,'\n','<br>',[rfReplaceAll]);
szFooterText := StringReplace(szFooterText,#10,'<br>',[rfReplaceAll]);
HTMLDrawEx(Canvas, szFooterText, r, nil, x, y, -1, -1, 1, true, false, false, true, true, false, true,
1.0, clBlue, clNone, clNone, clGray, anchor, stripped, focusanchor, FFooterXSize, FFooterYSize, hyperlinks,
mouselink, re, nil, nil, 0);
IconID := FooterIconIDs[TaskDialog.FooterIcon];
FooterIconTextWidth := TextRect.Right;
FooterIconTextHeight := TextRect.Bottom;
if IconID <> nil then
begin
Inc(FooterIconTextWidth, 24 + FHorzSpacing);
if FooterIconTextHeight < 24 then FooterIconTextHeight := 24;
end;
if IconID <> nil then
begin
FFooterIcon := TImage.Create(Self);
FFooterIconID := IconID;
with FFooterIcon do
begin
Name := 'FooterImage';
Parent := Self;
Visible := False;
SetBounds(FHorzMargin, Y, 16, 16);
end;
end;
end;
ButtonGroupWidth := CmBtnGroupWidth + CsBtnGroupWidth + verifTextWidth;
if (TaskDialog.ExpandedText <> '') and Assigned(FExpandButton) then
begin
k := 0;
l := 0;
GetTextSize(Canvas, FTaskDialog.CollapsControlText, k, l);
GetTextSize(Canvas, FTaskDialog.ExpandControlText, n, l);
k := Max(k, n);
ButtonGroupWidth := ButtonGroupWidth + FExpandButton.Width + FHorzSpacing + k + FHorzSpacing;
end;
if TaskDialog.Content = '' then
Y := Y - 20;
case TaskDialog.InputType of
itEdit:
begin
FInputEdit := TEdit.Create(self);
FInputEdit.Parent := Self;
FInputEdit.TabStop := true;
FInputEdit.Text := TaskDialog.InputText;
ALeft := IconTextWidth - TextRect.Right + FHorzMargin;
if UseRightToLeftAlignment then
ALeft := Self.ClientWidth - ALeft - Width;
FInputEdit.SetBounds(ALeft, Y + 20, ClientWidth - ALeft, 20);
end;
itComboEdit, itComboList:
begin
FInputCombo := TComboBox.Create(self);
FInputCombo.Parent := Self;
FInputCombo.TabStop := true;
FInputCombo.Text := TaskDialog.InputText;
FInputCombo.Items.Assign(TaskDialog.InputItems);
if TaskDialog.InputType = itComboList then
begin
FInputCombo.Style := csDropDownList;
FInputCombo.ItemIndex := FInputCombo.Items.IndexOf(TaskDialog.InputText);
end;
ALeft := IconTextWidth - TextRect.Right + FHorzMargin;
if UseRightToLeftAlignment then
ALeft := Self.ClientWidth - ALeft - Width;
FInputCombo.SetBounds(ALeft, Y + 20, ClientWidth - ALeft, 20);
end;
itDate:
begin
FInputDate := TDateTimePicker.Create(self);
FInputDate.Parent := Self;
FInputDate.TabStop := true;
ALeft := IconTextWidth - TextRect.Right + FHorzMargin;
if UseRightToLeftAlignment then
ALeft := Self.ClientWidth - ALeft - Width;
FInputDate.Top := Y + 20;
FInputDate.Left := ALeft;
end;
itMemo:
begin
FInputMemo := TMemo.Create(self);
FInputMemo.Parent := Self;
FInputMemo.TabStop := true;
FInputMemo.WantReturns := false;
FInputMemo.Lines.Text := TaskDialog.InputText;
ALeft := IconTextWidth - TextRect.Right + FHorzMargin;
if UseRightToLeftAlignment then
ALeft := Self.ClientWidth - ALeft - Width;
FInputMemo.SetBounds(ALeft, Y + 20, ClientWidth - ALeft, 60);
end;
itCustom:
begin
if Assigned(TaskDialog.InputControl) then
begin
FOldParent := TaskDialog.InputControl.Parent;
TaskDialog.InputControl.Parent := self;
TaskDialog.InputControl.Visible := true;
if Assigned(TaskDialog.OnDialogInputSetText) then
TaskDialog.OnDialogInputSetText(TaskDialog, TaskDialog.InputText)
else
SetWindowText(TaskDialog.InputControl.Handle, Pchar(TaskDialog.InputText));
ALeft := IconTextWidth - TextRect.Right + FHorzMargin;
if UseRightToLeftAlignment then
ALeft := Self.ClientWidth - ALeft - Width;
TaskDialog.InputControl.Left := ALeft;
TaskDialog.InputControl.Top := Y + 20;
if TaskDialog.InputControl.Width + ALeft > self.Width then
w := TaskDialog.InputControl.Width + ALeft + ALeft;
//TaskDialog.InputControl.SetBounds(ALeft, Y + 20, ClientWidth - ALeft, 20);
end;
end;
end;
//-- setting Form Width
k := Max(FFooterXSize, Max(IconTextWidth, ButtonGroupWidth)) + FHorzMargin * 2;
k := Max(FExpTextXSize + FHorzMargin * 2, k);
w := Max(w, k);
w := Max(w, FMinFormWidth);
if w > (Screen.Width - 2 * GetSystemMetrics(SM_CYEDGE)) then
w := Screen.Width - 2 * GetSystemMetrics(SM_CYEDGE);
// if w > 800 then
// w := 800;
ClientWidth := w;
if (TaskDialog.InputType = itCustom) and Assigned(TaskDialog.InputControl) then
begin
if TaskDialog.InputControl.Width > ClientWidth - ALeft then
TaskDialog.InputControl.Width := ClientWidth - ALeft;
end;
if (doProgressBar in TaskDialog.Options) then
begin
FProgressBar.Width := ClientWidth - FHorzMargin*2;
end;
SetPositions;
if (TaskDialog.ExpandedText <> '') then
begin
SetExpanded((doExpandedDefault in TaskDialog.Options));
end;
Left := (Screen.Width div 2) - (Width div 2);
Top := (Screen.Height div 2) - (Height div 2);
OldFont.Free;
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.UpdateDialog;
var
DialogUnits: TPoint;
ButtonSpacing, ButtonGroupWidth, IconTextWidth, X, Y: Integer;
IconID: PChar;
TextRect: TRect;
Msg: string;
DlgType: TTaskDialogIcon;
Buttons: TCommonButtons;
i, w: Integer;
CmBtnGroupWidth, CsBtnGroupWidth: Integer;
r, re: trect;
anchor, stripped: string;
HyperLinks,MouseLink, k, l, n: Integer;
Focusanchor,szFooterText: string;
OldFont: TFont;
begin
if not Assigned(FTaskDialog) then
Exit;
Msg := FTaskDialog.Instruction;
DlgType := FTaskDialog.Icon;
Buttons := FTaskDialog.CommonButtons;
OldFont := TFont.Create;
OldFont.Assign(Canvas.Font);
DialogUnits := GetAveCharSize(Canvas);
w := 0;
if FTaskDialog.Title <> '' then
Caption := FTaskDialog.Title
else
Caption := GetExeName;
if (Caption <> '') then
begin
w := 1000;
GetTextSize(Canvas, Caption, w, l);
w := w + 50;
end;
ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X, 4);
CmBtnGroupWidth := 0;
CsBtnGroupWidth := 0;
Y := FVertMargin;
//ALeft := 0;
for i := 0 to FcmBtnList.Count-1 do
begin
CmBtnGroupWidth := CmBtnGroupWidth + TButton(FcmBtnList.Items[i]).Width + ButtonSpacing;
end;
if not (docommandLinks in FTaskDialog.Options) then
begin
for i := 0 to FcsBtnList.Count-1 do
begin
CsBtnGroupWidth := CsBtnGroupWidth + TButton(FcsBtnList.Items[i]).Width + ButtonSpacing;
end;
end
else
begin
end;
// Instruction
Canvas.Font.Size := 11;
Canvas.Font.Style := [fsBold];
SetRect(TextRect, 0, 0, Screen.Width div 2, 0);
DrawText(Canvas.Handle, PChar(Msg), Length(Msg) + 1, TextRect,
DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or
DrawTextBiDiModeFlagsReadingOnly);
Canvas.Font.Assign(OldFont);
IconID := IconIDs[DlgType];
IconTextWidth := TextRect.Right;
if (IconId <> nil) then
begin
Inc(IconTextWidth, 32 + FHorzSpacing);
end;
if Assigned(Message) then
begin
Message.Caption := Msg;
//ALeft := IconTextWidth - TextRect.Right + FHorzMargin;
//if UseRightToLeftAlignment then
//ALeft := Self.ClientWidth - ALeft - Width;
y := Y + Height + FVertSpacing;
end;
if (FTaskDialog.RadioButtons.Count > 0) then
begin
FTaskDialog.RadioButtonResult := FTaskDialog.DefaultRadioButton;
for i := 0 to FRadioList.Count - 1 do
begin
with TRadioButton(FRadioList.Items[i]) do
begin
BoundsRect := TextRect;
Left := FHorzParaMargin + FHorzMargin;
Top := Y;
Width := Self.Width - Left - 4;
GetTextSize(Canvas, Caption, k, l);
w := Max(w, Left + k + FHorzMargin + 20);
end;
end;
end;
{if (FTaskDialog.ExpandedText <> '') and Assigned(FExpandLabel) then
begin
with FExpandLabel do
begin
Left := ALeft;
Top := Y;
FExpandLabel.Caption := FTaskDialog.ExpandedText;
end;
end; }
if (FTaskDialog.VerificationText <> '') and Assigned(FVerificationCheck) then
begin
k := 0;
with FVerificationCheck do
begin
BoundsRect := TextRect;
Caption := FTaskDialog.VerificationText;
Left := FHorzMargin;
Top := Y;
GetTextSize(Canvas, Caption, k, l);
w := Max(w, Left + k);
end;
end;
FFooterXSize := 0;
FFooterYSize := 0;
if (FTaskDialog.Footer <> '') then
begin
r := Rect(FHorzMargin, Y, 300, Y + 26);
x := 0;
szFooterText := StringReplace(FTaskDialog.Footer,'\n','<br>',[rfReplaceAll]);
szFooterText := StringReplace(szFooterText,#10,'<br>',[rfReplaceAll]);
HTMLDrawEx(Canvas, szFooterText, r, nil, x, y, -1, -1, 1, true, false, false, true, true, false, true,
1.0, clBlue, clNone, clNone, clGray, anchor, stripped, focusanchor, FFooterXSize, FFooterYSize, hyperlinks,
mouselink, re, nil, nil, 0);
if Assigned(FFooterIcon) then
begin
FFooterIcon.SetBounds(FHorzMargin, Y, 16, 16);
end;
end;
ButtonGroupWidth := CmBtnGroupWidth + CsBtnGroupWidth;
if (FTaskDialog.ExpandedText <> '') and Assigned(FExpandButton) then
begin
k := 0;
l := 0;
GetTextSize(Canvas, FTaskDialog.CollapsControlText, k, l);
GetTextSize(Canvas, FTaskDialog.ExpandControlText, n, l);
k := Max(k, n);
ButtonGroupWidth := ButtonGroupWidth + FExpandButton.Width + FHorzSpacing + k + FHorzSpacing;
end;
//-- setting Form Width
k := Max(FFooterXSize, Max(IconTextWidth, ButtonGroupWidth)) + FHorzMargin * 2;
w := Max(w, k);
w := Max(w, FMinFormWidth);
ClientWidth := w;
if (doProgressBar in FTaskDialog.Options) and Assigned(FProgressBar) then
begin
FProgressBar.Width := ClientWidth - FHorzMargin*2;
end;
SetPositions;
OldFont.Free;
Invalidate;
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.SetPositions;
var
DialogUnits: TPoint;
HorzMargin, VertMargin, VertSpacing, ButtonSpacing, ButtonGroupWidth, X, Y: Integer;
i, h: Integer;
CmBtnGroupWidth, CsBtnGroupWidth, BtnH: Integer;
X1, y1: Integer;
r, re, rc: trect;
anchor, stripped: string;
HyperLinks,MouseLink: Integer;
Focusanchor: string;
ExpTextTop, verifTextWidth, k, l: Integer;
szContent: string;
szExpandedText,szFooterText: string;
//lbl:TLabel;
//ExH: integer;
begin
if not Assigned(FTaskDialog) then
Exit;
DialogUnits := GetAveCharSize(Canvas);
HorzMargin := MulDiv(mcHorzMargin, DialogUnits.X, 4);
VertMargin := MulDiv(mcVertMargin, DialogUnits.Y, 8);
VertSpacing := MulDiv(mcVertSpacing, DialogUnits.Y, 8);
ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X, 4);
CmBtnGroupWidth := 0;
CsBtnGroupWidth := 0;
Y := VertMargin;
{$IFDEF DELPHI7_LVL}
Message.Transparent := true;
{$ENDIF}
// Instruction Label
if (Message.Caption <> '') then
y := Y + Message.Height + VertSpacing
else
Message.Visible := False;
if (FTaskDialog.Content <> '') then
begin
//FContent.Width := ClientWidth - FContent.Left - HorzMargin;
//FContent.Top := Y;
//Y := Y + FContent.Height + VertSpacing;
X1 := 0;
Y1 := 0;
r := GetContentRect;
r := Rect(r.Left, Y, R.Right, Y + 26);
if (doHyperlinks in FTaskDialog.Options) then
begin
szContent := StringReplace(FTaskDialog.Content,'\n','<br>',[rfReplaceAll]);
szContent := StringReplace(szContent,#10,'<br>',[rfReplaceAll]);
HTMLDrawEx(Canvas, szContent, r, nil, x1, y1, -1, -1, 1, true, true, false, true, true, false, true,
1.0, clBlue, clNone, clNone, clGray, anchor, stripped, focusanchor, FContentXSize, FContentYSize, hyperlinks,
mouselink, re, nil, nil, 0);
end
else
begin
if HasLf(FTaskDialog.Content) then
szContent := StringReplace(FTaskDialog.Content,'\n',#13,[rfReplaceAll])
else
szContent := FTaskDialog.Content;
{
if (Message.Caption <> '') then
FContentXSize := Message.Width
else
FContentXSize := 360;
if FContentXSize < 360 then
FContentXSize := 360;
}
FContentXSize := r.Right - r.Left;
GetTextSize(Canvas, szContent, FContentXSize, FContentYSize);
end;
rc := GetContentRect;
if (fContentXSize > rc.Right - rc.Left) then
ClientWidth := ClientWidth + (fContentXSize - (rc.Right - rc.Left));
y1 := FContentYSize;
if (Message.Caption = '') and Assigned(FIcon) then
begin
y1 := Max(FIcon.Height, Y1);
end;
Y := Y + Y1 + VertSpacing;
case FTaskDialog.InputType of
itEdit: FInputEdit.Top := Y - 10;
itComboEdit,itComboList: FInputCombo.Top := Y - 10;
itDate: FInputDate.Top := Y - 10;
itMemo: FInputMemo.Top := Y - 10;
itCustom: if Assigned(FTaskDialog.InputControl) then
FTaskDialog.InputControl.Top := Y - 10;
end;
end
else
begin
if (FTaskDialog.RadioButtons.Count = 0) and not (doCommandLinks in FTaskDialog.Options) then
Y := Y + VertSpacing;
if (Message.Caption = '') and Assigned(FIcon) then
Y := Y + VertSpacing + VertMargin;
end;
if (FTaskDialog.InputType in [itEdit, itComboEdit, itComboList, itDate]) then
begin
Y := Y + 30;
end;
if (FTaskDialog.InputType in [itMemo]) then
begin
Y := Y + 70;
end;
if (FTaskDialog.InputType in [itCustom]) then
begin
if Assigned(FTaskDialog.InputControl) then
Y := Y + FTaskDialog.InputControl.Height + 10
else
Y := Y + 30;
end;
if (doProgressBar in FTaskDialog.Options) then
begin
if Assigned(FIcon) then
begin
Y := Max(Y, FIcon.Top + FIcon.Height+3);
end;
FProgressBar.Top := Y;
Y := Y + FProgressBar.Height + VertSpacing;
end;
if (FTaskDialog.RadioButtons.Count > 0) then
begin
for i:= 0 to FRadioList.Count-1 do
begin
TRadioButton(FRadioList.Items[i]).Top := Y;
TRadioButton(FRadioList.Items[i]).Width := ClientWidth - TRadioButton(FRadioList.Items[i]).Left - HorzMargin;
Y := Y + TRadioButton(FRadioList.Items[i]).Height + 4;
end;
Y := Y + VertSpacing - 4;
end;
FExpTextXSize := 0;
FExpTextYSize := 0;
ExpTextTop := 0;
if (FTaskDialog.ExpandedText <> '') then
begin
if FExpanded then
begin
(*lbl := TLabel.Create(self);
{$IFDEF DELPHI7_LVL}
lbl.WordWrap := true;
{$ENDIF}
lbl.Width := ClientWidth - FExpandLabel.Left - HorzMargin;
lbl.Caption := FTaskDialog.FExpandedText;
ExH := lbl.Height;
lbl.Free;
FExpandLabel.Top := Y;
FExpandLabel.Width := ClientWidth - FExpandLabel.Left - HorzMargin;
FExpandLabel.Height := ExH;
Y := Y + FExpandLabel.Height + VertSpacing;
FExpandLabel.Visible := True;
*)
X1 := 0;
Y1 := 0;
r := GetExpTextRect;
r := Rect(r.Left, Y, R.Right, Y + 26);
if (doHyperlinks in FTaskDialog.Options) then
begin
szExpandedText := StringReplace(FTaskDialog.ExpandedText,'\n','<br>',[rfReplaceAll]);
szExpandedText := StringReplace(szExpandedText,#10,'<br>',[rfReplaceAll]);
HTMLDrawEx(Canvas, szExpandedText, r, nil, x1, y1, -1, -1, 1, true, true, false, true, true, false, true,
1.0, clBlue, clNone, clNone, clGray, anchor, stripped, focusanchor, FExpTextXSize, FExpTextYSize, hyperlinks,
mouselink, re, nil, nil, 0);
end
else
begin
szExpandedText := StringReplace(FTaskDialog.ExpandedText,'\n',#13,[rfReplaceAll]);
FExpTextXSize := r.Right - r.Left;
GetTextSize(Canvas, szExpandedText, FExpTextXSize, FExpTextYSize);
end;
ExpTextTop := Y;
FExpTextTop := ExpTextTop;
Y := Y + FExpTextYSize + VertSpacing;
end
else
begin
//FExpandLabel.Visible := False;
end;
end;
if not (docommandLinks in FTaskDialog.Options) then
begin
for i:= 0 to FcsBtnList.Count-1 do
begin
CsBtnGroupWidth := CsBtnGroupWidth + TButton(FcsBtnList.Items[i]).Width{ + ButtonSpacing};
end;
if (FcsBtnList.Count > 0) then
CsBtnGroupWidth := CsBtnGroupWidth + (FcsBtnList.Count-1) * ButtonSpacing;
end
else
begin
for i:= 0 to FcsBtnList.Count-1 do
begin
if Assigned(FIcon) then
TTaskDialogButton(FcsBtnList.Items[i]).Left := FHorzParaMargin; // FIcon.Left + FIcon.Width + FHorzSpacing;
TTaskDialogButton(FcsBtnList.Items[i]).Top := Y;
TTaskDialogButton(FcsBtnList.Items[i]).Width := ClientWidth - TTaskDialogButton(FcsBtnList.Items[i]).Left - HorzMargin;
Y := Y + TTaskDialogButton(FcsBtnList.Items[i]).Height + 2;
end;
FWhiteWindowHeight := Y;
Y := Y + VertSpacing;
end;
for i := 0 to FcmBtnList.Count-1 do
begin
CmBtnGroupWidth := CmBtnGroupWidth + TButton(FcmBtnList.Items[i]).Width{ + ButtonSpacing};
end;
CmBtnGroupWidth := CmBtnGroupWidth + (FcmBtnList.Count-1) * ButtonSpacing;
verifTextWidth := 0;
if (FTaskDialog.VerificationText <> '') then
begin
GetTextSize(Canvas, FTaskDialog.VerificationText, k, l);
verifTextWidth := k + FVertSpacing * 2;
end;
ButtonGroupWidth := CsBtnGroupWidth + CmBtnGroupWidth;
X := (ClientWidth - ButtonGroupWidth - FHorzSpacing - 4); //(ClientWidth - ButtonGroupWidth) div 2;
h := Y;
BtnH := 0;
if (FTaskDialog.ExpandedText <> '') then
begin
X := (ClientWidth - ButtonGroupWidth - FHorzSpacing - 4);
{
k := 0;
l := 0;
GetTextSize(Canvas, FTaskDialog.CollapsControlText, k, l);
GetTextSize(Canvas, FTaskDialog.ExpandControlText, n, l);
k := Max(k, n);
ButtonGroupWidth := ButtonGroupWidth + FExpandButton.Width + ButtonSpacing + k + FHorzSpacing;
}
end;
if (FTaskDialog.ExpandedText <> '') then
begin
with FExpandButton do
begin
Top := Y;
Left := FVertMargin; //X;
//Inc(X, FExpandButton.Width + ButtonSpacing);
if (FExpandButton.Height > BtnH) then
BtnH := FExpandButton.Height;
end;
end;
if (FTaskDialog.VerificationText <> '') and Assigned(FVerificationCheck) then
begin
FVerificationCheck.Width := verifTextWidth - FVertSpacing; //ClientWidth - FVerificationCheck.Left - HorzMargin;
FVerificationCheck.Top := Y + BtnH;
FVerificationCheck.Left := FVertMargin + 3;
//X := FVerificationCheck.Left + FVerificationCheck.Width + FVertMargin;
end;
if not (docommandLinks in FTaskDialog.Options) then
begin
for i:= 0 to FcsBtnList.Count-1 do
begin
with TButton(FcsBtnList.Items[i]) do
begin
Top := Y;
Left := X;
Inc(X, TButton(FcsBtnList.Items[i]).Width + ButtonSpacing);
//if (i = 0) then
//h := h + TButton(FcsBtnList.Items[i]).Height;
if (TButton(FcsBtnList.Items[i]).Height > BtnH) then
BtnH := TButton(FcsBtnList.Items[i]).Height;
end;
end;
if (FcsBtnList.Count > 0) then
FWhiteWindowHeight := TButton(FcsBtnList.items[0]).Top{ - (FVertSpacing div 2)};
end;
for i := 0 to FcmBtnList.Count-1 do
begin
with TButton(FcmBtnList.Items[i]) do
begin
Top := Y;
Left := X;
Inc(X, TButton(FcmBtnList.Items[i]).Width + ButtonSpacing);
//if (i = 0) then
//h := h + TButton(FcmBtnList.Items[i]).Height;
if (TButton(FcmBtnList.Items[i]).Height > BtnH) then
BtnH := TButton(FcmBtnList.Items[i]).Height;
end;
if (FcmBtnList.Count > 0) then
FWhiteWindowHeight := TButton(FcmBtnList.items[0]).Top{ - (FVertSpacing div 2)};
end;
if (FTaskDialog.VerificationText <> '') and Assigned(FVerificationCheck) then
begin
h := h + Max(BtnH, FVerificationCheck.Height + VertSpacing);
y := y + Max(BtnH + FVertSpacing, FVerificationCheck.Height + VertSpacing);
end
else
begin
h := h + BtnH;
if (BtnH > 0) then
y := y + BtnH + FVertSpacing;
end;
if (FTaskDialog.Footer <> '') then
begin
X1 := 0;
Y1 := 0;
if Assigned(FFooterIcon) then
r := Rect(HorzMargin + 20, Y, Width - HorzMargin, Y + 100)
else
r := Rect(HorzMargin, Y, Width - HorzMargin, Y + 100);
szFooterText := StringReplace(FTaskDialog.Footer,'\n','<br>',[rfReplaceAll]);
szFooterText := StringReplace(szFooterText,#10,'<br>',[rfReplaceAll]);
HTMLDrawEx(Canvas, szFooterText, r, nil, x1, y1, -1, -1, 1, true, false, false, true, true, false, true,
1.0, clBlue, clNone, clNone, clGray, anchor, stripped, focusanchor, FFooterXSize, FFooterYSize, hyperlinks,
mouselink, re, nil, nil, 0);
y1 := FFooterYSize;
if Assigned(FFooterIcon) then
begin
FFooterIcon.Top := Y;
y1 := Max(Y1, 20);
end;
h := h + Y1 + VertSpacing;
end;
h := h + VertMargin;
ClientHeight := h;
if (FcmBtnList.Count = 0) and ((docommandLinks in FTaskDialog.Options) or (not (docommandLinks in FTaskDialog.Options) and (FcsBtnList.Count = 0))) then
FWhiteWindowHeight := Height;
if (ExpTextTop > 0) and (doExpandedFooter in FTaskDialog.Options) then
FWhiteWindowHeight := ExpTextTop;
end;
//------------------------------------------------------------------------------
constructor TAdvMessageForm.CreateNew(AOwner: TComponent; Dummy: Integer);
var
NonClientMetrics: TNonClientMetrics;
begin
inherited CreateNew(AOwner);
NonClientMetrics.cbSize := sizeof(NonClientMetrics);
if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
Font.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont);
FExpandButton := nil;
FExpanded := true;
//FExpandLabel := nil;
FExpandControlText := '';
FCollapsControlText := '';
FcmBtnList := TList.Create;
FcsBtnList := TList.Create;
FRadioList := TList.Create;
FFooterXSize := 0;
FFooterYSize := 0;
FWhiteWindowHeight := Height;
FHorzParaMargin := 0;
FMinFormWidth := 350;
end;
//------------------------------------------------------------------------------
{procedure TAdvMessageForm.HelpButtonClick(Sender: TObject);
begin
Application.HelpContext(HelpContext);
end;}
//------------------------------------------------------------------------------
procedure TAdvMessageForm.CustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if ((ssAlt in Shift) and (Key = VK_F4)) then
Key := 0;
if (Shift = [ssCtrl]) and (Key = Word('C')) then
begin
Beep;
WriteToClipBoard(GetFormText);
end;
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.WMActivate(var M: TWMActivate);
begin
// only do this when parent form is topmost
SetWindowPos( Handle, HWND_TOP, 0,0,0,0, SWP_NOMOVE or SWP_NOSIZE );
end;
procedure TAdvMessageForm.WriteToClipBoard(Text: String);
var
Data: THandle;
DataPtr: Pointer;
begin
if OpenClipBoard(0) then
begin
try
Data := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, Length(Text) + 1);
try
DataPtr := GlobalLock(Data);
try
Move(PChar(Text)^, DataPtr^, Length(Text) + 1);
EmptyClipBoard;
SetClipboardData(CF_TEXT, Data);
finally
GlobalUnlock(Data);
end;
except
GlobalFree(Data);
raise;
end;
finally
CloseClipBoard;
end;
end
else
raise Exception.CreateRes(@SCannotOpenClipboard);
end;
//------------------------------------------------------------------------------
function TAdvMessageForm.GetFormText: String;
var
DividerLine, ButtonCaptions: string;
I: integer;
begin
DividerLine := StringOfChar('-', 27) + sLineBreak;
for I := 0 to ComponentCount - 1 do
if Components[I] is TButton then
ButtonCaptions := ButtonCaptions + TButton(Components[I]).Caption +
StringOfChar(' ', 3);
ButtonCaptions := StringReplace(ButtonCaptions,'&','', [rfReplaceAll]);
Result := Format('%s%s%s%s%s%s%s%s%s%s', [DividerLine, Caption, sLineBreak,
DividerLine, Message.Caption, sLineBreak, DividerLine, ButtonCaptions,
sLineBreak, DividerLine]);
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.SetExpandButton(const Value: TTaskDialogButton);
begin
if Assigned(FExpandButton) then
FExpandButton.OnClick := nil;
FExpandButton := Value;
if Assigned(FExpandButton) then
FExpandButton.OnClick := OnExpandButtonClick;
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.OnExpandButtonClick(Sender: TObject);
begin
if Assigned(FExpandButton) then
begin
SetExpanded(not Expanded);
end;
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.SetExpanded(Value: Boolean);
begin
if FExpanded then
begin
if not Value then
begin
FExpandButton.Picture.LoadFromResourceName(HInstance, 'TD_EXP');
FExpandButton.Picture.TransparentColor := clFuchsia;
FExpandButton.PictureHot.LoadFromResourceName(HInstance, 'TD_EXPHOT');
FExpandButton.PictureHot.TransparentColor := clFuchsia;
FExpandButton.PictureDown.LoadFromResourceName(HInstance, 'TD_EXPDOWN');
FExpandButton.PictureDown.TransparentColor := clFuchsia;
end;
end
else
begin
if Value then
begin
FExpandButton.Picture.LoadFromResourceName(HInstance, 'TD_COLP');
FExpandButton.Picture.TransparentColor := clFuchsia;
FExpandButton.PictureHot.LoadFromResourceName(HInstance, 'TD_COLPHOT');
FExpandButton.PictureHot.TransparentColor := clFuchsia;
FExpandButton.PictureDown.LoadFromResourceName(HInstance, 'TD_COLPDOWN');
FExpandButton.PictureDown.TransparentColor := clFuchsia;
end;
end;
FExpanded := Value;
SetPositions;
Invalidate;
end;
//------------------------------------------------------------------------------
destructor TAdvMessageForm.Destroy;
begin
FcmBtnList.Free;
FcsBtnList.Free;
FRadioList.Free;
if Assigned(FTimer) then
FTimer.Free;
inherited;
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.DrawExpandedText;
var
r, re: trect;
anchor, stripped: string;
HyperLinks,MouseLink: Integer;
Focusanchor: string;
xsize, ysize: Integer;
szExpandedText: string;
begin
if not Assigned(FTaskDialog) or (not FExpanded) then
Exit;
R := GetExpTextRect;
if (FTaskDialog.ExpandedText <> '') then
begin
if (doHyperlinks in FTaskDialog.Options) then
begin
szExpandedText := StringReplace(FTaskDialog.ExpandedText,'\n','<br>',[rfReplaceAll]);
szExpandedText := StringReplace(szExpandedText,#10,'<br>',[rfReplaceAll]);
HTMLDrawEx(Canvas, szExpandedText, R, nil, 0, 0, -1, -1, 1, false, false, false, false, False, false,
true, 1.0, clBlue, clNone, clNone, clGray, anchor, stripped, focusanchor, xsize, ysize,
hyperlinks, mouselink, re, nil , nil, 0);
end
else
begin
szExpandedText := StringReplace(FTaskDialog.ExpandedText,'\n',#13,[rfReplaceAll]);
DrawText(Canvas.Handle,PChar(szExpandedText),Length(szExpandedText), R, DT_EXPANDTABS or DT_LEFT or DT_VCENTER or DT_WORDBREAK or DT_NOPREFIX);
end;
end;
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.DrawContent;
var
r, re: trect;
anchor, stripped: string;
HyperLinks,MouseLink: Integer;
Focusanchor: string;
xsize, ysize: Integer;
szContent: string;
begin
if not Assigned(FTaskDialog) then
Exit;
R := GetContentRect;
if (FTaskDialog.Content <> '') then
begin
if (doHyperlinks in FTaskDialog.Options) then
begin
szContent := StringReplace(FTaskDialog.Content,'\n','<br>',[rfReplaceAll]);
szContent := StringReplace(szContent,#10,'<br>',[rfReplaceAll]);
HTMLDrawEx(Canvas, szContent, R, nil, 0, 0, -1, -1, 1, false, false, false, false, False, false,
true, 1.0, clBlue, clNone, clNone, clGray, anchor, stripped, focusanchor, xsize, ysize,
hyperlinks, mouselink, re, nil , nil, 0);
end
else
begin
if HasLf(FTaskDialog.Content) then
szContent := StringReplace(FTaskDialog.Content,'\n',#13,[rfReplaceAll])
else
szContent := FTaskDialog.Content;
DrawText(Canvas.Handle,PChar(szContent),Length(szContent), R, DT_EXPANDTABS or DT_LEFT or DT_VCENTER or DT_WORDBREAK or DT_NOPREFIX);
end;
end;
end;
//------------------------------------------------------------------------------
function TAdvMessageForm.GetContentRect: TRect;
var
X, Y: Integer;
begin
Result := Rect(-1, -1, -1, -1);
if Assigned(FTaskDialog) and (FTaskDialog.Content <> '') then
begin
X := FHorzMargin;
if Assigned(FIcon) then
X := FIcon.Left + FIcon.Width + FHorzSpacing;
if (Message.Caption <> '') then
Y := Message.Top + Message.Height + FVertSpacing
else
Y := FVertMargin;
Result := Rect(X, Y, ClientWidth - FHorzMargin, Y + FContentYSize);
end;
end;
//------------------------------------------------------------------------------
function TAdvMessageForm.GetExpTextRect: TRect;
var
X, Y: Integer;
begin
Result := Rect(-1, -1, -1, -1);
if Assigned(FTaskDialog) and FExpanded then
begin
X := FHorzMargin;
if Assigned(FIcon) then
X := FIcon.Left + FIcon.Width + FHorzSpacing;
{if (Message.Caption <> '') then
Y := Message.Top + Message.Height + FVertSpacing
else
Y := FVertMargin;
if (FTaskDialog.Content <> '') then
y := Y + FContentYSize + FVertSpacing;
if (doProgressBar in FTaskDialog.Options) then
begin
if Assigned(FIcon) then
begin
Y := Max(Y, FIcon.Top + FIcon.Height+3);
end;
if Assigned(FProgressBar) then
Y := Y + FProgressBar.Height + FVertSpacing;
end;
if (FTaskDialog.RadioButtons.Count > 0) then
begin
if (FRadioList.Count > 0) then
Y := Y + TRadioButton(FRadioList.Items[FRadioList.Count-1]).Height + FVertSpacing;
end;}
Y := FExpTextTop;
Result := Rect(X, Y, ClientWidth - FHorzMargin, Y + FExpTextYSize);
end;
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.DrawFooter;
var
r, re: trect;
anchor, stripped: string;
HyperLinks,MouseLink: Integer;
Focusanchor: string;
xsize, ysize, i: Integer;
bmp: TBitmap;
shieldbmp: TBitmap;
IconH: THandle;
szFooterText: string;
begin
if not Assigned(FTaskDialog) then
Exit;
if (FTaskDialog.Footer <> '') then
begin
R := GetFooterRect;
i := R.Top - FVertSpacing;
Canvas.Pen.Color := RGB(223, 223, 223);
Canvas.MoveTo(2, i);
Canvas.LineTo(ClientWidth -3, i);
Canvas.Pen.Color := clWhite;
Canvas.MoveTo(2, i+1);
Canvas.LineTo(ClientWidth -3, i+1);
if Assigned(FFooterIcon) then
begin
IconH := LoadImage(0,FFooterIconID,IMAGE_ICON,16,16, LR_SHARED);
bmp := TBitmap.Create;
bmp.Width := 16;
bmp.Height := 16;
bmp.Transparent := True;
bmp.Canvas.Brush.Color := RGB(240, 240, 240);
bmp.Canvas.Rectangle(0,0,16,16);
//DrawIcon(bmp.Canvas.Handle,0, 0, IconH);
//Canvas.StretchDraw(Rect(R.Left, R.Top-2, R.Left+16, R.Top+14), bmp);
if FTaskDialog.FooterIcon = tfiShield then
begin
shieldbmp := TBitmap.Create;
shieldbmp.Handle := LoadBitmap(hInstance, 'TD_SHIELD');
bmp.Canvas.StretchDraw(Rect(0,0,16,16),shieldbmp);
shieldbmp.Free;
end
else
begin
DrawIconEx(bmp.Canvas.Handle, 0, 0, IconH, 16, 16, 0, bmp.Canvas.Brush.Handle, DI_NORMAL); //Replaced DrawIcon
end;
Canvas.Draw(R.Left, R.Top, bmp);
bmp.Free;
R.Left := R.Left + 20;
end;
szFooterText := StringReplace(FTaskDialog.Footer,'\n','<br>',[rfReplaceAll]);
szFooterText := StringReplace(szFooterText,#10,'<br>',[rfReplaceAll]);
HTMLDrawEx(Canvas, szFooterText, R, nil, 0, 0, -1, -1, 1, false, false, false, false, False, false,
true, 1.0, clBlue, clNone, clNone, clGray, anchor, stripped, focusanchor, xsize, ysize,
hyperlinks, mouselink, re, nil , nil, 0);
end;
end;
//------------------------------------------------------------------------------
function TAdvMessageForm.GetFooterRect: TRect;
begin
Result := Rect(-1, -1, -1, -1);
if Assigned(FTaskDialog) and (FTaskDialog.Footer <> '') then
begin
Result := Rect(FHorzMargin, ClientHeight - FFooterYSize-10, ClientWidth - FHorzMargin, ClientHeight);
end;
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.Paint;
var
i: Integer;
R: TRect;
s: string;
VerInfo: TOSVersionInfo;
begin
inherited;
i := FWhiteWindowHeight;
{if (FcmBtnList.Count > 0) then
i := TButton(FcmBtnList.Items[0]).Top
else if (FcsBtnList.Count > 0) then
i := TButton(FcsBtnList.Items[0]).Top;}
VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(verinfo);
if (i > 0) then
begin
R := ClientRect;
R.Top := i - (FVertSpacing div 2) ;
Canvas.Brush.Color := RGB(240, 240, 240);
Canvas.FillRect(R);
Canvas.Pen.Color := RGB(223, 223, 223);
Canvas.MoveTo(R.Left, R.Top);
Canvas.LineTo(R.Right, R.Top);
R := ClientRect;
Canvas.Brush.Style := bsClear;
if (verinfo.dwMajorVersion >= 6) then
Canvas.Pen.Style := psClear
else
Canvas.Pen.Style := psSolid;
if DRAWBORDER and not IsVista then // only draw on non Vista
begin
Canvas.Pen.Color := clGray;
Canvas.Rectangle(R.Left+1, R.Top+1, R.Right-1, R.Bottom-1);
end;
Canvas.Pen.Style := psSolid;
end;
DrawContent;
DrawExpandedText;
if Assigned(FTaskDialog) and (FTaskDialog.ExpandedText <> '') and Assigned(FExpandButton) then
begin
if not FExpanded then
s := FTaskDialog.CollapsControlText
else
s := FTaskDialog.ExpandControlText;
Canvas.Brush.Style := bsClear;
R := Rect(FExpandButton.Left + FExpandButton.Width + FHorzSpacing - 5, FExpandButton.Top, ClientRect.Right, FExpandButton.Top + FExpandButton.Height);
DrawText(Canvas.Handle,PChar(s),Length(s), R, DT_SINGLELINE or DT_LEFT or DT_VCENTER);
end;
DrawFooter;
end;
//------------------------------------------------------------------------------
function TAdvMessageForm.IsAnchor(x, y: integer): string;
var
r: trect;
xsize, ysize: integer;
anchor, stripped: string;
HyperLinks,MouseLink: Integer;
Focusanchor: string;
re: TRect;
AText: String;
begin
Result := '';
if not Assigned(FTaskDialog) then
Exit;
AText := '';
R := GetFooterRect;
if PtInRect(R, Point(X, Y)) then
begin
if Assigned(FFooterIcon) then
begin
R.Left := R.Left + 20;
end;
AText := FTaskDialog.Footer;
end
else
begin
R := GetContentRect;
if PtInRect(R, Point(X, y)) then
AText := FTaskDialog.Content
else
begin
R := GetExpTextRect;
if PtInRect(R, Point(X, y)) then
AText := FTaskDialog.ExpandedText;
end;
end;
AText := StringReplace(AText,'\n','<br>',[rfReplaceAll,rfIgnoreCase]);
AText := StringReplace(AText,#10,'<br>',[rfReplaceAll,rfIgnoreCase]);
Anchor := '';
if (AText <> '') then
begin
if HTMLDrawEx(Canvas, AText, r, nil, x, y, -1, -1, 1, true, false, false, true, true, false, true,
1.0, clBlue, clNone, clNone, clGray, anchor, stripped, focusanchor, xsize, ysize, hyperlinks,
mouselink, re, nil, nil, 0) then
Result := anchor;
end;
end;
procedure TAdvMessageForm.KeyDown(var Key: Word; Shift: TShiftSTate);
var
s: string;
begin
inherited;
if (Key = VK_F1) then
begin
if FTaskDialog.HelpContext <> 0 then
Application.HelpContext(FTaskDialog.HelpContext);
end;
if (Key = ord('C')) and (ssCtrl in Shift) then
begin
// got ctrl-c
s := FTaskDialog.FTitle + #13#10;
s := s + FTaskDialog.FInstruction + #13#10;
s := s + FTaskDialog.FContent;
clipboard.Open;
clipboard.AsText := s;
clipboard.Close;
end;
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Anchor: string;
begin
inherited;
Anchor := IsAnchor(X, Y);
if Anchor <> '' then
begin
if not Assigned(FTaskDialog.OnDialogHyperlinkClick) then
begin
if (Pos('://', anchor) > 0) then
VistaShellOpen(0, 'iexplore.exe', Anchor);
end;
if Assigned(FTaskDialog.OnDialogHyperlinkClick) then
FTaskDialog.OnDialogHyperlinkClick(FTaskDialog, Anchor);
end;
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.MouseMove(Shift: TShiftState; X, Y: Integer);
var
anchor: string;
begin
anchor := IsAnchor(x, y);
if (Anchor <> '') then
begin
if (self.Cursor = crDefault) or (fAnchor <> Anchor) then
begin
fAnchor := Anchor;
self.Cursor := crHandPoint;
//if fAnchorHint then
//Application.CancelHint;
//if Assigned(fAnchorEnter) then fAnchorEnter(self, anchor);
end;
end
else
begin
if (self.Cursor = crHandPoint) then
begin
self.Cursor := crDefault;
//if assigned(fAnchorExit) then fAnchorExit(self, anchor);
end;
end;
inherited;
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.OnTimer(Sender: TObject);
var
State: TTaskDialogProgressState;
Pos: Integer;
begin
if Assigned(FTaskDialog) then
begin
if Assigned(FTaskDialog.OnDialogTimer) then
FTaskDialog.OnDialogTimer(FTaskDialog);
if Assigned(FTaskDialog.OnDialogProgress) then
begin
Pos := FProgressBar.Position;
FTaskDialog.OnDialogProgress(FTaskDialog, Pos, State);
FProgressBar.Position := Pos;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.ClickButton(ButtonID: integer);
var
Btn: TButton;
TaskBtn: TTaskDialogButton;
begin
TaskBtn := nil;
Btn := GetButton(ButtonID, TaskBtn);
if Assigned(Btn) then
Btn.Click
else if Assigned(TaskBtn) then
TaskBtn.Click;
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.EnableButton(ButtonID: integer;
Enabled: boolean);
var
Btn: TButton;
TaskBtn: TTaskDialogButton;
begin
TaskBtn := nil;
Btn := GetButton(ButtonID, TaskBtn);
if Assigned(Btn) then
Btn.Enabled := Enabled
else if Assigned(TaskBtn) then
TaskBtn.Enabled := Enabled;
end;
//------------------------------------------------------------------------------
function TAdvMessageForm.GetButton(ButtonID: Integer; var TaskButton: TTaskDialogButton): TButton;
var
i, j: Integer;
begin
j := 0;
Result := nil;
for i := 0 to FcmBtnList.Count-1 do
begin
Inc(j);
if (j >= ButtonID) then
begin
TButton(FcmBtnList.Items[i]).Enabled := Enabled;
Result := TButton(FcmBtnList.Items[i]);
break;
end;
end;
if not Assigned(Result) then
begin
j := 99;
for i := 0 to FcsBtnList.Count-1 do
begin
Inc(j);
if (j >= ButtonID) then
begin
if (doCommandLinks in FTaskDialog.Options) then
begin
TTaskDialogButton(FcsBtnList.Items[i]).Enabled := Enabled;
TaskButton := TTaskDialogButton(FcsBtnList.Items[i]);
end
else
begin
TButton(FcsBtnList.Items[i]).Enabled := Enabled;
Result := TButton(FcsBtnList.Items[i]);
end;
break;
end;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TTaskDialogButton.Click;
var
Form: TCustomForm;
begin
Form := GetParentForm(Self);
if Form <> nil then
Form.ModalResult := ModalResult;
inherited;
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.OnVerifyClick(Sender: TObject);
begin
if not Assigned(FTaskDialog) or not Assigned(FVerificationCheck) then
Exit;
FTaskDialog.VerifyResult := FVerificationCheck.Checked;
if Assigned(FVerificationCheck) and Assigned(FTaskDialog.OnDialogVerifyClick) then
FTAskDialog.OnDialogVerifyClick(FTaskDialog, FVerificationCheck.Checked);
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.OnRadioClick(Sender: TObject);
begin
if not Assigned(FTaskDialog) or not Assigned(FRadioList) then
Exit;
FTaskDialog.RadioButtonResult := FRadioList.IndexOf(Sender) + 200;
if Assigned(FTaskDialog) and Assigned(FTaskDialog.OnDialogRadioClick) then
FTAskDialog.OnDialogRadioClick(FTaskDialog, FTaskDialog.RadioButtonResult);
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.DoClose(var Action: TCloseAction);
var
CanClose: Boolean;
s: string;
a: array[0..255] of char;
begin
CanClose := True;
if Assigned(FTaskDialog) and Assigned(FTaskDialog.OnDialogClose) then
begin
FTaskDialog.OnDialogClose(FTaskDialog, CanClose);
end;
case FTaskDialog.InputType of
itEdit: FTaskDialog.InputText := FInputEdit.Text;
itComboEdit, itComboList: FTaskDialog.InputText := FInputCombo.Text;
itDate: FTaskDialog.InputText := DateToStr(FInputDate.Date);
itMemo: FTaskDialog.InputText := FInputMemo.Lines.Text;
itCustom:
begin
if Assigned(FTaskDialog.InputControl) then
begin
GetWindowText(FTaskDialog.InputControl.Handle, a, sizeof(a));
s := strpas(a);
if Assigned(FTaskDialog.OnDialogInputGetText) then
begin
s := '';
FTaskDialog.OnDialogInputGetText(Self, s);
end;
FTaskDialog.InputText := s;
if CanClose then
begin
FTaskDialog.InputControl.Visible := false;
FTaskDialog.InputControl.Parent := FOldParent;
end;
end;
end;
end;
if not CanClose then
Action := caNone;
inherited;
end;
procedure TAdvMessageForm.DoShow;
var
defBtn: integer;
begin
inherited;
defBtn := -1;
if FTaskDialog.DefaultButton <> -1 then
begin
if (FTaskDialog.DefaultButton - 100 >= 0) and (FTaskDialog.DefaultButton - 100 < FTaskDialog.CustomButtons.Count) then
defBtn := FTaskDialog.DefaultButton - 100;
end;
if defBtn <> -1 then
begin
if (docommandLinks in FTaskDialog.Options) then
TTaskDialogButton(FcsBtnList[defBtn]).SetFocus
else
TCustomControl(FcsBtnList[defBtn]).SetFocus;
end
else
begin
if (FTaskDialog.DefaultButton >= 0) and (FTaskDialog.DefaultButton < FCmBtnList.Count) then
begin
if TCustomControl(FcmBtnList[FTaskDialog.DefaultButton]).Enabled then
TCustomControl(FcmBtnList[FTaskDialog.DefaultButton]).SetFocus;
end;
end;
case FTaskDialog.InputType of
itEdit: FInputEdit.SetFocus;
itComboEdit, itComboList: FInputCombo.SetFocus;
itDate: FInputDate.SetFocus;
itMemo: FInputMemo.SetFocus;
itCustom: FTaskDialog.InputControl.SetFocus;
end;
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.OnButtonClick(Sender: TObject);
begin
if not Assigned(FTaskDialog) or not Assigned(FcsBtnList) then
Exit;
if Assigned(FTaskDialog) and Assigned(FTaskDialog.onDialogButtonClick) then
FTaskDialog.OnDialogButtonClick(FTaskDialog, FcsBtnList.IndexOf(Sender) + 100);
end;
//------------------------------------------------------------------------------
procedure TAdvMessageForm.CMDialogChar(var Message: TCMDialogChar);
var
I: Integer;
begin
if Assigned(FTaskDialog) and (docommandLinks in FTaskDialog.Options) then
begin
for I := 0 to FcsBtnList.Count-1 do
begin
if (TControl(FcsBtnList[I]) is TTaskDialogButton) and IsAccel(Message.CharCode, TTaskDialogButton(FcsBtnList[I]).Caption) and CanFocus then
begin
TTaskDialogButton(FcsBtnList[I]).Click;
Message.Result := 1;
Exit;
end;
end;
end;
if (FTaskDialog.ExpandControlText <> '') and Expanded then
begin
if IsAccel(Message.CharCode, FTaskDialog.FExpandControlText) then
begin
OnExpandButtonClick(Self);
end;
end
else
if (FTaskDialog.CollapsControlText <> '') and not Expanded then
if IsAccel(Message.CharCode, FTaskDialog.FCollapsControlText) then
begin
OnExpandButtonClick(Self);
end;
inherited;
if Assigned(FTaskDialog) and (doAllowDialogCancel in FTaskDialog.Options) and (Message.CharCode = VK_ESCAPE) then
begin
Self.Close;
end;
end;
function CoreShowmessage(
const Title, // dialog window title
Instruction, // the part of the message shown in blue
content, // additional message if desired
verify: string; // ex Do Not Show this Again
tiIcon: tTaskDialogIcon): boolean;
var
td: TCustomAdvTaskDialog;
begin
td := TCustomAdvTaskDialog.Create(application);
td.Title := Title;
td.Instruction := instruction;
td.Content := Content;
td.VerificationText := verify;
td.icon := tiIcon;
td.Execute;
result := (verify <> '') and td.VerifyResult;
td.free;
end {CoreShowmessage};
//=====================================================================
// This returns false unless verify is not blank AND the verify checkbox
// was not checked.
//---------------------------------------------------------------------
function AdvShowMessage(
const Title, // dialog window title
Instruction, // the part of the message shown in blue
content, // additional message if desired
verify: string; // ex Do Not Show this Again
tiIcon: tTaskDialogIcon): boolean; overload;
begin
result := coreShowmessage(title, instruction,content,verify,tiIcon);
end { tmsShowMessage };
function AdvShowmessage(const Instruction: string):boolean; overload;
begin // Only instruction . tiInformation
result := CoreShowMessage('',Instruction,'','',tiInformation);
end;
function AdvShowmessage(const Title, Instruction: string):boolean; overload;
begin // title, instruction tiInformation
result := CoreShowMessage(Title,Instruction,'','',tiInformation);
end;
function AdvShowmessage(const Title, Instruction: string;tiIcon: TTaskDialogIcon): boolean; overload;
begin
result := CoreShowMessage(Title,Instruction,'','',tiIcon);
end;
function AdvShowMessageFmt(const Instruction: string; Parameters: array of const): boolean;
begin
Result := AdvShowmessage(Format(Instruction,Parameters));
end;
function AdvMessageBox(hWnd: HWND; lpInstruction, lpTitle: PChar; flags: UINT): Integer;
const
MB_CANCELTRYCONTINUE = $00000006; // missing from windows unit so probably never be used
var
td: TCustomAdvTaskDialog;
res: integer;
def: integer;
num: integer;
task: tCommonButton;
txt: string;
begin
td := TCustomAdvTaskDialog.Create(application);
td.Title := lptitle;
td.instruction := lpInstruction;
// extract the icon from flags
case MB_ICONMASK and flags of
MB_ICONEXCLAMATION: td.Icon := tiWarning; // Exclamation mark= MB_ICONWARNING
MB_ICONINFORMATION: td.Icon := tiInformation; // Circled I = MB_ICONASTERISK
MB_ICONQUESTION: td.Icon := tiQuestion; // Question (api says don't use any more
MB_ICONSTOP: td.Icon := tiError; //Stop sign = MB_ICONERROR & MB_ICONHAND
end;
// extract the buttons from flags
// MessageBox() Flags from Windows help file
// MB_ABORTRETRYIGNORE
// The message box contains three push buttons: Abort, Retry, and Ignore.
// MB_CANCELTRYCONTINUE
// Microsoft Windows 2000/XP: The message box contains three push buttons: Cancel, Try Again, Continue. Use this message box type instead of MB_ABORTRETRYIGNORE.
// MB_HELP
// Windows 95/98/Me, Windows NT 4.0 and later: Adds a Help button to the message box. When the user clicks the Help button or presses F1, the system sends a WM_HELP message to the owner.
// MB_OK
// The message box contains one push button: OK. This is the default.
// MB_OKCANCEL
// The message box contains two push buttons: OK and Cancel.
// MB_RETRYCANCEL
// The message box contains two push buttons: Retry and Cancel.
// MB_YESNO
// The message box contains two push buttons: Yes and No.
// MB_YESNOCANCEL
// The message box contains three push buttons: Yes, No, and Cancel.
td.Commonbuttons := [];
txt := '';
case MB_TYPEMASK and flags of
MB_ABORTRETRYIGNORE: txt := SAbortButton + #10 + SRetryButton + #10 + SIgnoreButton;
MB_CANCELTRYCONTINUE: txt := SCancelButton + #10 + SRetryButton + #10 + SContinue;
MB_OK: td.Commonbuttons := [cbOK];
MB_RETRYCANCEL: txt := SRetryButton + #10 + SCancelButton;
MB_OKCANCEL: td.CommonButtons := [cbOK,cbCancel];
MB_YESNOCANCEL: td.Commonbuttons := [cbYes, cbNO, cbCancel];
MB_YESNO: td.CommonButtons := [cbYes, cbNO];
end;
if MB_HELP and flags <> 0 then
begin
if length(txt) > 0 then
txt := txt + #10;
txt := txt + SHelpButton;
end;
if txt <> '' then
td.CustomButtons.text := txt;
// deal with mbDefbutton1, 2, 3 & 4
def := 0;
if mb_DefButton1 and flags <> 0 then
def := 1;
if mb_DefButton2 and flags <> 0 then
def := 2;
if mb_DefButton3 and flags <> 0 then
def := 3;
if mb_DefButton4 and flags <> 0 then
def := 4;
if def > 0 then
begin // have to set default button
num := td.CustomButtons.count;
if num <= def then
td.DefaultButton := 99 + def
else
begin
// I think this compiles on supported delphi compilers
for task := cbOK to cbClose do
begin
if task in td.CommonButtons then
begin
inc(num);
if num = def then
begin
case task of
cbOK: td.Defaultbutton := idOK;
cbYes: td.Defaultbutton := idYES;
cbNo: td.Defaultbutton := idNO;
cbCancel: td.Defaultbutton := idCANCEL;
cbRetry: td.Defaultbutton := idRETRY;
cbClose: td.Defaultbutton := idCLOSE;
end;
break;
end;
end;
end;
end;
end;
if (cbCancel in td.CommonButtons) then
td.Options := td.Options + [doAllowDialogCancel];
// Deal with mbAppModal, mbSystemModal and mbtaskModal
// not sure what to do with these (I personally haven't used them.
result := 0;
res := td.Execute;
case res of
1: result := IDOK;
2: result := IDCANCEL;
3: result := IDABORT;
4: result := IDRETRY;
5: result := IDIGNORE;
6: result := IDYES;
7: result := IDNO;
else
begin
case MB_TYPEMASK and flags of
MB_ABORTRETRYIGNORE:
case res of
100: result := IDABORT;
101: result := IDRETRY;
102: result := IDIGNORE;
end;
MB_CANCELTRYCONTINUE:
case res of
100: result := IDCANCEL;
{$IFDEF DELPHI9_LVL}
101: result := IDTRYAGAIN;
102: result := IDCONTINUE;
{$ENDIF}
end;
MB_RETRYCANCEL:
case res of
100: result := IDRETRY;
101: result := IDCANCEL;
end;
end;
end;
end;
td.Free;
end;
//==================================================================================================
function AdvTaskMessageDlg(const Title, Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
begin
Result := AdvTaskMessageDlgPosHelp(Title, Msg, DlgType, Buttons, HelpCtx, -1, -1, '');
end;
//--------------------------------------------------------------------------------------------------
function AdvTaskMessageDlg(const Title, Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): Integer; overload;
begin
Result := AdvTaskMessageDlgPosHelp(Title, Msg, DlgType, Buttons, HelpCtx,
-1, -1, '', DefaultButton);
end;
//--------------------------------------------------------------------------------------------------
function AdvTaskMessageDlgPos(const Title, Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): Integer;
begin
Result := AdvTaskMessageDlgPosHelp(Title, Msg, DlgType, Buttons, HelpCtx, X, Y, '');
end;
//--------------------------------------------------------------------------------------------------
function AdvTaskMessageDlgPos(const Title, Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
DefaultButton: TMsgDlgBtn): Integer; overload;
begin
Result := AdvTaskMessageDlgPosHelp(Title, Msg, DlgType, Buttons, HelpCtx,
X, Y, '', DefaultButton);
end;
//--------------------------------------------------------------------------------------------------
function AdvTaskMessageDlgPosHelp(const Title, Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
const HelpFileName: string): Integer;
begin
Result := AdvTaskMessageDlgPosHelp(Title, Msg, DlgType, Buttons, HelpCtx, X, Y,
HelpFileName, mbYes);
end;
function AdvMessageDlg(const Instruction: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer; overload;
begin
// passes mbHelp as the default button since we can't deal with help anyway
Result := AdvMessageDlg(Instruction,Dlgtype,Buttons,HelpCtx,mbHelp);
end;
function AdvMessageDlg(const Instruction: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): Integer; overload;
var
td: TCustomAdvTaskDialog;
ray: array[0..3] of integer;
res: integer;
begin
td := TCustomAdvTaskDialog.Create(Application);
td.Instruction := instruction;
case DlgType of
mtWarning:
begin
td.Icon := tiWarning;
td.Title := SMsgDlgWarning;
end;
mtError:
begin
td.Icon := tiError;
td.Title := SMsgDlgError;
end;
mtInformation:
begin
td.Icon := tiInformation;
td.Title := SMsgDlgInformation;
end;
mtConfirmation:
begin
td.Icon := tiQuestion;
td.Title := SMsgDlgConfirm;
end;
end;
fillchar(ray,sizeof(ray),0);
td.CommonButtons := [];
// TMsgDlgBtn = (mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, mbIgnore,
// mbAll, mbNoToAll, mbYesToAll, mbHelp);
if (mbYes in Buttons) then
td.CommonButtons := td.CommonButtons + [cbYes];
if (mbNo in Buttons) then
td.CommonButtons := td.CommonButtons + [cbNo];
if (mbOK in Buttons) then
td.CommonButtons := td.CommonButtons + [cbOK];
if (mbCancel in Buttons) then
td.CommonButtons := td.CommonButtons + [cbCancel];
if (mbAbort in Buttons) then
td.CommonButtons := td.CommonButtons + [cbClose];
if (mbRetry in Buttons) then
td.CommonButtons := td.CommonButtons + [cbRetry];
if (mbIgnore in Buttons) then
begin
td.CustomButtons.Add(SMsgDlgIgnore);
ray[0] := mrIgnore;
end;
if (mbAll in Buttons) then
begin
ray[td.custombuttons.Count] := mrALL;
td.CustomButtons.Add(SMsgDlgAll);
end;
if (mbNoToAll in buttons) then
begin
ray[td.custombuttons.Count] := mrNoToAll;
td.CustomButtons.Add(SMsgDlgNoToAll);
end;
if (mbYesToAll in buttons) then
begin
ray[td.custombuttons.Count] := mrYesToAll;
td.Custombuttons.Add(SMsgDlgYesToAll);
end;
if (mbHelp in buttons) then
begin
ray[td.Custombuttons.Count] := mrNone;
td.Custombuttons.Add(SMsgDlgHelp);
end;
case DefaultButton of
mbYes: td.DefaultButton := integer(mrYes);
mbNo: td.DefaultButton := integer(mrNo);
mbCancel: td.DefaultButton := integer(mrCancel);
mbOK: td.DefaultButton := integer(mrOK);
mbAbort: td.DefaultButton := integer(mrAbort);
mbRetry: td.DefaultButton := integer(mrRetry);
mbIgnore: td.DefaultButton := integer(mrIgnore);
end;
td.HelpContext := HelpCtx;
td.Options := td.Options + [doAllowDialogCancel];
result := 0;
res := td.Execute;
case res of
1: Result := mrOk;
2: Result := mrCancel;
3: Result := mrAbort;
4: Result := mrRetry;
6: Result := mrYes;
7: Result := mrNo;
else
if (res > 99) and (res < 100 + high(ray)) then
begin
result := ray[res - 100];
if (Result = mrNone) and (td.HelpContext > 0) then
begin
Application.HelpContext(td.HelpContext);
end;
end;
end;
end;
//--------------------------------------------------------------------------------------------------
function AdvTaskMessageDlgPosHelp(const Title, Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer;
const HelpFileName: string; DefaultButton: TMsgDlgBtn): Integer;
var
td: TAdvTaskDialog;
ray: array[0..3] of integer;
res: integer;
begin
td := TAdvTaskDialog.Create(Application);
try
td.Instruction := Title;
td.Content := msg;
case DlgType of
mtWarning:
begin
td.Icon := tiWarning;
td.Title := SMsgDlgWarning;
end;
mtError:
begin
td.Icon := tiError;
td.Title := SMsgDlgError;
end;
mtInformation:
begin
td.Icon := tiInformation;
td.Title := SMsgDlgInformation;
end;
mtConfirmation:
begin
td.Icon := tiShield;
td.Title := SMsgDlgConfirm;
end;
end;
fillchar(ray,sizeof(ray),0);
td.CommonButtons := [];
// TMsgDlgBtn = (mbYes, mbNo, mbOK, mbCancel, mbAdvrt, mbRetry, mbIgnore,
// mbAll, mbNoToAll, mbYesToAll, mbHelp);
if (mbYes in Buttons) then
td.CommonButtons := td.CommonButtons + [cbYes];
if (mbNo in Buttons) then
td.CommonButtons := td.CommonButtons + [cbNo];
if (mbOK in Buttons) then
td.CommonButtons := td.CommonButtons + [cbOK];
if (mbCancel in Buttons) then
td.CommonButtons := td.CommonButtons + [cbCancel];
if (mbAbort in Buttons) then
td.CommonButtons := td.CommonButtons + [cbClose];
if (mbRetry in Buttons) then
td.CommonButtons := td.CommonButtons + [cbRetry];
if (mbIgnore in Buttons) then
begin
td.CustomButtons.Add(SMsgDlgIgnore);
ray[0] := mrIgnore;
end;
if (mbAll in Buttons) then
begin
ray[td.custombuttons.Count] := mrALL;
td.CustomButtons.Add(SMsgDlgAll);
end;
if (mbNoToAll in buttons) then
begin
ray[td.custombuttons.Count] := mrNoToAll;
td.CustomButtons.add(SMsgDlgNoToAll);
end;
if (mbYesToAll in buttons) then
begin
ray[td.custombuttons.Count] := mrYesToAll;
td.Custombuttons.Add(SMsgDlgYesToAll);
end;
if (mbHelp in buttons) then
begin
ray[td.Custombuttons.Count] := mrNone;
td.Custombuttons.Add(SMsgDlgHelp);
end;
case DefaultButton of
mbYes: td.DefaultButton := integer(mrYes);
mbNo: td.DefaultButton := integer(mrNo);
mbCancel: td.DefaultButton := integer(mrCancel);
mbOK: td.DefaultButton := integer(mrOK);
mbAbort: td.DefaultButton := integer(mrAbort);
mbRetry: td.DefaultButton := integer(mrRetry);
mbIgnore: td.DefaultButton := integer(mrIgnore);
end;
td.HelpContext := HelpCtx;
td.Options := td.Options + [doAllowDialogCancel];
Result := 0;
res := td.Execute;
case res of
1: Result := mrOk;
2: Result := mrCancel;
3: Result := mrAbort;
4: Result := mrRetry;
6: Result := mrYes;
7: Result := mrNo;
else
if (res > 99) and (res < 100+high(ray)) then
begin
result := ray[res-100];
if (Result = mrNone) and (td.HelpContext > 0) then
begin
Application.HelpContext(td.HelpContext);
end;
end;
end;
finally
td.Free;
end;
end;
function AdvInputQueryDlg(ACaption, APrompt: string; var Value: string):boolean;
var
AID: TAdvInputTaskDialog;
begin
AID := TAdvInputTaskDialog.Create(Application);
AID.Instruction := APrompt;
AID.Title := ACaption;
AID.InputText := Value;
AID.InputType := itEdit;
AID.CommonButtons := [cbOK, cbCancel];
Result := AID.Execute = mrOK;
Value := AID.InputText;
end;
//------------------------------------------------------------------------------
procedure Register;
begin
RegisterComponents('TMS',[TAdvTaskDialog, TAdvInputTaskDialog]);
end;
//------------------------------------------------------------------------------
{ TAdvInputTaskDialog }
constructor TAdvInputTaskDialog.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FInputType := itEdit;
Options := Options + [doAllowDialogCancel];
end;
function TAdvInputTaskDialog.Execute: integer;
begin
Result := AdvMessageDlgPos(Self, -1, -1);
end;
initialization
//cbOK, cbYes, cbNo, cbCancel, cbRetry, cbClose);
ButtonCaptions[cbOK] := @SSpanishMsgDlgOK;
ButtonCaptions[cbYes] := @SSpanishMsgDlgYes;
ButtonCaptions[cbNo] := @SSpanishMsgDlgNo;
ButtonCaptions[cbCancel] := @SSpanishMsgDlgCancel;
ButtonCaptions[cbRetry] := @SSpanishMsgDlgRetry;
ButtonCaptions[cbClose] := @SSpanishMsgDlgClose;
Captions[tiBlank] := nil;
Captions[tiWarning] := @SSpanishMsgDlgWarning;
Captions[tiQuestion] := @SSpanishMsgDlgConfirm;
Captions[tiError] := @SSpanishMsgDlgError;
Captions[tiShield] := @SSpanishMsgDlgInformation;
{$IFDEF FREEWARE}
if (FindWindow('TApplication', nil) = 0) OR
(FindWindow('TAppBuilder', nil) = 0) then
begin
MessageBox(0,'Application uses trial version of TMS components','Info',MB_OK);
end
{$ENDIF}
end.
Reference in New Issue View Git Blame Copy Permalink