2009-03-02 18:02:25 +00:00
{***************************************************************************}
{ TTaskDialog component }
{ for Delphi & C++Builder }
{ }
{ written by TMS Software }
{ copyright <20> 2006 - 2008 }
{ 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;
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 = 2 ; // 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
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 3 5 0 ;
property ProgressBarMin: integer read FProgressBarMin write FProgressBarMin default 0 ;
property ProgressBarMax: integer read FProgressBarMax write FProgressBarMax default 1 0 0 ;
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' ) ;
procedure Register ;
implementation
2009-03-02 19:25:57 +00:00
uses
SpanishContst;
2009-03-02 18:02:25 +00:00
{$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+ 1 0 1 ;
TDM_CLICK_BUTTON = WM_USER+ 1 0 2 ; // wParam = Button ID
TDM_SET_MARQUEE_PROGRESS_BAR = WM_USER+ 1 0 3 ; // wParam = 0 (nonMarque) wParam != 0 (Marquee)
TDM_SET_PROGRESS_BAR_STATE = WM_USER+ 1 0 4 ; // wParam = new progress state
TDM_SET_PROGRESS_BAR_RANGE = WM_USER+ 1 0 5 ; // lParam = MAKELPARAM(nMinRange, nMaxRange)
TDM_SET_PROGRESS_BAR_POS = WM_USER+ 1 0 6 ; // wParam = new position
TDM_SET_PROGRESS_BAR_MARQUEE = WM_USER+ 1 0 7 ; // wParam = 0 (stop marquee), wParam != 0 (start marquee), lparam = speed (milliseconds between repaints)
TDM_SET_ELEMENT_TEXT = WM_USER+ 1 0 8 ; // wParam = element (TASKDIALOG_ELEMENTS), lParam = new element text (LPCWSTR)
TDM_CLICK_RADIO_BUTTON = WM_USER+ 1 1 0 ; // wParam = Radio Button ID
TDM_ENABLE_BUTTON = WM_USER+ 1 1 1 ; // lParam = 0 (disable), lParam != 0 (enable), wParam = Button ID
TDM_ENABLE_RADIO_BUTTON = WM_USER+ 1 1 2 ; // lParam = 0 (disable), lParam != 0 (enable), wParam = Radio Button ID
TDM_CLICK_VERIFICATION = WM_USER+ 1 1 3 ; // wParam = 0 (unchecked), 1 (checked), lParam = 1 (set key focus)
TDM_UPDATE_ELEMENT_TEXT = WM_USER+ 1 1 4 ; // wParam = element (TASKDIALOG_ELEMENTS), lParam = new element text (LPCWSTR)
TDM_SET_BUTTON_ELEVATION_REQUIRED_STATE = WM_USER+ 1 1 5 ; // wParam = Button ID, lParam = 0 (elevation not required), lParam != 0 (elevation required)
TDM_UPDATE_ICON = WM_USER+ 1 1 6 ; // 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 = 1 0 ; // 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 = 1 0 0 ;
TD_ICON_WARNING = 1 0 1 ;
TD_ICON_QUESTION = 1 0 2 ;
TD_ICON_ERROR = 1 0 3 ;
TD_ICON_INFORMATION = 1 0 4 ;
TD_ICON_BLANK_AGAIN = 1 0 5 ;
TD_ICON_SHIELD = 1 0 6 ;
}
// 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 = 1 7 ;
TD_ICON_WARNING = 8 4 ;
TD_ICON_QUESTION = 9 9 ;
TD_ICON_ERROR = 9 8 ;
TD_ICON_INFORMATION = 8 1 ;
TD_ICON_BLANK_AGAIN = 0 ;
TD_ICON_SHIELD = 7 8 ;
type
TProControl = class( TControl) ;
PTASKDIALOG_BUTTON = ^ TTASKDIALOG_BUTTON;
TTASKDIALOG_BUTTON = record
nButtonID: integer ;
pszButtonText: pwidechar ;
end ;
TTaskDialogWideString = array [ 0 .. 1 0 2 3 ] 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 + 1 0 ;
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 : = 2 0 0 ;
DefaultButton : = 0 ;
Options : = [ ] ;
VerifyResult : = false ;
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 : = 1 0 0 ;
FDialogForm : = nil ;
FApplicationIsParent : = true ;
FModalParent : = 0 ;
FCustomIcon : = TIcon. Create;
FDefaultRadioButton : = 2 0 0 ;
FMinFormWidth : = 3 5 0 ;
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 + 2 0 ) ;
}
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 1 6 ) and $FF ;
if ( verinfo. dwMajorVersion > = 6 ) and ( ComCtlVersion > 5 ) and ( FNonNativeDialog = nndAuto) then
begin
// check COMCTL version ...
DLLHandle : = LoadLibrary( 'comctl32.dll' ) ;
if DLLHandle > = 3 2 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 + 1 0 0 ;
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 + 2 0 0 ;
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 , 2 3 , 2 2 ) ;
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 .. 5 1 ] of Char ;
begin
for I : = 0 to 2 5 do Buffer[ I] : = Chr( I + Ord( 'A' ) ) ;
for I : = 0 to 2 5 do Buffer[ I + 2 6 ] : = Chr( I + Ord( 'a' ) ) ;
GetTextExtentPoint( Canvas. Handle, Buffer, 5 2 , TSize( Result ) ) ;
Result . X : = Result . X div 5 2 ;
end ;
//------------------------------------------------------------------------------
var
ButtonWidths : array [ TCommonButton] of integer ; // initialized to zero
ButtonCaptions: array [ TCommonButton] of Pointer ; // = (
// @SMsgDlgOK, @SMsgDlgYes, @SMsgDlgNo, @SMsgDlgCancel, @SMsgDlgRetry, @SMsgDlgAbort);
// ButtonNames: array[TCommonButton] of string = ('OK', 'Yes', 'No', 'Cancel', 'Retry', 'Abort');
//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;
if doAllowMinimize in TaskDialog. Options then
begin
BorderStyle : = bsSingle;
BorderIcons : = [ biSystemMenu, biMinimize]
end
else
begin
BorderStyle : = bsDialog;
BorderIcons : = [ ] ;
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;
{$IFDEF DELPHI5_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 , 1 0 0 0 , 1 0 0 )
else
SetRect( R, 0 , 0 , W, 1 0 0 ) ;
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 = 1 0 ;
mcVertSpacing = 1 0 ;
mcButtonWidth = 5 0 ;
mcButtonHeight = 1 4 ;
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 : = 1 0 0 0 ;
GetTextSize( Canvas, Caption, w, l) ;
w : = w + 5 0 ;
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 + 1 6 ;
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( 6 0 , 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 + 1 6 ;
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 + 1 0 0 ) ;
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( 6 0 , 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 : = 1 1 ;
hf. Style : = [ fsBold] ;
pf. Assign( Canvas. Font) ;
for i : = 0 to TaskDialog. CustomButtons. Count- 1 do
begin
Canvas. Font. Size : = 1 0 ;
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 + 1 8 ; }
bw : = bw + 2 6 ;
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 + 3 2 )
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 , 8 3 , 1 9 6 ) ;
HeadingFont. Assign( hf) ;
HeadingFont. Color : = RGB( 0 , 8 3 , 1 9 6 ) ; //RGB(21, 28, 85);
ModalResult : = i + 1 0 0 ; //mrAbort;
//Default := (ModalResult = TaskDialog.DefaultButton);
BorderColorHot : = RGB( 1 0 8 , 2 2 5 , 2 5 5 ) ;
BorderColorDown : = RGB( 1 0 8 , 2 2 5 , 2 5 5 ) ;
Width : = Max( 6 0 , n) ;
if TaskDialog. DefaultButton < > - 1 then
AutoFocus : = true ;
Height : = Max( bh, Max( ButtonHeight, Canvas. TextHeight( 'gh' ) + 2 0 ) ) ;
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( 6 0 , ButtonWidths[ B] ) ;
Height : = ButtonHeight;
cmBtnGroupWidth : = cmBtnGroupWidth + Width + ButtonSpacing;
//if B = mbHelp then
//OnClick := TMessageForm(Result).HelpButtonClick;
end ;
end ;
// Instruction
Canvas. Font. Size : = 1 1 ;
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, 3 2 + FHorzSpacing) ;
if IconTextHeight < 3 2 then IconTextHeight : = 3 2 ;
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 : = 3 2 ;
Picture. Bitmap. Width : = 3 2 ;
Picture. Bitmap. Canvas. Brush. Color : = clWhite;
Picture. Bitmap. Canvas. Pen. Style : = psClear;
Picture. Bitmap. Canvas. Rectangle( 0 , 0 , 3 1 , 3 1 ) ;
end ;
else
Picture. Icon. Handle : = LoadIcon( 0 , IconID) ;
end ;
end ;
SetBounds( FHorzMargin, Y, 3 2 , 3 2 ) ;
end ;
end ;
Message : = TLabel. Create( Self) ;
with Message do
begin
Name : = 'Instr' ;
Parent : = Self;
{$IFDEF DELPHI7_LVL}
WordWrap : = True ;
{$ENDIF}
Caption : = Msg;
Font. Size : = 1 1 ;
Font. Color : = RGB( 0 , 8 3 , 1 9 6 ) ;
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 : = 1 0 0 ;
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 + 1 2 ) ;
Min : = TaskDialog. ProgressBarMin;
Max : = TaskDialog. ProgressBarMax;
Position : = 0 ;
end ;
if not Assigned( FTimer) then
begin
FTimer : = TTimer. Create( Self) ;
FTimer. Interval : = 1 0 0 ;
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 + 2 0 ) ;
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 + 2 0 0 = 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 + 2 0 0 = 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, 3 0 0 , Y + 2 6 ) ;
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 : = 1 9 ;
Height : = 1 9 ;
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( 2 4 0 , 2 4 0 , 2 4 0 ) ;
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, 3 0 0 , Y + 2 6 ) ;
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, 2 4 + FHorzSpacing) ;
if FooterIconTextHeight < 2 4 then FooterIconTextHeight : = 2 4 ;
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, 1 6 , 1 6 ) ;
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 - 2 0 ;
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 + 2 0 , ClientWidth - ALeft, 2 0 ) ;
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 + 2 0 , ClientWidth - ALeft, 2 0 ) ;
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 + 2 0 ;
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 + 2 0 , ClientWidth - ALeft, 6 0 ) ;
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 + 2 0 ;
//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 : = 1 0 0 0 ;
GetTextSize( Canvas, Caption, w, l) ;
w : = w + 5 0 ;
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 : = 1 1 ;
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, 3 2 + 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 + 2 0 ) ;
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, 3 0 0 , Y + 2 6 ) ;
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, 1 6 , 1 6 ) ;
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 + 2 6 ) ;
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 : = 3 6 0 ;
if FContentXSize < 3 6 0 then
FContentXSize : = 3 6 0 ;
}
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 - 1 0 ;
itComboEdit, itComboList: FInputCombo. Top : = Y - 1 0 ;
itDate: FInputDate. Top : = Y - 1 0 ;
itMemo: FInputMemo. Top : = Y - 1 0 ;
itCustom: if Assigned( FTaskDialog. InputControl) then
FTaskDialog. InputControl. Top : = Y - 1 0 ;
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 + 3 0 ;
end ;
if ( FTaskDialog. InputType in [ itMemo] ) then
begin
Y : = Y + 7 0 ;
end ;
if ( FTaskDialog. InputType in [ itCustom] ) then
begin
if Assigned( FTaskDialog. InputControl) then
Y : = Y + FTaskDialog. InputControl. Height + 1 0
else
Y : = Y + 3 0 ;
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 + 2 6 ) ;
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 + 2 0 , Y, Width - HorzMargin, Y + 1 0 0 )
else
r : = Rect( HorzMargin, Y, Width - HorzMargin, Y + 1 0 0 ) ;
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, 2 0 ) ;
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 : = 3 5 0 ;
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( '-' , 2 7 ) + 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( 2 2 3 , 2 2 3 , 2 2 3 ) ;
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, 1 6 , 1 6 , LR_SHARED) ;
bmp : = TBitmap. Create;
bmp. Width : = 1 6 ;
bmp. Height : = 1 6 ;
bmp. Transparent : = True ;
bmp. Canvas. Brush. Color : = RGB( 2 4 0 , 2 4 0 , 2 4 0 ) ;
bmp. Canvas. Rectangle( 0 , 0 , 1 6 , 1 6 ) ;
//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 , 1 6 , 1 6 ) , shieldbmp) ;
shieldbmp. Free;
end
else
begin
DrawIconEx( bmp. Canvas. Handle, 0 , 0 , IconH, 1 6 , 1 6 , 0 , bmp. Canvas. Brush. Handle, DI_NORMAL) ; //Replaced DrawIcon
end ;
Canvas. Draw( R. Left, R. Top, bmp) ;
bmp. Free;
R. Left : = R. Left + 2 0 ;
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- 1 0 , 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( 2 4 0 , 2 4 0 , 2 4 0 ) ;
Canvas. FillRect( R) ;
Canvas. Pen. Color : = RGB( 2 2 3 , 2 2 3 , 2 2 3 ) ;
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 + 2 0 ;
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 : = 9 9 ;
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) + 2 0 0 ;
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 .. 2 5 5 ] 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;
FTaskDialog. InputControl. Visible : = false ;
FTaskDialog. InputControl. Parent : = FOldParent;
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 - 1 0 0 > = 0 ) and ( FTaskDialog. DefaultButton - 1 0 0 < FTaskDialog. CustomButtons. Count) then
defBtn : = FTaskDialog. DefaultButton - 1 0 0 ;
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) + 1 0 0 ) ;
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 : = 9 9 + 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
1 0 0 : result : = IDABORT;
1 0 1 : result : = IDRETRY;
1 0 2 : result : = IDIGNORE;
end ;
MB_CANCELTRYCONTINUE:
case res of
1 0 0 : result : = IDCANCEL;
{$IFDEF DELPHI9_LVL}
1 0 1 : result : = IDTRYAGAIN;
1 0 2 : result : = IDCONTINUE;
{$ENDIF}
end ;
MB_RETRYCANCEL:
case res of
1 0 0 : result : = IDRETRY;
1 0 1 : 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 > 9 9 ) and ( res < 1 0 0 + high( ray) ) then
begin
result : = ray[ res - 1 0 0 ] ;
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 > 9 9 ) and ( res < 1 0 0 + high( ray) ) then
begin
result : = ray[ res- 1 0 0 ] ;
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);
2009-03-02 19:25:57 +00:00
ButtonCaptions[ cbOK] : = @ SSpanishMsgDlgOK;
ButtonCaptions[ cbYes] : = @ SSpanishMsgDlgYes;
ButtonCaptions[ cbNo] : = @ SSpanishMsgDlgNo;
ButtonCaptions[ cbCancel] : = @ SSpanishMsgDlgCancel;
ButtonCaptions[ cbRetry] : = @ SSpanishMsgDlgRetry;
ButtonCaptions[ cbClose] : = @ SSpanishMsgDlgAbort;
2009-03-02 18:02:25 +00:00
Captions[ tiBlank] : = nil ;
2009-03-02 19:25:57 +00:00
Captions[ tiWarning] : = @ SSpanishMsgDlgWarning;
Captions[ tiQuestion] : = @ SSpanishMsgDlgConfirm;
Captions[ tiError] : = @ SSpanishMsgDlgError;
Captions[ tiShield] : = @ SSpanishMsgDlgInformation;
2009-03-02 18:02:25 +00:00
{$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 .
