diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvInputTaskDialogDemo.dpr b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvInputTaskDialogDemo.dpr new file mode 100644 index 0000000..ea78c08 --- /dev/null +++ b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvInputTaskDialogDemo.dpr @@ -0,0 +1,13 @@ +program AdvInputTaskDialogDemo; + +uses + Forms, + UAdvInputTaskDialogDemo in 'UAdvInputTaskDialogDemo.pas' {Form1}; + +{$R *.res} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvInputTaskDialogDemo.dproj b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvInputTaskDialogDemo.dproj new file mode 100644 index 0000000..cbce3c2 --- /dev/null +++ b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvInputTaskDialogDemo.dproj @@ -0,0 +1,113 @@ + + + {40ed30c4-44b3-4d9c-8bf7-596b00214c5a} + Debug + AnyCPU + DCC32 + AdvInputTaskDialogDemo.exe + AdvInputTaskDialogDemo.dpr + + + 7.0 + False + False + 0 + RELEASE + + + 7.0 + DEBUG + + + Delphi.Personality + + + + False + True + False + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1033 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Microsoft Office XP Sample Automation Server Wrapper Components + Microsoft Office 2000 Sample Automation Server Wrapper Components + CodeGear C++Builder Office 2000 Servers Package + CodeGear C++Builder Office XP Servers Package + + + AdvInputTaskDialogDemo.dpr + + + + + + + MainSource + + +
Form1
+ + + \ No newline at end of file diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvInputTaskDialogDemo.res b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvInputTaskDialogDemo.res new file mode 100644 index 0000000..be94ddf Binary files /dev/null and b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvInputTaskDialogDemo.res differ diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvMsgBoxExplorer.dpr b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvMsgBoxExplorer.dpr new file mode 100644 index 0000000..bc37470 --- /dev/null +++ b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvMsgBoxExplorer.dpr @@ -0,0 +1,14 @@ +program AdvMsgBoxExplorer; + +uses + Forms, + Unit1 in 'Unit1.pas' {Form1}; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvMsgBoxExplorer.dproj b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvMsgBoxExplorer.dproj new file mode 100644 index 0000000..79dd07c --- /dev/null +++ b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvMsgBoxExplorer.dproj @@ -0,0 +1,41 @@ + + + {3be14241-b500-4048-b206-8a73172c37f9} + AdvMsgBoxExplorer.dpr + Debug + AnyCPU + DCC32 + AdvMsgBoxExplorer.exe + + + 7.0 + False + False + 0 + RELEASE + + + 7.0 + DEBUG + + + Delphi.Personality + VCLApplication + +FalseTrueFalseFalseFalse1000FalseFalseFalseFalseFalse103312521.0.0.01.0.0.0 + Microsoft Office XP Sample Automation Server Wrapper Components + Microsoft Office 2000 Sample Automation Server Wrapper Components + CodeGear C++Builder Office 2000 Servers Package + CodeGear C++Builder Office XP Servers Package + AdvMsgBoxExplorer.dpr + + + + + MainSource + + +
Form1
+ + + \ No newline at end of file diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvMsgBoxExplorer.res b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvMsgBoxExplorer.res new file mode 100644 index 0000000..42a5081 Binary files /dev/null and b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvMsgBoxExplorer.res differ diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Demo/TaskDialogExplorer.dpr b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/TaskDialogExplorer.dpr new file mode 100644 index 0000000..e1ac7bc --- /dev/null +++ b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/TaskDialogExplorer.dpr @@ -0,0 +1,14 @@ +program TaskDialogExplorer; + +uses + Forms, + fmMain in 'fmMain.pas' {MainForm}; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Demo/TaskDialogExplorer.dproj b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/TaskDialogExplorer.dproj new file mode 100644 index 0000000..9ae7939 --- /dev/null +++ b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/TaskDialogExplorer.dproj @@ -0,0 +1,41 @@ + + + {15a8d16e-1063-4b59-8cb3-07496f176779} + TaskDialogExplorer.dpr + Debug + AnyCPU + DCC32 + TaskDialogExplorer.exe + + + 7.0 + False + False + 0 + RELEASE + + + 7.0 + DEBUG + + + Delphi.Personality + VCLApplication + +FalseTrueFalseFalseFalse1000FalseFalseFalseFalseFalse103312521.0.0.01.0.0.0 + Microsoft Office XP Sample Automation Server Wrapper Components + Microsoft Office 2000 Sample Automation Server Wrapper Components + CodeGear C++Builder Office 2000 Servers Package + CodeGear C++Builder Office XP Servers Package + TaskDialogExplorer.dpr + + + + + MainSource + + +
MainForm
+ + + \ No newline at end of file diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Demo/TaskDialogExplorer.res b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/TaskDialogExplorer.res new file mode 100644 index 0000000..42a5081 Binary files /dev/null and b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/TaskDialogExplorer.res differ diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Demo/UAdvInputTaskDialogDemo.dfm b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/UAdvInputTaskDialogDemo.dfm new file mode 100644 index 0000000..685effd --- /dev/null +++ b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/UAdvInputTaskDialogDemo.dfm @@ -0,0 +1,100 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + Caption = 'TAdvInputTaskDialog demo' + ClientHeight = 225 + ClientWidth = 406 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + PixelsPerInch = 96 + TextHeight = 13 + object Label1: TLabel + Left = 264 + Top = 22 + Width = 91 + Height = 13 + Caption = 'Preset input value:' + end + object Label2: TLabel + Left = 264 + Top = 103 + Width = 34 + Height = 13 + Caption = 'Result:' + end + object RadioGroup1: TRadioGroup + Left = 16 + Top = 16 + Width = 233 + Height = 161 + Caption = 'Select input control' + ItemIndex = 0 + Items.Strings = ( + 'Edit' + 'Combo editor' + 'Combo list' + 'Memo' + 'Date picker' + 'Custom control (spin editor)') + TabOrder = 0 + end + object Button1: TButton + Left = 264 + Top = 72 + Width = 121 + Height = 25 + Caption = 'Show inputdialog' + TabOrder = 1 + OnClick = Button1Click + end + object Edit1: TEdit + Left = 264 + Top = 45 + Width = 121 + Height = 21 + TabOrder = 2 + Text = 'preset' + end + object Edit2: TEdit + Left = 264 + Top = 122 + Width = 121 + Height = 21 + TabOrder = 3 + end + object SpinEdit1: TSpinEdit + Left = 16 + Top = 195 + Width = 121 + Height = 22 + MaxValue = 0 + MinValue = 0 + TabOrder = 4 + Value = 0 + Visible = False + end + object AdvInputTaskDialog1: TAdvInputTaskDialog + CommonButtons = [] + DefaultButton = 0 + Icon = tiInformation + InputType = itEdit + InputItems.Strings = ( + 'BMW' + 'Audi' + 'Mercedes' + 'Porsche' + 'VW' + 'Ferrari') + Title = 'Windows Vista Input dialog' + Content = 'Enter value here' + OnDialogInputSetText = AdvInputTaskDialog1DialogInputSetText + OnDialogInputGetText = AdvInputTaskDialog1DialogInputGetText + Left = 352 + Top = 152 + end +end diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Demo/UAdvInputTaskDialogDemo.pas b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/UAdvInputTaskDialogDemo.pas new file mode 100644 index 0000000..ee4bdd9 --- /dev/null +++ b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/UAdvInputTaskDialogDemo.pas @@ -0,0 +1,69 @@ +unit UAdvInputTaskDialogDemo; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls, ExtCtrls, TaskDialog, Spin; + +type + TForm1 = class(TForm) + AdvInputTaskDialog1: TAdvInputTaskDialog; + RadioGroup1: TRadioGroup; + Button1: TButton; + Edit1: TEdit; + Label1: TLabel; + Label2: TLabel; + Edit2: TEdit; + SpinEdit1: TSpinEdit; + procedure Button1Click(Sender: TObject); + procedure AdvInputTaskDialog1DialogInputGetText(Sender: TObject; + var Text: string); + procedure AdvInputTaskDialog1DialogInputSetText(Sender: TObject; + Text: string); + private + { Private declarations } + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.dfm} + +procedure TForm1.AdvInputTaskDialog1DialogInputGetText(Sender: TObject; + var Text: string); +begin + Text := SpinEdit1.Text; +end; + +procedure TForm1.AdvInputTaskDialog1DialogInputSetText(Sender: TObject; + Text: string); +begin + SpinEdit1.Text := Text; +end; + +procedure TForm1.Button1Click(Sender: TObject); +begin + case radiogroup1.ItemIndex of + 0: AdvInputTaskDialog1.InputType := itEdit; + 1: AdvInputTaskDialog1.InputType := itComboEdit; + 2: AdvInputTaskDialog1.InputType := itComboList; + 3: AdvInputTaskDialog1.InputType := itMemo; + 4: AdvInputTaskDialog1.InputType := itDate; + 5: + begin + AdvInputTaskDialog1.InputType := itCustom; + AdvInputTaskDialog1.InputControl := SpinEdit1; + + end; + end; + AdvInputTaskDialog1.InputText := Edit1.Text; + AdvInputTaskDialog1.Execute; + Edit2.Text := AdvInputTaskDialog1.InputText; +end; + +end. diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Demo/Unit1.dfm b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/Unit1.dfm new file mode 100644 index 0000000..3f3e4c6 --- /dev/null +++ b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/Unit1.dfm @@ -0,0 +1,130 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + Caption = 'AdvMessageBox Test' + ClientHeight = 303 + ClientWidth = 380 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + PixelsPerInch = 96 + TextHeight = 13 + object Label1: TLabel + Left = 14 + Top = 16 + Width = 47 + Height = 13 + Caption = 'Caption: ' + end + object Label2: TLabel + Left = 30 + Top = 48 + Width = 25 + Height = 13 + Caption = 'Icon:' + end + object Label3: TLabel + Left = 29 + Top = 76 + Width = 26 + Height = 13 + Caption = 'Text:' + end + object Label4: TLabel + Left = 14 + Top = 184 + Width = 41 + Height = 13 + Caption = 'Buttons:' + end + object Label5: TLabel + Left = 24 + Top = 232 + Width = 34 + Height = 13 + Caption = 'Result:' + end + object lbresults: TLabel + Left = 64 + Top = 232 + Width = 3 + Height = 13 + end + object BtnTMS: TButton + Left = 65 + Top = 264 + Width = 145 + Height = 25 + Caption = 'TMS TAdvMessageBox' + TabOrder = 0 + OnClick = BtnTMSClick + end + object BtnWindows: TButton + Left = 216 + Top = 264 + Width = 145 + Height = 25 + Caption = 'Windows Messagebox' + TabOrder = 1 + OnClick = BtnWindowsClick + end + object edCaption: TEdit + Left = 61 + Top = 13 + Width = 300 + Height = 21 + TabOrder = 2 + Text = 'Test of MessageBox' + end + object cbIcon: TComboBox + Left = 61 + Top = 45 + Width = 300 + Height = 21 + ItemHeight = 13 + ItemIndex = 0 + TabOrder = 3 + Text = 'Select Icon' + Items.Strings = ( + 'Select Icon' + 'MB_ICONEXCLAMATION' + 'MB_ICONWARNING' + 'MB_ICONASTERISK' + 'MB_ICONINFORMATION' + 'MB_ICONQUESTION' + 'MB_ICONSTOP' + 'MB_ICONERROR' + 'MB_ICONHAND') + end + object MemoInfo: TMemo + Left = 61 + Top = 76 + Width = 300 + Height = 89 + Lines.Strings = ( + 'Sample short message.') + TabOrder = 4 + end + object cbButtons: TComboBox + Left = 64 + Top = 184 + Width = 297 + Height = 21 + ItemHeight = 13 + TabOrder = 5 + Text = 'Pick Buttons' + Items.Strings = ( + 'Pick the buttons to show' + 'ABORT, RETRY, IGNORE' + 'CANCEL, TRY AGAIN, CONTINUE' + 'OK' + 'OK, CANCEL' + 'RETRY, CANCEL' + 'YES, NO' + 'YES, NO, CANCEL') + end +end diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Demo/Unit1.pas b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/Unit1.pas new file mode 100644 index 0000000..9ab33f9 --- /dev/null +++ b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/Unit1.pas @@ -0,0 +1,125 @@ +unit Unit1; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, StdCtrls; + +type + TForm1 = class(TForm) + BtnTMS: TButton; + BtnWindows: TButton; + Label1: TLabel; + edCaption: TEdit; + Label2: TLabel; + cbIcon: TComboBox; + Label3: TLabel; + MemoInfo: TMemo; + Label4: TLabel; + cbButtons: TComboBox; + Label5: TLabel; + lbresults: TLabel; + procedure BtnWindowsClick(Sender: TObject); + procedure BtnTMSClick(Sender: TObject); + private + Fmbtitle: string; + FBoxInformation: string; + FBoxflags: integer; + { Private declarations } + procedure MakeDialog(id: string); + procedure Setmbtitle(const Value: string); + procedure SetBoxInformation(const Value: string); + procedure SetBoxflags(const Value: integer); + public + { Public declarations } + + property BoxTitle: string read Fmbtitle write Setmbtitle; + property BoxInformation: string read FBoxInformation write SetBoxInformation; + property Boxflags: integer read FBoxflags write SetBoxflags; + end; + +var + Form1: TForm1; + +implementation + +uses + TaskDialog; + +{$R *.dfm} + +const + MB_CANCELTRYCONTINUE = $00000006; + iconlist: array[1..8] of integer = + (MB_ICONEXCLAMATION, + MB_ICONWARNING, + MB_ICONINFORMATION, + MB_ICONASTERISK, + MB_ICONQUESTION, + MB_ICONSTOP, + MB_ICONERROR, + MB_ICONHAND); + btnlist: array[1..7] of integer = + ( MB_ABORTRETRYIGNORE, + MB_CANCELTRYCONTINUE, + MB_OK, + MB_OKCANCEL, + MB_RETRYCANCEL, + MB_YESNO, + MB_YESNOCANCEL); + + + +// Create dialog fields for the messagebox +procedure TForm1.MakeDialog(id: string); +var + i: Integer; +begin + // make box fields from ui + BoxTitle := edCaption.text + ' ('+id+')'; // title + BoxInformation := memoInfo.Lines[0]; // info + for i := 1 to memoInfo.Lines.count - 1 do + BoxInformation := BoxInformation + #10+MemoInfo.Lines[i]; + BoxFlags := 0; + if cbIcon.ItemIndex > 0 then + BoxFlags := BoxFlags or IconList[cbIcon.ItemIndex]; + if cbButtons.ItemIndex > 0 then + BoxFlags := boxFlags or btnlist[cbButtons.itemindex]; +end; + +procedure TForm1.BtnTMSClick(Sender: TObject); +var + res: integer; +begin + MakeDialog('TMS'); + res := AdvMessagebox(0,pchar(BoxInformation), pchar(BoxTitle), BoxFlags); + lbResults.caption := IntToStr(res); +end; + +procedure TForm1.BtnWindowsClick(Sender: TObject); +var + res: integer; +begin + MakeDialog('WINDOWS'); + res := Messagebox(0,pchar(BoxInformation),pchar(BoxTitle),BoxFlags); + lbResults.caption := InttoStr(res); +end; + + +procedure TForm1.SetBoxflags(const Value: integer); +begin + FBoxflags := Value; +end; + +procedure TForm1.SetBoxInformation(const Value: string); +begin + FBoxInformation := Value; +end; + +procedure TForm1.Setmbtitle(const Value: string); +begin + Fmbtitle := Value; +end; + +end. diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Demo/fmMain.dfm b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/fmMain.dfm new file mode 100644 index 0000000..a1d4604 --- /dev/null +++ b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/fmMain.dfm @@ -0,0 +1,310 @@ +object MainForm: TMainForm + Left = 0 + Top = 0 + Hint = 'Thiis the Windows title for the dialog b ox' + Caption = 'TMS TAdvTaskDialog Explorer' + ClientHeight = 426 + ClientWidth = 530 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + Position = poDesktopCenter + ShowHint = True + PixelsPerInch = 96 + TextHeight = 13 + object Label1: TLabel + Left = 136 + Top = 278 + Width = 321 + Height = 13 + Caption = 'Separate button names with spaces (Use quotes to embed spaces)' + end + object Label3: TLabel + Left = 8 + Top = 4 + Width = 81 + Height = 13 + Caption = 'Include elements' + end + object Label2: TLabel + Left = 36 + Top = 238 + Width = 81 + Height = 13 + Caption = 'Common Buttons' + end + object Label4: TLabel + Left = 58 + Top = 164 + Width = 61 + Height = 13 + Caption = 'Expand label' + end + object Label5: TLabel + Left = 306 + Top = 163 + Width = 72 + Height = 13 + Caption = 'Collapse Label:' + end + object Label6: TLabel + Left = 19 + Top = 367 + Width = 74 + Height = 13 + Caption = 'Default button:' + end + object Button1: TButton + Left = 242 + Top = 393 + Width = 264 + Height = 25 + Caption = 'Test TAdvTaskDialog' + TabOrder = 0 + OnClick = Button1Click + end + object cbFooter: TCheckBox + Left = 18 + Top = 325 + Width = 97 + Height = 17 + Caption = 'Include Footer' + Checked = True + State = cbChecked + TabOrder = 1 + OnClick = cbFooterClick + end + object cbExpanded: TCheckBox + Left = 18 + Top = 126 + Width = 84 + Height = 17 + Caption = 'More Details' + Checked = True + State = cbChecked + TabOrder = 2 + OnClick = cbExpandedClick + end + object cbVerify: TCheckBox + Left = 19 + Top = 303 + Width = 81 + Height = 12 + Caption = 'Verify text' + Checked = True + State = cbChecked + TabOrder = 3 + OnClick = cbVerifyClick + end + object cbRadioButtons: TCheckBox + Left = 19 + Top = 187 + Width = 89 + Height = 17 + Caption = 'Radio buttons' + Checked = True + State = cbChecked + TabOrder = 4 + OnClick = cbRadioButtonsClick + end + object edCustomButtons: TEdit + Left = 128 + Top = 261 + Width = 378 + Height = 21 + TabOrder = 5 + Text = '"Custom 1" "Custom 2"' + end + object memoRadiobuttons: TMemo + Left = 128 + Top = 185 + Width = 377 + Height = 45 + Lines.Strings = ( + 'Radio Button 1' + 'Radio Button 2' + 'Radio Button 3') + TabOrder = 6 + end + object cbCustom: TCheckBox + Left = 19 + Top = 263 + Width = 89 + Height = 17 + Caption = 'Custom Buttons' + Checked = True + State = cbChecked + TabOrder = 7 + OnClick = cbCustomClick + end + object edVerifyText: TEdit + Left = 127 + Top = 299 + Width = 377 + Height = 21 + TabOrder = 8 + Text = 'Check box if you can read :)' + end + object cbCaption: TCheckBox + Left = 19 + Top = 23 + Width = 89 + Height = 17 + Caption = 'Caption' + Checked = True + State = cbChecked + TabOrder = 9 + OnClick = cbCaptionClick + end + object edCaption: TEdit + Left = 129 + Top = 21 + Width = 378 + Height = 21 + Hint = 'Text for the Windows dialog box caption.' + TabOrder = 10 + Text = 'Test of AdvTaskDialog' + end + object MemoFooter: TMemo + Left = 127 + Top = 323 + Width = 378 + Height = 35 + Lines.Strings = ( + 'Sample Footer message' + 'For example: If you do this you will loose all unsaved changes!') + TabOrder = 11 + end + object cbInstruction: TCheckBox + Left = 19 + Top = 46 + Width = 83 + Height = 17 + Caption = 'Instruction' + Checked = True + State = cbChecked + TabOrder = 12 + OnClick = cbInstructionClick + end + object MemoInstruction: TMemo + Left = 128 + Top = 48 + Width = 377 + Height = 33 + Lines.Strings = ( + 'This is the bold blue main instruction and' + 'can be mulitple lines.') + TabOrder = 13 + end + object cbContent: TCheckBox + Left = 19 + Top = 86 + Width = 64 + Height = 17 + Caption = 'Content' + Checked = True + State = cbChecked + TabOrder = 14 + OnClick = cbContentClick + end + object MemoContent: TMemo + Left = 128 + Top = 87 + Width = 377 + Height = 32 + Lines.Strings = ( + 'This is the normal "content" of the dialog.' + ' Notice it'#39's in relatively small print.') + TabOrder = 15 + end + object cbBtnOK: TCheckBox + Left = 129 + Top = 240 + Width = 50 + Height = 10 + Caption = 'cbOK' + Checked = True + State = cbChecked + TabOrder = 16 + end + object cbBtnNo: TCheckBox + Left = 246 + Top = 240 + Width = 50 + Height = 10 + Caption = 'cbNo' + TabOrder = 17 + end + object cbBtnCancel: TCheckBox + Left = 366 + Top = 240 + Width = 66 + Height = 10 + Caption = 'cbCancel' + TabOrder = 18 + end + object cbBtnClose: TCheckBox + Left = 442 + Top = 240 + Width = 62 + Height = 10 + Caption = 'cbClose' + TabOrder = 19 + end + object cbBtnRetry: TCheckBox + Left = 304 + Top = 240 + Width = 60 + Height = 10 + Caption = 'cbRetry' + TabOrder = 20 + end + object cbBtnYes: TCheckBox + Left = 182 + Top = 240 + Width = 55 + Height = 10 + Caption = 'cbYes' + TabOrder = 21 + end + object MemoExpand: TMemo + Left = 128 + Top = 125 + Width = 376 + Height = 33 + Lines.Strings = ( + 'This is for extended details that are initiall hidden' + 'unless user clicks the "view more" button.') + TabOrder = 22 + end + object edExpand: TEdit + Left = 127 + Top = 161 + Width = 121 + Height = 21 + TabOrder = 23 + Text = 'More Detail' + end + object edCollapse: TEdit + Left = 384 + Top = 161 + Width = 121 + Height = 21 + TabOrder = 24 + Text = 'Less Detail' + end + object spnDefButton: TSpinEdit + Left = 127 + Top = 364 + Width = 46 + Height = 22 + MaxValue = 0 + MinValue = 0 + TabOrder = 25 + Value = 0 + end +end diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Demo/fmMain.pas b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/fmMain.pas new file mode 100644 index 0000000..440d6e9 --- /dev/null +++ b/TAdvTaskDialog/internal/1.5.1.6/1/Demo/fmMain.pas @@ -0,0 +1,293 @@ +unit fmMain; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, TaskDialog, StdCtrls, Spin; + +type + TMainForm = class(TForm) + Button1: TButton; + cbFooter: TCheckBox; + cbExpanded: TCheckBox; + cbVerify: TCheckBox; + cbRadioButtons: TCheckBox; + cbBtnOK: TCheckBox; + cbBtnYes: TCheckBox; + cbBtnNo: TCheckBox; + cbBtnCancel: TCheckBox; + cbBtnRetry: TCheckBox; + cbBtnClose: TCheckBox; + edCustomButtons: TEdit; + Label1: TLabel; + Label3: TLabel; + memoRadiobuttons: TMemo; + cbCustom: TCheckBox; + edVerifyText: TEdit; + cbCaption: TCheckBox; + edCaption: TEdit; + MemoFooter: TMemo; + cbInstruction: TCheckBox; + MemoInstruction: TMemo; + cbContent: TCheckBox; + MemoContent: TMemo; + Label2: TLabel; + MemoExpand: TMemo; + edExpand: TEdit; + edCollapse: TEdit; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + spnDefButton: TSpinEdit; + procedure Button1Click(Sender: TObject); + procedure Button3Click(Sender: TObject); + procedure specialButtonClick(sender: tObject; buttonid: integer); + procedure cbCaptionClick(Sender: TObject); + procedure cbRadioButtonsClick(Sender: TObject); + procedure cbCustomClick(Sender: TObject); + procedure cbVerifyClick(Sender: TObject); + procedure cbFooterClick(Sender: TObject); + procedure cbInstructionClick(Sender: TObject); + procedure cbContentClick(Sender: TObject); + procedure cbExpandedClick(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.dfm} + +procedure tmsShowmessage(const Title,Instruction,content: string; icon: tTaskDialogIcon); +var + td: tAdvTaskDialog; +begin + td := tAdvTaskDialog.Create(application); + td.Title := title; + td.Instruction := Instruction; + td.Content := Content; + td.icon := icon; + td.Execute; + td.Free; +end {ShowmessageEx}; + +procedure TMainForm.Button1Click(Sender: TObject); +var + td : tAdvTaskDialog; + msg: string; + ButtonChecked: integer; // custom button number checked + lab: string; + txt: string; + i: Integer; + inQuote: boolean; + resname: string; +begin + // + td := tAdvTaskDialog.Create(self); + td.Clear; + td.DialogPosition := dpOwnerFormCenter; + + // Dialog box Caption or Title + if cbCaption.checked then + td.Title := edCaption.text; + + // Main Instruction field + if cbInstruction.checked then + begin + // Note this field will not transform \n to #13#10 + td.Instruction := memoInstruction.lines.text; + end; + + // Content -- relatively small black text + if cbContent.checked then + td.Content := MemoContent.lines.text; + + // Radio buttons optional + if cbradioButtons.checked then + begin + td.RadioButtons.Add('Button 1'); + td.RadioButtons.Add('Button 2'); +// for i := 0 to MemoRadioButtons.Lines.count - 1 do +// td.RadioButtons.Add(MemoRadioButtons.Lines[i]); + td.DefaultRadioButton := -1; + end; + // verification checkbox: probably most used for 'Do Not Show again' + if cbVerify.checked then + td.VerificationText := edVerifytext.Text; + + // Expansiion text + if cbExpanded.checked then + td.ExpandedText := memoExpand.lines.text; + // these don't show if expandedtext is blank + td.ExpandControlText := edCollapse.text; + td.CollapsControlText := edExpand.Text; + + // Programmer defined Custom Buttons + if cbCustom.Checked and (length(edCustombuttons.text) > 0) then + begin + td.CommonButtons := []; + txt := edCustomButtons.text; + if length(txt) > 0 then + begin + lab := ''; + inquote := false; + for i := 1 to length(txt) do + begin + if txt[i] = '"' then + inQuote := not Inquote; + if ((txt[i] = ' ') and (not inQuote)) or (i = length(txt)) then + begin // have end of a button + if (i = length(txt)) and (txt[i] <> ' ') then + lab := lab + txt[i]; + if length(lab) > 0 then + td.CustomButtons.add(lab); + lab := ''; + end else if txt[i] <> '"' then + lab := lab + txt[i]; + end; + end; + end; + // Common buttons To be shown + if cbBtnOK.checked then + td.CommonButtons := td.CommonButtons + [cbOK]; + if cbBtnYes.checked then + td.CommonButtons := td.CommonButtons + [cbYes]; + if cbBtnNo.checked then + td.CommonButtons := td.CommonButtons + [cbNo]; + if cbBtnCancel.checked then + td.CommonButtons := td.CommonButtons + [cbCancel]; + if cbBtnRetry.checked then + td.CommonButtons := td.CommonButtons + [cbRetry]; + if cbBtnClose.checked then + td.CommonButtons := td.CommonButtons + [cbClose]; + + if spnDefButton.Value <> 0 then + td.DefaultButton := spnDefButton.Value; + + // Footer message + if cbFooter.checked then + begin + msg := ''; + for i := 0 to MemoFooter.Lines.count - 1 do + msg := msg +memoFooter.lines[i]+ '\n'; + setlength(msg,length(msg)-2); + td.Footer := msg; + end; + + td.Icon := tiWarning; + td.FooterIcon := tfiError; + + ButtonChecked := td.Execute; + + msg := ''; + if cbRadioButtons.checked then + msg := 'Radio Button #'+IntToStr(td.RadioButtonResult-199)+' was selected.'+#13#10; + if buttonChecked < 100 then + begin // it's a standard button + case ButtonChecked of + id_OK: resname := 'cbOK'; + id_YES: resname := 'cbYES'; + id_NO: resname := 'cbNO'; + id_CANCEL: resname := 'cbCANCEL'; + id_RETRY: resname := 'cbRETRY'; + id_ABORT: resname := 'cbCLOSE'; + else + resname := 'UNKNOWN'; + end; + end else begin + resName := td.CustomButtons[ButtonChecked-100]; + end; + msg := msg +'<'+resname+'> Button (#'+IntToStr(ButtonChecked)+') was clicked.'; + if cbVerify.Checked then + begin + msg := msg + #13#10+'Verify box was '; + if not td.VerifyResult then + msg := msg +'NOT '; + msg := msg + 'checked.'; + end; + td.Free; + tmsShowmessage('TaskDialog Espoerer',msg,'',tiInformation); + +end; + +procedure TMainForm.Button3Click(Sender: TObject); +begin + tmsShowmessage('This is the Title','This is the Instruction','This is the content',tiWarning); +end; + +procedure TMainForm.cbCaptionClick(Sender: TObject); +begin + edCaption.Enabled := (sender as tCheckbox).checked; + if edCaption.Enabled and (edCaption.Text = '') then + edCaption.text := 'Test of AdvTaskDialog'; +end; + +procedure TMainForm.cbContentClick(Sender: TObject); +begin + MemoContent.Enabled := (sender as tCheckbox).checked; + if MemoContent.Enabled and (MemoContent.lines.count = 0) then + memoContent.lines.text := 'This is the normal "content" of the dialog.'#13#10+ + 'Notice it''s in relatively small print.'; +end; + +procedure TMainForm.cbCustomClick(Sender: TObject); +begin + edCustomButtons.Enabled := (sender as tCheckbox).checked; + if edCustomButtons.enabled and (edCustomButtons.Text = '') then + edCustomButtons.text := '"Custom 1" "Custom 2"'; +end; + +procedure TMainForm.cbExpandedClick(Sender: TObject); +begin + MemoExpand.enabled := (sender as tCheckbox).checked; +end; + +procedure TMainForm.cbFooterClick(Sender: TObject); +begin + MemoFooter.Enabled := (sender as tcheckbox).checked; + if MemoFooter.Enabled and (MemoFooter.Lines.count = 0) then + memoFooter.Lines.Text := 'Sample footer Message'#13#10+ + 'For Example: If you do this you will loose all unsaved changes.'; +end; + +procedure TMainForm.cbInstructionClick(Sender: TObject); +begin + MemoInstruction.Enabled := (sender as tCheckbox).Checked; + if MemoInstruction.Enabled and (memoInstruction.lines.count = 0) then + MemoInstruction.Lines.text := 'This is the bold blue main instruction and'#1310+ + 'can be mulitple lines.'; +end; + +procedure TMainForm.cbRadioButtonsClick(Sender: TObject); +begin + memoRadioButtons.Enabled := (sender as tCheckbox).checked; + if memoradioButtons.Enabled and (memoRadioButtons.lines.count = 0) then + begin + memoRadioButtons.Lines.Add('Test Radio Button #1'); + memoRadioButtons.Lines.Add('Test Radio button #2'); + MemoRadioButtons.Lines.Add('Test Radio Button #3'); + end; +end; + +procedure TMainForm.cbVerifyClick(Sender: TObject); +begin + edVerifyText.enabled := (sender as tCheckbox).Checked; + if edverifyText.Enabled and (edVerifyText.Text = '') then + edVerifyText.text := 'Check Box if you can read :)'; +end; + +procedure TMainForm.specialButtonClick(sender: tObject; buttonid: integer); +var + td: tAdvTaskDialog; +begin + td := sender as tAdvTaskDialog; + td.tag := buttonid; +end; + +end. diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/PictureContainer.dcu b/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/PictureContainer.dcu new file mode 100644 index 0000000..73238e6 Binary files /dev/null and b/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/PictureContainer.dcu differ diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/SpanishConsts.dcu b/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/SpanishConsts.dcu new file mode 100644 index 0000000..8c95998 Binary files /dev/null and b/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/SpanishConsts.dcu differ diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/SpanishContst.dcu b/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/SpanishContst.dcu new file mode 100644 index 0000000..7b82f45 Binary files /dev/null and b/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/SpanishContst.dcu differ diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialog.dcu b/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialog.dcu new file mode 100644 index 0000000..e4b8c22 Binary files /dev/null and b/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialog.dcu differ diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialog.res b/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialog.res new file mode 100644 index 0000000..5028366 Binary files /dev/null and b/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialog.res differ diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialogDE.dcu b/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialogDE.dcu new file mode 100644 index 0000000..7e74d67 Binary files /dev/null and b/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialogDE.dcu differ diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialogPkg.bpl b/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialogPkg.bpl new file mode 100644 index 0000000..4d9290f Binary files /dev/null and b/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialogPkg.bpl differ diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialogPkg.dcp b/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialogPkg.dcp new file mode 100644 index 0000000..6f2e9b0 Binary files /dev/null and b/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialogPkg.dcp differ diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialogPkg.dcu b/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialogPkg.dcu new file mode 100644 index 0000000..a0d6d0f Binary files /dev/null and b/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialogPkg.dcu differ diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialogRegDE.dcu b/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialogRegDE.dcu new file mode 100644 index 0000000..f421522 Binary files /dev/null and b/TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialogRegDE.dcu differ diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Source/SpanishConsts.pas b/TAdvTaskDialog/internal/1.5.1.6/1/Source/SpanishConsts.pas new file mode 100644 index 0000000..6cbab14 --- /dev/null +++ b/TAdvTaskDialog/internal/1.5.1.6/1/Source/SpanishConsts.pas @@ -0,0 +1,22 @@ +unit SpanishConsts; + +interface + +resourcestring + SSpanishMsgDlgOK = 'OK'; + SSpanishMsgDlgYes = '&Si'; + SSpanishMsgDlgNo = '&No'; + SSpanishMsgDlgCancel = 'Cancelar'; + SSpanishMsgDlgAbort = '&Abortar'; + SSpanishMsgDlgRetry = '&Reintentar'; + + SSpanishMsgDlgWarning = 'Aviso'; + SSpanishMsgDlgError = 'Error'; + SSpanishMsgDlgInformation = 'Información'; + SSpanishMsgDlgConfirm = 'Confirmación'; + + +implementation + +end. + diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialog.pas b/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialog.pas new file mode 100644 index 0000000..d976bd0 --- /dev/null +++ b/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialog.pas @@ -0,0 +1,4814 @@ +{***************************************************************************} +{ TTaskDialog component } +{ for Delphi & C++Builder } +{ } +{ written by TMS Software } +{ copyright © 2006 - 2009 } +{ Email : info@tmssoftware.com } +{ Web : http://www.tmssoftware.com } +{ } +{ The source code is given as is. The author is not responsible } +{ for any possible damage done due to the use of this code. } +{ The component can be freely used in any application. The complete } +{ source code remains property of the author and may not be distributed, } +{ published, given or sold in any form as such. No parts of the source } +{ code can be included in any other component or application without } +{ written authorization of the author. } +{***************************************************************************} + +unit TaskDialog; + +{$R TASKDIALOG.RES} + +{$I TMSDEFS.INC} + +interface + +uses + Classes, Windows, Messages, Forms, Dialogs, SysUtils, StdCtrls, Graphics, Consts, Math, + ExtCtrls, Controls, ComCtrls, PictureContainer, ComObj, ShellAPI, CommCtrl, ClipBrd, ImgList; + +const +{$IFNDEF DELPHI6_LVL} + sLineBreak = #13#10; +{$ENDIF} + + MAJ_VER = 1; // Major version nr. + MIN_VER = 5; // Minor version nr. + REL_VER = 1; // Release nr. + BLD_VER = 6; // Build nr. + + // version history + // 1.0.0.0 : First release + // 1.0.1.0 : Added support for Information icon + // : Fixed issue with radiobutton initialization + // 1.0.2.0 : Various cosmetic fixes for emulated dialog + // : Design time preview + // 1.0.3.0 : Improved wordwrapped content display + // 1.0.4.0 : Added support to display shield icon on non Vista operating systems + // 1.0.5.0 : Fixed issue with tiError icon for non Vista operating systems + // 1.0.5.1 : Fixed issue with tiBlank icon for non Vista operating systems + // 1.0.5.2 : Removed Close button from dialog caption for non Vista operating systems + // 1.0.5.3 : Fixed issue with blank FooterIcon + // : Fixed issue with content height + // 1.0.5.4 : Improved : content sizing for non Vista operating systems dialogs + // 1.0.5.5 : Fixed issue with progress bar for non Vista operating systems dialogs + // 1.0.5.6 : Fixed issue with Expanded Text size calculation for non Vista operating systems dialogs + // 1.0.5.7 : Fixed issue with default button for non Vista operating systems dialogs + // 1.0.5.8 : Fixed issue with Expanded Text size calculation for non Vista operating systems dialogs + // : Fixed issue with FooterIcon drawing + // 1.0.6.0 : New : property DialogPosition added , only applicable for non Vista OS + // : Fixed : issue with ESC key handling + // 1.1.0.0 : Improved : Reflect properties change at run time + // : Fixed issues with Footer and its FooterIcon size + // : Added ShortCut support in CommandLinks + // 1.2.0.0 : New : support added for Hyperlinks in expanded text + // : New : option to show no default radiobutton added + // : New : capability to update instruction, content, expanded text, footer while dialog is displayed + // : New : option to allow cancelling the dialog with ESC added + // : Improved : text wrapping for verify text + // : New : TAdvTaskDialogEx component created using TAdvGlowButton on non Vista emulation + // : New : property ApplicationIsParent added + // : New : support for custom icons + // 1.2.1.0 : New : support for Information & Shield footer icon + // : Improved : border drawing on Vista in XP compatibility mode + // : New : added support for \n linebreaks in Vista emulation mode + // 1.2.1.1 : Fixed : issue with DefaultRadioButton initialization + // 1.2.1.2 : Fixed : issue with \n linebreaks with doHyperlinks style + // 1.2.2.0 : Improved : keyboard handling for CommandLinks dialog on non Vista emulation + // : Improved : DefaultButton handling for CommandLinks dialog on non Vista emulation + // 1.2.2.1 : Fixed : issue with noCommandLinksIcon on non Vista emulation + // 1.2.2.2 : Fixed : hot painting issue on taskdialog button on non Vista emulation + // 1.2.3.0 : Improved : allow using \n line separators in footer text on non Vista emulation + // : Fixed : issue with doAllowDialogCancel on non Vista emulation + // : Fixed : issue with doAllowMinimize on non Vista emulation + // 1.2.4.0 : Improved : removed limitation on text length of Content, Title, ... in Vista native mode + // : Improved : handling of linefeed character on non Vista emulation + // : Improved : handling of anchors in Vista native mode + // : Improved : handling of ESC with common buttons + // 1.2.4.1 : Improved : prevent that Alt-F4 can close the dialog + // 1.2.5.0 : New : support for hotkeys on expand/contract text on non-Vista emulation + // 1.2.5.1 : Fixed : issue with identical accelerator key for expand/collaps + // 1.2.6.0 : Improved : taskdialog does not size beyond screen width + // : Improved : DefaultButton can be set to -1 to have no default button + // 1.2.7.0 : New: NonNativeDialog property added + // : New: NonNativeMinFormWidth public property added + // 1.2.8.0 : Improved : display of disabled task button + // 1.2.8.1 : Fixed : display of long text in non native taskdialog + // 1.2.8.2 : Fixed : issue with DefaultButton = IdYes, IdNo + // 1.5.0.0 : New : replacement functions for ShowMessage , MessageDlg + // : New : TAdvInputTaskDialog + // : New : ElevateButton method added + // : Improved : message label set transparent + // : Improved : Ctrl-C puts taskdialog text on clipboard + // 1.5.0.1 : Fixed : Delphi 5 issue with TAdvInputTaskDialog + // 1.5.0.2 : Fixed : issue with use of TAdvTaskDialog on topmost forms + // 1.5.0.3 : Improved : automatic height adaption of custom input control + // 1.5.0.4 : Fixed : issue with removing InputControl at designtime + // 1.5.0.5 : Improved : width control of custom editor in TAdvInputTaskDialog + // 1.5.0.6 : Improved : AdvShowMessageBox() handling of ESC key for cancel button + // 1.5.0.7 : Improved : handling of \n linefeed sequence + // 1.5.0.8 : Improved : use of dialog constants in AdvMessageDlg procs + // 1.5.0.9 : Improved : use of question icon in mtConfirmation dialog type + // 1.5.1.0 : Improved : support for F1 help handling + // : Improved : support for HelpContext in message dialog replacements + // : New : various new AdvMessageDlg() function overloads to set Title & Caption separately + // 1.5.1.1 : Fixed : issue with use of dialog on modal StayOnTop forms + // 1.5.1.2 : Improved : handling of button disabling for non native dialog + // 1.5.1.3 : Improved : Clear method clears InputText field too + // 1.5.1.4 : Fixed : issue with handling OnDialogClose and custom input controls in TAdvInputTaskDialog + // 1.5.1.5 : Fixed : close button shown on emulated dialog when doAllowDialogCancel is set + // 1.5.1.6 : Improved : when custom input control is wider than taskdialog, adapt width of taskdialog + +type + {$IFNDEF DELPHI6_LVL} + PBoolean = ^Boolean; + {$ENDIF} + + TTaskDialogResult = (trNone, trOk, trCancel); + + TNonNativeDialog = (nndAuto, nndAlways); + + TTaskDialogOption = (doHyperlinks, doCommandLinks, doCommandLinksNoIcon, doExpandedDefault, + doExpandedFooter, doAllowMinimize, doVerifyChecked, doProgressBar, doProgressBarMarquee, + doTimer, doNoDefaultRadioButton, doAllowDialogCancel); + + TTaskDialogOptions = set of TTaskDialogOption; + + TTaskDialogIcon = (tiBlank, tiWarning, tiQuestion, tiError, tiInformation,tiNotUsed,tiShield); + //(mtWarning, mtError, mtInformation, mtConfirmation, mtCustom); + TTaskDialogFooterIcon = (tfiBlank, tfiWarning, tfiQuestion, tfiError, tfiInformation, + tfiShield); + + TTaskDialogProgressState = (psNormal, psError, psPaused); + + TTaskDialogPosition = (dpScreenCenter, dpOwnerFormCenter); + + TCommonButton = (cbOK, cbYes, cbNo, cbCancel, cbRetry, cbClose); + + TTaskDialogButtonClickEvent = procedure(Sender: TObject; ButtonID: integer) of object; + TTaskDialogHyperlinkClickEvent = procedure(Sender: TObject; HRef: string) of object; + TTaskDialogVerifyClickEvent = procedure(Sender: TObject; Checked: boolean) of object; + TTaskDialogCloseEvent = procedure(Sender: TObject; var CanClose: boolean) of object; + + TTaskDialogProgressEvent = procedure(Sender: TObject; var Pos: integer; var State: TTaskDialogProgressState) of object; + + TCommonButtons = set of TCommonButton; + + TAdvMessageForm = class; + + TInputType = (itEdit, itMemo, itComboEdit, itComboList, itDate, itCustom, itNone); + + TInputGetTextEvent = procedure(Sender: TObject; var Text: string) of object; + TInputSetTextEvent = procedure(Sender: TObject; Text: string) of object; + + TCustomAdvTaskDialog = class(TComponent) + private + FTitle: string; + FContent: string; + FFooter: string; + FInstruction: string; + FCommonButtons: TCommonButtons; + FExpandedText: string; + FCollapsControlText: string; + FExpandControlText: string; + FButtonResult: integer; + FVerifyResult: boolean; + FVerifyText: string; + FCustomButtons: TStringList; + FCustomIcon: TIcon; + FOptions: TTaskDialogOptions; + FRadioButtons: TStringList; + FhWnd: THandle; + FOnCreated: TNotifyEvent; + FOnTimer: TNotifyEvent; + FHelpContext: longint; + FProgressBarMin: integer; + FProgressBarMax: integer; + FOnDialogHyperlinkClick: TTaskDialogHyperlinkClickEvent; + FOnDialogClick: TTaskDialogButtonClickEvent; + FOnDialogRadioClick: TTaskDialogButtonClickEvent; + FOnDialogVerifyClick: TTaskDialogVerifyClickEvent; + FOnDialogProgress: TTaskDialogProgressEvent; + FOnDialogClose: TTaskDialogCloseEvent; + FOnDialogInputGetText: TInputGetTextEvent; + FOnDialogInputSetText: TInputSetTextEvent; + FIcon: TTaskDialogIcon; + FFooterIcon: TTaskDialogFooterIcon; + FDefaultButton: integer; + FDefaultRadioButton: integer; + FDialogForm: TAdvMessageForm; + FDlgPosition: TTaskDialogPosition; + FApplicationIsParent: Boolean; + FModalParent: THandle; + FMinFormWidth: Integer; + FNonNativeDialog: TNonNativeDialog; + FInputType: TInputType; + FInputText: string; + FInputItems: TStrings; + FInputControl: TWinControl; + function GetVersion: string; + procedure SetVersion(const Value: string); + function GetVersionNr: Integer; + procedure SetCustomButtons(const Value: TStringList); + procedure SetRadioButtons(const Value: TStringList); + procedure SetContent(const Value: string); + procedure SetInstruction(const Value: string); + procedure SetFooter(const Value: string); + procedure SetExpandedText(const Value: string); + procedure SetCustomIcon(const Value: TIcon); + procedure SetInputItems(const Value: TStrings); + protected + function CreateButton(AOwner: TComponent): TWinControl; virtual; + function CreateRadioButton(AOwner: TComponent): TWinControl; virtual; + procedure InitRadioButton(AOwner: TForm; Btn: TWinControl; btnIndex: Integer; OnClickEvent : TNotifyEvent); virtual; + procedure SetRadioButtonState(Btn: TWinControl; Checked: boolean); virtual; + procedure SetRadioButtonCaption(Btn: TWinControl; Value: string); virtual; + procedure SetButtonCaption(aButton: TWinControl; Value: TCaption); virtual; + procedure SetButtonCancel(aButton: TWinControl; Value: Boolean); virtual; + procedure SetButtonDefault(aButton: TWinControl; Value: Boolean); virtual; + procedure SetButtonModalResult(aButton: TWinControl; Value: Integer); virtual; + function GetButtonModalResult(aButton: TWinControl): Integer; virtual; + procedure Notification(AComponent: TComponent; AOperation: TOperation); override; + procedure TaskDialogFormCreated(Sender: TObject); + property CustomButtons: TStringList read FCustomButtons write SetCustomButtons; + property CustomIcon: TIcon read FCustomIcon write SetCustomIcon; + property RadioButtons: TStringList read FRadioButtons write SetRadioButtons; + property CommonButtons: TCommonButtons read FCommonButtons write FCommonButtons; + property DefaultButton: integer read FDefaultButton write FDefaultButton; + property DefaultRadioButton: integer read FDefaultRadioButton write FDefaultRadioButton; + property DialogPosition: TTaskDialogPosition read FDlgPosition write FDlgPosition default dpScreenCenter; + property ExpandedText: string read FExpandedText write SetExpandedText; + property Footer: string read FFooter write SetFooter; + property FooterIcon: TTaskDialogFooterIcon read FFooterIcon write FFooterIcon default tfiBlank; + property HelpContext: longint read FHelpContext write FHelpContext default 0; + property Icon: TTaskDialogIcon read FIcon write FIcon default tiBlank; + property InputText: string read FInputText write FInputText; + property InputType: TInputType read FInputType write FInputType; + property InputItems: TStrings read FInputItems write SetInputItems; + property InputControl: TWinControl read FInputControl write FInputControl; + property Title: string read FTitle write FTitle; + property Instruction: string read FInstruction write SetInstruction; + property Content: string read FContent write SetContent; + property ExpandControlText: string read FExpandControlText write FExpandControlText; + property CollapsControlText: string read FCollapsControlText write FCollapsControlText; + property Options: TTaskDialogOptions read FOptions write FOptions; + property ApplicationIsParent: boolean read FApplicationIsParent write FApplicationIsParent default true; + property VerificationText: string read FVerifyText write FVerifyText; + property NonNativeDialog: TNonNativeDialog read FNonNativeDialog write FNonNativeDialog default nndAuto; + property NonNativeMinFormWidth: integer read FMinFormWidth write FMinFormWidth default 350; + + property ProgressBarMin: integer read FProgressBarMin write FProgressBarMin default 0; + property ProgressBarMax: integer read FProgressBarMax write FProgressBarMax default 100; + property Version: string read GetVersion write SetVersion; + + property OnDialogCreated: TNotifyEvent read FOnCreated write FOnCreated; + property OnDialogClose: TTaskDialogCloseEvent read FOnDialogClose write FOnDialogClose; + property OnDialogButtonClick: TTaskDialogButtonClickEvent read FOnDialogClick write FOnDialogClick; + property OnDialogInputSetText: TInputSetTextEvent read FOnDialogInputSetText write FOnDialogInputSetText; + property OnDialogInputGetText: TInputGetTextEvent read FOnDialogInputGetText write FOnDialogInputGetText; + property OnDialogRadioClick: TTaskDialogButtonClickEvent read FOnDialogRadioClick write FOnDialogRadioClick; + property OnDialogHyperlinkClick: TTaskDialogHyperlinkClickEvent read FOnDialogHyperlinkClick write FOnDialogHyperLinkClick; + property OnDialogTimer: TNotifyEvent read FOnTimer write FOnTimer; + property OnDialogVerifyClick: TTaskDialogVerifyClickEvent read FOnDialogVerifyClick write FOnDialogVerifyClick; + property OnDialogProgress: TTaskDialogProgressEvent read FOnDialogProgress write FOnDialogProgress; + public + property hWnd: THandle read FhWnd write FhWnd; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function Execute: integer; virtual; + procedure Clear; + procedure EnableButton(ButtonID: integer; Enabled: boolean); + procedure ElevateButton(ButtonID: integer; Enabled: boolean); + procedure ClickButton(ButtonID: integer); + property RadioButtonResult: integer read FButtonResult write FButtonResult; + property VerifyResult: boolean read FVerifyResult write FVerifyResult; + property ModalParent: THandle read FModalParent write FModalParent; + end; + + TAdvTaskDialog = class(TCustomAdvTaskDialog) + published + property CustomButtons; + property CustomIcon; + property RadioButtons; + property CommonButtons; + property DefaultButton; + property DefaultRadioButton; + property DialogPosition; + property ExpandedText; + property Footer; + property FooterIcon; + property HelpContext; + property Icon; + property Title; + property Instruction; + property Content; + property ExpandControlText; + property CollapsControlText; + property Options; + property ApplicationIsParent; + property VerificationText; + property NonNativeDialog; + property NonNativeMinFormWidth; + + property ProgressBarMin; + property ProgressBarMax; + property Version; + + property OnDialogCreated; + property OnDialogClose; + property OnDialogButtonClick; + property OnDialogRadioClick; + property OnDialogHyperlinkClick; + property OnDialogTimer; + property OnDialogVerifyClick; + property OnDialogProgress; + end; + + TAdvInputTaskDialog = class(TCustomAdvTaskDialog) + public + constructor Create(AOwner: TComponent); override; + function Execute: integer; override; + published + property ApplicationIsParent; + property CustomButtons; + property CustomIcon; + property CommonButtons; + property DefaultButton; + property DialogPosition; + property ExpandedText; + property Footer; + property FooterIcon; + property Icon; + property InputControl; + property InputType; + property InputText; + property InputItems; + property Instruction; + property Title; + property Content; + property ExpandControlText; + property CollapsControlText; + property VerificationText; + property OnDialogCreated; + property OnDialogClose; + property OnDialogButtonClick; + property OnDialogVerifyClick; + property OnDialogInputSetText; + property OnDialogInputGetText; + end; + + TTaskDialogButton = class(TCustomControl) + private + FOnMouseLeave: TNotifyEvent; + FOnMouseEnter: TNotifyEvent; + FGlyph: TBitmap; + FGlyphDisabled: TBitmap; + FGlyphDown: TBitmap; + FGlyphHot: TBitmap; + FMouseInControl: Boolean; + FMouseDown: Boolean; + FBorderColorDown: TColor; + FBorderColorHot: TColor; + FBorderColor: TColor; + FModalResult: TModalResult; + FHeadingFont: TFont; + FAutoFocus: boolean; + procedure OnPictureChanged(Sender: TObject); + procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER; + procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; + procedure SetGlyph(const Value: TBitmap); + procedure SetGlyphDisabled(const Value: TBitmap); + procedure SetGlyphDown(const Value: TBitmap); + procedure SetGlyphHot(const Value: TBitmap); + procedure SetHeadingFont(const Value: TFont); + protected + procedure Paint; override; + procedure KeyPress(var Key: char); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Click; override; + procedure DoEnter; override; + procedure DoExit; override; + property AutoFocus: boolean read FAutoFocus write FAutoFocus; + published + property Anchors; + property BorderColor: TColor read FBorderColor write FBorderColor; + property BorderColorHot: TColor read FBorderColorHot write FBorderColorHot; + property BorderColorDown: TColor read FBorderColorDown write FBorderColorDown; + property Constraints; + property Enabled; + property HeadingFont: TFont read FHeadingFont write SetHeadingFont; + property ModalResult: TModalResult read FModalResult write FModalResult default 0; + property Picture: TBitmap read FGlyph write SetGlyph; + property PictureHot: TBitmap read FGlyphHot write SetGlyphHot; + property PictureDown: TBitmap read FGlyphDown write SetGlyphDown; + property PictureDisabled: TBitmap read FGlyphDisabled write SetGlyphDisabled; + property Visible; + property OnClick; + property OnDblClick; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter; + property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave; + end; + + TAdvMessageForm = class(TForm) + private + Message: TLabel; + FHorzMargin: Integer; + FVertMargin: Integer; + FHorzSpacing: Integer; + FVertSpacing: Integer; + FExpandButton: TTaskDialogButton; + FExpanded: Boolean; + //FExpandLabel: TLabel; + FExpandControlText: String; + FCollapsControlText: String; + FcmBtnList: TList; + FcsBtnList: TList; + FTaskDialog: TCustomAdvTaskDialog; + FFooterIcon: TImage; + FFooterIconID: PChar; + FRadioList: TList; + FVerificationCheck: TCheckBox; + FProgressBar: TProgressBar; + FIcon: TImage; + FFooterXSize: Integer; + FFooterYSize: Integer; + FContentXSize: Integer; + FContentYSize: Integer; + FExpTextXSize: Integer; + FExpTextYSize: Integer; + FExpTextTop: Integer; + FAnchor: String; + FTimer: TTimer; + FWhiteWindowHeight: Integer; + FHorzParaMargin: Integer; + FMinFormWidth: Integer; + FInputEdit: TEdit; + FInputCombo: TComboBox; + FInputDate: TDateTimePicker; + FInputMemo: TMemo; + FOldParent: TWinControl; + procedure WMActivate(var M: TWMActivate); message WM_ACTIVATE; + procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR; + procedure OnTimer(Sender: TObject); + procedure OnExpandButtonClick(Sender: TObject); + procedure OnVerifyClick(Sender: TObject); + procedure OnRadioClick(Sender: TObject); + procedure OnButtonClick(Sender: TObject); + procedure SetExpandButton(const Value: TTaskDialogButton); + procedure GetTextSize(Canvas: TCanvas; Text: string;var W, H: Integer); + //procedure GetMultiLineTextSize(Canvas: TCanvas; Text: string; HeadingFont, ParaFont: TFont; var W, H: Integer); + //procedure HelpButtonClick(Sender: TObject); + protected + procedure SetExpanded(Value: Boolean); + procedure CustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure WriteToClipBoard(Text: String); + function GetFormText: String; + procedure Paint; override; + procedure KeyDown(var Key:Word;Shift:TShiftSTate); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure DoClose(var Action: TCloseAction); override; + + function GetButton(ButtonID: Integer; var TaskButton: TTaskDialogButton): TButton; + procedure EnableButton(ButtonID: integer; Enabled: boolean); + procedure ClickButton(ButtonID: integer); + function IsAnchor(x, y: integer): string; + function GetFooterRect: TRect; + function GetContentRect: TRect; + function GetExpTextRect: TRect; + procedure DrawExpandedText; + procedure DrawContent; + procedure DrawFooter; + property Expanded: Boolean read FExpanded default true; + property ExpandButton: TTaskDialogButton read FExpandButton write SetExpandButton; + procedure DoShow; override; + public + constructor CreateNew(AOwner: TComponent; Dummy: Integer); {$IFNDEF BCB} reintroduce; {$ENDIF} + destructor Destroy; override; + procedure BuildTaskDialog(TaskDialog: TCustomAdvTaskDialog); + procedure SetPositions; + procedure UpdateDialog; + property MinFormWidth: Integer Read FMinFormWidth Write FMinFormWidth; + end; + + function AdvMessageDlgPos(TaskDialog: TCustomAdvTaskDialog; X, Y: Integer): Integer; + + +function AdvShowMessage(const Instruction: string): boolean; overload; +function AdvShowMessage(const Title, Instruction: string): boolean; overload; +function AdvShowmessage(const Title, Instruction: string; tiIcon: tTaskDialogIcon): boolean; overload; +function AdvShowMessage(const Title, Instruction, content, verify: string; + tiIcon: tTaskDialogIcon): boolean; overload; + +function AdvMessageBox(hWnd: HWND; lpInstruction, lpTitle: PChar; flags: UINT): Integer; + + +function AdvShowMessageFmt(const Instruction: string; Parameters: array of const): boolean; + +function AdvMessageDlg(const Instruction: string; DlgType: TMsgDlgType; + Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer; overload; + +function AdvMessageDlg(const Instruction: string; DlgType: TMsgDlgType; + Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): Integer; overload; + +function AdvTaskMessageDlg(const Title, Msg: string; DlgType: TMsgDlgType; + Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer; overload; +function AdvTaskMessageDlg(const Title, Msg: string; DlgType: TMsgDlgType; + Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): Integer; overload; + +function AdvTaskMessageDlgPos(const Title, Msg: string; DlgType: TMsgDlgType; + Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): Integer; overload; + +function AdvTaskMessageDlgPos(const Title, Msg: string; DlgType: TMsgDlgType; + Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer; + DefaultButton: TMsgDlgBtn): Integer; overload; + +function AdvTaskMessageDlgPosHelp(const Title, Msg: string; DlgType: TMsgDlgType; + Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer; + const HelpFileName: string): Integer; overload; + +function AdvTaskMessageDlgPosHelp(const Title, Msg: string; DlgType: TMsgDlgType; + Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer; + const HelpFileName: string; DefaultButton: TMsgDlgBtn): Integer; overload; + + + +function AdvInputQueryDlg(ACaption, APrompt: string; var Value: string): boolean; + +var + DRAWBORDER: Boolean = True; + ButtonNames: array[TCommonButton] of string = ('OK', 'Yes', 'No', 'Cancel', 'Retry', 'Abort'); + ButtonCaptions: array[TCommonButton] of Pointer; + +procedure Register; + +implementation + +{$I HTMLENGO.PAS} + +const + TDE_CONTENT = 0; + TDE_EXPANDED_INFORMATION = 1; + TDE_FOOTER = 2; + TDE_MAIN_INSTRUCTION = 3; + + TDF_ENABLE_HYPERLINKS = $0001; + TDF_USE_HICON_MAIN = $0002; + TDF_USE_HICON_FOOTER = $0004; + TDF_ALLOW_DIALOG_CANCELLATION = $0008; + TDF_USE_COMMAND_LINKS = $0010; + TDF_USE_COMMAND_LINKS_NO_ICON = $0020; + TDF_EXPAND_FOOTER_AREA = $0040; + TDF_EXPANDED_BY_DEFAULT = $0080; + TDF_VERIFICATION_FLAG_CHECKED = $0100; + TDF_SHOW_PROGRESS_BAR = $0200; + TDF_SHOW_MARQUEE_PROGRESS_BAR = $0400; + TDF_CALLBACK_TIMER = $0800; + TDF_POSITION_RELATIVE_TO_WINDOW = $1000; + TDF_RTL_LAYOUT = $2000; + TDF_NO_DEFAULT_RADIO_BUTTON = $4000; + TDF_CAN_BE_MINIMIZED = $8000; + + TDM_NAVIGATE_PAGE = WM_USER+101; + TDM_CLICK_BUTTON = WM_USER+102; // wParam = Button ID + TDM_SET_MARQUEE_PROGRESS_BAR = WM_USER+103; // wParam = 0 (nonMarque) wParam != 0 (Marquee) + TDM_SET_PROGRESS_BAR_STATE = WM_USER+104; // wParam = new progress state + TDM_SET_PROGRESS_BAR_RANGE = WM_USER+105; // lParam = MAKELPARAM(nMinRange, nMaxRange) + TDM_SET_PROGRESS_BAR_POS = WM_USER+106; // wParam = new position + TDM_SET_PROGRESS_BAR_MARQUEE = WM_USER+107; // wParam = 0 (stop marquee), wParam != 0 (start marquee), lparam = speed (milliseconds between repaints) + TDM_SET_ELEMENT_TEXT = WM_USER+108; // wParam = element (TASKDIALOG_ELEMENTS), lParam = new element text (LPCWSTR) + TDM_CLICK_RADIO_BUTTON = WM_USER+110; // wParam = Radio Button ID + TDM_ENABLE_BUTTON = WM_USER+111; // lParam = 0 (disable), lParam != 0 (enable), wParam = Button ID + TDM_ENABLE_RADIO_BUTTON = WM_USER+112; // lParam = 0 (disable), lParam != 0 (enable), wParam = Radio Button ID + TDM_CLICK_VERIFICATION = WM_USER+113; // wParam = 0 (unchecked), 1 (checked), lParam = 1 (set key focus) + TDM_UPDATE_ELEMENT_TEXT = WM_USER+114; // wParam = element (TASKDIALOG_ELEMENTS), lParam = new element text (LPCWSTR) + TDM_SET_BUTTON_ELEVATION_REQUIRED_STATE = WM_USER+115; // wParam = Button ID, lParam = 0 (elevation not required), lParam != 0 (elevation required) + TDM_UPDATE_ICON = WM_USER+116; // wParam = icon element (TASKDIALOG_ICON_ELEMENTS), lParam = new icon (hIcon if TDF_USE_HICON_* was set, PCWSTR otherwise) + + TDN_CREATED = 0; + TDN_NAVIGATED = 1; + TDN_BUTTON_CLICKED = 2; // wParam = Button ID + TDN_HYPERLINK_CLICKED = 3; // lParam = (LPCWSTR)pszHREF + TDN_TIMER = 4; // wParam = Milliseconds since dialog created or timer reset + TDN_DESTROYED = 5; + TDN_RADIO_BUTTON_CLICKED = 6; // wParam = Radio Button ID + TDN_DIALOG_CONSTRUCTED = 7; + TDN_VERIFICATION_CLICKED = 8; // wParam = 1 if checkbox checked, 0 if not, lParam is unused and always 0 + TDN_HELP = 9; + TDN_EXPANDO_BUTTON_CLICKED = 10; // wParam = 0 (dialog is now collapsed), wParam != 0 (dialog is now expanded) + + TDCBF_OK_BUTTON = $0001; // selected control return value IDOK + TDCBF_YES_BUTTON = $0002; // selected control return value IDYES + TDCBF_NO_BUTTON = $0004; // selected control return value IDNO + TDCBF_CANCEL_BUTTON = $0008; // selected control return value IDCANCEL + TDCBF_RETRY_BUTTON = $0010; // selected control return value IDRETRY + TDCBF_CLOSE_BUTTON = $0020; // selected control return value IDCLOSE + + PBST_NORMAL = $0001; + PBST_ERROR = $0002; + PBST_PAUSED = $0003; +{ + TD_ICON_BLANK = 100; + TD_ICON_WARNING = 101; + TD_ICON_QUESTION = 102; + TD_ICON_ERROR = 103; + TD_ICON_INFORMATION = 104; + TD_ICON_BLANK_AGAIN = 105; + TD_ICON_SHIELD = 106; +} + // Well, Microsoft did it again, incorrect TD_ICON_xxx values in the SDK + // and changing values just between last beta2 & RTM... Gotta love them. + // These values were obtained emperically by the lack of proper documentation + + TD_ICON_BLANK = 17; + TD_ICON_WARNING = 84; + TD_ICON_QUESTION = 99; + TD_ICON_ERROR = 98; + TD_ICON_INFORMATION = 81; + TD_ICON_BLANK_AGAIN = 0; + TD_ICON_SHIELD = 78; + + +type + TProControl = class(TControl); + + PTASKDIALOG_BUTTON = ^TTASKDIALOG_BUTTON; + TTASKDIALOG_BUTTON = record + nButtonID: integer; + pszButtonText: pwidechar; + end; + + TTaskDialogWideString = array[0..1023] of widechar; + + TTaskDialogButtonArray = array of TTASKDIALOG_BUTTON; + TTaskDialogWideStringArray = array of TTaskDialogWideString; + + PTASKDIALOGCONFIG = ^TTASKDIALOGCONFIG; + TTASKDIALOGCONFIG = record + cbSize: integer; + hwndParent: THandle; + hInstance: THandle; + dwFlags: integer; // TASKDIALOG_FLAGS dwFlags; + dwCommonButtons: integer; // TASKDIALOG_COMMON_BUTTON_FLAGS + pszWindowTitle: pwidechar; + hMainIcon: integer; + pszMainInstruction: pwidechar; + pszContent: pwidechar; + cButtons: integer; + pbuttons: pinteger; // const TASKDIALOG_BUTTON* pButtons; + nDefaultButton: integer; + cRadioButtons: integer; + pRadioButtons: pinteger; //const TASKDIALOG_BUTTON* pRadioButtons; + nDefaultRadioButton: integer; + pszVerificationText: pwidechar; + pszExpandedInformation: pwidechar; + pszExpandedControlText: pwidechar; + pszCollapsedControlText: pwidechar; + case Integer of + 0: (hFooterIcon: HICON); + 1: (pszFooterIcon: pwidechar; + pszFooter: pwidechar; + pfCallback: pinteger; + pData: pointer; + cxWidth: integer // width of the Task Dialog's client area in DLU's. + // If 0, Task Dialog will calculate the ideal width. + ); +{ + hFooterIcon: integer; + pszFooter: pwidechar; + pfCallBack: pinteger; // PFTASKDIALOGCALLBACK pfCallback; + pData: pointer; + cxWidth: integer; +} + end; + +//------------------------------------------------------------------------------ + +procedure RunElevated(HWND: THandle; pszPath, pszParameters, pszDirectory: string); +var + shex : SHELLEXECUTEINFO; +begin + fillchar(shex, sizeof(shex),0); + shex.cbSize := sizeof( SHELLEXECUTEINFO ); + shex.fMask := 0; + shex.wnd := hwnd; + shex.lpVerb := 'runas'; + shex.lpFile := pchar(pszPath); + shex.lpParameters := pchar(pszParameters); + shex.lpDirectory := nil; + shex.nShow := SW_NORMAL; + ShellExecuteEx(@shex); +end; + +//------------------------------------------------------------------------------ + +function IsVista: boolean; +var + hKernel32: HMODULE; +begin + hKernel32 := GetModuleHandle('kernel32'); + if (hKernel32 > 0) then + begin + Result := GetProcAddress(hKernel32, 'GetLocaleInfoEx') <> nil; + end + else + Result := false; +end; + +//------------------------------------------------------------------------------ + +procedure VistaShellOpen(HWND: THandle; Command, Param: string); +begin + if IsVista then + RunElevated(HWND, Command, Param, '') + else + ShellExecute(HWND, 'open', pchar(Param), nil, nil, SW_NORMAL); +end; + +//------------------------------------------------------------------------------ + +function GetFileVersion(const AFileName: string): Cardinal; +var + FileName: string; + InfoSize, Wnd: DWORD; + VerBuf: Pointer; + FI: PVSFixedFileInfo; + VerSize: DWORD; +begin + Result := Cardinal(-1); + // GetFileVersionInfo modifies the filename parameter data while parsing. + // Copy the string const into a local variable to create a writeable copy. + FileName := AFileName; + UniqueString(FileName); + InfoSize := GetFileVersionInfoSize(PChar(FileName), Wnd); + if InfoSize <> 0 then + begin + GetMem(VerBuf, InfoSize); + try + if GetFileVersionInfo(PChar(FileName), Wnd, InfoSize, VerBuf) then + if VerQueryValue(VerBuf, '\', Pointer(FI), VerSize) then + Result:= FI.dwFileVersionMS; + finally + FreeMem(VerBuf); + end; + end; +end; + + +function TaskDialogCallbackProc(hWnd: THandle; msg, wParam, lparam: integer; refData: pointer): integer; stdcall; +var + td: TAdvTaskDialog; + SPos: integer; + State: TTaskDialogProgressState; + Res: integer; + CanClose: boolean; + Anchor: string; + + procedure ShowHelpException(E: Exception); + var + Msg: string; + Flags: Integer; + begin + Flags := MB_OK or MB_ICONSTOP; + if Application.UseRightToLeftReading then + Flags := Flags or MB_RTLREADING; + Msg := E.Message; + if (Msg <> '') and (AnsiLastChar(Msg) > '.') then + Msg := Msg + '.'; + MessageBox(0, PChar(Msg), PChar(Application.Title), Flags); + end; + +begin + td := nil; + if Assigned(refdata) then + td := TAdvTaskDialog(refdata); + + Res := 0; + + if Assigned(td) then + td.hWnd := hWnd; + + case msg of + TDN_CREATED: + begin + if Assigned(td) and Assigned(td.OnDialogCreated) then + begin + td.OnDialogCreated(td); + + if (doProgressBar in td.Options) then + begin + SendMessage(hWnd, TDM_SET_PROGRESS_BAR_RANGE, 0, MakeLParam(td.ProgressBarMin,td.ProgressBarMax)); + end; + end; + end; + TDN_BUTTON_CLICKED: + begin + if Assigned(td) and Assigned(td.OnDialogButtonClick) then + begin + td.OnDialogButtonClick(td, wParam); + end; + + if Assigned(td) and Assigned(td.OnDialogClose) then + begin + CanClose := true; + td.OnDialogClose(td, CanClose); + if not CanClose then + Res := 1; + end; + end; + TDN_RADIO_BUTTON_CLICKED: + begin + if Assigned(td) and Assigned(td.OnDialogRadioClick) then + begin + td.OnDialogRadioClick(td, wParam); + end; + end; + TDN_HYPERLINK_CLICKED: + begin + if Assigned(td) then + begin + Anchor := WideCharToString(PWideChar(lparam)); + + if not Assigned(td.OnDialogHyperlinkClick) then + begin + if (Pos('://', Anchor) > 0) then + VistaShellOpen(0, 'iexplore.exe', Anchor); + end; + + if Assigned(td.OnDialogHyperlinkClick) then + begin + td.OnDialogHyperlinkClick(td, Anchor); + end; + end; + end; + TDN_VERIFICATION_CLICKED: + begin + if Assigned(td) and Assigned(td.OnDialogVerifyClick) then + begin + td.OnDialogVerifyClick(td, bool(wparam)); + end; + end; + TDN_HELP: + begin + if Assigned(td) then + if td.HelpContext <> 0 then + try + Application.HelpContext(td.HelpContext); + except + on E: Exception do + ShowHelpException(E); + end; + end; + TDN_TIMER: + begin + if Assigned(td) and Assigned(td.OnDialogTimer) then + begin + td.OnDialogTimer(td); + end; + + if Assigned(td) and Assigned(td.OnDialogProgress) then + begin + td.OnDialogProgress(td, SPos, State); + SendMessage(hWnd,TDM_SET_PROGRESS_BAR_POS,SPos,0); + case State of + psNormal: SendMessage(hWnd,TDM_SET_PROGRESS_BAR_STATE, PBST_NORMAL, 0); + psError: SendMessage(hWnd,TDM_SET_PROGRESS_BAR_STATE, PBST_ERROR, 0); + psPaused: SendMessage(hWnd,TDM_SET_PROGRESS_BAR_STATE, PBST_PAUSED, 0); + end; + end; + end; + end; + + Result := Res; +end; + +//------------------------------------------------------------------------------ + +function RemoveSpaces(S: String): String; +var + i: Integer; +begin + Result := S; + for i := 1 to Length(s) do + begin + if (s[i] = ' ') then + Result := copy(S, 2, Length(S)-1) + else + Break; + end; + + for i := Length(s) downto 1 do + begin + if (s[i] = ' ') then + Result := copy(S, 1, Length(S)-1) + else + Break; + end; +end; + +//------------------------------------------------------------------------------ + +function HasLf(s:string): boolean; +var + i,j: integer; +begin + Result := false; + i := pos('\n', s); + if i > 0 then + begin + j := pos(':\n',s); + + if (j = -1) or (j <> i - 1) then + Result := true; + end; +end; + +//------------------------------------------------------------------------------ + +procedure SplitInToLines(Text: string; sl: TStrings); +var + i, j: Integer; + s, rs: string; +begin + if (Text <> '') and Assigned(sl) then + begin + rs := #13; + if HasLf(Text) or (pos(rs, Text) > 0) then + begin + Text := RemoveSpaces(Text); + + while (Length(Text) > 0) do + begin + i := Pos('\n', Text); + j := 2; + if (i <= 0) then + begin + i := pos(rs, Text); + j := 2; + end; + + if (i <= 0) then + begin + i := Length(Text)+1; + j := 0; + end; + s := copy(Text, 1, i-1); + Delete(Text, 1, i-1+j); + s := RemoveSpaces(s); + sl.Add(s); + Text := RemoveSpaces(Text); + end; + end + else + sl.Add(Text); + end; +end; + +//------------------------------------------------------------------------------ + +procedure GetMultiLineTextSize(Canvas: TCanvas; Text: string; HeadingFont, ParaFont: TFont; DrawTextBiDiModeFlagsReadingOnly: Longint; var W, H: Integer; WithSpace: Boolean = True); +var + R: TRect; + i, tw, th: Integer; + s: string; + OldFont: TFont; + SL: TStringList; +begin + if Assigned(Canvas) then + begin + OldFont := TFont.Create; + OldFont.Assign(Canvas.Font); + if HasLf(Text) or (pos(#13, Text) > 0) then + begin + tw := 0; + th := 0; + + SL := TStringList.Create; + SplitInToLines(Text, SL); + s := RemoveSpaces(SL[0]); + + if (s <> '') then + begin + Canvas.Font.Assign(HeadingFont); + SetRect(R, 0, 0, 0, 0); + Windows.DrawText( Canvas.handle, PChar(s), -1, R, + DT_CALCRECT or DT_LEFT or DT_SINGLELINE or DrawTextBiDiModeFlagsReadingOnly); + tw := R.Right; + th := R.Bottom; + if WithSpace then + begin + tw := tw + 8; + th := th + 10; + end; + end; + + Canvas.Font.Assign(ParaFont); + for i:= 1 to SL.Count-1 do + begin + s := SL[i]; + if (s <> '') then + begin + SetRect(R, 0, 0, 0, 0); + Windows.DrawText( Canvas.handle, PChar(s), -1, R, + DT_CALCRECT or DT_LEFT or DT_SINGLELINE or DrawTextBiDiModeFlagsReadingOnly); + if WithSpace then + begin + tw := Max(tw, R.Right + 8); + th := th + R.Bottom + 2; + end + else + begin + tw := Max(tw, R.Right); + th := th + R.Bottom; + end; + end; + end; + + W := tw; + H := th; + SL.Free; + end + else + begin + Canvas.Font.Assign(HeadingFont); + SetRect(R, 0, 0, 0, 0); + Windows.DrawText( Canvas.handle, PChar(Text), -1, R, + DT_CALCRECT or DT_LEFT or DT_SINGLELINE or DrawTextBiDiModeFlagsReadingOnly); + W := R.Right; + H := R.Bottom; + end; + + Canvas.Font.Assign(OldFont); + OldFont.Free; + end; +end; + +//------------------------------------------------------------------------------ + +{ TAdvTaskDialog } + +procedure TCustomAdvTaskDialog.Clear; +begin + CommonButtons := []; + RadioButtons.Clear; + CustomButtons.Clear; + Icon := tiBlank; + FooterIcon := tfiBlank; + Instruction := ''; + Title := ''; + Content := ''; + Footer := ''; + VerificationText := ''; + ExpandControlText := ''; + CollapsControlText := ''; + ExpandedText := ''; + DefaultRadioButton := 200; + DefaultButton := 0; + Options := []; + VerifyResult := false; + InputText := ''; +end; + +//------------------------------------------------------------------------------ + +procedure TCustomAdvTaskDialog.ClickButton(ButtonID: integer); +begin + SendMessage(hWnd, TDM_CLICK_BUTTON, ButtonID, 0); + if Assigned(FDialogForm) then + FDialogForm.ClickButton(ButtonID); +end; + +//------------------------------------------------------------------------------ + +constructor TCustomAdvTaskDialog.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FCustomButtons := TStringList.Create; + FRadioButtons := TStringList.Create; + FProgressBarMin := 0; + FProgressBarMax := 100; + FDialogForm := nil; + FApplicationIsParent := true; + FModalParent := 0; + FCustomIcon := TIcon.Create; + FDefaultRadioButton := 200; + FMinFormWidth := 350; + FNonNativeDialog := nndAuto; + FInputType := itNone; + FInputItems := TStringList.Create; +end; + +//------------------------------------------------------------------------------ + +destructor TCustomAdvTaskDialog.Destroy; +begin + FRadioButtons.Free; + FCustomButtons.Free; + FCustomIcon.Free; + FInputItems.Free; + inherited; +end; + +//------------------------------------------------------------------------------ + +function TCustomAdvTaskDialog.CreateButton(AOwner: TComponent): TWinControl; +begin + Result := TButton.Create(AOwner); +end; + +//------------------------------------------------------------------------------ + +function TCustomAdvTaskDialog.CreateRadioButton(AOwner: TComponent): TWinControl; +begin + Result := TRadioButton.Create(AOwner); +end; + +procedure TCustomAdvTaskDialog.SetRadioButtonState(Btn: TWinControl; Checked: boolean); +begin + TRadioButton(Btn).Checked := Checked; +end; + +//------------------------------------------------------------------------------ + +procedure TCustomAdvTaskDialog.InitRadioButton(AOwner: TForm; Btn: TWinControl; btnIndex: Integer; OnClickEvent : TNotifyEvent); +begin + with TRadioButton(Btn) do + begin + Name := 'Radio' + inttostr(btnIndex); + Parent := AOwner; + Font.Name := AOwner.Canvas.Font.Name; + Font.Size := 8; + BiDiMode := AOwner.BiDiMode; + OnClick := OnClickEvent; + + { + BoundsRect := TextRect; + Left := FHorzParaMargin + FHorzMargin; //ALeft + FHorzMargin; + Top := Y; + Width := Self.Width - Left - 4; + GetTextSize(Canvas, Caption, k, l); + w := Max(w, Left + k + FHorzMargin + 20); + } + end; +end; + +//------------------------------------------------------------------------------ + +procedure TCustomAdvTaskDialog.TaskDialogFormCreated(Sender: TObject); +begin + if Assigned(OnDialogCreated) then + OnDialogCreated(Self); +end; + +//------------------------------------------------------------------------------ + +procedure TCustomAdvTaskDialog.Notification(AComponent: TComponent; + AOperation: TOperation); +begin + inherited; + if not (csDestroying in ComponentState) then + begin + if (AOperation = opRemove) then + begin + if (AComponent = FInputControl) then + FInputControl := nil; + end; + end; +end; + +//------------------------------------------------------------------------------ + +procedure TCustomAdvTaskDialog.ElevateButton(ButtonID: integer; + Enabled: boolean); +begin + SendMessage(hWnd, TDM_SET_BUTTON_ELEVATION_REQUIRED_STATE, ButtonID, integer(Enabled)); +end; + +procedure TCustomAdvTaskDialog.EnableButton(ButtonID: integer; Enabled: boolean); +begin + SendMessage(hWnd, TDM_ENABLE_BUTTON, ButtonID, integer(Enabled)); + if Assigned(FDialogForm) then + FDialogForm.EnableButton(ButtonID, Enabled); +end; + +//------------------------------------------------------------------------------ + +function ConvertNL(s: string): string; +begin + if Pos('\\n', s) > 0 then + Result := StringReplace(s, '\\n', '\n', [rfReplaceAll]) + else + begin + if pos('\n',s) > 0 then + Result := StringReplace(s,'\n',#10,[rfReplaceAll]) + else + Result := s; + end; +end; + +//------------------------------------------------------------------------------ + +function TCustomAdvTaskDialog.Execute: integer; +var + verinfo: TOSVersionInfo; + DLLHandle: THandle; + res,radiores: integer; + verify: boolean; + TaskDialogConfig : TTASKDIALOGCONFIG; + TaskDialogIndirectProc : function(AConfig: PTASKDIALOGCONFIG; Res: pinteger; ResRadio: pinteger; VerifyFLag: pboolean): integer cdecl stdcall; +{ + wTitle: TTaskDialogWideString; + wDesc: TTaskDialogWideString; + wContent: TTaskDialogWideString; + wExpanded: TTaskDialogWideString; + wExpandedControl: TTaskDialogWideString; + wCollapsedControl: TTaskDialogWideString; + wFooter: TTaskDialogWideString; + wVerifyText: TTaskDialogWideString; +} + TBA: TTaskDialogButtonArray; + TBWS: TTaskDialogWideStringArray; + i: integer; + + TRA: TTaskDialogButtonArray; + TRWS: TTaskDialogWideStringArray; + ComCtlVersion: integer; + + +begin + Result := -1; + + VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo); + GetVersionEx(verinfo); + + ComCtlVersion := GetFileVersion('COMCTL32.DLL'); + ComCtlVersion := (ComCtlVersion shr 16) and $FF; + + if (verinfo.dwMajorVersion >= 6) and (ComCtlVersion > 5) and (FNonNativeDialog = nndAuto) then + begin + // check COMCTL version ... + + DLLHandle := LoadLibrary('comctl32.dll'); + if DLLHandle >= 32 then + begin + @TaskDialogIndirectProc := GetProcAddress(DLLHandle,'TaskDialogIndirect'); + + if Assigned(TaskDialogIndirectProc) then + begin + FillChar(TaskDialogConfig, sizeof(TTASKDIALOGCONFIG),0); + TaskDialogConfig.cbSize := sizeof(TTASKDIALOGCONFIG); + + if ModalParent <> 0 then + begin + TaskDialogConfig.hwndParent := ModalParent + end + else + begin + if Assigned(Self.Owner) and not ApplicationIsParent then + TaskDialogConfig.hwndParent := (Self.Owner as TWinControl).Handle + else + TaskDialogConfig.hwndParent := Application.Handle; + end; + + if FCustomButtons.Count > 0 then + begin + SetLength(TBA, FCustomButtons.Count); + SetLength(TBWS, FCustomButtons.Count); + + for i := 0 to FCustomButtons.Count - 1 do + begin + StringToWideChar(ConvertNL(FCustomButtons.Strings[i]), TBWS[i], sizeof(TBWS[i])); + TBA[i].pszButtonText := TBWS[i]; + TBA[i].nButtonID := i + 100; + end; + + TaskDialogConfig.cButtons := FCustomButtons.Count; + TaskDialogConfig.pbuttons := @TBA[0]; + end; + + if FRadioButtons.Count > 0 then + begin + SetLength(TRA, FRadioButtons.Count); + SetLength(TRWS, FRadioButtons.Count); + + for i := 0 to FRadioButtons.Count - 1 do + begin + StringToWideChar(ConvertNL(FRadioButtons.Strings[i]), TRWS[i], sizeof(TRWS[i])); + TRA[i].pszButtonText := TRWS[i]; + TRA[i].nButtonID := i + 200; + end; + + TaskDialogConfig.cRadioButtons := FRadioButtons.Count; + TaskDialogConfig.pRadioButtons := @TRA[0]; + end; + + if FTitle <> '' then + begin + TaskDialogConfig.pszWindowTitle := PWideChar(WideString(ConvertNL(FTitle))); + end; + + if FInstruction <> '' then + begin + TaskDialogConfig.pszMainInstruction := PWideChar(WideString(ConvertNL(FInstruction))); + end; + + if FContent <> '' then + begin + TaskDialogConfig.pszContent := PWideChar(WideString(ConvertNL(FContent))); + end; + + if FFooter <> '' then + begin + TaskDialogConfig.pszFooter := PWideChar(WideString(ConvertNL(FFooter))); + end; + + if FExpandControlText <> '' then + begin + TaskDialogConfig.pszExpandedControlText := PWideChar(WideString(FExpandControlText)); + end; + + if FCollapsControlText <> '' then + begin + TaskDialogConfig.pszCollapsedControlText := PWideChar(WideString(FCollapsControlText)); + end; + + if FExpandedText <> '' then + begin + TaskDialogConfig.pszExpandedInformation := PWideChar(WideString(FExpandedText)) + end; + + if FVerifyText <> '' then + begin + TaskDialogConfig.pszVerificationText := PWideChar(WideString(FVerifyText)); + end; + + if cbOk in FCommonButtons then + TaskDialogConfig.dwCommonButtons := TaskDialogConfig.dwCommonButtons or TDCBF_OK_BUTTON; + + if cbYes in FCommonButtons then + TaskDialogConfig.dwCommonButtons := TaskDialogConfig.dwCommonButtons or TDCBF_YES_BUTTON; + + if cbNo in FCommonButtons then + TaskDialogConfig.dwCommonButtons := TaskDialogConfig.dwCommonButtons or TDCBF_NO_BUTTON; + + if cbCancel in FCommonButtons then + TaskDialogConfig.dwCommonButtons := TaskDialogConfig.dwCommonButtons or TDCBF_CANCEL_BUTTON; + + if cbClose in FCommonButtons then + TaskDialogConfig.dwCommonButtons := TaskDialogConfig.dwCommonButtons or TDCBF_CLOSE_BUTTON; + + if cbRetry in FCommonButtons then + TaskDialogConfig.dwCommonButtons := TaskDialogConfig.dwCommonButtons or TDCBF_RETRY_BUTTON; + + if doCommandLinks in FOptions then + TaskDialogConfig.dwFlags := TDF_USE_COMMAND_LINKS; + + if doCommandLinksNoIcon in FOptions then + TaskDialogConfig.dwFlags := TDF_USE_COMMAND_LINKS_NO_ICON; + + if doHyperlinks in FOptions then + TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_ENABLE_HYPERLINKS; + + if doExpandedDefault in FOptions then + TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_EXPANDED_BY_DEFAULT; + + if doExpandedFooter in FOptions then + TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_EXPAND_FOOTER_AREA; + + if doAllowMinimize in FOptions then + TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_CAN_BE_MINIMIZED; + + if doVerifyChecked in FOptions then + TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_VERIFICATION_FLAG_CHECKED; + + if doProgressBar in FOptions then + TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_SHOW_PROGRESS_BAR; + + if doProgressBarMarquee in FOptions then + TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_SHOW_MARQUEE_PROGRESS_BAR; + + if (doProgressBarMarquee in FOptions) or + (doProgressBar in FOptions) or + (doTimer in FOptions) then + TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_CALLBACK_TIMER; + + if (DialogPosition = dpOwnerFormCenter) then + TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_POSITION_RELATIVE_TO_WINDOW; + + if doNoDefaultRadioButton in FOptions then + TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_NO_DEFAULT_RADIO_BUTTON; + + if doAllowDialogCancel in FOptions then + TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_ALLOW_DIALOG_CANCELLATION; + + TaskDialogConfig.hInstance := 0; + + if not CustomIcon.Empty then + begin + TaskDialogConfig.hMainIcon := CustomIcon.Handle; + TaskDialogConfig.dwFlags := TaskDialogConfig.dwFlags or TDF_USE_HICON_MAIN; + end + else + begin + case Icon of + tiWarning: TaskDialogConfig.hMainIcon := TD_ICON_WARNING; + tiQuestion: TaskDialogConfig.hMainIcon := TD_ICON_QUESTION; + tiError: TaskDialogConfig.hMainIcon := TD_ICON_ERROR; + tiShield: TaskDialogConfig.hMainIcon := TD_ICON_SHIELD; + tiBlank: TaskDialogConfig.hMainIcon := TD_ICON_BLANK; + tiInformation: TaskDialogConfig.hMainIcon := TD_ICON_INFORMATION; + end; + end; + + case FooterIcon of + tfiWarning: TaskDialogConfig.hFooterIcon := TD_ICON_WARNING; + tfiQuestion: TaskDialogConfig.hFooterIcon := TD_ICON_QUESTION; + tfiError: TaskDialogConfig.hFooterIcon := TD_ICON_ERROR; + tfiInformation: TaskDialogConfig.hFooterIcon := THandle(MAKEINTRESOURCEW(Word(-3))); + tfiShield: TaskDialogConfig.hFooterIcon := THandle(MAKEINTRESOURCEW(Word(-4))); + end; + + TaskDialogConfig.pfCallBack := @TaskDialogCallbackProc; + TaskDialogConfig.pData := Self; + + TaskDialogConfig.nDefaultButton := DefaultButton; + TaskDialogConfig.nDefaultRadioButton := DefaultRadioButton; + + + TaskDialogIndirectProc(@TaskDialogConfig, @res, @radiores, @verify); + + RadioButtonResult := radiores; + VerifyResult := verify; + Result := res; + + end; + end; + end + else + Result := AdvMessageDlgPos(Self, -1, -1); +end; + +//------------------------------------------------------------------------------ + +function TCustomAdvTaskDialog.GetVersion: string; +var + vn: Integer; +begin + vn := GetVersionNr; + Result := IntToStr(Hi(Hiword(vn))) + '.' + IntToStr(Lo(Hiword(vn))) + '.' + + IntToStr(Hi(Loword(vn))) + '.' + IntToStr(Lo(Loword(vn))); +end; + +//------------------------------------------------------------------------------ + +function TCustomAdvTaskDialog.GetVersionNr: Integer; +begin + Result := MakeLong(MakeWord(BLD_VER, REL_VER), MakeWord(MIN_VER, MAJ_VER)); +end; + +//------------------------------------------------------------------------------ + +procedure TCustomAdvTaskDialog.SetContent(const Value: string); +begin + if (FContent <> Value) then + begin + FContent := Value; + SendMessage(hWnd, TDM_UPDATE_ELEMENT_TEXT, TDE_CONTENT, Integer(PWideChar(WideString(FContent)))); + if Assigned(FDialogForm) then + FDialogForm.UpdateDialog; + end; +end; + +//------------------------------------------------------------------------------ + +procedure TCustomAdvTaskDialog.SetCustomButtons(const Value: TStringList); +begin + FCustomButtons.Assign(Value); +end; + +procedure TCustomAdvTaskDialog.SetCustomIcon(const Value: TIcon); +begin + FCustomIcon.Assign(Value); +end; + +//------------------------------------------------------------------------------ + +procedure TCustomAdvTaskDialog.SetExpandedText(const Value: string); +begin + if (FExpandedText <> Value) then + begin + FExpandedText := Value; + SendMessage(hWnd, TDM_UPDATE_ELEMENT_TEXT, TDE_EXPANDED_INFORMATION, Integer(PWideChar(WideString(FExpandedText)))); + if Assigned(FDialogForm) then + FDialogForm.UpdateDialog; + end; +end; + +//------------------------------------------------------------------------------ + +procedure TCustomAdvTaskDialog.SetFooter(const Value: string); +begin + if (FFooter <> Value) then + begin + FFooter := Value; + SendMessage(hWnd, TDM_UPDATE_ELEMENT_TEXT, TDE_FOOTER, Integer(PWideChar(WideString(FFooter)))); + if Assigned(FDialogForm) then + FDialogForm.UpdateDialog; + end; +end; + +//------------------------------------------------------------------------------ + +procedure TCustomAdvTaskDialog.SetInputItems(const Value: TStrings); +begin + FInputItems.Assign(Value); +end; + +procedure TCustomAdvTaskDialog.SetInstruction(const Value: string); +begin + if (FInstruction <> Value) then + begin + FInstruction := Value; + SendMessage(hWnd, TDM_UPDATE_ELEMENT_TEXT, TDE_MAIN_INSTRUCTION, Integer(PWideChar(WideString(FInstruction)))); + if Assigned(FDialogForm) then + FDialogForm.UpdateDialog; + end; +end; + +//------------------------------------------------------------------------------ + +procedure TCustomAdvTaskDialog.SetRadioButtonCaption(Btn: TWinControl; + Value: string); +begin + TRadioButton(Btn).Caption := Value; +end; + +//------------------------------------------------------------------------------ + +procedure TCustomAdvTaskDialog.SetRadioButtons(const Value: TStringList); +begin + FRadioButtons.Assign(Value); +end; + +//------------------------------------------------------------------------------ + +procedure TCustomAdvTaskDialog.SetVersion(const Value: string); +begin + +end; + +//------------------------------------------------------------------------------ + +procedure TCustomAdvTaskDialog.SetButtonCancel(aButton: TWinControl; Value: Boolean); +begin + if not Assigned(aButton) or not (aButton is TButton) then + Exit; + + TButton(aButton).Cancel := Value; +end; + +//------------------------------------------------------------------------------ + +procedure TCustomAdvTaskDialog.SetButtonDefault(aButton: TWinControl; Value: Boolean); +begin + if not Assigned(aButton) or not (aButton is TButton) then + Exit; + + TButton(aButton).Default := Value; +end; + +//------------------------------------------------------------------------------ + +procedure TCustomAdvTaskDialog.SetButtonModalResult(aButton: TWinControl; Value: Integer); +begin + if not Assigned(aButton) or not (aButton is TButton) then + Exit; + + TButton(aButton).ModalResult := Value; +end; + +//------------------------------------------------------------------------------ + +function TCustomAdvTaskDialog.GetButtonModalResult( + aButton: TWinControl): Integer; +begin + Result := mrNone; + if not Assigned(aButton) or not (aButton is TButton) then + Exit; + + Result := TButton(aButton).ModalResult; +end; + +//------------------------------------------------------------------------------ + +procedure TCustomAdvTaskDialog.SetButtonCaption(aButton: TWinControl; + Value: TCaption); +begin + if not Assigned(aButton) or not (aButton is TButton) then + Exit; + + TButton(aButton).Caption := Value; +end; + +//------------------------------------------------------------------------------ + +{ TTaskDialogButton } + +constructor TTaskDialogButton.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FGlyph := TBitmap.Create; + FGlyph.OnChange := OnPictureChanged; + + FGlyphHot := TBitmap.Create; + + FGlyphDown := TBitmap.Create; + + FGlyphDisabled := TBitmap.Create; + FGlyphDisabled.OnChange := OnPictureChanged; + + FHeadingFont := TFont.Create; + + SetBounds(0, 0, 23, 22); + ShowHint := False; + FBorderColorDown := clNone; + FBorderColorHot := clNone; + FBorderColor := clNone; +end; + +//------------------------------------------------------------------------------ + +destructor TTaskDialogButton.Destroy; +begin + FGlyph.Free; + FGlyphHot.Free; + FGlyphDown.Free; + FGlyphDisabled.Free; + FHeadingFont.Free; + inherited; +end; + +procedure TTaskDialogButton.DoEnter; +begin + inherited; + Invalidate; +end; + +procedure TTaskDialogButton.DoExit; +begin + inherited; + Invalidate; +end; + +procedure TTaskDialogButton.KeyPress(var Key: char); +begin + inherited; + if (Key = #32) or (Key = #13) then + begin + Click; + end; +end; + +//------------------------------------------------------------------------------ + +procedure TTaskDialogButton.Paint; +var + Pic: TBitmap; + x, y, bw, bh, i: Integer; + R, TR: TRect; + BrClr: TColor; + SL: TStringList; +begin + inherited; + + R := ClientRect; + + BrClr := clNone; + + if FMouseDown then + BrClr := BorderColorDown + else if FMouseInControl then + BrClr := BorderColorHot; + + if not Enabled then + BrClr := clNone; + + if GetFocus = Handle then + BrClr := BorderColorDown; + + Pic := Picture; + if FMouseDown and not FGlyphDown.Empty then + Pic := FGlyphDown + else if FMouseInControl and not FGlyphHot.Empty then + Pic := FGlyphHot; + + if not Enabled and not PictureDisabled.Empty then + Pic := PictureDisabled; + + if Assigned(Pic) and not Pic.Empty then + begin + Pic.Transparent := True; + if (Caption = '') then + begin + x := (Width - Pic.Width) div 2; + y := (Height - Pic.Height) div 2; + end + else + begin + x := 4; + y := (Height - Pic.Height) div 2; + end; + + Canvas.Draw(x, y, Pic); + R.Left := x + Pic.Width + 3; + end + else + R.Left := R.Left + 2; + + if (Caption <> '') then + begin + if HasLf(Caption) or (pos(#13, Caption) > 0) then + begin + TR := R; + SL := TStringList.Create; + SplitInToLines(Caption, SL); + GetMultiLineTextSize(Canvas, Caption, HeadingFont, Self.Font, DrawTextBiDiModeFlagsReadingOnly, bw, bh); + TR.Top := 2 + (Height - bh) div 2; + + Canvas.Brush.Style := bsClear; + if (SL[0] <> '') then + begin + Canvas.Font.Assign(HeadingFont); + + if not Enabled then + Canvas.Font.Color := clSilver; + + DrawText(Canvas.Handle, PChar(SL[0]),Length(SL[0]), TR, DT_LEFT or DT_TOP or DT_SINGLELINE); + TR.Top := TR.Top + Canvas.TextHeight('gh') + 4; + end; + + Canvas.Font.Assign(Self.Font); + + if not Enabled then + Canvas.Font.Color := clSilver; + + for i:= 1 to SL.Count - 1 do + begin + DrawText(Canvas.Handle, PChar(SL[i]),Length(SL[i]), TR, DT_LEFT or DT_TOP or DT_SINGLELINE); + TR.Top := TR.Top + Canvas.TextHeight('gh') + 2; + end; + SL.Free; + end + else + begin + Canvas.Brush.Style := bsClear; + Canvas.Font.Assign(HeadingFont); + if not Enabled then + Canvas.Font.Color := clSilver; + DrawText(Canvas.Handle,PChar(Caption),Length(Caption), R, DT_LEFT or DT_VCENTER or DT_SINGLELINE); + end; + end; + + if (BrClr <> clNone) then + begin + R := ClientRect; + Canvas.Pen.Color := BrClr; + Canvas.Brush.Style := bsClear; + Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, 2, 2); + end; +end; + +//------------------------------------------------------------------------------ + +procedure TTaskDialogButton.MouseDown(Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + inherited; + + if (ssLeft in Shift) then + begin + FMouseDown := True; + Invalidate; + end; +end; + +//------------------------------------------------------------------------------ + +procedure TTaskDialogButton.MouseMove(Shift: TShiftState; X, Y: Integer); +begin + inherited; + +end; + +//------------------------------------------------------------------------------ + +procedure TTaskDialogButton.MouseUp(Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + inherited; + + FMouseDown := False; + Invalidate; +end; + +//------------------------------------------------------------------------------ + +procedure TTaskDialogButton.SetGlyph(const Value: TBitmap); +begin + FGlyph.Assign(Value); + Invalidate; +end; + +//------------------------------------------------------------------------------ + +procedure TTaskDialogButton.SetGlyphDown(const Value: TBitmap); +begin + FGlyphDown.Assign(Value); +end; + +//------------------------------------------------------------------------------ + +procedure TTaskDialogButton.SetGlyphHot(const Value: TBitmap); +begin + FGlyphHot.Assign(Value); +end; + +//------------------------------------------------------------------------------ + +procedure TTaskDialogButton.SetGlyphDisabled(const Value: TBitmap); +begin + FGlyphDisabled.Assign(Value); + Invalidate; +end; + +//------------------------------------------------------------------------------ + +procedure TTaskDialogButton.OnPictureChanged(Sender: TObject); +begin + Invalidate; +end; + +//------------------------------------------------------------------------------ + +procedure TTaskDialogButton.CMMouseEnter(var Message: TMessage); +begin + inherited; + FMouseInControl := True; + + if AutoFocus then + SetFocus; + + Invalidate; + if Assigned(FOnMouseEnter) then + FOnMouseEnter(Self); +end; + +//------------------------------------------------------------------------------ + +procedure TTaskDialogButton.CMMouseLeave(var Message: TMessage); +begin + inherited; + FMouseInControl := False; + Invalidate; + + if Assigned(FOnMouseLeave) then + FOnMouseLeave(Self); +end; + +//------------------------------------------------------------------------------ + +procedure TTaskDialogButton.SetHeadingFont(const Value: TFont); +begin + FHeadingFont.Assign(Value); +end; + +//------------------------------------------------------------------------------ + +function GetAveCharSize(Canvas: TCanvas): TPoint; +var + I: Integer; + Buffer: array[0..51] of Char; +begin + for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A')); + for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a')); + GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result)); + Result.X := Result.X div 52; +end; + +//------------------------------------------------------------------------------ + +var + ButtonWidths : array[TCommonButton] of integer; // initialized to zero + //tiBlank, tiWarning, tiQuestion, tiError, tiInformation,tiNotUsed,tiShield + IconIDs: array[TTaskDialogIcon] of PChar = (IDI_ASTERISK, IDI_EXCLAMATION, IDI_QUESTION, IDI_ERROR, IDI_INFORMATION, nil, IDI_HAND); + FooterIconIDs: array[TTaskDialogFooterIcon] of PChar = (nil, IDI_EXCLAMATION, IDI_QUESTION, IDI_HAND, IDI_INFORMATION, IDI_WINLOGO); + Captions: array[TTaskDialogIcon] of Pointer; + // = (nil, @SMsgDlgWarning, @SMsgDlgConfirm, @SMsgDlgError, @SMsgDlgInformation); + ModalResults: array[TCommonButton] of Integer = (mrOk, mrYes, mrNo, mrCancel, mrRetry, mrAbort); + //(tiBlank, tiWarning, tiQuestion, tiError, tiShield); + //(mtWarning, mtError, mtInformation, mtConfirmation, mtCustom); + +function CreateAdvMessageDlg(TaskDialog: TCustomAdvTaskDialog): TForm; +begin + Result := nil; + if not Assigned(TaskDialog) then + Exit; + + if TaskDialog.ApplicationIsParent then + Result := TAdvMessageForm.CreateNew(Application,0) + else + Result := TAdvMessageForm.CreateNew((TaskDialog.Owner) as TCustomForm,0); + + with Result do + begin + BiDiMode := Application.BiDiMode; + BorderIcons := []; + + if doAllowMinimize in TaskDialog.Options then + begin + BorderStyle := bsSingle; + BorderIcons := [biSystemMenu,biMinimize] + end + else + begin + BorderStyle := bsDialog; + end; + + if cbCancel in TaskDialog.CommonButtons then + TaskDialog.Options := TaskDialog.Options + [doAllowDialogCancel]; + + if doAllowDialogCancel in TaskDialog.Options then + begin + BorderIcons := BorderIcons + [biSystemMenu]; + end; + + if not TaskDialog.ApplicationIsParent then + begin + if ((TaskDialog.Owner) is TForm) then + if ((TaskDialog.Owner) as TForm).FormStyle = fsStayOnTop then + FormStyle := fsStayOnTop; + end; + + Canvas.Font := Font; + KeyPreview := True; + OnKeyDown := TAdvMessageForm(Result).CustomKeyDown; + end; + //TaskDialog.Options := TaskDialog.Options + [doAllowDialogCancel]; + TAdvMessageForm(Result).MinFormWidth := TaskDialog.NonNativeMinFormWidth; + TAdvMessageForm(Result).BuildTaskDialog(TaskDialog); +end; + +//------------------------------------------------------------------------------ + +function AdvMessageDlgPos(TaskDialog: TCustomAdvTaskDialog; X, Y: Integer): Integer; +var + DlgForm: TAdvMessageForm; +begin + Result := -1; + if not Assigned(TaskDialog) then + Exit; + + DlgForm := TAdvMessageForm(CreateAdvMessageDlg(TaskDialog)); + + DlgForm.OnShow := TaskDialog.TaskDialogFormCreated; + + TaskDialog.FDialogForm := DlgForm; + + with DlgForm do + try + Color := clWhite; + //HelpContext := HelpCtx; + //HelpFile := HelpFileName; + if X >= 0 then Left := X; + if Y >= 0 then Top := Y; + {$IFDEF DELPHI5_LVL} + if TaskDialog.DialogPosition = dpOwnerFormCenter then + begin + if (Y < 0) and (X < 0) then + Position := poOwnerFormCenter; + end + else + begin + DefaultMonitor := dmMainForm; + if (Y < 0) and (X < 0) then + Position := poScreenCenter; + end; + {$ELSE} + {$ENDIF} + Result := ShowModal; + {$IFNDEF DELPHI6_LVL} + Close; + {$ENDIF} + finally + TaskDialog.FDialogForm := nil; + Free; + end; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.GetTextSize(Canvas: TCanvas; Text: string;var W, H: Integer); +var + R: TRect; +begin + if (Text = '') then + begin + W := 0; + H := 0; + Exit; + end; + + if Assigned(Canvas) then + begin + if W = 0 then + SetRect(R, 0, 0, 1000, 100) + else + SetRect(R, 0, 0, W, 100); + + DrawText(Canvas.Handle, PChar(Text), Length(Text)+1, R, + DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or DT_NOPREFIX or + DrawTextBiDiModeFlagsReadingOnly); + + W := R.Right; + H := R.Bottom; + end; +end; + +//------------------------------------------------------------------------------ + +const + mcHorzMargin = 8; + mcVertMargin = 8; + mcHorzSpacing = 10; + mcVertSpacing = 10; + mcButtonWidth = 50; + mcButtonHeight = 14; + mcButtonSpacing = 4; + +function GetExeName: string; +var + s: string; + fe: string; +begin + s := ExtractFileName(Application.EXEName); + fe := ExtractFileExt(s); + if (Length(fe) > 0) then + delete(s, length(s) - Length(fe) + 1, length(fe)); + Result := s; +end; + +procedure TAdvMessageForm.BuildTaskDialog(TaskDialog: TCustomAdvTaskDialog); +var + DialogUnits: TPoint; + ButtonWidth, ButtonHeight, ButtonSpacing, ButtonCount, ButtonGroupWidth, + IconTextWidth, IconTextHeight, X, Y, ALeft: Integer; + B, DefaultButton, CancelButton: TCommonButton; + IconID: PChar; + TextRect, FR: TRect; + Msg: string; + DlgType: TTaskDialogIcon; + Buttons: TCommonButtons; + i, bw, bh, h, w, j, FooterIconTextWidth, FooterIconTextHeight: Integer; + CmBtnGroupWidth, CsBtnGroupWidth: Integer; + r, re: trect; + anchor, stripped: string; + HyperLinks,MouseLink, k, l, n: Integer; + Focusanchor: string; + OldFont, hf, pf: TFont; + verifTextWidth: Integer; + v: Boolean; + szContent,szExpandedText,szFooterText: string; + defIdx: integer; + +begin + if not Assigned(TaskDialog) then + Exit; + + FTaskDialog := TaskDialog; + Msg := TaskDialog.Instruction; + DlgType := TaskDialog.Icon; + Buttons := TaskDialog.CommonButtons; + + OldFont := TFont.Create; + OldFont.Assign(Canvas.Font); + + DialogUnits := GetAveCharSize(Canvas); + FHorzMargin := MulDiv(mcHorzMargin, DialogUnits.X, 4); + FVertMargin := MulDiv(mcVertMargin, DialogUnits.Y, 8); + FHorzSpacing := MulDiv(mcHorzSpacing, DialogUnits.X, 4); + FVertSpacing := MulDiv(mcVertSpacing, DialogUnits.Y, 8); + + w := 0; + + if TaskDialog.Title <> '' then + Caption := TaskDialog.Title + else + Caption := GetExeName; + + if (Caption <> '') then + begin + w := 1000; + GetTextSize(Canvas, Caption, w, l); + w := w + 50; + end; + + ButtonWidth := MulDiv(mcButtonWidth, DialogUnits.X, 4); + ButtonHeight := MulDiv(mcButtonHeight, DialogUnits.Y, 8); + ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X, 4); + CmBtnGroupWidth := 0; + CsBtnGroupWidth := 0; + ButtonCount := 0; + FHorzParaMargin := FHorzMargin; + Y := FVertMargin; + FcmBtnList.Clear; + + DefaultButton := cbOk; + if TaskDialog.DefaultButton <> -1 then + begin + + if TaskDialog.DefaultButton = 0 then + begin + if (cbOk in Buttons) then DefaultButton := cbOk else + if cbYes in Buttons then DefaultButton := cbYes else + DefaultButton := cbRetry; + if cbCancel in Buttons then CancelButton := cbCancel else + if cbNo in Buttons then CancelButton := cbNo else + CancelButton := cbOk; + end + else + begin + case TaskDialog.DefaultButton of + 1: if (cbOk in Buttons) then DefaultButton := cbOK + else + DefaultButton := cbYes; + 2: if (cbCancel in Buttons) then DefaultButton := cbCancel + else + DefaultButton := cbNo; + 6: if (cbYes in Buttons) then DefaultButton := cbYes; + 7: if (cbNo in Buttons) then DefaultButton := cbNo; + end; + end; + end; + + + for B := Low(TCommonButton) to High(TCommonButton) do + begin + if B in Buttons then + begin + if ButtonWidths[B] = 0 then + begin + TextRect := Rect(0,0,0,0); + Windows.DrawText( Canvas.Handle, + PChar(LoadResString(ButtonCaptions[B])), -1, + TextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or + DrawTextBiDiModeFlagsReadingOnly); + with TextRect do + ButtonWidths[B] := Right - Left + 16; + end; + + if ButtonWidths[B] > ButtonWidth then + ButtonWidth := ButtonWidths[B]; + + i := FcmBtnList.Add(TaskDialog.CreateButton(Self)); + + with TWinControl(FcmBtnList.Items[i]) do + begin + Name := ButtonNames[B]; + Parent := Self; + TaskDialog.SetButtonCaption(TWinControl(FcmBtnList.Items[i]), LoadResString(ButtonCaptions[B])); + TaskDialog.SetButtonModalResult(TWinControl(FcmBtnList.Items[i]), ModalResults[B]); + //ModalResult := ModalResults[B]; + + if (TaskDialog.GetButtonModalResult(TWinControl(FcmBtnList.Items[i])) = mrCancel) and + (doAllowDialogCancel in TaskDialog.Options) then + TaskDialog.SetButtonCancel(TWinControl(FcmBtnList.Items[i]), True); + //Cancel := true; + + if (TaskDialog.DefaultButton <> -1) then + begin + if (B = DefaultButton) then + begin + //Default := True; + TaskDialog.SetButtonDefault(TWinControl(FcmBtnList.Items[i]), True); + TabOrder := 0; + end; + end; + + if (B = CancelButton) and (doAllowDialogCancel in TaskDialog.Options) then + TaskDialog.SetButtonCancel(TWinControl(FcmBtnList.Items[i]), True); + + Width := Max(60, ButtonWidths[B]); + Height := ButtonHeight; + cmBtnGroupWidth := cmBtnGroupWidth + Width + ButtonSpacing; + //if B = mbHelp then + //OnClick := TMessageForm(Result).HelpButtonClick; + if TaskDialog.DefaultButton = -1 then + TabStop := false; + end; + //Inc(ButtonCount); + end; + end; + + FcsBtnList.Clear; + if not (docommandLinks in TaskDialog.Options) then + begin + for i := 0 to TaskDialog.CustomButtons.Count - 1 do + begin + TextRect := Rect(0,0,0,0); + Windows.DrawText( Canvas.Handle, + PChar(TaskDialog.CustomButtons[i]), -1, + TextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or + DrawTextBiDiModeFlagsReadingOnly); + + with TextRect do + bw := Right - Left + 16; + + if bw > ButtonWidth then + ButtonWidth := bw; + + j := FcsBtnList.Add(TaskDialog.CreateButton(Self)); + with TWinControl(FcsBtnList.Items[j]) do + begin + Name := 'Button'+inttostr(i); + Parent := Self; + TaskDialog.SetButtonCaption(TWinControl(FcsBtnList.Items[j]), TaskDialog.CustomButtons[i]); + //ModalResult := i + 100; //mrAbort; + TaskDialog.SetButtonModalResult(TWinControl(FcsBtnList.Items[j]), i + 100); + v := (TaskDialog.GetButtonModalResult(TWinControl(FcsBtnList.Items[j])) = TaskDialog.DefaultButton); + TaskDialog.SetButtonDefault(TWinControl(FcsBtnList.Items[j]), V); + //Default := (ModalResult = TaskDialog.DefaultButton); + //if V then + // TabOrder := 0; + //if B = DefaultButton then Default := True; + //if B = CancelButton then Cancel := True; + Width := Max(60, bw); + Height := ButtonHeight; + TProControl(FcsBtnList.Items[j]).OnClick := OnButtonClick; + CsBtnGroupWidth := CsBtnGroupWidth + Width + ButtonSpacing; + if TaskDialog.DefaultButton = -1 then + TabStop := false; + end; + end; + end + else + begin + n := 0; + hf := TFont.Create; + pf := TFont.Create; + hf.Assign(Canvas.Font); + hf.Size := 11; + hf.Style := [fsBold]; + pf.Assign(Canvas.Font); + + + for i := 0 to TaskDialog.CustomButtons.Count-1 do + begin + Canvas.Font.Size := 10; + Canvas.Font.Style := []; + bw := 0; + bh := 0; + GetMultiLineTextSize(Canvas, TaskDialog.CustomButtons[i], Hf, Pf, DrawTextBiDiModeFlagsReadingOnly, bw, bh); + + {TextRect := Rect(0,0,0,0); + Windows.DrawText( Canvas.handle, + PChar(TaskDialog.CustomButtons[i]), -1, + TextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or + DrawTextBiDiModeFlagsReadingOnly); + with TextRect do bw := (Right - Left) + 8 + 18;} + bw := bw + 26; + if bw > ButtonWidth then + ButtonWidth := bw; + + if bw > n then + n := bw; + + if not (doCommandLinksNoIcon in TaskDialog.Options) then + w := Max(w, n + FHorzMargin*2 + FHorzSpacing + 32) + else + w := Max(w, n + FHorzMargin); + + j := FcsBtnList.Add(TTaskDialogButton.Create(Self)); + with TTaskDialogButton(FcsBtnList.Items[j]) do + begin + Name := 'Button'+inttostr(i); + Parent := Self; + Caption := TaskDialog.CustomButtons[i]; + Font.Assign(pf); + Font.Color := RGB(0, 83, 196); + HeadingFont.Assign(hf); + HeadingFont.Color := RGB(0, 83, 196);//RGB(21, 28, 85); + ModalResult := i + 100; //mrAbort; + //Default := (ModalResult = TaskDialog.DefaultButton); + BorderColorHot := RGB(108, 225, 255); + BorderColorDown := RGB(108, 225, 255); + Width := Max(60, n); + if TaskDialog.DefaultButton <> -1 then + AutoFocus := true; + + Height := Max(bh, Max(ButtonHeight, Canvas.TextHeight('gh') + 20)); + + if not (doCommandLinksNoIcon in TaskDialog.Options) then + begin + Picture.LoadFromResourceName(HInstance, 'TD_ARW'); + Picture.TransparentColor := clFuchsia; + + PictureHot.LoadFromResourceName(HInstance, 'TD_ARWHOT'); + PictureHot.TransparentColor := clFuchsia; + + PictureDown.LoadFromResourceName(HInstance, 'TD_ARWDOWN'); + PictureDown.TransparentColor := clFuchsia; + + PictureDisabled.LoadFromResourceName(HInstance, 'TD_ARWDIS'); + PictureDisabled.TransparentColor := clFuchsia; + end; + + if TaskDialog.DefaultButton = -1 then + TabStop := false + else + TabStop := true; + + OnClick := OnButtonClick; + //CsBtnGroupWidth := CsBtnGroupWidth + Width + ButtonSpacing; + end; + + end; + Canvas.Font.Assign(OldFont); + hf.Free; + pf.Free; + end; + + // if no button then OK button is added + if (FcmBtnList.Count = 0) and (FcsBtnList.Count = 0) then + begin + b := cbOK; + TextRect := Rect(0,0,0,0); + Windows.DrawText( canvas.handle, + PChar(LoadResString(ButtonCaptions[B])), -1, + TextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or + DrawTextBiDiModeFlagsReadingOnly); + with TextRect do ButtonWidths[B] := Right - Left + 8; + + //if ButtonWidths[B] > ButtonWidth then + //ButtonWidth := ButtonWidths[B]; + + i := FcmBtnList.Add(TaskDialog.CreateButton(Self)); + with TWinControl(FcmBtnList.Items[i]) do + begin + Name := ButtonNames[B]; + Parent := Self; + TaskDialog.SetButtonCaption(TWinControl(FcmBtnList.Items[i]), LoadResString(ButtonCaptions[B])); + TaskDialog.SetButtonModalResult(TWinControl(FcmBtnList.Items[i]), ModalResults[B]); + //ModalResult := ModalResults[B]; + //Default := True; + TaskDialog.SetButtonDefault(TWinControl(FcmBtnList.Items[i]), True); + //Cancel := True; // handle ESC + + if doAllowDialogCancel in TaskDialog.Options then + TaskDialog.SetButtonCancel(TWinControl(FcmBtnList.Items[i]), True); + + Width := Max(60, ButtonWidths[B]); + Height := ButtonHeight; + cmBtnGroupWidth := cmBtnGroupWidth + Width + ButtonSpacing; + //if B = mbHelp then + //OnClick := TMessageForm(Result).HelpButtonClick; + end; + end; + + // Instruction + Canvas.Font.Size := 11; + Canvas.Font.Style := [fsBold]; + + SetRect(TextRect, 0, 0, Screen.Width div 2, 0); + DrawText(Canvas.Handle, PChar(Msg), Length(Msg) + 1, TextRect, + DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or + DrawTextBiDiModeFlagsReadingOnly); + + Canvas.Font.Assign(OldFont); + + IconID := IconIDs[DlgType]; + + IconTextWidth := TextRect.Right; + IconTextHeight := TextRect.Bottom; + if IconID <> nil then + begin + Inc(IconTextWidth, 32 + FHorzSpacing); + if IconTextHeight < 32 then IconTextHeight := 32; + end; + + {if DlgType <> tiBlank then + Caption := LoadResString(Captions[DlgType]) else + Caption := Application.Title;} + + if ((IconID <> nil) or not (TaskDialog.CustomIcon.Empty)) {and not (doCommandLinksNoIcon in TaskDialog.Options)} then + begin + FIcon := TImage.Create(Self); + with FIcon do + begin + Name := 'Image'; + Parent := Self; + + if not TaskDialog.CustomIcon.Empty then + begin + Picture.Icon.Assign(TaskDialog.CustomIcon); + end + else + begin + + case TaskDialog.Icon of + tiShield: Picture.Bitmap.Handle := LoadBitmap(hInstance, 'TD_SHIELD'); + tiBlank: + begin + Picture.Bitmap.Height := 32; + Picture.Bitmap.Width := 32; + Picture.Bitmap.Canvas.Brush.Color := clWhite; + Picture.Bitmap.Canvas.Pen.Style := psClear; + Picture.Bitmap.Canvas.Rectangle(0,0,31,31); + end; + else + Picture.Icon.Handle := LoadIcon(0, IconID); + end; + end; + + SetBounds(FHorzMargin, Y, 32, 32); + end; + end; + + Message := TLabel.Create(Self); + with Message do + begin + Name := 'Instr'; + Parent := Self; + {$IFDEF DELPHI7_LVL} + WordWrap := True; + {$ENDIF} + Caption := Msg; + Font.Size := 11; + Font.Color := RGB(0, 83, 196); + Font.Style := [fsBold]; + BoundsRect := TextRect; + BiDiMode := Self.BiDiMode; + ShowAccelChar := false; + ALeft := IconTextWidth - TextRect.Right + FHorzMargin; + if UseRightToLeftAlignment then + ALeft := Self.ClientWidth - ALeft - Width; + SetBounds(ALeft, Y, + TextRect.Right, TextRect.Bottom); + y := Y + Height + FVertSpacing; + FHorzParaMargin := ALeft; + end; + + if (doTimer in TaskDialog.Options) then + begin + FTimer := TTimer.Create(Self); + FTimer.Interval := 100; + FTimer.OnTimer := OnTimer; + FTimer.Enabled := True; + end; + + if (doProgressBar in TaskDialog.Options) then + begin + FProgressBar := TProgressBar.Create(Self); + with FProgressBar do + begin + Name := 'ProgressBar'; + Parent := Self; + BoundsRect := Rect(FHorzMargin, Y, Width - FHorzMargin, Y + 12); + Min := TaskDialog.ProgressBarMin; + Max := TaskDialog.ProgressBarMax; + Position := 0; + end; + + if not Assigned(FTimer) then + begin + FTimer := TTimer.Create(Self); + FTimer.Interval := 100; + FTimer.OnTimer := OnTimer; + FTimer.Enabled := True; + end; + end; + + if (TaskDialog.RadioButtons.Count > 0) then + begin + if (doNodefaultRadioButton in FTaskDialog.Options) then + FTaskDialog.RadioButtonResult := 0 + else + FTaskDialog.RadioButtonResult := FTaskDialog.DefaultRadioButton; + + for i := 0 to TaskDialog.RadioButtons.Count-1 do + begin + j := FRadioList.Add(FTaskDialog.CreateRadioButton(Self)); + + TaskDialog.InitRadioButton(self, TWinControl(FRadioList.Items[j]), i, OnRadioClick); + + with TWinControl(FRadioList.Items[j]) do + begin + (* + Name := 'Radio' + inttostr(i); + Parent := Self; + Font.Name := Canvas.Font.Name; + Font.Size := 8; + {$IFDEF DELPHI7_LVL} + //WordWrap := False; + {$ENDIF} + OnClick := OnRadioClick; + BiDiMode := Self.BiDiMode; + *) + + BoundsRect := TextRect; + Left := FHorzParaMargin + FHorzMargin; //ALeft + FHorzMargin; + Top := Y; + Width := Self.Width - Left - 4; + GetTextSize(Canvas, Caption, k, l); + w := Max(w, Left + k + FHorzMargin + 20); + end; + + TaskDialog.SetRadioButtonCaption(FRadioList.Items[j],TaskDialog.RadioButtons[i]); + + if doNoDefaultRadioButton in TaskDialog.Options then + TaskDialog.SetRadioButtonState(FRadioList.Items[j], False) + else + begin + if (TaskDialog.DefaultRadioButton > 0) then + TaskDialog.SetRadioButtonState(FRadioList.Items[j], (j + 200 = TaskDialog.DefaultRadioButton)) + else + begin + TaskDialog.SetRadioButtonState(FRadioList.Items[j], (i = 0)); + end; + end; + + (* + with TRadioButton(FRadioList.Items[j]) do + begin + if doNoDefaultRadioButton in TaskDialog.Options then + Checked := False + else + begin + if (TaskDialog.DefaultRadioButton > 0) then + Checked := (j + 200 = TaskDialog.DefaultRadioButton) + else + begin + Checked := (i = 0); + end; + end; + end; + *) + end; + end; + + if (TaskDialog.ExpandedText <> '') then + begin + (*FExpandLabel := TLabel.Create(Self); + with FExpandLabel do + begin + Name := 'Expand'; + Parent := Self; + {$IFDEF DELPHI7_LVL} + WordWrap := True; + {$ENDIF} + ShowAccelChar := false; + BiDiMode := Self.BiDiMode; + FExpandLabel.Caption := TaskDialog.ExpandedText; + Left := ALeft; + Top := Y; + end; *) + + FExpTextXSize := 0; + FExpTextYSize := 0; + r := Rect(FHorzMargin, Y, 300, Y + 26); + + + if (doHyperlinks in FTaskDialog.Options) then + begin + szExpandedText := StringReplace(FTaskDialog.ExpandedText,'\n','
',[rfReplaceAll]); + szExpandedText := StringReplace(szExpandedText,#10,'
',[rfReplaceAll]); + + HTMLDrawEx(Canvas, szExpandedText, r, nil, x, y, -1, -1, 1, true, false, false, true, true, false, true, + 1.0, clBlue, clNone, clNone, clGray, anchor, stripped, focusanchor, FExpTextXSize, FExpTextYSize, hyperlinks, + mouselink, re, nil, nil, 0); + end + else + begin + szExpandedText := StringReplace(FTaskDialog.ExpandedText,'\n',#13,[rfReplaceAll]); + + FExpTextXSize := r.Right - r.Left; + //szContent := StringReplace(FTaskDialog.Content,'\n',#13,[rfReplaceAll]); + //GetTextSize(Canvas, szContent, FExpTextXSize, FExpTextYSize); + + GetTextSize(Canvas, szExpandedText, FExpTextXSize, FExpTextYSize); + end; + + FExpandButton := TTaskDialogButton.Create(Self); + with FExpandButton do + begin + Name := 'ExpandButton'; + Parent := Self; + Caption := ''; + ModalResult := mrNone; + Width := 19; + Height := 19; + OnClick := OnExpandButtonClick; + Picture.LoadFromResourceName(HInstance, 'TD_COLP'); + Picture.TransparentColor := clFuchsia; + + PictureHot.LoadFromResourceName(HInstance, 'TD_COLPHOT'); + PictureHot.TransparentColor := clFuchsia; + + PictureDown.LoadFromResourceName(HInstance, 'TD_COLPDOWN'); + PictureDown.TransparentColor := clFuchsia; + end; + end; + + verifTextWidth := 0; + if (TaskDialog.VerificationText <> '') then + begin + k := 0; + FVerificationCheck := TCheckBox.Create(Self); + with FVerificationCheck do + begin + Name := 'Verification'; + Parent := Self; + {$IFDEF DELPHI7_LVL} + WordWrap := False; + {$ENDIF} + BoundsRect := TextRect; + BiDiMode := Self.BiDiMode; + Caption := TaskDialog.VerificationText; + Left := FHorzMargin; + Top := Y; + Color := RGB(240, 240, 240); + OnClick := OnVerifyClick; + Checked := (doVerifyChecked in TaskDialog.Options); + GetTextSize(Canvas, Caption, k, l); + verifTextWidth := k + FVertSpacing *2; + w := Max(w, Left + k); + end; + end; + + FFooterXSize := 0; + FFooterYSize := 0; + if (TaskDialog.Footer <> '') then + begin + r := Rect(FHorzMargin, Y, 300, Y + 26); + + szFooterText := StringReplace(FTaskDialog.Footer,'\n','
',[rfReplaceAll]); + szFooterText := StringReplace(szFooterText,#10,'
',[rfReplaceAll]); + + HTMLDrawEx(Canvas, szFooterText, r, nil, x, y, -1, -1, 1, true, false, false, true, true, false, true, + 1.0, clBlue, clNone, clNone, clGray, anchor, stripped, focusanchor, FFooterXSize, FFooterYSize, hyperlinks, + mouselink, re, nil, nil, 0); + + IconID := FooterIconIDs[TaskDialog.FooterIcon]; + FooterIconTextWidth := TextRect.Right; + FooterIconTextHeight := TextRect.Bottom; + if IconID <> nil then + begin + Inc(FooterIconTextWidth, 24 + FHorzSpacing); + if FooterIconTextHeight < 24 then FooterIconTextHeight := 24; + end; + + if IconID <> nil then + begin + FFooterIcon := TImage.Create(Self); + FFooterIconID := IconID; + + with FFooterIcon do + begin + Name := 'FooterImage'; + Parent := Self; + Visible := False; + SetBounds(FHorzMargin, Y, 16, 16); + end; + end; + end; + + ButtonGroupWidth := CmBtnGroupWidth + CsBtnGroupWidth + verifTextWidth; + if (TaskDialog.ExpandedText <> '') and Assigned(FExpandButton) then + begin + k := 0; + l := 0; + GetTextSize(Canvas, FTaskDialog.CollapsControlText, k, l); + GetTextSize(Canvas, FTaskDialog.ExpandControlText, n, l); + k := Max(k, n); + ButtonGroupWidth := ButtonGroupWidth + FExpandButton.Width + FHorzSpacing + k + FHorzSpacing; + end; + + if TaskDialog.Content = '' then + Y := Y - 20; + + case TaskDialog.InputType of + itEdit: + begin + FInputEdit := TEdit.Create(self); + FInputEdit.Parent := Self; + FInputEdit.TabStop := true; + FInputEdit.Text := TaskDialog.InputText; + + ALeft := IconTextWidth - TextRect.Right + FHorzMargin; + if UseRightToLeftAlignment then + ALeft := Self.ClientWidth - ALeft - Width; + + FInputEdit.SetBounds(ALeft, Y + 20, ClientWidth - ALeft, 20); + end; + itComboEdit, itComboList: + begin + FInputCombo := TComboBox.Create(self); + FInputCombo.Parent := Self; + FInputCombo.TabStop := true; + FInputCombo.Text := TaskDialog.InputText; + FInputCombo.Items.Assign(TaskDialog.InputItems); + + if TaskDialog.InputType = itComboList then + begin + FInputCombo.Style := csDropDownList; + FInputCombo.ItemIndex := FInputCombo.Items.IndexOf(TaskDialog.InputText); + end; + + ALeft := IconTextWidth - TextRect.Right + FHorzMargin; + if UseRightToLeftAlignment then + ALeft := Self.ClientWidth - ALeft - Width; + + FInputCombo.SetBounds(ALeft, Y + 20, ClientWidth - ALeft, 20); + end; + itDate: + begin + FInputDate := TDateTimePicker.Create(self); + FInputDate.Parent := Self; + FInputDate.TabStop := true; + ALeft := IconTextWidth - TextRect.Right + FHorzMargin; + if UseRightToLeftAlignment then + ALeft := Self.ClientWidth - ALeft - Width; + + FInputDate.Top := Y + 20; + FInputDate.Left := ALeft; + end; + itMemo: + begin + FInputMemo := TMemo.Create(self); + FInputMemo.Parent := Self; + FInputMemo.TabStop := true; + FInputMemo.WantReturns := false; + FInputMemo.Lines.Text := TaskDialog.InputText; + ALeft := IconTextWidth - TextRect.Right + FHorzMargin; + if UseRightToLeftAlignment then + ALeft := Self.ClientWidth - ALeft - Width; + FInputMemo.SetBounds(ALeft, Y + 20, ClientWidth - ALeft, 60); + end; + itCustom: + begin + if Assigned(TaskDialog.InputControl) then + begin + FOldParent := TaskDialog.InputControl.Parent; + TaskDialog.InputControl.Parent := self; + TaskDialog.InputControl.Visible := true; + if Assigned(TaskDialog.OnDialogInputSetText) then + TaskDialog.OnDialogInputSetText(TaskDialog, TaskDialog.InputText) + else + SetWindowText(TaskDialog.InputControl.Handle, Pchar(TaskDialog.InputText)); + + ALeft := IconTextWidth - TextRect.Right + FHorzMargin; + if UseRightToLeftAlignment then + ALeft := Self.ClientWidth - ALeft - Width; + + TaskDialog.InputControl.Left := ALeft; + TaskDialog.InputControl.Top := Y + 20; + + if TaskDialog.InputControl.Width + ALeft > self.Width then + w := TaskDialog.InputControl.Width + ALeft + ALeft; + + //TaskDialog.InputControl.SetBounds(ALeft, Y + 20, ClientWidth - ALeft, 20); + end; + end; + end; + + //-- setting Form Width + k := Max(FFooterXSize, Max(IconTextWidth, ButtonGroupWidth)) + FHorzMargin * 2; + k := Max(FExpTextXSize + FHorzMargin * 2, k); + w := Max(w, k); + w := Max(w, FMinFormWidth); + + if w > (Screen.Width - 2 * GetSystemMetrics(SM_CYEDGE)) then + w := Screen.Width - 2 * GetSystemMetrics(SM_CYEDGE); +// if w > 800 then +// w := 800; + + ClientWidth := w; + + if (TaskDialog.InputType = itCustom) and Assigned(TaskDialog.InputControl) then + begin + if TaskDialog.InputControl.Width > ClientWidth - ALeft then + TaskDialog.InputControl.Width := ClientWidth - ALeft; + end; + + if (doProgressBar in TaskDialog.Options) then + begin + FProgressBar.Width := ClientWidth - FHorzMargin*2; + end; + + SetPositions; + + if (TaskDialog.ExpandedText <> '') then + begin + SetExpanded((doExpandedDefault in TaskDialog.Options)); + end; + + Left := (Screen.Width div 2) - (Width div 2); + Top := (Screen.Height div 2) - (Height div 2); + OldFont.Free; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.UpdateDialog; +var + DialogUnits: TPoint; + ButtonSpacing, ButtonGroupWidth, IconTextWidth, X, Y: Integer; + IconID: PChar; + TextRect: TRect; + Msg: string; + DlgType: TTaskDialogIcon; + Buttons: TCommonButtons; + i, w: Integer; + CmBtnGroupWidth, CsBtnGroupWidth: Integer; + r, re: trect; + anchor, stripped: string; + HyperLinks,MouseLink, k, l, n: Integer; + Focusanchor,szFooterText: string; + OldFont: TFont; +begin + if not Assigned(FTaskDialog) then + Exit; + + Msg := FTaskDialog.Instruction; + DlgType := FTaskDialog.Icon; + Buttons := FTaskDialog.CommonButtons; + + OldFont := TFont.Create; + OldFont.Assign(Canvas.Font); + + DialogUnits := GetAveCharSize(Canvas); + w := 0; + + if FTaskDialog.Title <> '' then + Caption := FTaskDialog.Title + else + Caption := GetExeName; + + + if (Caption <> '') then + begin + w := 1000; + GetTextSize(Canvas, Caption, w, l); + w := w + 50; + end; + + ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X, 4); + CmBtnGroupWidth := 0; + CsBtnGroupWidth := 0; + Y := FVertMargin; + //ALeft := 0; + + for i := 0 to FcmBtnList.Count-1 do + begin + CmBtnGroupWidth := CmBtnGroupWidth + TButton(FcmBtnList.Items[i]).Width + ButtonSpacing; + end; + + if not (docommandLinks in FTaskDialog.Options) then + begin + for i := 0 to FcsBtnList.Count-1 do + begin + CsBtnGroupWidth := CsBtnGroupWidth + TButton(FcsBtnList.Items[i]).Width + ButtonSpacing; + end; + end + else + begin + + end; + + // Instruction + Canvas.Font.Size := 11; + Canvas.Font.Style := [fsBold]; + + SetRect(TextRect, 0, 0, Screen.Width div 2, 0); + DrawText(Canvas.Handle, PChar(Msg), Length(Msg) + 1, TextRect, + DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or + DrawTextBiDiModeFlagsReadingOnly); + + Canvas.Font.Assign(OldFont); + + + IconID := IconIDs[DlgType]; + IconTextWidth := TextRect.Right; + if (IconId <> nil) then + begin + Inc(IconTextWidth, 32 + FHorzSpacing); + end; + + if Assigned(Message) then + begin + Message.Caption := Msg; + //ALeft := IconTextWidth - TextRect.Right + FHorzMargin; + //if UseRightToLeftAlignment then + //ALeft := Self.ClientWidth - ALeft - Width; + y := Y + Height + FVertSpacing; + end; + + if (FTaskDialog.RadioButtons.Count > 0) then + begin + FTaskDialog.RadioButtonResult := FTaskDialog.DefaultRadioButton; + + for i := 0 to FRadioList.Count - 1 do + begin + with TRadioButton(FRadioList.Items[i]) do + begin + BoundsRect := TextRect; + Left := FHorzParaMargin + FHorzMargin; + Top := Y; + Width := Self.Width - Left - 4; + GetTextSize(Canvas, Caption, k, l); + w := Max(w, Left + k + FHorzMargin + 20); + end; + end; + end; + + {if (FTaskDialog.ExpandedText <> '') and Assigned(FExpandLabel) then + begin + with FExpandLabel do + begin + Left := ALeft; + Top := Y; + FExpandLabel.Caption := FTaskDialog.ExpandedText; + end; + end; } + + if (FTaskDialog.VerificationText <> '') and Assigned(FVerificationCheck) then + begin + k := 0; + with FVerificationCheck do + begin + BoundsRect := TextRect; + Caption := FTaskDialog.VerificationText; + Left := FHorzMargin; + Top := Y; + GetTextSize(Canvas, Caption, k, l); + w := Max(w, Left + k); + end; + end; + + FFooterXSize := 0; + FFooterYSize := 0; + if (FTaskDialog.Footer <> '') then + begin + r := Rect(FHorzMargin, Y, 300, Y + 26); + x := 0; + szFooterText := StringReplace(FTaskDialog.Footer,'\n','
',[rfReplaceAll]); + szFooterText := StringReplace(szFooterText,#10,'
',[rfReplaceAll]); + + HTMLDrawEx(Canvas, szFooterText, r, nil, x, y, -1, -1, 1, true, false, false, true, true, false, true, + 1.0, clBlue, clNone, clNone, clGray, anchor, stripped, focusanchor, FFooterXSize, FFooterYSize, hyperlinks, + mouselink, re, nil, nil, 0); + + if Assigned(FFooterIcon) then + begin + FFooterIcon.SetBounds(FHorzMargin, Y, 16, 16); + end; + end; + + ButtonGroupWidth := CmBtnGroupWidth + CsBtnGroupWidth; + if (FTaskDialog.ExpandedText <> '') and Assigned(FExpandButton) then + begin + k := 0; + l := 0; + GetTextSize(Canvas, FTaskDialog.CollapsControlText, k, l); + GetTextSize(Canvas, FTaskDialog.ExpandControlText, n, l); + k := Max(k, n); + ButtonGroupWidth := ButtonGroupWidth + FExpandButton.Width + FHorzSpacing + k + FHorzSpacing; + end; + + + //-- setting Form Width + k := Max(FFooterXSize, Max(IconTextWidth, ButtonGroupWidth)) + FHorzMargin * 2; + w := Max(w, k); + w := Max(w, FMinFormWidth); + + + ClientWidth := w; + + if (doProgressBar in FTaskDialog.Options) and Assigned(FProgressBar) then + begin + FProgressBar.Width := ClientWidth - FHorzMargin*2; + end; + + SetPositions; + + OldFont.Free; + Invalidate; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.SetPositions; +var + DialogUnits: TPoint; + HorzMargin, VertMargin, VertSpacing, ButtonSpacing, ButtonGroupWidth, X, Y: Integer; + i, h: Integer; + CmBtnGroupWidth, CsBtnGroupWidth, BtnH: Integer; + X1, y1: Integer; + r, re, rc: trect; + anchor, stripped: string; + HyperLinks,MouseLink: Integer; + Focusanchor: string; + ExpTextTop, verifTextWidth, k, l: Integer; + szContent: string; + szExpandedText,szFooterText: string; + //lbl:TLabel; + //ExH: integer; +begin + if not Assigned(FTaskDialog) then + Exit; + + DialogUnits := GetAveCharSize(Canvas); + HorzMargin := MulDiv(mcHorzMargin, DialogUnits.X, 4); + VertMargin := MulDiv(mcVertMargin, DialogUnits.Y, 8); + VertSpacing := MulDiv(mcVertSpacing, DialogUnits.Y, 8); + ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X, 4); + CmBtnGroupWidth := 0; + CsBtnGroupWidth := 0; + Y := VertMargin; + + {$IFDEF DELPHI7_LVL} + Message.Transparent := true; + {$ENDIF} + + // Instruction Label + if (Message.Caption <> '') then + y := Y + Message.Height + VertSpacing + else + Message.Visible := False; + + if (FTaskDialog.Content <> '') then + begin + //FContent.Width := ClientWidth - FContent.Left - HorzMargin; + //FContent.Top := Y; + //Y := Y + FContent.Height + VertSpacing; + X1 := 0; + Y1 := 0; + r := GetContentRect; + r := Rect(r.Left, Y, R.Right, Y + 26); + + if (doHyperlinks in FTaskDialog.Options) then + begin + szContent := StringReplace(FTaskDialog.Content,'\n','
',[rfReplaceAll]); + szContent := StringReplace(szContent,#10,'
',[rfReplaceAll]); + + HTMLDrawEx(Canvas, szContent, r, nil, x1, y1, -1, -1, 1, true, true, false, true, true, false, true, + 1.0, clBlue, clNone, clNone, clGray, anchor, stripped, focusanchor, FContentXSize, FContentYSize, hyperlinks, + mouselink, re, nil, nil, 0); + end + else + begin + if HasLf(FTaskDialog.Content) then + szContent := StringReplace(FTaskDialog.Content,'\n',#13,[rfReplaceAll]) + else + szContent := FTaskDialog.Content; + + { + if (Message.Caption <> '') then + FContentXSize := Message.Width + else + FContentXSize := 360; + + if FContentXSize < 360 then + FContentXSize := 360; + } + FContentXSize := r.Right - r.Left; + GetTextSize(Canvas, szContent, FContentXSize, FContentYSize); + end; + + rc := GetContentRect; + if (fContentXSize > rc.Right - rc.Left) then + ClientWidth := ClientWidth + (fContentXSize - (rc.Right - rc.Left)); + + y1 := FContentYSize; + if (Message.Caption = '') and Assigned(FIcon) then + begin + y1 := Max(FIcon.Height, Y1); + end; + + Y := Y + Y1 + VertSpacing; + + case FTaskDialog.InputType of + itEdit: FInputEdit.Top := Y - 10; + itComboEdit,itComboList: FInputCombo.Top := Y - 10; + itDate: FInputDate.Top := Y - 10; + itMemo: FInputMemo.Top := Y - 10; + itCustom: if Assigned(FTaskDialog.InputControl) then + FTaskDialog.InputControl.Top := Y - 10; + end; + + end + else + begin + if (FTaskDialog.RadioButtons.Count = 0) and not (doCommandLinks in FTaskDialog.Options) then + Y := Y + VertSpacing; + + if (Message.Caption = '') and Assigned(FIcon) then + Y := Y + VertSpacing + VertMargin; + end; + + if (FTaskDialog.InputType in [itEdit, itComboEdit, itComboList, itDate]) then + begin + Y := Y + 30; + end; + + if (FTaskDialog.InputType in [itMemo]) then + begin + Y := Y + 70; + end; + + if (FTaskDialog.InputType in [itCustom]) then + begin + if Assigned(FTaskDialog.InputControl) then + Y := Y + FTaskDialog.InputControl.Height + 10 + else + Y := Y + 30; + end; + + if (doProgressBar in FTaskDialog.Options) then + begin + if Assigned(FIcon) then + begin + Y := Max(Y, FIcon.Top + FIcon.Height+3); + end; + FProgressBar.Top := Y; + Y := Y + FProgressBar.Height + VertSpacing; + end; + + if (FTaskDialog.RadioButtons.Count > 0) then + begin + for i:= 0 to FRadioList.Count-1 do + begin + TRadioButton(FRadioList.Items[i]).Top := Y; + TRadioButton(FRadioList.Items[i]).Width := ClientWidth - TRadioButton(FRadioList.Items[i]).Left - HorzMargin; + Y := Y + TRadioButton(FRadioList.Items[i]).Height + 4; + end; + Y := Y + VertSpacing - 4; + end; + + FExpTextXSize := 0; + FExpTextYSize := 0; + ExpTextTop := 0; + if (FTaskDialog.ExpandedText <> '') then + begin + if FExpanded then + begin + (*lbl := TLabel.Create(self); + {$IFDEF DELPHI7_LVL} + lbl.WordWrap := true; + {$ENDIF} + lbl.Width := ClientWidth - FExpandLabel.Left - HorzMargin; + lbl.Caption := FTaskDialog.FExpandedText; + ExH := lbl.Height; + lbl.Free; + + FExpandLabel.Top := Y; + FExpandLabel.Width := ClientWidth - FExpandLabel.Left - HorzMargin; + FExpandLabel.Height := ExH; + + Y := Y + FExpandLabel.Height + VertSpacing; + FExpandLabel.Visible := True; + *) + + + X1 := 0; + Y1 := 0; + r := GetExpTextRect; + r := Rect(r.Left, Y, R.Right, Y + 26); + + if (doHyperlinks in FTaskDialog.Options) then + begin + szExpandedText := StringReplace(FTaskDialog.ExpandedText,'\n','
',[rfReplaceAll]); + szExpandedText := StringReplace(szExpandedText,#10,'
',[rfReplaceAll]); + + HTMLDrawEx(Canvas, szExpandedText, r, nil, x1, y1, -1, -1, 1, true, true, false, true, true, false, true, + 1.0, clBlue, clNone, clNone, clGray, anchor, stripped, focusanchor, FExpTextXSize, FExpTextYSize, hyperlinks, + mouselink, re, nil, nil, 0); + end + else + begin + szExpandedText := StringReplace(FTaskDialog.ExpandedText,'\n',#13,[rfReplaceAll]); + + FExpTextXSize := r.Right - r.Left; + GetTextSize(Canvas, szExpandedText, FExpTextXSize, FExpTextYSize); + end; + + ExpTextTop := Y; + FExpTextTop := ExpTextTop; + Y := Y + FExpTextYSize + VertSpacing; + end + else + begin + //FExpandLabel.Visible := False; + end; + end; + + if not (docommandLinks in FTaskDialog.Options) then + begin + for i:= 0 to FcsBtnList.Count-1 do + begin + CsBtnGroupWidth := CsBtnGroupWidth + TButton(FcsBtnList.Items[i]).Width{ + ButtonSpacing}; + end; + + if (FcsBtnList.Count > 0) then + CsBtnGroupWidth := CsBtnGroupWidth + (FcsBtnList.Count-1) * ButtonSpacing; + end + else + begin + for i:= 0 to FcsBtnList.Count-1 do + begin + if Assigned(FIcon) then + TTaskDialogButton(FcsBtnList.Items[i]).Left := FHorzParaMargin; // FIcon.Left + FIcon.Width + FHorzSpacing; + TTaskDialogButton(FcsBtnList.Items[i]).Top := Y; + TTaskDialogButton(FcsBtnList.Items[i]).Width := ClientWidth - TTaskDialogButton(FcsBtnList.Items[i]).Left - HorzMargin; + Y := Y + TTaskDialogButton(FcsBtnList.Items[i]).Height + 2; + end; + FWhiteWindowHeight := Y; + Y := Y + VertSpacing; + end; + + for i := 0 to FcmBtnList.Count-1 do + begin + CmBtnGroupWidth := CmBtnGroupWidth + TButton(FcmBtnList.Items[i]).Width{ + ButtonSpacing}; + end; + CmBtnGroupWidth := CmBtnGroupWidth + (FcmBtnList.Count-1) * ButtonSpacing; + + verifTextWidth := 0; + if (FTaskDialog.VerificationText <> '') then + begin + GetTextSize(Canvas, FTaskDialog.VerificationText, k, l); + verifTextWidth := k + FVertSpacing * 2; + end; + + ButtonGroupWidth := CsBtnGroupWidth + CmBtnGroupWidth; + + X := (ClientWidth - ButtonGroupWidth - FHorzSpacing - 4); //(ClientWidth - ButtonGroupWidth) div 2; + h := Y; + BtnH := 0; + + if (FTaskDialog.ExpandedText <> '') then + begin + X := (ClientWidth - ButtonGroupWidth - FHorzSpacing - 4); + { + k := 0; + l := 0; + GetTextSize(Canvas, FTaskDialog.CollapsControlText, k, l); + GetTextSize(Canvas, FTaskDialog.ExpandControlText, n, l); + k := Max(k, n); + ButtonGroupWidth := ButtonGroupWidth + FExpandButton.Width + ButtonSpacing + k + FHorzSpacing; + } + end; + + if (FTaskDialog.ExpandedText <> '') then + begin + with FExpandButton do + begin + Top := Y; + Left := FVertMargin; //X; + //Inc(X, FExpandButton.Width + ButtonSpacing); + if (FExpandButton.Height > BtnH) then + BtnH := FExpandButton.Height; + end; + end; + + if (FTaskDialog.VerificationText <> '') and Assigned(FVerificationCheck) then + begin + FVerificationCheck.Width := verifTextWidth - FVertSpacing; //ClientWidth - FVerificationCheck.Left - HorzMargin; + FVerificationCheck.Top := Y + BtnH; + FVerificationCheck.Left := FVertMargin + 3; + //X := FVerificationCheck.Left + FVerificationCheck.Width + FVertMargin; + end; + + if not (docommandLinks in FTaskDialog.Options) then + begin + for i:= 0 to FcsBtnList.Count-1 do + begin + with TButton(FcsBtnList.Items[i]) do + begin + Top := Y; + Left := X; + Inc(X, TButton(FcsBtnList.Items[i]).Width + ButtonSpacing); + //if (i = 0) then + //h := h + TButton(FcsBtnList.Items[i]).Height; + if (TButton(FcsBtnList.Items[i]).Height > BtnH) then + BtnH := TButton(FcsBtnList.Items[i]).Height; + end; + end; + if (FcsBtnList.Count > 0) then + FWhiteWindowHeight := TButton(FcsBtnList.items[0]).Top{ - (FVertSpacing div 2)}; + end; + + for i := 0 to FcmBtnList.Count-1 do + begin + with TButton(FcmBtnList.Items[i]) do + begin + Top := Y; + Left := X; + Inc(X, TButton(FcmBtnList.Items[i]).Width + ButtonSpacing); + //if (i = 0) then + //h := h + TButton(FcmBtnList.Items[i]).Height; + if (TButton(FcmBtnList.Items[i]).Height > BtnH) then + BtnH := TButton(FcmBtnList.Items[i]).Height; + end; + + if (FcmBtnList.Count > 0) then + FWhiteWindowHeight := TButton(FcmBtnList.items[0]).Top{ - (FVertSpacing div 2)}; + end; + + if (FTaskDialog.VerificationText <> '') and Assigned(FVerificationCheck) then + begin + h := h + Max(BtnH, FVerificationCheck.Height + VertSpacing); + y := y + Max(BtnH + FVertSpacing, FVerificationCheck.Height + VertSpacing); + end + else + begin + h := h + BtnH; + if (BtnH > 0) then + y := y + BtnH + FVertSpacing; + end; + + if (FTaskDialog.Footer <> '') then + begin + X1 := 0; + Y1 := 0; + if Assigned(FFooterIcon) then + r := Rect(HorzMargin + 20, Y, Width - HorzMargin, Y + 100) + else + r := Rect(HorzMargin, Y, Width - HorzMargin, Y + 100); + + szFooterText := StringReplace(FTaskDialog.Footer,'\n','
',[rfReplaceAll]); + szFooterText := StringReplace(szFooterText,#10,'
',[rfReplaceAll]); + + HTMLDrawEx(Canvas, szFooterText, r, nil, x1, y1, -1, -1, 1, true, false, false, true, true, false, true, + 1.0, clBlue, clNone, clNone, clGray, anchor, stripped, focusanchor, FFooterXSize, FFooterYSize, hyperlinks, + mouselink, re, nil, nil, 0); + + y1 := FFooterYSize; + if Assigned(FFooterIcon) then + begin + FFooterIcon.Top := Y; + y1 := Max(Y1, 20); + end; + h := h + Y1 + VertSpacing; + end; + + h := h + VertMargin; + ClientHeight := h; + if (FcmBtnList.Count = 0) and ((docommandLinks in FTaskDialog.Options) or (not (docommandLinks in FTaskDialog.Options) and (FcsBtnList.Count = 0))) then + FWhiteWindowHeight := Height; + + if (ExpTextTop > 0) and (doExpandedFooter in FTaskDialog.Options) then + FWhiteWindowHeight := ExpTextTop; +end; + +//------------------------------------------------------------------------------ + +constructor TAdvMessageForm.CreateNew(AOwner: TComponent; Dummy: Integer); +var + NonClientMetrics: TNonClientMetrics; +begin + inherited CreateNew(AOwner); + NonClientMetrics.cbSize := sizeof(NonClientMetrics); + if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then + Font.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont); + + FExpandButton := nil; + FExpanded := true; + //FExpandLabel := nil; + FExpandControlText := ''; + FCollapsControlText := ''; + FcmBtnList := TList.Create; + FcsBtnList := TList.Create; + FRadioList := TList.Create; + FFooterXSize := 0; + FFooterYSize := 0; + FWhiteWindowHeight := Height; + FHorzParaMargin := 0; + FMinFormWidth := 350; +end; + +//------------------------------------------------------------------------------ + +{procedure TAdvMessageForm.HelpButtonClick(Sender: TObject); +begin + Application.HelpContext(HelpContext); +end;} + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.CustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + if ((ssAlt in Shift) and (Key = VK_F4)) then + Key := 0; + + if (Shift = [ssCtrl]) and (Key = Word('C')) then + begin + Beep; + WriteToClipBoard(GetFormText); + end; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.WMActivate(var M: TWMActivate); +begin + // only do this when parent form is topmost + SetWindowPos( Handle, HWND_TOP, 0,0,0,0, SWP_NOMOVE or SWP_NOSIZE ); +end; + +procedure TAdvMessageForm.WriteToClipBoard(Text: String); +var + Data: THandle; + DataPtr: Pointer; +begin + if OpenClipBoard(0) then + begin + try + Data := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, Length(Text) + 1); + try + DataPtr := GlobalLock(Data); + try + Move(PChar(Text)^, DataPtr^, Length(Text) + 1); + EmptyClipBoard; + SetClipboardData(CF_TEXT, Data); + finally + GlobalUnlock(Data); + end; + except + GlobalFree(Data); + raise; + end; + finally + CloseClipBoard; + end; + end + else + raise Exception.CreateRes(@SCannotOpenClipboard); +end; + +//------------------------------------------------------------------------------ + +function TAdvMessageForm.GetFormText: String; +var + DividerLine, ButtonCaptions: string; + I: integer; +begin + DividerLine := StringOfChar('-', 27) + sLineBreak; + for I := 0 to ComponentCount - 1 do + if Components[I] is TButton then + ButtonCaptions := ButtonCaptions + TButton(Components[I]).Caption + + StringOfChar(' ', 3); + ButtonCaptions := StringReplace(ButtonCaptions,'&','', [rfReplaceAll]); + Result := Format('%s%s%s%s%s%s%s%s%s%s', [DividerLine, Caption, sLineBreak, + DividerLine, Message.Caption, sLineBreak, DividerLine, ButtonCaptions, + sLineBreak, DividerLine]); +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.SetExpandButton(const Value: TTaskDialogButton); +begin + if Assigned(FExpandButton) then + FExpandButton.OnClick := nil; + + FExpandButton := Value; + + if Assigned(FExpandButton) then + FExpandButton.OnClick := OnExpandButtonClick; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.OnExpandButtonClick(Sender: TObject); +begin + if Assigned(FExpandButton) then + begin + SetExpanded(not Expanded); + end; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.SetExpanded(Value: Boolean); +begin + if FExpanded then + begin + if not Value then + begin + FExpandButton.Picture.LoadFromResourceName(HInstance, 'TD_EXP'); + FExpandButton.Picture.TransparentColor := clFuchsia; + FExpandButton.PictureHot.LoadFromResourceName(HInstance, 'TD_EXPHOT'); + FExpandButton.PictureHot.TransparentColor := clFuchsia; + FExpandButton.PictureDown.LoadFromResourceName(HInstance, 'TD_EXPDOWN'); + FExpandButton.PictureDown.TransparentColor := clFuchsia; + end; + end + else + begin + if Value then + begin + FExpandButton.Picture.LoadFromResourceName(HInstance, 'TD_COLP'); + FExpandButton.Picture.TransparentColor := clFuchsia; + FExpandButton.PictureHot.LoadFromResourceName(HInstance, 'TD_COLPHOT'); + FExpandButton.PictureHot.TransparentColor := clFuchsia; + FExpandButton.PictureDown.LoadFromResourceName(HInstance, 'TD_COLPDOWN'); + FExpandButton.PictureDown.TransparentColor := clFuchsia; + end; + end; + FExpanded := Value; + SetPositions; + Invalidate; +end; + +//------------------------------------------------------------------------------ + +destructor TAdvMessageForm.Destroy; +begin + FcmBtnList.Free; + FcsBtnList.Free; + FRadioList.Free; + if Assigned(FTimer) then + FTimer.Free; + inherited; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.DrawExpandedText; +var + r, re: trect; + anchor, stripped: string; + HyperLinks,MouseLink: Integer; + Focusanchor: string; + xsize, ysize: Integer; + szExpandedText: string; +begin + if not Assigned(FTaskDialog) or (not FExpanded) then + Exit; + + R := GetExpTextRect; + if (FTaskDialog.ExpandedText <> '') then + begin + + if (doHyperlinks in FTaskDialog.Options) then + begin + szExpandedText := StringReplace(FTaskDialog.ExpandedText,'\n','
',[rfReplaceAll]); + szExpandedText := StringReplace(szExpandedText,#10,'
',[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','
',[rfReplaceAll]); + szContent := StringReplace(szContent,#10,'
',[rfReplaceAll]); + + HTMLDrawEx(Canvas, szContent, R, nil, 0, 0, -1, -1, 1, false, false, false, false, False, false, + true, 1.0, clBlue, clNone, clNone, clGray, anchor, stripped, focusanchor, xsize, ysize, + hyperlinks, mouselink, re, nil , nil, 0); + end + else + begin + if HasLf(FTaskDialog.Content) then + szContent := StringReplace(FTaskDialog.Content,'\n',#13,[rfReplaceAll]) + else + szContent := FTaskDialog.Content; + DrawText(Canvas.Handle,PChar(szContent),Length(szContent), R, DT_EXPANDTABS or DT_LEFT or DT_VCENTER or DT_WORDBREAK or DT_NOPREFIX); + end; + end; +end; + +//------------------------------------------------------------------------------ + +function TAdvMessageForm.GetContentRect: TRect; +var + X, Y: Integer; +begin + Result := Rect(-1, -1, -1, -1); + if Assigned(FTaskDialog) and (FTaskDialog.Content <> '') then + begin + X := FHorzMargin; + if Assigned(FIcon) then + X := FIcon.Left + FIcon.Width + FHorzSpacing; + if (Message.Caption <> '') then + Y := Message.Top + Message.Height + FVertSpacing + else + Y := FVertMargin; + Result := Rect(X, Y, ClientWidth - FHorzMargin, Y + FContentYSize); + end; +end; + +//------------------------------------------------------------------------------ + +function TAdvMessageForm.GetExpTextRect: TRect; +var + X, Y: Integer; +begin + Result := Rect(-1, -1, -1, -1); + if Assigned(FTaskDialog) and FExpanded then + begin + X := FHorzMargin; + if Assigned(FIcon) then + X := FIcon.Left + FIcon.Width + FHorzSpacing; + {if (Message.Caption <> '') then + Y := Message.Top + Message.Height + FVertSpacing + else + Y := FVertMargin; + + if (FTaskDialog.Content <> '') then + y := Y + FContentYSize + FVertSpacing; + + if (doProgressBar in FTaskDialog.Options) then + begin + if Assigned(FIcon) then + begin + Y := Max(Y, FIcon.Top + FIcon.Height+3); + end; + + if Assigned(FProgressBar) then + Y := Y + FProgressBar.Height + FVertSpacing; + end; + + if (FTaskDialog.RadioButtons.Count > 0) then + begin + if (FRadioList.Count > 0) then + Y := Y + TRadioButton(FRadioList.Items[FRadioList.Count-1]).Height + FVertSpacing; + end;} + Y := FExpTextTop; + + Result := Rect(X, Y, ClientWidth - FHorzMargin, Y + FExpTextYSize); + end; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.DrawFooter; +var + r, re: trect; + anchor, stripped: string; + HyperLinks,MouseLink: Integer; + Focusanchor: string; + xsize, ysize, i: Integer; + bmp: TBitmap; + shieldbmp: TBitmap; + IconH: THandle; + szFooterText: string; + +begin + if not Assigned(FTaskDialog) then + Exit; + + if (FTaskDialog.Footer <> '') then + begin + R := GetFooterRect; + + i := R.Top - FVertSpacing; + Canvas.Pen.Color := RGB(223, 223, 223); + Canvas.MoveTo(2, i); + Canvas.LineTo(ClientWidth -3, i); + Canvas.Pen.Color := clWhite; + Canvas.MoveTo(2, i+1); + Canvas.LineTo(ClientWidth -3, i+1); + + if Assigned(FFooterIcon) then + begin + + IconH := LoadImage(0,FFooterIconID,IMAGE_ICON,16,16, LR_SHARED); + + bmp := TBitmap.Create; + bmp.Width := 16; + bmp.Height := 16; + bmp.Transparent := True; + bmp.Canvas.Brush.Color := RGB(240, 240, 240); + bmp.Canvas.Rectangle(0,0,16,16); + //DrawIcon(bmp.Canvas.Handle,0, 0, IconH); + //Canvas.StretchDraw(Rect(R.Left, R.Top-2, R.Left+16, R.Top+14), bmp); + + if FTaskDialog.FooterIcon = tfiShield then + begin + shieldbmp := TBitmap.Create; + shieldbmp.Handle := LoadBitmap(hInstance, 'TD_SHIELD'); + bmp.Canvas.StretchDraw(Rect(0,0,16,16),shieldbmp); + shieldbmp.Free; + end + else + begin + DrawIconEx(bmp.Canvas.Handle, 0, 0, IconH, 16, 16, 0, bmp.Canvas.Brush.Handle, DI_NORMAL); //Replaced DrawIcon + end; + Canvas.Draw(R.Left, R.Top, bmp); + bmp.Free; + + R.Left := R.Left + 20; + end; + szFooterText := StringReplace(FTaskDialog.Footer,'\n','
',[rfReplaceAll]); + szFooterText := StringReplace(szFooterText,#10,'
',[rfReplaceAll]); + + HTMLDrawEx(Canvas, szFooterText, R, nil, 0, 0, -1, -1, 1, false, false, false, false, False, false, + true, 1.0, clBlue, clNone, clNone, clGray, anchor, stripped, focusanchor, xsize, ysize, + hyperlinks, mouselink, re, nil , nil, 0); + end; +end; + +//------------------------------------------------------------------------------ + +function TAdvMessageForm.GetFooterRect: TRect; +begin + Result := Rect(-1, -1, -1, -1); + if Assigned(FTaskDialog) and (FTaskDialog.Footer <> '') then + begin + Result := Rect(FHorzMargin, ClientHeight - FFooterYSize-10, ClientWidth - FHorzMargin, ClientHeight); + end; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.Paint; +var + i: Integer; + R: TRect; + s: string; + VerInfo: TOSVersionInfo; + +begin + inherited; + i := FWhiteWindowHeight; + + {if (FcmBtnList.Count > 0) then + i := TButton(FcmBtnList.Items[0]).Top + else if (FcsBtnList.Count > 0) then + i := TButton(FcsBtnList.Items[0]).Top;} + + VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo); + GetVersionEx(verinfo); + + if (i > 0) then + begin + R := ClientRect; + R.Top := i - (FVertSpacing div 2) ; + Canvas.Brush.Color := RGB(240, 240, 240); + Canvas.FillRect(R); + Canvas.Pen.Color := RGB(223, 223, 223); + Canvas.MoveTo(R.Left, R.Top); + Canvas.LineTo(R.Right, R.Top); + R := ClientRect; + Canvas.Brush.Style := bsClear; + + if (verinfo.dwMajorVersion >= 6) then + Canvas.Pen.Style := psClear + else + Canvas.Pen.Style := psSolid; + + if DRAWBORDER and not IsVista then // only draw on non Vista + begin + Canvas.Pen.Color := clGray; + Canvas.Rectangle(R.Left+1, R.Top+1, R.Right-1, R.Bottom-1); + end; + Canvas.Pen.Style := psSolid; + end; + + DrawContent; + DrawExpandedText; + if Assigned(FTaskDialog) and (FTaskDialog.ExpandedText <> '') and Assigned(FExpandButton) then + begin + if not FExpanded then + s := FTaskDialog.CollapsControlText + else + s := FTaskDialog.ExpandControlText; + + Canvas.Brush.Style := bsClear; + R := Rect(FExpandButton.Left + FExpandButton.Width + FHorzSpacing - 5, FExpandButton.Top, ClientRect.Right, FExpandButton.Top + FExpandButton.Height); + DrawText(Canvas.Handle,PChar(s),Length(s), R, DT_SINGLELINE or DT_LEFT or DT_VCENTER); + end; + DrawFooter; +end; + +//------------------------------------------------------------------------------ + +function TAdvMessageForm.IsAnchor(x, y: integer): string; +var + r: trect; + xsize, ysize: integer; + anchor, stripped: string; + + HyperLinks,MouseLink: Integer; + Focusanchor: string; + re: TRect; + AText: String; +begin + Result := ''; + if not Assigned(FTaskDialog) then + Exit; + + AText := ''; + R := GetFooterRect; + if PtInRect(R, Point(X, Y)) then + begin + if Assigned(FFooterIcon) then + begin + R.Left := R.Left + 20; + end; + AText := FTaskDialog.Footer; + end + else + begin + R := GetContentRect; + if PtInRect(R, Point(X, y)) then + AText := FTaskDialog.Content + else + begin + R := GetExpTextRect; + if PtInRect(R, Point(X, y)) then + AText := FTaskDialog.ExpandedText; + end; + end; + + AText := StringReplace(AText,'\n','
',[rfReplaceAll,rfIgnoreCase]); + AText := StringReplace(AText,#10,'
',[rfReplaceAll,rfIgnoreCase]); + + Anchor := ''; + if (AText <> '') then + begin + if HTMLDrawEx(Canvas, AText, r, nil, x, y, -1, -1, 1, true, false, false, true, true, false, true, + 1.0, clBlue, clNone, clNone, clGray, anchor, stripped, focusanchor, xsize, ysize, hyperlinks, + mouselink, re, nil, nil, 0) then + Result := anchor; + end; +end; + +procedure TAdvMessageForm.KeyDown(var Key: Word; Shift: TShiftSTate); +var + s: string; +begin + inherited; + if (Key = VK_F1) then + begin + if FTaskDialog.HelpContext <> 0 then + Application.HelpContext(FTaskDialog.HelpContext); + end; + if (Key = ord('C')) and (ssCtrl in Shift) then + begin + // got ctrl-c + s := FTaskDialog.FTitle + #13#10; + s := s + FTaskDialog.FInstruction + #13#10; + s := s + FTaskDialog.FContent; + clipboard.Open; + clipboard.AsText := s; + clipboard.Close; + end; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.MouseDown(Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +var + Anchor: string; +begin + inherited; + Anchor := IsAnchor(X, Y); + if Anchor <> '' then + begin + if not Assigned(FTaskDialog.OnDialogHyperlinkClick) then + begin + if (Pos('://', anchor) > 0) then + VistaShellOpen(0, 'iexplore.exe', Anchor); + end; + + if Assigned(FTaskDialog.OnDialogHyperlinkClick) then + FTaskDialog.OnDialogHyperlinkClick(FTaskDialog, Anchor); + end; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.MouseMove(Shift: TShiftState; X, Y: Integer); +var + anchor: string; +begin + anchor := IsAnchor(x, y); + if (Anchor <> '') then + begin + if (self.Cursor = crDefault) or (fAnchor <> Anchor) then + begin + fAnchor := Anchor; + self.Cursor := crHandPoint; + //if fAnchorHint then + //Application.CancelHint; + //if Assigned(fAnchorEnter) then fAnchorEnter(self, anchor); + end; + end + else + begin + if (self.Cursor = crHandPoint) then + begin + self.Cursor := crDefault; + //if assigned(fAnchorExit) then fAnchorExit(self, anchor); + end; + end; + inherited; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.OnTimer(Sender: TObject); +var + State: TTaskDialogProgressState; + Pos: Integer; +begin + if Assigned(FTaskDialog) then + begin + if Assigned(FTaskDialog.OnDialogTimer) then + FTaskDialog.OnDialogTimer(FTaskDialog); + + if Assigned(FTaskDialog.OnDialogProgress) then + begin + Pos := FProgressBar.Position; + FTaskDialog.OnDialogProgress(FTaskDialog, Pos, State); + FProgressBar.Position := Pos; + end; + end; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.ClickButton(ButtonID: integer); +var + Btn: TButton; + TaskBtn: TTaskDialogButton; +begin + TaskBtn := nil; + Btn := GetButton(ButtonID, TaskBtn); + if Assigned(Btn) then + Btn.Click + else if Assigned(TaskBtn) then + TaskBtn.Click; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.EnableButton(ButtonID: integer; + Enabled: boolean); +var + Btn: TButton; + TaskBtn: TTaskDialogButton; +begin + TaskBtn := nil; + Btn := GetButton(ButtonID, TaskBtn); + if Assigned(Btn) then + Btn.Enabled := Enabled + else if Assigned(TaskBtn) then + TaskBtn.Enabled := Enabled; +end; + +//------------------------------------------------------------------------------ + +function TAdvMessageForm.GetButton(ButtonID: Integer; var TaskButton: TTaskDialogButton): TButton; +var + i, j: Integer; +begin + j := 0; + Result := nil; + for i := 0 to FcmBtnList.Count-1 do + begin + Inc(j); + if (j >= ButtonID) then + begin + TButton(FcmBtnList.Items[i]).Enabled := Enabled; + Result := TButton(FcmBtnList.Items[i]); + break; + end; + end; + + if not Assigned(Result) then + begin + j := 99; + for i := 0 to FcsBtnList.Count-1 do + begin + Inc(j); + if (j >= ButtonID) then + begin + if (doCommandLinks in FTaskDialog.Options) then + begin + TTaskDialogButton(FcsBtnList.Items[i]).Enabled := Enabled; + TaskButton := TTaskDialogButton(FcsBtnList.Items[i]); + end + else + begin + TButton(FcsBtnList.Items[i]).Enabled := Enabled; + Result := TButton(FcsBtnList.Items[i]); + end; + break; + end; + end; + end; +end; + +//------------------------------------------------------------------------------ + +procedure TTaskDialogButton.Click; +var + Form: TCustomForm; +begin + Form := GetParentForm(Self); + if Form <> nil then + Form.ModalResult := ModalResult; + inherited; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.OnVerifyClick(Sender: TObject); +begin + if not Assigned(FTaskDialog) or not Assigned(FVerificationCheck) then + Exit; + + FTaskDialog.VerifyResult := FVerificationCheck.Checked; + + if Assigned(FVerificationCheck) and Assigned(FTaskDialog.OnDialogVerifyClick) then + FTAskDialog.OnDialogVerifyClick(FTaskDialog, FVerificationCheck.Checked); +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.OnRadioClick(Sender: TObject); +begin + if not Assigned(FTaskDialog) or not Assigned(FRadioList) then + Exit; + + FTaskDialog.RadioButtonResult := FRadioList.IndexOf(Sender) + 200; + if Assigned(FTaskDialog) and Assigned(FTaskDialog.OnDialogRadioClick) then + FTAskDialog.OnDialogRadioClick(FTaskDialog, FTaskDialog.RadioButtonResult); +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.DoClose(var Action: TCloseAction); +var + CanClose: Boolean; + s: string; + a: array[0..255] of char; + +begin + CanClose := True; + + if Assigned(FTaskDialog) and Assigned(FTaskDialog.OnDialogClose) then + begin + FTaskDialog.OnDialogClose(FTaskDialog, CanClose); + end; + + case FTaskDialog.InputType of + itEdit: FTaskDialog.InputText := FInputEdit.Text; + itComboEdit, itComboList: FTaskDialog.InputText := FInputCombo.Text; + itDate: FTaskDialog.InputText := DateToStr(FInputDate.Date); + itMemo: FTaskDialog.InputText := FInputMemo.Lines.Text; + itCustom: + begin + if Assigned(FTaskDialog.InputControl) then + begin + GetWindowText(FTaskDialog.InputControl.Handle, a, sizeof(a)); + s := strpas(a); + if Assigned(FTaskDialog.OnDialogInputGetText) then + begin + s := ''; + FTaskDialog.OnDialogInputGetText(Self, s); + end; + FTaskDialog.InputText := s; + if CanClose then + begin + FTaskDialog.InputControl.Visible := false; + FTaskDialog.InputControl.Parent := FOldParent; + end; + end; + end; + end; + + if not CanClose then + Action := caNone; + inherited; +end; + +procedure TAdvMessageForm.DoShow; +var + defBtn: integer; +begin + inherited; + + defBtn := -1; + + if FTaskDialog.DefaultButton <> -1 then + begin + if (FTaskDialog.DefaultButton - 100 >= 0) and (FTaskDialog.DefaultButton - 100 < FTaskDialog.CustomButtons.Count) then + defBtn := FTaskDialog.DefaultButton - 100; + end; + + if defBtn <> -1 then + begin + if (docommandLinks in FTaskDialog.Options) then + TTaskDialogButton(FcsBtnList[defBtn]).SetFocus + else + TCustomControl(FcsBtnList[defBtn]).SetFocus; + end + else + begin + if (FTaskDialog.DefaultButton >= 0) and (FTaskDialog.DefaultButton < FCmBtnList.Count) then + begin + if TCustomControl(FcmBtnList[FTaskDialog.DefaultButton]).Enabled then + TCustomControl(FcmBtnList[FTaskDialog.DefaultButton]).SetFocus; + end; + end; + + + case FTaskDialog.InputType of + itEdit: FInputEdit.SetFocus; + itComboEdit, itComboList: FInputCombo.SetFocus; + itDate: FInputDate.SetFocus; + itMemo: FInputMemo.SetFocus; + itCustom: FTaskDialog.InputControl.SetFocus; + end; + +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.OnButtonClick(Sender: TObject); +begin + if not Assigned(FTaskDialog) or not Assigned(FcsBtnList) then + Exit; + + if Assigned(FTaskDialog) and Assigned(FTaskDialog.onDialogButtonClick) then + FTaskDialog.OnDialogButtonClick(FTaskDialog, FcsBtnList.IndexOf(Sender) + 100); +end; + +//------------------------------------------------------------------------------ + +procedure TAdvMessageForm.CMDialogChar(var Message: TCMDialogChar); +var + I: Integer; +begin + if Assigned(FTaskDialog) and (docommandLinks in FTaskDialog.Options) then + begin + for I := 0 to FcsBtnList.Count-1 do + begin + if (TControl(FcsBtnList[I]) is TTaskDialogButton) and IsAccel(Message.CharCode, TTaskDialogButton(FcsBtnList[I]).Caption) and CanFocus then + begin + TTaskDialogButton(FcsBtnList[I]).Click; + Message.Result := 1; + Exit; + end; + end; + end; + + if (FTaskDialog.ExpandControlText <> '') and Expanded then + begin + if IsAccel(Message.CharCode, FTaskDialog.FExpandControlText) then + begin + OnExpandButtonClick(Self); + end; + end + else + if (FTaskDialog.CollapsControlText <> '') and not Expanded then + if IsAccel(Message.CharCode, FTaskDialog.FCollapsControlText) then + begin + OnExpandButtonClick(Self); + end; + + inherited; + + + if Assigned(FTaskDialog) and (doAllowDialogCancel in FTaskDialog.Options) and (Message.CharCode = VK_ESCAPE) then + begin + Self.Close; + end; +end; + + +function CoreShowmessage( + const Title, // dialog window title + Instruction, // the part of the message shown in blue + content, // additional message if desired + verify: string; // ex Do Not Show this Again + tiIcon: tTaskDialogIcon): boolean; +var + td: TCustomAdvTaskDialog; +begin + td := TCustomAdvTaskDialog.Create(application); + td.Title := Title; + td.Instruction := instruction; + td.Content := Content; + td.VerificationText := verify; + td.icon := tiIcon; + td.Execute; + result := (verify <> '') and td.VerifyResult; + td.free; +end {CoreShowmessage}; + +//===================================================================== +// This returns false unless verify is not blank AND the verify checkbox +// was not checked. +//--------------------------------------------------------------------- +function AdvShowMessage( + const Title, // dialog window title + Instruction, // the part of the message shown in blue + content, // additional message if desired + verify: string; // ex Do Not Show this Again + tiIcon: tTaskDialogIcon): boolean; overload; +begin + result := coreShowmessage(title, instruction,content,verify,tiIcon); +end { tmsShowMessage }; + +function AdvShowmessage(const Instruction: string):boolean; overload; +begin // Only instruction . tiInformation + result := CoreShowMessage('',Instruction,'','',tiInformation); +end; + +function AdvShowmessage(const Title, Instruction: string):boolean; overload; +begin // title, instruction tiInformation + result := CoreShowMessage(Title,Instruction,'','',tiInformation); +end; + +function AdvShowmessage(const Title, Instruction: string;tiIcon: TTaskDialogIcon): boolean; overload; +begin + result := CoreShowMessage(Title,Instruction,'','',tiIcon); +end; + +function AdvShowMessageFmt(const Instruction: string; Parameters: array of const): boolean; +begin + Result := AdvShowmessage(Format(Instruction,Parameters)); +end; + +function AdvMessageBox(hWnd: HWND; lpInstruction, lpTitle: PChar; flags: UINT): Integer; +const + MB_CANCELTRYCONTINUE = $00000006; // missing from windows unit so probably never be used +var + td: TCustomAdvTaskDialog; + res: integer; + def: integer; + num: integer; + task: tCommonButton; + txt: string; +begin + td := TCustomAdvTaskDialog.Create(application); + td.Title := lptitle; + td.instruction := lpInstruction; + + // extract the icon from flags + case MB_ICONMASK and flags of + MB_ICONEXCLAMATION: td.Icon := tiWarning; // Exclamation mark= MB_ICONWARNING + MB_ICONINFORMATION: td.Icon := tiInformation; // Circled I = MB_ICONASTERISK + MB_ICONQUESTION: td.Icon := tiQuestion; // Question (api says don't use any more + MB_ICONSTOP: td.Icon := tiError; //Stop sign = MB_ICONERROR & MB_ICONHAND + end; + + // extract the buttons from flags + // MessageBox() Flags from Windows help file + // MB_ABORTRETRYIGNORE + // The message box contains three push buttons: Abort, Retry, and Ignore. + // MB_CANCELTRYCONTINUE + // Microsoft Windows 2000/XP: The message box contains three push buttons: Cancel, Try Again, Continue. Use this message box type instead of MB_ABORTRETRYIGNORE. + // MB_HELP + // Windows 95/98/Me, Windows NT 4.0 and later: Adds a Help button to the message box. When the user clicks the Help button or presses F1, the system sends a WM_HELP message to the owner. + // MB_OK + // The message box contains one push button: OK. This is the default. + // MB_OKCANCEL + // The message box contains two push buttons: OK and Cancel. + // MB_RETRYCANCEL + // The message box contains two push buttons: Retry and Cancel. + // MB_YESNO + // The message box contains two push buttons: Yes and No. + // MB_YESNOCANCEL + // The message box contains three push buttons: Yes, No, and Cancel. + td.Commonbuttons := []; + txt := ''; + case MB_TYPEMASK and flags of + MB_ABORTRETRYIGNORE: txt := SAbortButton + #10 + SRetryButton + #10 + SIgnoreButton; + MB_CANCELTRYCONTINUE: txt := SCancelButton + #10 + SRetryButton + #10 + SContinue; + MB_OK: td.Commonbuttons := [cbOK]; + MB_RETRYCANCEL: txt := SRetryButton + #10 + SCancelButton; + MB_OKCANCEL: td.CommonButtons := [cbOK,cbCancel]; + MB_YESNOCANCEL: td.Commonbuttons := [cbYes, cbNO, cbCancel]; + MB_YESNO: td.CommonButtons := [cbYes, cbNO]; + end; + + + + if MB_HELP and flags <> 0 then + begin + if length(txt) > 0 then + txt := txt + #10; + txt := txt + SHelpButton; + end; + if txt <> '' then + td.CustomButtons.text := txt; + + // deal with mbDefbutton1, 2, 3 & 4 + def := 0; + if mb_DefButton1 and flags <> 0 then + def := 1; + if mb_DefButton2 and flags <> 0 then + def := 2; + if mb_DefButton3 and flags <> 0 then + def := 3; + if mb_DefButton4 and flags <> 0 then + def := 4; + if def > 0 then + begin // have to set default button + num := td.CustomButtons.count; + if num <= def then + td.DefaultButton := 99 + def + else + begin + // I think this compiles on supported delphi compilers + for task := cbOK to cbClose do + begin + if task in td.CommonButtons then + begin + inc(num); + if num = def then + begin + case task of + cbOK: td.Defaultbutton := idOK; + cbYes: td.Defaultbutton := idYES; + cbNo: td.Defaultbutton := idNO; + cbCancel: td.Defaultbutton := idCANCEL; + cbRetry: td.Defaultbutton := idRETRY; + cbClose: td.Defaultbutton := idCLOSE; + end; + break; + end; + end; + end; + end; + end; + + if (cbCancel in td.CommonButtons) then + td.Options := td.Options + [doAllowDialogCancel]; + + // Deal with mbAppModal, mbSystemModal and mbtaskModal + // not sure what to do with these (I personally haven't used them. + result := 0; + res := td.Execute; + case res of + 1: result := IDOK; + 2: result := IDCANCEL; + 3: result := IDABORT; + 4: result := IDRETRY; + 5: result := IDIGNORE; + 6: result := IDYES; + 7: result := IDNO; + else + begin + case MB_TYPEMASK and flags of + MB_ABORTRETRYIGNORE: + case res of + 100: result := IDABORT; + 101: result := IDRETRY; + 102: result := IDIGNORE; + end; + MB_CANCELTRYCONTINUE: + case res of + 100: result := IDCANCEL; + {$IFDEF DELPHI9_LVL} + 101: result := IDTRYAGAIN; + 102: result := IDCONTINUE; + {$ENDIF} + end; + MB_RETRYCANCEL: + case res of + 100: result := IDRETRY; + 101: result := IDCANCEL; + end; + end; + end; + end; + td.Free; +end; + +//================================================================================================== + +function AdvTaskMessageDlg(const Title, Msg: string; DlgType: TMsgDlgType; + Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer; +begin + Result := AdvTaskMessageDlgPosHelp(Title, Msg, DlgType, Buttons, HelpCtx, -1, -1, ''); +end; + +//-------------------------------------------------------------------------------------------------- + +function AdvTaskMessageDlg(const Title, Msg: string; DlgType: TMsgDlgType; + Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): Integer; overload; +begin + Result := AdvTaskMessageDlgPosHelp(Title, Msg, DlgType, Buttons, HelpCtx, + -1, -1, '', DefaultButton); +end; + +//-------------------------------------------------------------------------------------------------- + +function AdvTaskMessageDlgPos(const Title, Msg: string; DlgType: TMsgDlgType; + Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer): Integer; +begin + Result := AdvTaskMessageDlgPosHelp(Title, Msg, DlgType, Buttons, HelpCtx, X, Y, ''); +end; + +//-------------------------------------------------------------------------------------------------- + +function AdvTaskMessageDlgPos(const Title, Msg: string; DlgType: TMsgDlgType; + Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer; + DefaultButton: TMsgDlgBtn): Integer; overload; +begin + Result := AdvTaskMessageDlgPosHelp(Title, Msg, DlgType, Buttons, HelpCtx, + X, Y, '', DefaultButton); +end; + +//-------------------------------------------------------------------------------------------------- + +function AdvTaskMessageDlgPosHelp(const Title, Msg: string; DlgType: TMsgDlgType; + Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer; + const HelpFileName: string): Integer; +begin + Result := AdvTaskMessageDlgPosHelp(Title, Msg, DlgType, Buttons, HelpCtx, X, Y, + HelpFileName, mbYes); +end; + + +function AdvMessageDlg(const Instruction: string; DlgType: TMsgDlgType; + Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer; overload; +begin + // passes mbHelp as the default button since we can't deal with help anyway + Result := AdvMessageDlg(Instruction,Dlgtype,Buttons,HelpCtx,mbHelp); +end; + +function AdvMessageDlg(const Instruction: string; DlgType: TMsgDlgType; + Buttons: TMsgDlgButtons; HelpCtx: Longint; DefaultButton: TMsgDlgBtn): Integer; overload; +var + td: TCustomAdvTaskDialog; + ray: array[0..3] of integer; + res: integer; +begin + td := TCustomAdvTaskDialog.Create(Application); + td.Instruction := instruction; + + case DlgType of + mtWarning: + begin + td.Icon := tiWarning; + td.Title := SMsgDlgWarning; + end; + mtError: + begin + td.Icon := tiError; + td.Title := SMsgDlgError; + end; + mtInformation: + begin + td.Icon := tiInformation; + td.Title := SMsgDlgInformation; + end; + mtConfirmation: + begin + td.Icon := tiQuestion; + td.Title := SMsgDlgConfirm; + end; + end; + + fillchar(ray,sizeof(ray),0); + td.CommonButtons := []; + +// TMsgDlgBtn = (mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, mbIgnore, +// mbAll, mbNoToAll, mbYesToAll, mbHelp); + + if (mbYes in Buttons) then + td.CommonButtons := td.CommonButtons + [cbYes]; + + if (mbNo in Buttons) then + td.CommonButtons := td.CommonButtons + [cbNo]; + + if (mbOK in Buttons) then + td.CommonButtons := td.CommonButtons + [cbOK]; + + if (mbCancel in Buttons) then + td.CommonButtons := td.CommonButtons + [cbCancel]; + + if (mbAbort in Buttons) then + td.CommonButtons := td.CommonButtons + [cbClose]; + + if (mbRetry in Buttons) then + td.CommonButtons := td.CommonButtons + [cbRetry]; + + if (mbIgnore in Buttons) then + begin + td.CustomButtons.Add(SMsgDlgIgnore); + ray[0] := mrIgnore; + end; + + if (mbAll in Buttons) then + begin + ray[td.custombuttons.Count] := mrALL; + td.CustomButtons.Add(SMsgDlgAll); + end; + + if (mbNoToAll in buttons) then + begin + ray[td.custombuttons.Count] := mrNoToAll; + td.CustomButtons.Add(SMsgDlgNoToAll); + end; + + if (mbYesToAll in buttons) then + begin + ray[td.custombuttons.Count] := mrYesToAll; + td.Custombuttons.Add(SMsgDlgYesToAll); + end; + + if (mbHelp in buttons) then + begin + ray[td.Custombuttons.Count] := mrNone; + td.Custombuttons.Add(SMsgDlgHelp); + end; + + case DefaultButton of + mbYes: td.DefaultButton := integer(mrYes); + mbNo: td.DefaultButton := integer(mrNo); + mbCancel: td.DefaultButton := integer(mrCancel); + mbOK: td.DefaultButton := integer(mrOK); + mbAbort: td.DefaultButton := integer(mrAbort); + mbRetry: td.DefaultButton := integer(mrRetry); + mbIgnore: td.DefaultButton := integer(mrIgnore); + end; + + td.HelpContext := HelpCtx; + td.Options := td.Options + [doAllowDialogCancel]; + + + result := 0; + res := td.Execute; + + case res of + 1: Result := mrOk; + 2: Result := mrCancel; + 3: Result := mrAbort; + 4: Result := mrRetry; + 6: Result := mrYes; + 7: Result := mrNo; + else + if (res > 99) and (res < 100 + high(ray)) then + begin + result := ray[res - 100]; + + if (Result = mrNone) and (td.HelpContext > 0) then + begin + Application.HelpContext(td.HelpContext); + end; + end; + end; +end; + + +//-------------------------------------------------------------------------------------------------- + +function AdvTaskMessageDlgPosHelp(const Title, Msg: string; DlgType: TMsgDlgType; + Buttons: TMsgDlgButtons; HelpCtx: Longint; X, Y: Integer; + const HelpFileName: string; DefaultButton: TMsgDlgBtn): Integer; +var + td: TAdvTaskDialog; + ray: array[0..3] of integer; + res: integer; +begin + td := TAdvTaskDialog.Create(Application); + try + td.Instruction := Title; + td.Content := msg; + + case DlgType of + mtWarning: + begin + td.Icon := tiWarning; + td.Title := SMsgDlgWarning; + end; + mtError: + begin + td.Icon := tiError; + td.Title := SMsgDlgError; + end; + mtInformation: + begin + td.Icon := tiInformation; + td.Title := SMsgDlgInformation; + end; + mtConfirmation: + begin + td.Icon := tiShield; + td.Title := SMsgDlgConfirm; + end; + end; + + fillchar(ray,sizeof(ray),0); + td.CommonButtons := []; + + // TMsgDlgBtn = (mbYes, mbNo, mbOK, mbCancel, mbAdvrt, mbRetry, mbIgnore, + // mbAll, mbNoToAll, mbYesToAll, mbHelp); + + if (mbYes in Buttons) then + td.CommonButtons := td.CommonButtons + [cbYes]; + + if (mbNo in Buttons) then + td.CommonButtons := td.CommonButtons + [cbNo]; + + if (mbOK in Buttons) then + td.CommonButtons := td.CommonButtons + [cbOK]; + + if (mbCancel in Buttons) then + td.CommonButtons := td.CommonButtons + [cbCancel]; + + if (mbAbort in Buttons) then + td.CommonButtons := td.CommonButtons + [cbClose]; + + if (mbRetry in Buttons) then + td.CommonButtons := td.CommonButtons + [cbRetry]; + + + if (mbIgnore in Buttons) then + begin + td.CustomButtons.Add(SMsgDlgIgnore); + ray[0] := mrIgnore; + end; + + if (mbAll in Buttons) then + begin + ray[td.custombuttons.Count] := mrALL; + td.CustomButtons.Add(SMsgDlgAll); + end; + + if (mbNoToAll in buttons) then + begin + ray[td.custombuttons.Count] := mrNoToAll; + td.CustomButtons.add(SMsgDlgNoToAll); + end; + + if (mbYesToAll in buttons) then + begin + ray[td.custombuttons.Count] := mrYesToAll; + td.Custombuttons.Add(SMsgDlgYesToAll); + end; + + if (mbHelp in buttons) then + begin + ray[td.Custombuttons.Count] := mrNone; + td.Custombuttons.Add(SMsgDlgHelp); + end; + + case DefaultButton of + mbYes: td.DefaultButton := integer(mrYes); + mbNo: td.DefaultButton := integer(mrNo); + mbCancel: td.DefaultButton := integer(mrCancel); + mbOK: td.DefaultButton := integer(mrOK); + mbAbort: td.DefaultButton := integer(mrAbort); + mbRetry: td.DefaultButton := integer(mrRetry); + mbIgnore: td.DefaultButton := integer(mrIgnore); + end; + + td.HelpContext := HelpCtx; + td.Options := td.Options + [doAllowDialogCancel]; + + Result := 0; + res := td.Execute; + case res of + 1: Result := mrOk; + 2: Result := mrCancel; + 3: Result := mrAbort; + 4: Result := mrRetry; + 6: Result := mrYes; + 7: Result := mrNo; + else + if (res > 99) and (res < 100+high(ray)) then + begin + result := ray[res-100]; + + if (Result = mrNone) and (td.HelpContext > 0) then + begin + Application.HelpContext(td.HelpContext); + end; + end; + end; + finally + td.Free; + end; +end; + + +function AdvInputQueryDlg(ACaption, APrompt: string; var Value: string):boolean; +var + AID: TAdvInputTaskDialog; +begin + AID := TAdvInputTaskDialog.Create(Application); + AID.Instruction := APrompt; + AID.Title := ACaption; + AID.InputText := Value; + AID.InputType := itEdit; + AID.CommonButtons := [cbOK, cbCancel]; + Result := AID.Execute = mrOK; + Value := AID.InputText; +end; + +//------------------------------------------------------------------------------ + +procedure Register; +begin + RegisterComponents('TMS',[TAdvTaskDialog, TAdvInputTaskDialog]); +end; + +//------------------------------------------------------------------------------ + + +{ TAdvInputTaskDialog } + +constructor TAdvInputTaskDialog.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FInputType := itEdit; + Options := Options + [doAllowDialogCancel]; +end; + +function TAdvInputTaskDialog.Execute: integer; +begin + Result := AdvMessageDlgPos(Self, -1, -1); +end; + + +initialization + //cbOK, cbYes, cbNo, cbCancel, cbRetry, cbClose); + ButtonCaptions[cbOK] := @SMsgDlgOK; + ButtonCaptions[cbYes] := @SMsgDlgYes; + ButtonCaptions[cbNo] := @SMsgDlgNo; + ButtonCaptions[cbCancel] := @SMsgDlgCancel; + ButtonCaptions[cbRetry] := @SMsgDlgRetry; + ButtonCaptions[cbClose] := @SMsgDlgAbort; + + Captions[tiBlank] := nil; + Captions[tiWarning] := @SMsgDlgWarning; + Captions[tiQuestion] := @SMsgDlgConfirm; + Captions[tiError] := @SMsgDlgError; + Captions[tiShield] := @SMsgDlgInformation; + + +{$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. diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialog.res b/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialog.res new file mode 100644 index 0000000..5028366 Binary files /dev/null and b/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialog.res differ diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogDE.pas b/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogDE.pas new file mode 100644 index 0000000..0434010 --- /dev/null +++ b/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogDE.pas @@ -0,0 +1,84 @@ +{***************************************************************************} +{ TTaskDialog component } +{ for Delphi & C++Builder } +{ version 1.2 } +{ } +{ written by TMS Software } +{ copyright © 2006 - 2007 } +{ 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 TaskDialogDE; + +interface + +{$I TMSDEFS.INC} + +uses + Classes, Graphics, Comctrls, Windows, Forms, TypInfo, Dialogs, ExtCtrls, + Controls, ExtDlgs, TaskDialog +{$IFDEF DELPHI6_LVL} + {$IFNDEF TMSDOTNET} + , DesignIntf, DesignEditors, ContNrs + {$ENDIF} + {$IFDEF TMSDOTNET} + , Borland.Vcl.design.DesignIntf, Borland.Vcl.design.DesignEditors, ContNrs + {$ENDIF} +{$ELSE} + , DsgnIntf +{$ENDIF} + ; + +type + + TTaskDialogEditor = class(TDefaultEditor) + public + function GetVerb(Index: Integer):string; override; + function GetVerbCount: Integer; override; + procedure ExecuteVerb(Index: Integer); override; + end; + +implementation + +{ TTaskDialogEditor } + +procedure TTaskDialogEditor.ExecuteVerb(Index: Integer); +var + AppIsParent: boolean; +begin + inherited; + case Index of + 0: + begin + AppIsParent := TAdvTaskDialog(Component).ApplicationIsParent; + TAdvTaskDialog(Component).ApplicationIsParent := true; + TAdvTaskDialog(Component).Execute; + TAdvTaskDialog(Component).ApplicationIsParent := AppIsParent; + end; + end; +end; + +function TTaskDialogEditor.GetVerb(Index: Integer): string; +begin + case Index of + 0: Result := 'Preview'; + end; +end; + +function TTaskDialogEditor.GetVerbCount: Integer; +begin + Result := 1; +end; + + + +end. diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogEx.pas b/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogEx.pas new file mode 100644 index 0000000..c1a40fe --- /dev/null +++ b/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogEx.pas @@ -0,0 +1,300 @@ +{***************************************************************************} +{ TTaskDialogEx component } +{ for Delphi & C++Builder } +{ } +{ written by TMS Software } +{ copyright © 2007 - 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 TaskDialogEx; + +{$I TMSDEFS.INC} + +interface + +uses + Classes, Windows, Messages, Forms, Dialogs, SysUtils, StdCtrls, Graphics, Consts, Math, + ExtCtrls, Controls, TaskDialog, AdvGlowButton, AdvOfficeButtons; + +type + TButtonCreatedEvent = procedure(Sender: TObject; Button: TAdvGlowButton) of object; + + TAdvTaskDialogEx = class(TAdvTaskDialog) + private + FOnButtonCreated: TButtonCreatedEvent; + FAppearance: TGlowButtonAppearance; + protected + function CreateRadioButton(AOwner: TComponent): TWinControl; override; + procedure SetRadioButtonState(Btn: TWinControl; Checked: boolean); override; + procedure SetRadioButtonCaption(Btn: TWinControl; Value: string); override; + function CreateButton(AOwner: TComponent): TWinControl; override; + procedure InitRadioButton(AOwner: TForm; Btn: TWinControl; btnIndex: Integer; OnClickEvent : TNotifyEvent); override; + procedure SetButtonCaption(aButton: TWinControl; Value: TCaption); override; + procedure SetButtonCancel(aButton: TWinControl; Value: Boolean); override; + procedure SetButtonDefault(aButton: TWinControl; Value: Boolean); override; + procedure SetButtonModalResult(aButton: TWinControl; Value: Integer); override; + function GetButtonModalResult(aButton: TWinControl): Integer; override; + public + property Appearance: TGlowButtonAppearance read FAppearance write FAppearance; + property OnButtonCreated:TButtonCreatedEvent read FOnButtonCreated write FOnButtonCreated; + end; + + TAdvInputTaskDialogEx = class(TAdvInputTaskDialog) + private + FOnButtonCreated: TButtonCreatedEvent; + FAppearance: TGlowButtonAppearance; + protected + function CreateRadioButton(AOwner: TComponent): TWinControl; override; + procedure SetRadioButtonState(Btn: TWinControl; Checked: boolean); override; + procedure SetRadioButtonCaption(Btn: TWinControl; Value: string); override; + function CreateButton(AOwner: TComponent): TWinControl; override; + procedure InitRadioButton(AOwner: TForm; Btn: TWinControl; btnIndex: Integer; OnClickEvent : TNotifyEvent); override; + procedure SetButtonCaption(aButton: TWinControl; Value: TCaption); override; + procedure SetButtonCancel(aButton: TWinControl; Value: Boolean); override; + procedure SetButtonDefault(aButton: TWinControl; Value: Boolean); override; + procedure SetButtonModalResult(aButton: TWinControl; Value: Integer); override; + function GetButtonModalResult(aButton: TWinControl): Integer; override; + public + property Appearance: TGlowButtonAppearance read FAppearance write FAppearance; + property OnButtonCreated:TButtonCreatedEvent read FOnButtonCreated write FOnButtonCreated; + end; + + +procedure Register; + +implementation + +//------------------------------------------------------------------------------ + +procedure Register; +begin + RegisterComponents('TMS',[TAdvTaskDialogEx]); +end; + +//------------------------------------------------------------------------------ + +{ TAdvTaskDialogEx } + +function TAdvTaskDialogEx.CreateButton(AOwner: TComponent): TWinControl; +begin + Result := TAdvGlowButton.Create(AOwner); + if Assigned(FAppearance) then + (Result as TAdvGlowButton).Appearance := FAppearance; + (Result as TAdvGlowButton).TabStop := true; + if Assigned(FOnButtonCreated) then + FOnButtonCreated(Self,(Result as TAdvGlowButton)); +end; + +//------------------------------------------------------------------------------ + +function TAdvTaskDialogEx.CreateRadioButton(AOwner: TComponent): TWinControl; +begin + Result := TAdvOfficeRadioButton.Create(AOwner); +end; + +//------------------------------------------------------------------------------ + +function TAdvTaskDialogEx.GetButtonModalResult( + aButton: TWinControl): Integer; +begin + Result := mrNone; + if not Assigned(aButton) or not (aButton is TAdvGlowButton) then + Exit; + + Result := TAdvGlowButton(aButton).ModalResult; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvTaskDialogEx.SetButtonCancel(aButton: TWinControl; + Value: Boolean); +begin + if not Assigned(aButton) or not (aButton is TAdvGlowButton) then + Exit; + + TAdvGlowButton(aButton).Cancel := Value; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvTaskDialogEx.SetButtonCaption(aButton: TWinControl; + Value: TCaption); +begin + if not Assigned(aButton) or not (aButton is TAdvGlowButton) then + Exit; + + TAdvGlowButton(aButton).Caption := Value; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvTaskDialogEx.SetButtonDefault(aButton: TWinControl; + Value: Boolean); +begin + if not Assigned(aButton) or not (aButton is TAdvGlowButton) then + Exit; + + TAdvGlowButton(aButton).Default := Value; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvTaskDialogEx.SetButtonModalResult(aButton: TWinControl; + Value: Integer); +begin + if not Assigned(aButton) or not (aButton is TAdvGlowButton) then + Exit; + + TAdvGlowButton(aButton).ModalResult := Value; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvTaskDialogEx.SetRadioButtonCaption(Btn: TWinControl; + Value: string); +begin + TAdvOfficeRadioButton(Btn).Caption := Value; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvTaskDialogEx.SetRadioButtonState(Btn: TWinControl; + Checked: boolean); +begin + TAdvOfficeRadioButton(Btn).Checked := Checked; +end; + +//------------------------------------------------------------------------------ + +procedure TAdvTaskDialogEx.InitRadioButton(AOwner: TForm; Btn: TWinControl; btnIndex: Integer; OnClickEvent : TNotifyEvent); +begin + with TRadioButton(Btn) do + begin + Name := 'Radio' + inttostr(btnIndex); + Parent := AOwner; + Font.Name := AOwner.Canvas.Font.Name; + Font.Size := 8; + BiDiMode := AOwner.BiDiMode; + OnClick := OnClickEvent; + + { + BoundsRect := TextRect; + Left := FHorzParaMargin + FHorzMargin; //ALeft + FHorzMargin; + Top := Y; + Width := Self.Width - Left - 4; + GetTextSize(Canvas, Caption, k, l); + w := Max(w, Left + k + FHorzMargin + 20); + } + end; +end; + +{ TAdvInputTaskDialogEx } + +//------------------------------------------------------------------------------ + +function TAdvInputTaskDialogEx.CreateButton(AOwner: TComponent): TWinControl; +begin + Result := TAdvGlowButton.Create(AOwner); + if Assigned(FAppearance) then + (Result as TAdvGlowButton).Appearance := FAppearance; + (Result as TAdvGlowButton).TabStop := true; + if Assigned(FOnButtonCreated) then + FOnButtonCreated(Self,(Result as TAdvGlowButton)); +end; + +function TAdvInputTaskDialogEx.CreateRadioButton( + AOwner: TComponent): TWinControl; +begin + Result := TAdvOfficeRadioButton.Create(AOwner); +end; + +function TAdvInputTaskDialogEx.GetButtonModalResult( + aButton: TWinControl): Integer; +begin + Result := mrNone; + if not Assigned(aButton) or not (aButton is TAdvGlowButton) then + Exit; + + Result := TAdvGlowButton(aButton).ModalResult; +end; + +procedure TAdvInputTaskDialogEx.SetButtonCancel(aButton: TWinControl; + Value: Boolean); +begin + if not Assigned(aButton) or not (aButton is TAdvGlowButton) then + Exit; + + TAdvGlowButton(aButton).Cancel := Value; +end; + +procedure TAdvInputTaskDialogEx.SetButtonCaption(aButton: TWinControl; + Value: TCaption); +begin + if not Assigned(aButton) or not (aButton is TAdvGlowButton) then + Exit; + + TAdvGlowButton(aButton).Caption := Value; +end; + +procedure TAdvInputTaskDialogEx.SetButtonDefault(aButton: TWinControl; + Value: Boolean); +begin + if not Assigned(aButton) or not (aButton is TAdvGlowButton) then + Exit; + + TAdvGlowButton(aButton).Default := Value; +end; + +procedure TAdvInputTaskDialogEx.SetButtonModalResult(aButton: TWinControl; + Value: Integer); +begin + if not Assigned(aButton) or not (aButton is TAdvGlowButton) then + Exit; + + TAdvGlowButton(aButton).ModalResult := Value; +end; + +procedure TAdvInputTaskDialogEx.SetRadioButtonCaption(Btn: TWinControl; + Value: string); +begin + TAdvOfficeRadioButton(Btn).Caption := Value; +end; + +procedure TAdvInputTaskDialogEx.SetRadioButtonState(Btn: TWinControl; + Checked: boolean); +begin + TAdvOfficeRadioButton(Btn).Checked := Checked; +end; + +procedure TAdvInputTaskDialogEx.InitRadioButton(AOwner: TForm; Btn: TWinControl; btnIndex: Integer; OnClickEvent : TNotifyEvent); +begin + with TRadioButton(Btn) do + begin + Name := 'Radio' + inttostr(btnIndex); + Parent := AOwner; + Font.Name := AOwner.Canvas.Font.Name; + Font.Size := 8; + BiDiMode := AOwner.BiDiMode; + OnClick := OnClickEvent; + { + BoundsRect := TextRect; + Left := FHorzParaMargin + FHorzMargin; //ALeft + FHorzMargin; + Top := Y; + Width := Self.Width - Left - 4; + GetTextSize(Canvas, Caption, k, l); + w := Max(w, Left + k + FHorzMargin + 20); + } + end; +end; + +end. diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogPkg.dpk b/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogPkg.dpk new file mode 100644 index 0000000..7a9bb7f --- /dev/null +++ b/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogPkg.dpk @@ -0,0 +1,40 @@ +package TaskDialogPkg; + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'TMS TaskDialog'} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide; + +contains + TaskDialogRegDE in 'TaskDialogRegDE.pas', + TaskDialog in 'TaskDialog.pas', + TaskDialogDE in 'TaskDialogDE.pas', + picturecontainer in 'picturecontainer.pas', + SpanishConsts in 'SpanishConsts.pas'; + +end. diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogPkg.dproj b/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogPkg.dproj new file mode 100644 index 0000000..5198e02 --- /dev/null +++ b/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogPkg.dproj @@ -0,0 +1,91 @@ + + + {322e4f51-9fd5-43be-8659-42e8edcc60b1} + TaskDialogPkg.dpk + Release + AnyCPU + DCC32 + ..\Lib\D11\TaskDialogPkgD2007.bpl + 12.0 + Base + + + true + + + ..\Lib\D12\TaskDialogPkg.bpl + 00400000 + false + ..\Lib\D12 + false + TMS TaskDialog + false + true + ..\Lib\D12 + true + 0 + true + ..\Lib\D12 + + + Delphi.Personality.12 + Package + + + + False + True + False + + + True + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 2067 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + TaskDialogPkg.dpk + + + + 12 + + + + MainSource + + + + + + + + + + + Base + + + + diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogPkg.res b/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogPkg.res new file mode 100644 index 0000000..5fc5c89 Binary files /dev/null and b/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogPkg.res differ diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogRegDE.pas b/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogRegDE.pas new file mode 100644 index 0000000..3a9109f --- /dev/null +++ b/TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogRegDE.pas @@ -0,0 +1,49 @@ +{***************************************************************************} +{ TTaskDialog component } +{ for Delphi & C++Builder } +{ version 1.2 } +{ } +{ written by TMS Software } +{ copyright © 2006 - 2007 } +{ 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 TaskDialogRegDE; + +interface +{$I TMSDEFS.INC} + +uses + Classes, TaskDialog, TaskDialogDE, + {$IFDEF DELPHI6_LVL} + {$IFDEF TMSDOTNET} + Borland.Vcl.Design.DesignIntf, Borland.Vcl.Design.DesignEditors + {$ENDIF} + {$IFNDEF TMSDOTNET} + DesignIntf, DesignEditors + {$ENDIF} + {$ELSE} + DsgnIntf + {$ENDIF} + ; + +procedure Register; + +implementation + +procedure Register; +begin + RegisterComponentEditor(TAdvTaskDialog,TTaskDialogEditor); +end; + +end. + diff --git a/TAdvTaskDialog/internal/1.5.1.6/1/Source/htmlengo.pas b/TAdvTaskDialog/internal/1.5.1.6/1/Source/htmlengo.pas new file mode 100644 index 0000000..8c876c1 --- /dev/null +++ b/TAdvTaskDialog/internal/1.5.1.6/1/Source/htmlengo.pas @@ -0,0 +1,2353 @@ +{**************************************************************************} +{ Mini HTML rendering engine } +{ for Delphi & C++Builder } +{ } +{ written by TMS Software } +{ copyright © 1999-2008 } +{ Email : info@tmssoftware.com } +{ Website : 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. } +{**************************************************************************} + +{$I TMSDEFS.INC} + +{$IFNDEF TMSDOTNET} +procedure PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap); +var + BitmapHeader: pBitmapInfo; + BitmapImage : POINTER; + HeaderSize : DWORD; + ImageSize : DWORD; +begin + GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize); + GetMem(BitmapHeader, HeaderSize); + GetMem(BitmapImage, ImageSize); + try + GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^); + StretchDIBits(Canvas.Handle, + DestRect.Left, DestRect.Top, // Destination Origin + DestRect.Right - DestRect.Left, // Destination Width + DestRect.Bottom - DestRect.Top, // Destination Height + 0, 0, // Source Origin + Bitmap.Width, Bitmap.Height, // Source Width & Height + BitmapImage, + TBitmapInfo(BitmapHeader^), + DIB_RGB_COLORS, + SRCCOPY) + finally + FreeMem(BitmapHeader); + FreeMem(BitmapImage) + end; +end; +{$ENDIF} + +{$IFDEF TMSDOTNET} +procedure PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap); +var + BitmapHeader: TBitmapInfo; + HeaderSize : DWORD; + ImageSize : DWORD; + Bits: HBITMAP; + Image: TBytes; + Info: IntPtr; + +begin + Bits := Bitmap.Handle; + + GetDIBSizes(Bits, HeaderSize, ImageSize); + + + Info := System.Runtime.InteropServices.Marshal.AllocHGlobal(HeaderSize); + + try + SetLength(Image, ImageSize); + GetDIB(Bits, 0, Info, Image); + + BitmapHeader := TBitmapInfo(System.Runtime.InteropServices.Marshal.PtrToStructure(Info, TypeOf(TBitmapInfo))); + + StretchDIBits(Canvas.Handle, + DestRect.Left, DestRect.Top, // Destination Origin + DestRect.Right - DestRect.Left, // Destination Width + DestRect.Bottom - DestRect.Top, // Destination Height + 0, 0, // Source Origin + Bitmap.Width, Bitmap.Height, // Source Width & Height + Image, + Info, + DIB_RGB_COLORS, + SRCCOPY) + finally + System.Runtime.InteropServices.Marshal.FreeHGlobal(Info); + end; +end; +{$ENDIF} + +function DirExists(const Name: string): Boolean; +var + Code: Integer; +begin + {$IFNDEF TMSDOTNET} + Code := GetFileAttributes(PChar(Name)); + {$ENDIF} + {$IFDEF TMSDOTNET} + Code := GetFileAttributes(Name); + {$ENDIF} + Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); +end; + +function SysImage(Canvas: TCanvas;x,y:Integer;APath:string;large,draw,print:boolean;resfactor:double):TPoint; +var + SFI: TSHFileInfo; + i,Err: Integer; + imglsthandle: THandle; + rx,ry: Integer; + bmp: TBitmap; + r: TRect; +begin + Val(APath,i,Err); + + {$IFNDEF TMSDOTNET} + FillChar(SFI,Sizeof(SFI),0); + {$ENDIF} + + {$IFNDEF TMSDOTNET} + if (APath <> '') and (Err <> 0) then + begin + if FileExists(APath) or DirExists(APath) then + // If the file or directory exists, just let Windows figure out it's attrs. + SHGetFileInfo(PChar(APath), 0, SFI, SizeOf(TSHFileInfo), + SHGFI_SYSICONINDEX {or OPEN_FLAG[Open] or SELECTED_FLAG[Selected]}) + else + // File doesn't exist, so Windows doesn't know what to do with it. We have + // to tell it by passing the attributes we want, and specifying the + // SHGFI_USEFILEATTRIBUTES flag so that the function knows to use them. + SHGetFileInfo(PChar(APath), 0, SFI, SizeOf(TSHFileInfo), + SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES {or OPEN_FLAG[Open] or SELECTED_FLAG[Selected]}); + i := SFI.iIcon; + end; + + if Large then + imglsthandle := SHGetFileInfo('', 0, SFI, SizeOf(SFI), + SHGFI_SYSICONINDEX or SHGFI_LARGEICON) + else + imglsthandle := SHGetFileInfo('', 0, SFI, SizeOf(SFI), + SHGFI_SYSICONINDEX or SHGFI_SMALLICON); + {$ENDIF} + {$IFDEF TMSDOTNET} + if (APath <> '') and (Err <> 0) then + begin + if FileExists(APath) or DirExists(APath) then + // If the file or directory exists, just let Windows figure out it's attrs. + SHGetFileInfo(APath, 0, SFI, System.Runtime.interopservices.marshal.SizeOf(TypeOf(TSHFileInfo)), + SHGFI_SYSICONINDEX {or OPEN_FLAG[Open] or SELECTED_FLAG[Selected]}) + else + // File doesn't exist, so Windows doesn't know what to do with it. We have + // to tell it by passing the attributes we want, and specifying the + // SHGFI_USEFILEATTRIBUTES flag so that the function knows to use them. + SHGetFileInfo(APath, 0, SFI, System.Runtime.interopservices.Marshal.SizeOf(TypeOf(TSHFileInfo)), + SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES {or OPEN_FLAG[Open] or SELECTED_FLAG[Selected]}); + i := SFI.iIcon; + end; + + if Large then + imglsthandle := SHGetFileInfo('', 0, SFI, System.Runtime.interopservices.Marshal.SizeOf(TypeOf(SFI)), + SHGFI_SYSICONINDEX or SHGFI_LARGEICON) + else + imglsthandle := SHGetFileInfo('', 0, SFI, System.Runtime.interopservices.Marshal.SizeOf(TypeOf(SFI)), + SHGFI_SYSICONINDEX or SHGFI_SMALLICON); + {$ENDIF} + + + ImageList_GetIconSize(imglsthandle,rx,ry); + + {$IFNDEF TMSDOTNET} + Result := Point(rx,ry); + {$ENDIF} + {$IFDEF TMSDOTNET} + Result := Borland.Vcl.Types.Point(rx,ry); + {$ENDIF} + + if Draw and not Print then + ImageList_Draw(imglsthandle,i,Canvas.Handle,x,y, ILD_TRANSPARENT); + + if Draw and Print then + begin + bmp := TBitmap.Create; + bmp.Width := rx; + bmp.Height := ry; + ImageList_Draw(imglsthandle,i,bmp.Canvas.handle,0,0,ILD_NORMAL); + r.left := x; + r.top := y; + r.right := x + Round(rx * ResFactor); + r.bottom := y + Round(ry * ResFactor); + PrintBitmap(Canvas,r,bmp); + bmp.Free; + end; +end; + +procedure DrawHTMLGradient(Canvas: TCanvas; FromColor,ToColor,BorderColor: TColor; Steps: Integer;R:TRect; Direction: Boolean); +var + diffr,startr,endr: Integer; + diffg,startg,endg: Integer; + diffb,startb,endb: Integer; + iend: Integer; + rstepr,rstepg,rstepb,rstepw: Real; + i,stepw: Word; +begin + if Steps = 0 then + Steps := 1; + + FromColor := ColorToRGB(FromColor); + ToColor := ColorToRGB(ToColor); + + startr := (FromColor and $0000FF); + startg := (FromColor and $00FF00) shr 8; + startb := (FromColor and $FF0000) shr 16; + endr := (ToColor and $0000FF); + endg := (ToColor and $00FF00) shr 8; + endb := (ToColor and $FF0000) shr 16; + + diffr := endr - startr; + diffg := endg - startg; + diffb := endb - startb; + + rstepr := diffr / steps; + rstepg := diffg / steps; + rstepb := diffb / steps; + + if Direction then + rstepw := (R.Right - R.Left) / Steps + else + rstepw := (R.Bottom - R.Top) / Steps; + + with Canvas do + begin + for i := 0 to Steps - 1 do + begin + endr := startr + Round(rstepr*i); + endg := startg + Round(rstepg*i); + endb := startb + Round(rstepb*i); + stepw := Round(i*rstepw); + Pen.Color := endr + (endg shl 8) + (endb shl 16); + Brush.Color := Pen.Color; + if Direction then + begin + iend := R.Left + stepw + Trunc(rstepw) + 1; + if iend > R.Right then + iend := R.Right; + Rectangle(R.Left + stepw,R.Top,iend,R.Bottom) + end + else + begin + iend := R.Top + stepw + Trunc(rstepw)+1; + if iend > r.Bottom then + iend := r.Bottom; + Rectangle(R.Left,R.Top + stepw,R.Right,iend); + end; + end; + + if BorderColor <> clNone then + begin + Brush.Style := bsClear; + Pen.Color := BorderColor; + Rectangle(R.Left,R.Top,R.Right,R.Bottom); + end; + end; +end; + +{ +procedure DrawHTMLGradient(Canvas: TCanvas; FromColor,ToColor: TColor; Steps: Integer;R:TRect; Direction: Boolean); +var + diffr,startr,endr: Integer; + diffg,startg,endg: Integer; + diffb,startb,endb: Integer; + iend: Integer; + rstepr,rstepg,rstepb,rstepw: Real; + i,stepw: Word; + +begin + if Steps = 0 then + Steps := 1; + + FromColor := ColorToRGB(FromColor); + ToColor := ColorToRGB(ToColor); + + startr := (FromColor and $0000FF); + startg := (FromColor and $00FF00) shr 8; + startb := (FromColor and $FF0000) shr 16; + endr := (ToColor and $0000FF); + endg := (ToColor and $00FF00) shr 8; + endb := (ToColor and $FF0000) shr 16; + + diffr := endr - startr; + diffg := endg - startg; + diffb := endb - startb; + + rstepr := diffr / steps; + rstepg := diffg / steps; + rstepb := diffb / steps; + + if Direction then + rstepw := (R.Right - R.Left) / Steps + else + rstepw := (R.Bottom - R.Top) / Steps; + + with Canvas do + begin + for i := 0 to Steps - 1 do + begin + endr := startr + Round(rstepr*i); + endg := startg + Round(rstepg*i); + endb := startb + Round(rstepb*i); + stepw := Round(i*rstepw); + Pen.Color := endr + (endg shl 8) + (endb shl 16); + Brush.Color := Pen.Color; + if Direction then + begin + iend := R.Left + stepw + Trunc(rstepw) + 1; + if iend > R.Right then + iend := R.Right; + Rectangle(R.Left + stepw,R.Top,iend,R.Bottom) + end + else + begin + iend := R.Top + stepw + Trunc(rstepw)+1; + if iend > r.Bottom then + iend := r.Bottom; + Rectangle(R.Left,R.Top + stepw,R.Right,iend); + end; + end; + end; +end; +} + +function Text2Color(s:string):tcolor; +begin + Result := clBlack; + + if (s='clred') then result:=clred else + if (s='clblack') then result:=clblack else + if (s='clblue') then result:=clblue else + if (s='clgreen') then result:=clgreen else + if (s='claqua') then result:=claqua else + if (s='clyellow') then result:=clyellow else + if (s='clfuchsia') then result:=clfuchsia else + if (s='clwhite') then result:=clwhite else + if (s='cllime') then result:=cllime else + if (s='clsilver') then result:=clsilver else + if (s='clgray') then result:=clgray else + if (s='clolive') then result:=clolive else + if (s='clnavy') then result:=clnavy else + if (s='clpurple') then result:=clpurple else + if (s='clteal') then result:=clteal else + if (s='clmaroon') then result:=clmaroon; + + if Result <> clBlack then Exit; + + if (s='clbackground') then result:=clbackground else + if (s='clactivecaption') then result:=clactivecaption else + if (s='clinactivecaption') then result:=clinactivecaption else + if (s='clmenu') then result:=clmenu else + if (s='clwindow') then result:=clwindow else + if (s='clwindowframe') then result:=clwindowframe else + if (s='clmenutext') then result:=clmenutext else + if (s='clwindowtext') then result:=clwindowtext else + if (s='clcaptiontext') then result:=clcaptiontext else + if (s='clactiveborder') then result:=clactiveborder else + if (s='clinactiveborder') then result:=clinactiveborder else + if (s='clappworkspace') then result:=clappworkspace else + if (s='clhighlight') then result:=clhighlight else + if (s='clhighlighttext') then result:=clhighlighttext else + if (s='clbtnface') then result:=clbtnface else + if (s='clbtnshadow') then result:=clbtnshadow else + if (s='clgraytext') then result:=clgraytext else + if (s='clbtntext') then result:=clbtntext else + if (s='clinactivecaptiontext') then result:=clinactivecaptiontext else + if (s='clbtnhighlight') then result:=clbtnhighlight else + if (s='cl3ddkshadow') then result:=clgraytext else + if (s='cl3dlight') then result:=cl3dlight else + if (s='clinfotext') then result:=clinfotext else + if (s='clinfobk') then result:=clinfobk; +end; + +function HexVal(s:string): Integer; +var + i,j: Integer; +begin + if Length(s) < 2 then + begin + Result := 0; + Exit; + end; + + if s[1] >= 'A' then + i := ord(s[1]) - ord('A') + 10 + else + i := ord(s[1]) - ord('0'); + + if s[2] >= 'A' then + j := ord(s[2]) - ord('A') + 10 + else + j := ord(s[2]) - ord('0'); + + Result := i shl 4 + j; +end; + +function Hex2Color(s:string): TColor; +var + r,g,b: Integer; +begin + r := Hexval(Copy(s,2,2)); + g := Hexval(Copy(s,4,2)) shl 8; + b := Hexval(Copy(s,6,2)) shl 16; + Result := TColor(b + g + r); +end; + +function IPos(su,s:string):Integer; +begin + Result := Pos(UpperCase(su),UpperCase(s)); +end; + +function IStrToInt(s:string):Integer; +var + Err,Res: Integer; +begin + Val(s,Res,Err); + Result := Res; +end; + +function DBTagStrip(s:string):string; +var + i,j: Integer; +begin + i := Pos('<#',s); + if i > 0 then + begin + Result := Copy(s,1,i - 1); + Delete(s,1,i); + j := Pos('>',s); + if j > 0 then + Delete(s,j,1); + Result := Result + s; + end + else + Result := s; +end; + +function CRLFStrip(s:string;break:boolean):string; +var + i: Integer; +begin + Result := ''; + for i := 1 to Length(s) do + begin + if not ( (s[i] =#13) or (s[i] =#10)) then + Result := Result + s[i] + else + if (s[i] = #13) and break then + Result := Result + '
'; + end; +end; + +function VarPos(su,s:string;var Res:Integer):Integer; +begin + Res := Pos(su,s); + Result := Res; +end; + +function TagReplaceString(const Srch,Repl:string;var Dest:string):Boolean; +var + i: Integer; +begin + i := IPos(srch,dest); + if i > 0 then + begin + Result := True; + Delete(Dest,i,Length(Srch)); + Dest := Copy(Dest,1,i-1) + Repl + Copy(Dest,i,Length(Dest)); + end + else + Result := False; +end; + +{$WARNINGS OFF} +function HTMLDrawEx(Canvas:TCanvas; s:string; fr:TRect; + FImages: TCustomImageList; + XPos,YPos,FocusLink,HoverLink,ShadowOffset: Integer; + CheckHotSpot,CheckHeight,Print,Selected,Blink,HoverStyle,WordWrap: Boolean; + ResFactor:Double; + URLColor,HoverColor,HoverFontColor,ShadowColor:TColor; + var AnchorVal,StripVal,FocusAnchor: string; + var XSize,YSize,HyperLinks,MouseLink: Integer; + var HoverRect:TRect;ic: THTMLPictureCache; pc: TPictureContainer;LineSpacing: Integer): Boolean; +var + su: string; + r,dr,hr,rr,er: TRect; + htmlwidth,htmlheight,txtheight: Integer; + Align: TAlignment; + PIndent: Integer; + OldFont: TFont; + CalcFont: TFont; + DrawFont: TFont; + OldCalcFont: TFont; + OldDrawFont: TFont; + Hotspot, ImageHotspot: Boolean; + Anchor,OldAnchor,MouseInAnchor,Error: Boolean; + bgcolor,paracolor,hvrcolor,hvrfntcolor,pencolor,blnkcolor,hifcol,hibcol: TColor; + LastAnchor,OldAnchorVal: string; + IMGSize: TPoint; + isSup,isSub,isPara,isShad: Boolean; + subh,suph,imgali,srchpos,hlcount,licount: Integer; + hrgn,holdfont: THandle; + ListIndex: Integer; + dtp: TDrawTextParams; + Invisible: Boolean; + FoundTag: Boolean; + {new for editing} + nnFit: Integer; + nnSize: TSize; + inspoint: Integer; + {$IFNDEF TMSDOTNET} + nndx: Pointer; + {$ENDIF} + AltImg,ImgIdx,OldImgIdx: Integer; + DrawStyle: DWord; + Col1,Col2: TColor; + ofsx,newofsx: integer; + + procedure StartRotated(Canvas:TCanvas;Angle: Integer); + var + LFont:TLogFont; + begin + {$IFNDEF TMSDOTNET} + GetObject(Canvas.Font.Handle,SizeOf(LFont),Addr(LFont)); + {$ENDIF} + + {$IFDEF TMSDOTNET} + GetObject(Canvas.Font.Handle,System.Runtime.InteropServices.Marshal.SizeOf(TypeOf(LFont)),LFont); + {$ENDIF} + + LFont.lfEscapement := Angle * 10; + LFont.lfOrientation := Angle * 10; + hOldFont:=SelectObject(Canvas.Handle,CreateFontIndirect(LFont)); + end; + + procedure EndRotated(Canvas:TCanvas); + begin + DeleteObject(SelectObject(Canvas.Handle,hOldFont)); + end; + + function HTMLDrawLine(Canvas: TCanvas;var s:string;r: TRect;Calc:Boolean; + var w,h,subh,suph,imgali:Integer;var Align:TAlignment; var PIndent: Integer; + XPos,YPos:Integer;var Hotspot,ImageHotSpot:Boolean;OffsetX: integer; var NewOffsetX: integer):string; + var + su,Res,TagProp,Prop,AltProp,Tagp,LineText:string; + cr: TRect; + linebreak,imgbreak,linkbreak: Boolean; + th,sw,indent,err,bmpx,bmpy,oldh: Integer; + TagPos,SpacePos,o,l: Integer; + bmp: THTMLPicture; + ABitmap: TBitmap; + NewColor,NewColorTo: TColor; + TagWidth,TagHeight,WordLen,WordLenEx,WordWidth: Integer; + TagChar: Char; + LengthFits, SpaceBreak: Boolean; + + begin + Result := ''; + LineText := ''; + r.Bottom := r.Bottom - Subh; + + w := 0; + sw := 0; + + LineBreak := False; + ImgBreak := False; + LinkBreak := False; + HotSpot := False; + ImageHotSpot := False; + +// r.Left := r.Left + offsetX; + + cr := r; + res := ''; + + if not Calc then + cr.Left := cr.Left + OffsetX; + + if isPara and not Calc then + begin + Pencolor := Canvas.Pen.Color; + Canvas.Pen.color := Canvas.Brush.Color; + Canvas.Rectangle(fr.Left,r.Top,fr.Right,r.Top + h); + end; + + while (Length(s) > 0) and not LineBreak and not ImgBreak do + begin + // get next word or till next HTML tag + TagPos := Pos('<',s); + + if WordWrap then + SpacePos := Pos(' ',s) + else + SpacePos := 0; + + if (Tagpos > 0) and ((SpacePos > TagPos) or (SpacePos = 0)) then + begin + su := Copy(s,1,TagPos - 1); + end + else + begin + if SpacePos > 0 then + su := Copy(s,1,SpacePos) + else + su := s; + end; + + {$IFDEF TMSDEBUG} + DbgMsg(su+ '.'); + {$ENDIF} + + WordLen := Length(su); + + while Pos(' ',su) > 0 do + begin + TagReplacestring(' ',' ',su); + end; + + while Pos('<',su) > 0 do + begin + TagReplacestring('<','<',su); + end; + + while Pos('>',su) > 0 do + begin + TagReplacestring('>','>',su); + end; + + WordLenEx := Length(su); + + if WordLen > 0 then + begin + th := Canvas.TextHeight(su); + + if isSub and (subh < (th shr 2)) then subh := th shr 2; + if isSup and (suph < (th shr 2)) then suph := th shr 2; + + if th > h then + h := th; + + StripVal := StripVal + su; + + if Invisible then + Delete(s,1,WordLen); + + if not Invisible then + begin + // draw mode + if not Calc then + begin + if isSup then + cr.Bottom := cr.Bottom - suph; + if isSub then + cr.Bottom := cr.Bottom + subh; + + cr.Bottom := cr.Bottom - imgali; + + if isShad then + begin + OffsetRect(cr,ShadowOffset,ShadowOffset); + NewColor := Canvas.Font.Color; + Canvas.Font.Color := ShadowColor; + {$IFNDEF TMSDOTNET} + DrawTextEx(Canvas.Handle,PChar(su),WordLenEx,cr,DrawStyle and not DT_EXTERNALLEADING,nil); + {$ENDIF} + {$IFDEF TMSDOTNET} + DrawTextEx(Canvas.Handle,su,WordLenEx,cr,DrawStyle and not DT_EXTERNALLEADING,nil); + {$ENDIF} + Offsetrect(cr,-ShadowOffset,-ShadowOffset); + Canvas.Font.Color := NewColor; + end; + + {$IFNDEF TMSDOTNET} + DrawTextEx(Canvas.Handle,PChar(su),WordLenEx,cr,DrawStyle and not DT_EXTERNALLEADING,nil); + DrawTextEx(Canvas.Handle,PChar(su),WordLenEx,cr,DrawStyle or DT_CALCRECT,nil); + {$ENDIF} + + {$IFDEF TMSDOTNET} + DrawTextEx(Canvas.Handle,su,WordLenEx,cr,DrawStyle and not DT_EXTERNALLEADING,nil); + DrawTextEx(Canvas.Handle,su,WordLenEx,cr,DrawStyle or DT_CALCRECT,nil); + {$ENDIF} + + if Anchor and (Hyperlinks - 1 = FocusLink) then + FocusAnchor := LastAnchor; + + {$IFDEF TMSDEBUG} + if Anchor then + OutputDebugString(pchar('drawrect for '+anchorval+' = ['+inttostr(cr.Left)+':'+inttostr(cr.Top)+'] ['+inttostr(cr.right)+':'+inttostr(cr.bottom)+'] @ ['+inttostr(xpos)+':'+inttostr(ypos))); + {$ENDIF} + + if Error then + begin + Canvas.Pen.Color := clRed; + Canvas.Pen.Width := 1; + + l := (cr.Left div 2) * 2; + if (l mod 4)=0 then o := 2 else o := 0; + + Canvas.MoveTo(l,r.Bottom + o - 1); + while l < cr.Right do + begin + if o = 2 then o := 0 else o := 2; + Canvas.LineTo(l + 2,r.bottom + o - 1); + Inc(l,2); + end; + // if o = 2 then o := 0 else o := 2; + // Canvas.LineTo(l + 2,r.Bottom + o - 1); + end; + + cr.Left := cr.Right; + cr.Right := r.Right; + cr.Bottom := r.Bottom; + cr.Top := r.Top; + end + else + begin + cr := r; //reinitialized each time ! + {$IFNDEF TMSDOTNET} + DrawTextEx(Canvas.Handle,PChar(su),WordLenEx,cr,DrawStyle or DT_CALCRECT,nil); + {$ENDIF} + + {$IFDEF TMSDOTNET} + DrawTextEx(Canvas.Handle,su,WordLenEx,cr,DrawStyle or DT_CALCRECT,nil); + {$ENDIF} + + // preparations for editing purposes + if (ypos > cr.Top) and (ypos < cr.bottom) and (xpos > w) then {scan charpos here} + begin + {$IFNDEF TMSDOTNET} + er := rect(w,cr.top,xpos,cr.bottom); + Fillchar(dtp,sizeof(dtp),0); + {$ENDIF} + + {$IFDEF TMSDOTNET} + er := Borland.Vcl.Types.rect(w,cr.top,xpos,cr.bottom); + {$ENDIF} + dtp.cbSize:=sizeof(dtp); + + {$IFDEF DELPHI4_LVL} + {$IFNDEF TMSDOTNET} + GetTextExtentExPoint(Canvas.Handle,pChar(su),WordLenEx,xpos-w,@nnfit,nil,nnSize); + {$ENDIF} + {$IFDEF TMSDOTNET} + GetTextExtentExPoint(Canvas.Handle,su,WordLenEx,xpos-w,nnfit,nil,nnSize); + {$ENDIF} + {$ELSE} + {$IFNDEF TMSDOTNET} + nndx := nil; {fix for declaration error in Delphi 3 WINDOWS.PAS} + GetTextExtentExPoint(Canvas.Handle,pChar(su),WordLenEx,xpos - w,nnfit,integer(nndx^),nnSize); + {$ENDIF} + {$IFDEF TMSDOTNET} + GetTextExtentExPoint(Canvas.Handle,su,WordLenEx,xpos - w,nnfit,nil,nnSize); + {$ENDIF} + {$ENDIF} + + {this will get the character pos of the insertion point} + if nnfit = WordLen then + InsPoint := InsPoint + WordLen + else + InsPoint := InsPoint + nnfit; + end; + {end of preparations for editing purposes} + + { Calculated text width } + WordWidth := cr.Right - cr.Left; + w := w + WordWidth; + + if (XPos - cr.Left >= w - WordWidth) and (XPos - cr.Left <= w) and Anchor then + begin + HotSpot := True; + if (YPos > cr.Top){ and (YPos < cr.Bottom)} then + begin + Anchorval := LastAnchor; + MouseInAnchor := True; + end; + end; + end; + + LengthFits := (w < r.Right - r.Left - OfsX) or (r.Right - r.Left - OfsX <= WordWidth); + + if not LengthFits and + ((Length(LineText) > 0) and (LineText[Length(LineText)] <> ' ')) then + LengthFits := True; + + LineText := LineText + su; + + if LengthFits or not WordWrap then + begin + Res := Res + Copy(s,1,WordLen); + + //if not LengthFits and Calc and (LineText <> su) then + // s := ''; + + Delete(s,1,WordLen); + + if Length(su) >= WordLen then + begin + {$IFNDEF TMSDOTNET} + if System.Copy(su, WordLen, 1) = ' ' then + {$ENDIF} + {$IFDEF TMSDOTNET} + if Copy(su, WordLen, 1) = ' ' then + {$ENDIF} + sw := Canvas.TextWidth(' ') + else + sw := 0; + end + else + sw := 0; + end + else + begin + LineBreak := True; + w := w - WordWidth; + end; + end; + end; + + TagPos := Pos('<',s); + + if (TagPos = 1) and (Length(s) <= 2) then + s := ''; + + if not LineBreak and (TagPos = 1) and (Length(s) > 2) then + begin + if (s[2] = '/') and (Length(s) > 3) then + begin + case UpCase(s[3]) of + 'A':begin + if (not HoverStyle or (Hoverlink = Hyperlinks)) and not Calc then + begin + Canvas.Font.Style := Canvas.Font.Style - [fsUnderline]; + if Hovercolor <> clNone then + begin + Canvas.Brush.Color := HvrColor; + if HvrColor = clNone then + Canvas.Brush.Style := bsClear; + end; + if HoverFontColor <> clNone then + Canvas.Font.Color := HoverFontColor; + end; + + if not Selected then + Canvas.Font.Color := Oldfont.Color; + + Anchor := False; + + if MouseInAnchor then + begin + hr.Bottom := r.Bottom; + hr.Right := r.Left + w; + if r.Top <> hr.Top then + begin + hr.Left := r.Left; + hr.Top := r.Top; + end; + + HoverRect := hr; + MouseLink := HyperLinks; + {$IFDEF TMSDEBUG} + DbgRect('hotspot anchor '+lastanchor,hr); + {$ENDIF} + MouseInAnchor := False; + end; + + if Focuslink = Hyperlinks - 1 then + begin + rr.Right := cr.Left; + rr.Bottom := cr.Bottom - ImgAli; + rr.Top := rr.Bottom - Canvas.TextHeight('gh'); + InflateRect(rr,1,0); + if not Calc then Canvas.DrawFocusRect(rr); + end; + end; + 'E':begin + if not Calc then + Error := False; + end; + 'B':begin + if s[4] <> '>' then + Canvas.Font.Color := OldFont.Color + else + Canvas.Font.Style := Canvas.Font.Style - [fsBold]; + end; + 'S':begin + TagChar := UpCase(s[4]); + + if (TagChar = 'U') then + begin + isSup := False; + isSub := False; + end + else + if (TagChar = 'H') then + isShad := False + else + Canvas.Font.Style := Canvas.Font.Style - [fsStrikeOut]; + end; + 'F':begin + Canvas.Font.Name := OldFont.Name; + Canvas.Font.Size := OldFont.Size; + if not Calc and not Selected then + begin + Canvas.Font.Color := OldFont.Color; + Canvas.Brush.Color := BGColor; + if BGColor = clNone then + begin + Canvas.Brush.Style := bsClear; + end; + end; + end; + 'H':begin + if not Calc then + begin + Canvas.Font.Color := hifCol; + Canvas.Brush.Color := hibCol; + if hibCol = clNone then + Canvas.Brush.Style := bsClear; + end; + end; + 'I':begin + Canvas.Font.Style := Canvas.Font.Style - [fsItalic]; + end; + 'L':begin + LineBreak := True; + end; + 'O':begin + NewOffsetX := 0; + end; + 'P':begin + LineBreak := True; + if not Calc then + begin + Canvas.Brush.Color := ParaColor; + if ParaColor = clNone then Canvas.Brush.Style := bsClear; + isPara := false; + end; + end; + 'U':begin + if (s[4] <> '>') and (ListIndex > 0) then + Dec(Listindex) + else + Canvas.Font.Style := Canvas.Font.Style - [fsUnderline]; + end; + 'R':begin + EndRotated(Canvas); + end; + 'Z':Invisible := False; + end; + end + else + begin + case Upcase(s[2]) of + 'A':begin + { only do this when at hover position in xpos,ypos } + if (FocusLink = HyperLinks) and not Calc then + begin + rr.Left := cr.Left; + rr.Top := cr.Top; + end; + + Inc(HyperLinks); + if (not HoverStyle or (Hoverlink = HyperLinks)) and not Calc then + begin + Canvas.Font.Style := Canvas.Font.Style + [fsUnderline]; + if (Hovercolor <> clNone) and not Calc then + begin + HvrColor := Canvas.Brush.Color; + + if Canvas.Brush.Style = bsClear then + HvrColor := clNone; + Canvas.Brush.Color := HoverColor; + end; + + if HoverFontColor <> clNone then + begin + hvrfntcolor := Canvas.Font.Color; + Canvas.Font.Color := HoverFontColor; + end; + end; + + if not Selected and ((HoverFontColor = clNone) or (HoverLink <> HyperLinks) or not HoverStyle) then + Canvas.Font.Color := URLColor; + + TagProp := Copy(s,3,Pos('>',s) - 1); // + Prop := Copy(TagProp,Pos('"',TagProp) + 1,Length(TagProp)); + Prop := Copy(Prop,1,Pos('"',Prop) - 1); + LastAnchor := Prop; + Anchor := True; + + hr.Left := w; + hr.Top := r.Top; + end; + 'B':begin + TagChar := Upcase(s[3]); + case TagChar of + '>': Canvas.Font.Style := Canvas.Font.Style + [fsBold]; // tag + 'R': //
tag + begin + LineBreak := true; + StripVal := StripVal + #13; + end; + 'L': if not Blink then + Canvas.Font.Color := BlnkColor; // tag + 'O': + begin + Res := Res + Copy(s,1,pos('>',s)); + if not Calc and not Selected then + begin + TagProp := Uppercase(Copy(s,6,pos('>',s)-1)); + + if (Pos('BACKGROUND',TagProp) > 0) then + begin + Prop := Copy(TagProp,Pos('BACKGROUND',TagProp)+10,Length(TagProp)); + Prop := Copy(Prop,Pos('"',Prop)+1,Length(prop)); + Prop := Copy(Prop,1,Pos('"',Prop)-1); + + if Pos('IDX:', UpperCase(Prop)) > 0 then + begin + Delete(Prop, 1, 4); + if Assigned(FImages) and (IStrToInt(Prop) < FImages.Count) then + begin + IMGSize.X := MulDiv(FImages.Width, GetDeviceCaps(Canvas.Handle, LOGPIXELSX), 96); + IMGSize.Y := MulDiv(FImages.Height, GetDeviceCaps(Canvas.Handle, LOGPIXELSY), 96); + + if not Calc and not Print then +{$IFDEF DELPHI4_LVL} + FImages.Draw(Canvas, CR.Left, CR.Top, IStrToInt(Prop), True); +{$ELSE} + FImages.Draw(Canvas, CR.Left, CR.Top, IStrToInt(Prop)); +{$ENDIF} + + if not Calc and Print then + begin + CR.Right := CR.Left + Round(resfactor * FImages.Width); + CR.Bottom := CR.Top + Round(resfactor * FImages.Height); + + ABitmap := TBitmap.Create; + FImages.GetBitmap(IStrToInt(Prop), ABitmap); + PrintBitmap(Canvas, CR, ABitmap); + ABitmap.Free; + CR := r; + end; + end; + end; + + if Pos('SSYS:', UpperCase(Prop)) > 0 then + begin + Delete(Prop, 1, 5); + IMGSize := SysImage(Canvas, CR.Left, CR.Top, Prop, False, not Calc, Print, resfactor); + + IMGSize.X := MulDiv(IMGSize.X, GetDeviceCaps(Canvas.Handle, LOGPIXELSX), 96); + IMGSize.Y := MulDiv(IMGSize.Y, GetDeviceCaps(Canvas.Handle, LOGPIXELSY), 96); + end; + + if Pos('LSYS:', UpperCase(Prop)) > 0 then + begin + Delete(Prop, 1, 5); + IMGSize := SysImage(Canvas, CR.Left, CR.Top, Prop, True, not Calc, Print, resfactor); + + IMGSize.X := MulDiv(IMGSize.X, GetDeviceCaps(Canvas.Handle, LOGPIXELSX), 96); + IMGSize.Y := MulDiv(IMGSize.Y, GetDeviceCaps(Canvas.Handle, LOGPIXELSY), 96); + end; + + bmp := nil; + + if (Pos(':',Prop) = 0) and Assigned(pc) then + begin + bmp := pc.FindPicture(Prop); + end; + + if (Pos('://',Prop) > 0) and Assigned(ic) then + begin + if ic.FindPicture(Prop) = nil then + with ic.AddPicture do + begin + Asynch := False; + LoadFromURL(Prop); + end; + bmp := ic.FindPicture(Prop); + end; + + if bmp <> nil then + begin + if not bmp.Empty and (bmp.Width > 0) and (bmp.Height > 0) then + begin + // do the tiling here + bmpy := 0; + hrgn := CreateRectRgn(fr.left, fr.top, fr.right,fr.bottom); + SelectClipRgn(Canvas.Handle, hrgn); + while (bmpy < fr.bottom-fr.top) do + begin + bmpx := 0; + while (bmpx < fr.right - fr.left) do + begin + Canvas.Draw(fr.left+bmpx,fr.top+bmpy,bmp); + bmpx := bmpx + bmp.width; + end; + bmpy := bmpy + bmp.height; + end; + SelectClipRgn(Canvas.handle, 0); + DeleteObject(hrgn); + end; + end; //end of bmp <> nil + end; //end of background + + if (Pos('BGTOPLEFT', TagProp) > 0) then + begin + Prop := Copy(TagProp, Pos('BGTOPLEFT', TagProp) + 10, Length(TagProp)); + Prop := Copy(Prop, Pos('"', Prop) + 1, Length(Prop)); + Prop := Copy(Prop, 1, Pos('"', Prop) - 1); + + if Pos('IDX:', UpperCase(Prop)) > 0 then + begin + Delete(Prop, 1, 4); + if Assigned(FImages) and (IStrToInt(Prop) < FImages.Count) then + begin + IMGSize.X := MulDiv(FImages.Width, GetDeviceCaps(Canvas.Handle, LOGPIXELSX), 96); + IMGSize.Y := MulDiv(FImages.Height, GetDeviceCaps(Canvas.Handle, LOGPIXELSY), 96); + + if not Calc and not Print then +{$IFDEF DELPHI4_LVL} + FImages.Draw(Canvas, CR.Left, CR.Top, IStrToInt(Prop), True); +{$ELSE} + FImages.Draw(Canvas, CR.Left, CR.Top, IStrToInt(Prop)); +{$ENDIF} + + if not Calc and Print then + begin + CR.Right := CR.Left + Round(resfactor * FImages.Width); + CR.Bottom := CR.Top + Round(resfactor * FImages.Height); + + ABitmap := TBitmap.Create; + FImages.GetBitmap(IStrToInt(Prop), ABitmap); + PrintBitmap(Canvas, CR, ABitmap); + ABitmap.Free; + CR := r; + end; + end; + end; + + if Pos('SSYS:', UpperCase(Prop)) > 0 then + begin + Delete(Prop, 1, 5); + IMGSize := SysImage(Canvas, CR.Left, CR.Top, Prop, False, not Calc, Print, resfactor); + + IMGSize.X := MulDiv(IMGSize.X, GetDeviceCaps(Canvas.Handle, LOGPIXELSX), 96); + IMGSize.Y := MulDiv(IMGSize.Y, GetDeviceCaps(Canvas.Handle, LOGPIXELSY), 96); + end; + + if Pos('LSYS:', UpperCase(Prop)) > 0 then + begin + Delete(Prop, 1, 5); + IMGSize := SysImage(Canvas, CR.Left, CR.Top, Prop, True, not Calc, Print, resfactor); + + IMGSize.X := MulDiv(IMGSize.X, GetDeviceCaps(Canvas.Handle, LOGPIXELSX), 96); + IMGSize.Y := MulDiv(IMGSize.Y, GetDeviceCaps(Canvas.Handle, LOGPIXELSY), 96); + end; + + bmp := nil; + + if (Pos(':', Prop) = 0) and Assigned(pc) then + begin + bmp := pc.FindPicture(Prop); + end; + + if (Pos('://', Prop) > 0) and Assigned(iC) then + begin + if iC.FindPicture(Prop) = nil then + with iC.AddPicture do + begin + ASYNCH := False; + LoadFromURL(Prop); + end; + bmp := iC.FindPicture(Prop); + end; + + if bmp <> nil then + begin + if not bmp.Empty and (bmp.Width > 0) and (bmp.Height > 0) then + begin + // do the tiling here + bmpy := 0; + HRgn := CreateRectRgn(fr.Left, fr.Top, fr.Right, fr.Bottom); + SelectClipRgn(Canvas.Handle, HRgn); + if (bmpy < fr.Bottom - fr.Top) then + begin + bmpx := 0; + if (bmpx < fr.Right - fr.Left) then + begin + Canvas.Draw(fr.Left + bmpx, fr.Top + bmpy, bmp); + bmpx := bmpx + bmp.Width; + end; + bmpy := bmpy + bmp.Height; + end; + SelectClipRgn(Canvas.Handle, 0); + DeleteObject(HRgn); + end; + end; //end of bmp <> nil + end; //end of bgtopleft + + if (Pos('BGTOPRIGHT', TagProp) > 0) then + begin + Prop := Copy(TagProp, Pos('BGTOPRIGHT', TagProp) + 10, Length(TagProp)); + Prop := Copy(Prop, Pos('"', Prop) + 1, Length(Prop)); + Prop := Copy(Prop, 1, Pos('"', Prop) - 1); + + if Pos('IDX:', UpperCase(Prop)) > 0 then + begin + Delete(Prop, 1, 4); + if Assigned(FImages) and (IStrToInt(Prop) < FImages.Count) then + begin + IMGSize.X := MulDiv(FImages.Width, GetDeviceCaps(Canvas.Handle, LOGPIXELSX), 96); + IMGSize.Y := MulDiv(FImages.Height, GetDeviceCaps(Canvas.Handle, LOGPIXELSY), 96); + + if not Calc and not Print then +{$IFDEF DELPHI4_LVL} + FImages.Draw(Canvas, CR.Right - FImages.Width, CR.Top, IStrToInt(Prop), True); +{$ELSE} + FImages.Draw(Canvas, CR.Right - FImages.Width, CR.Top, IStrToInt(Prop)); +{$ENDIF} + + if not Calc and Print then + begin + CR.Right := CR.Left + Round(resfactor * FImages.Width); + CR.Bottom := CR.Top + Round(resfactor * FImages.Height); + + ABitmap := TBitmap.Create; + FImages.GetBitmap(IStrToInt(Prop), ABitmap); + PrintBitmap(Canvas, CR, ABitmap); + ABitmap.Free; + CR := r; + end; + end; + end; + + if Pos('SSYS:', UpperCase(Prop)) > 0 then + begin + Delete(Prop, 1, 5); + IMGSize := SysImage(Canvas, CR.Right - FImages.Width, CR.Top, Prop, False, not Calc, Print, resfactor); + + IMGSize.X := MulDiv(IMGSize.X, GetDeviceCaps(Canvas.Handle, LOGPIXELSX), 96); + IMGSize.Y := MulDiv(IMGSize.Y, GetDeviceCaps(Canvas.Handle, LOGPIXELSY), 96); + end; + + if Pos('LSYS:', UpperCase(Prop)) > 0 then + begin + Delete(Prop, 1, 5); + IMGSize := SysImage(Canvas, CR.Right - FImages.Width, CR.Top, Prop, True, not Calc, Print, resfactor); + + IMGSize.X := MulDiv(IMGSize.X, GetDeviceCaps(Canvas.Handle, LOGPIXELSX), 96); + IMGSize.Y := MulDiv(IMGSize.Y, GetDeviceCaps(Canvas.Handle, LOGPIXELSY), 96); + end; + + bmp := nil; + + if (Pos(':', Prop) = 0) and Assigned(pc) then + begin + bmp := pc.FindPicture(Prop); + end; + + if (Pos('://', Prop) > 0) and Assigned(iC) then + begin + if iC.FindPicture(Prop) = nil then + with iC.AddPicture do + begin + ASYNCH := False; + LoadFromURL(Prop); + end; + bmp := iC.FindPicture(Prop); + end; + + if bmp <> nil then + begin + if not bmp.Empty and (bmp.Width > 0) and (bmp.Height > 0) then + begin + // do the printing here + bmpy := 0; + HRgn := CreateRectRgn(fr.Left, fr.Top, fr.Right, fr.Bottom); + SelectClipRgn(Canvas.Handle, HRgn); + if (bmpy < fr.Bottom - fr.Top) then + begin + bmpx := 0; + if (bmpx < fr.Right - fr.Left) then + begin + Canvas.Draw(fr.Right - bmp.Width, fr.Top + bmpy, bmp); + bmpx := bmpx + bmp.Width; + end; + bmpy := bmpy + bmp.Height; + end; + SelectClipRgn(Canvas.Handle, 0); + DeleteObject(HRgn); + end; + end; //end of bmp <> nil + end; //end of bgtopright + + if VarPos('BGCOLOR',TagProp,TagPos) > 0 then + begin + Prop := Copy(TagProp,TagPos + 5,Length(TagProp)); + Prop := Copy(Prop,Pos('"',Prop) + 1,Length(Prop)); + Prop := Copy(Prop,1,Pos('"',Prop) - 1); + + NewColor := clNone; + + if Length(Prop) > 0 then + begin + if Prop[1] = '#' then + NewColor := Hex2Color(Prop) + else + NewColor := Text2Color(AnsiLowerCase(prop)); + end; + + if VarPos('BGCOLORTO',TagProp,TagPos) > 0 then + begin + Prop := Copy(TagProp,TagPos + 5,Length(TagProp)); + Prop := Copy(Prop,Pos('"',Prop) + 1,Length(Prop)); + Prop := Copy(Prop,1,Pos('"',Prop) - 1); + NewColorTo := clNone; + + if Length(Prop) > 0 then + begin + if Prop[1] = '#' then + NewColorTo := Hex2Color(Prop) + else + NewColorTo := Text2Color(AnsiLowerCase(prop)); + end; + + Prop := 'H'; + if VarPos('DIR',TagProp,TagPos) > 0 then + begin + Prop := Copy(TagProp,TagPos + 3,Length(TagProp)); + Prop := Copy(Prop,Pos('"',Prop) + 1,Length(Prop)); + Prop := Copy(Prop,1,Pos('"',Prop) - 1); + end; + + Canvas.Pen.Color := Newcolor; + {$IFNDEF TMSDOTNET} + DrawHTMLGradient(Canvas,NewColor,NewColorTo,clNone,64,Rect(fr.left,fr.top,fr.right,fr.bottom),Prop = 'H'); + {$ENDIF} + {$IFDEF TMSDOTNET} + DrawHTMLGradient(Canvas,NewColor,NewColorTo,clNone,64,Borland.Vcl.Types.Rect(fr.left,fr.top,fr.right,fr.bottom),Prop = 'H'); + {$ENDIF} + Canvas.Brush.Style := bsClear + end + else + begin + BGColor := Canvas.Brush.Color; + Canvas.Brush.color := NewColor; + PenColor:=Canvas.Pen.Color; + Canvas.Pen.Color := Newcolor; + Canvas.Rectangle(fr.left - 2,fr.top,fr.right,fr.bottom); + Canvas.Pen.Color := PenColor; + end; + end; + end; + end; + end; + end; + 'E':begin + if not Calc then + Error := True; + end; + 'H':begin + case Upcase(s[3]) of + 'R': + begin + LineBreak := True; + if not Calc then + begin + Pencolor := Canvas.Pen.color; + Canvas.Pen.color:=clblack; + Canvas.MoveTo(r.left,cr.bottom+1); + Canvas.Lineto(r.right,cr.bottom+1); + Canvas.pen.color:=pencolor; + end; + end; + 'I': + begin + if not Calc then + begin + hifCol := Canvas.Font.Color; + hibCol := Canvas.Brush.Color; + if Canvas.Brush.Style = bsClear then + hibCol := clNone; + + Canvas.Brush.Color := clHighLight; + Canvas.Font.Color := clHighLightText; + end; + end; + end; + end; + 'I':begin + TagChar := Upcase(s[3]); + + if TagChar = '>' then // tag + Canvas.Font.Style := Canvas.Font.Style + [fsItalic] + else + if TagChar = 'N' then // tag + begin + TagProp := Copy(s,3,pos('>',s) - 1); + + Prop := Copy(TagProp,ipos('x',TagProp) + 2,Length(TagProp)); + Prop := Copy(Prop,Pos('"',Prop) + 1,Length(prop)); + Prop := Copy(Prop,1,Pos('"',Prop) - 1); + + val(Prop,indent,err); + if err = 0 then + begin + if indent > w then + begin + w := Indent; + cr.left := fr.left + Indent; + end; + end; + end + else + if TagChar = 'M' then + begin + inc(ImgIdx); + + TagProp := Copy(s,3,Pos('>',s) - 1); + Prop := Copy(TagProp,Pos('SRC',Uppercase(TagProp)) + 4,Length(TagProp)); + Prop := Copy(Prop,Pos('"',Prop) + 1,Length(Prop)); + Prop := Copy(Prop,1,Pos('"',Prop) - 1); + + TagProp := Uppercase(TagProp); + + if (Pos('ALT',TagProp) > 0) and (AltImg = ImgIdx) then + begin + Prop := Copy(TagProp,Pos('ALT',TagProp) + 4,Length(TagProp)); + Prop := Copy(Prop,Pos('"',Prop) + 1,Length(Prop)); + Prop := Copy(Prop,1,Pos('"',Prop) - 1); + end; + + TagWidth := 0; + TagHeight := 0; + + if Pos('WIDTH',TagProp) > 0 then + begin + Tagp := Copy(TagProp,Pos('WIDTH',TagProp) + 6,Length(TagProp)); + Tagp := Copy(Tagp,Pos('"',tagp) + 1,Length(Tagp)); + Tagp := Copy(Tagp,1,Pos('"',tagp) - 1); + Val(Tagp,TagWidth,Err); + end; + + if Pos('HEIGHT',TagProp) > 0 then + begin + Tagp := Copy(TagProp,ipos('HEIGHT',TagProp) + 7,Length(TagProp)); + Tagp := Copy(Tagp,pos('"',Tagp) + 1,Length(Tagp)); + Tagp := Copy(Tagp,1,pos('"',Tagp) - 1); + Val(Tagp,TagHeight,Err); + end; + + IMGSize.x := 0; + IMGSize.y := 0; + + if Pos('IDX:',Uppercase(Prop)) > 0 then + begin + Delete(Prop,1,4); + if Assigned(FImages) and (IStrToInt(Prop) < FImages.Count) then + begin + IMGSize.x := MulDiv(FImages.Width,GetDeviceCaps(Canvas.Handle,LOGPIXELSX),96); + IMGSize.y := MulDiv(FImages.Height,GetDeviceCaps(Canvas.Handle,LOGPIXELSY),96); + + if not Calc and not Print then + {$IFDEF DELPHI4_LVL} + FImages.Draw(Canvas,cr.Left,cr.Top,IStrToInt(Prop),True); + {$ELSE} + FImages.Draw(Canvas,cr.Left,cr.Top,IStrToInt(Prop)); + {$ENDIF} + + if not Calc and Print then + begin + cr.Right := cr.Left + Round(ResFactor * FImages.Width); + cr.Bottom := cr.Top + Round(ResFactor * FImages.Height); + + ABitmap := TBitmap.Create; + FImages.GetBitmap(IStrToInt(Prop),ABitmap); + PrintBitmap(Canvas,cr,ABitmap); + ABitmap.Free; + cr := r; + end; + end; + end; + + if Pos('SSYS:',Uppercase(Prop)) > 0 then + begin + Delete(Prop,1,5); + IMGSize := SysImage(Canvas,cr.Left,cr.Top,Prop,False,not Calc,Print,ResFactor); + + IMGSize.x := MulDiv(IMGSize.X,GetDeviceCaps(Canvas.Handle,LOGPIXELSX),96); + IMGSize.y := MulDiv(IMGSize.Y,GetDeviceCaps(Canvas.Handle,LOGPIXELSY),96); + end; + + if Pos('LSYS:',Uppercase(Prop)) > 0 then + begin + Delete(Prop,1,5); + IMGsize := SysImage(Canvas,cr.Left,cr.Top,Prop,True,not Calc,Print,ResFactor); + + IMGSize.x := MulDiv(IMGSize.X,GetDeviceCaps(Canvas.Handle,LOGPIXELSX),96); + IMGSize.y := MulDiv(IMGSize.Y,GetDeviceCaps(Canvas.Handle,LOGPIXELSY),96); + end; + + bmp := nil; + + if (Pos(':',Prop) = 0) and Assigned(pc) then + begin + bmp := pc.FindPicture(Prop); + end; + + if (Pos('://',Prop) > 0) and Assigned(ic) then + begin + if ic.FindPicture(Prop) = nil then + with ic.AddPicture do + begin + Asynch := False; + LoadFromURL(Prop); + end; + + bmp := ic.FindPicture(Prop); + end; + + if bmp <> nil then + begin + if not bmp.Empty then + begin + if not Calc {and not Print} then + begin + if (TagWidth > 0) and (TagHeight > 0) then + begin + bmp.Stretch := True; + {$IFNDEF TMSDOTNET} + Canvas.StretchDraw(Rect(cr.Left,cr.Top,cr.Left + TagWidth,cr.Top + TagHeight),bmp) + {$ENDIF} + {$IFDEF TMSDOTNET} + Canvas.StretchDraw(Borland.Vcl.Types.Rect(cr.Left,cr.Top,cr.Left + TagWidth,cr.Top + TagHeight),bmp) + {$ENDIF} + end + else + begin + + // need for animation - redraw background + if bmp.FrameCount > 1 then + begin + //Canvas.Pen.Color := BlnkColor; + //Canvas.Brush.Color := BlnkColor; + //Canvas.Rectangle(cr.Left,cr.Top,cr.Left + bmp.MaxWidth,cr.Top+bmp.MaxHeight); + end; + + Canvas.Draw(cr.Left + bmp.FrameXPos,cr.Top + bmp.FrameYPos,bmp); + end; + end; + + if (TagWidth > 0) and (TagHeight > 0) then + begin + IMGSize.x := MulDiv(TagWidth,GetDeviceCaps(Canvas.Handle,LOGPIXELSX),96); + IMGSize.y := MulDiv(TagHeight,GetDeviceCaps(Canvas.Handle,LOGPIXELSY),96); + end + else + begin + IMGSize.x := MulDiv(bmp.MaxWidth,GetDeviceCaps(Canvas.Handle,LOGPIXELSX),96); + IMGSize.y := MulDiv(bmp.MaxHeight,GetDeviceCaps(Canvas.Handle,LOGPIXELSY),96); + end; + end; + end; + + if (XPos - r.Left > w) and (XPos - r.Left < w + IMGSize.x) and + (YPos > cr.Top) and (YPos < cr.Top + IMGSize.Y) and Anchor then + begin + ImageHotSpot := True; + AnchorVal := LastAnchor; + AltImg := ImgIdx; + end; + + if Print then + begin + //IMGSize.x := Round(IMGSize.x * ResFactor); + //IMGSize.y := Round(IMGSize.y * ResFactor); + {$IFDEF TMSDEBUG} + DbgPoint('bmp : ',point(IMGSize.x,IMGSize.y)); + {$ENDIF} + end; + + oldh := h; + + if (w + IMGSize.x > r.Right-r.Left) and + (IMGSize.x < r.Right - r.Left) then + begin + ImgBreak := True; + end + else + begin + w := w + IMGSize.x; + cr.left := cr.left + IMGSize.x; + if IMGSize.y > h then + h := IMGSize.y; + end; + + if Pos('ALIGN',TagProp) > 0 then + begin + if Pos('"TOP',TagProp) > 0 then + begin + ImgAli := h - Canvas.TextHeight('gh'); + end + else + begin + if Pos('"MIDDLE',TagProp) > 0 then + ImgAli := (h - Canvas.TextHeight('gh')) shr 1; + end; + end; + + if (Pos('WRAP',TagProp) > 0) then + begin + h := Canvas.TextHeight('gh'); + ImgAli := 0; + end; + end; + end; + 'L':begin + w := w + 12 * ListIndex; + if Linkbreak then + Imgbreak := True else Linkbreak := True; + + cr.left := cr.left + 12 * (ListIndex - 1); + if not calc and not Invisible then + begin + Prop := Canvas.Font.Name; + Canvas.Font.Name := 'Symbol'; + + if Odd(ListIndex) then + DrawText(Canvas.Handle,'·',1,cr,0) + else + DrawText(Canvas.Handle,'o',1,cr,0); + + Canvas.Font.Name := prop; + end; + cr.Left := cr.Left + 12; + end; + 'U':begin + if s[3] <> '>' then + begin + Inc(ListIndex); + LineBreak := true; + end + else + Canvas.Font.Style := Canvas.Font.Style + [fsUnderline]; + end; + 'O':begin + TagChar := Upcase(s[3]); + if TagChar = 'F' then // tag + begin + TagProp := Copy(s,3,pos('>',s) - 1); + Prop := Copy(TagProp,ipos('x',TagProp) + 2,Length(TagProp)); + Prop := Copy(Prop,Pos('"',Prop) + 1,Length(prop)); + Prop := Copy(Prop,1,Pos('"',Prop) - 1); + val(Prop,NewOffsetX,err); + cr.Left := NewOffsetX; + w := NewOffsetX; + end + end; + 'P':begin + if (VarPos('>',s,TagPos)>0) then + begin + TagProp := Uppercase(Copy(s,3,TagPos-1)); + + if VarPos('ALIGN',TagProp,TagPos) > 0 then + begin + Prop := Copy(TagProp,TagPos+5,Length(TagProp)); + Prop := Copy(Prop,Pos('"',prop)+1,Length(Prop)); + Prop := Copy(Prop,1,Pos('"',prop)-1); + + if Pos('RIGHT',Prop) > 0 then Align := taRightJustify; + if Pos('LEFT',Prop) > 0 then Align := taLeftJustify; + if Pos('CENTER',Prop) > 0 then Align := taCenter; + end; + + if VarPos('INDENT',TagProp,TagPos) > 0 then + begin + Prop := Copy(TagProp,TagPos+6,Length(TagProp)); + Prop := Copy(Prop,Pos('"',prop)+1,Length(Prop)); + Prop := Copy(Prop,1,Pos('"',prop)-1); + PIndent := IStrToInt(Prop); + end; + + if VarPos('BGCOLOR',TagProp,TagPos) > 0 then + begin + Prop := Copy(TagProp,TagPos + 5,Length(TagProp)); + Prop := Copy(Prop,Pos('"',Prop) + 1,Length(Prop)); + Prop := Copy(Prop,1,Pos('"',Prop) - 1); + + NewColor := clNone; + + if Length(Prop) > 0 then + begin + if Prop[1] = '#' then + NewColor := Hex2Color(Prop) + else + NewColor := Text2Color(AnsiLowerCase(prop)); + end; + + if VarPos('BGCOLORTO',TagProp,TagPos) > 0 then + begin + Prop := Copy(TagProp,TagPos + 5,Length(TagProp)); + Prop := Copy(Prop,Pos('"',Prop) + 1,Length(Prop)); + Prop := Copy(Prop,1,Pos('"',Prop) - 1); + NewColorTo := clNone; + + if Length(Prop) > 0 then + begin + if Prop[1] = '#' then + NewColorTo := Hex2Color(Prop) + else + NewColorTo := Text2Color(AnsiLowerCase(prop)); + end; + if not Calc then + begin + isPara := True; + Canvas.Pen.Color := Newcolor; + {$IFNDEF TMSDOTNET} + DrawHTMLGradient(Canvas,NewColor,NewColorTo,clNone,64,Rect(fr.left,r.top,fr.right,r.bottom+2),true); + {$ENDIF} + {$IFDEF TMSDOTNET} + DrawHTMLGradient(Canvas,NewColor,NewColorTo,clNone,64,Borland.Vcl.Types.Rect(fr.left,r.top,fr.right,r.bottom+2),true); + {$ENDIF} + Canvas.Brush.Style := bsClear + end; + end + else + begin + if not Calc then + begin + isPara := True; + paracolor := Canvas.Brush.Color; + if Canvas.Brush.Style = bsClear then ParaColor := clNone; + Canvas.Brush.color := NewColor; + PenColor := Canvas.Pen.Color; + Canvas.Pen.Color := Newcolor; + Canvas.Rectangle(fr.left,r.top,fr.right,r.bottom); + end; + end; + end; + end; + end; + 'F':begin + if (VarPos('>',s,TagPos)>0) then + begin + TagProp := UpperCase(Copy(s,6,TagPos-6)); + + if (VarPos('FACE',TagProp,TagPos) > 0) then + begin + Prop := Copy(TagProp,TagPos+4,Length(TagProp)); + Prop := Copy(prop,pos('"',prop)+1,Length(prop)); + Prop := Copy(prop,1,pos('"',prop)-1); + Canvas.Font.Name := Prop; + end; + + if (VarPos(' COLOR',TagProp,TagPos) > 0) and not Selected then + begin + Prop := Copy(TagProp,TagPos+6,Length(TagProp)); + Prop := Copy(Prop,Pos('"',prop)+1,Length(prop)); + Prop := Copy(Prop,1,Pos('"',prop)-1); + //oldfont.color:=Canvas.font.color; + + if Length(Prop) > 0 then + begin + if Prop[1] = '#' then + Canvas.font.color := Hex2Color(Prop) + else + Canvas.Font.Color := Text2Color(AnsiLowerCase(prop)); + end; + + end; + + if (VarPos('BGCOLOR',TagProp,TagPos)>0) and not Calc and not Selected then + begin + Prop := Copy(TagProp,TagPos+7,Length(TagProp)); + Prop := Copy(prop,pos('"',prop)+1,Length(prop)); + Prop := Copy(prop,1,pos('"',prop)-1); + BGColor := Canvas.Brush.Color; + + if Canvas.Brush.Style = bsClear then + bgcolor := clNone; + + if Length(Prop) > 0 then + begin + if Prop[1] = '#' then + Canvas.Brush.Color := Hex2Color(Prop) + else + Canvas.Brush.Color := Text2Color(AnsiLowerCase(prop)); + end; + + end; + + if (VarPos('SIZE',TagProp,TagPos)>0) then + begin + Prop := Copy(TagProp,TagPos+4,Length(TagProp)); + Prop := Copy(Prop,Pos('=',Prop)+1,Length(Prop)); + Prop := Copy(Prop,Pos('"',Prop)+1,Length(Prop)); + + case IStrToInt(Prop) of + 1:Canvas.Font.Size := 8; + 2:Canvas.Font.Size := 10; + 3:Canvas.Font.Size := 12; + 4:Canvas.Font.Size := 14; + 5:Canvas.Font.Size := 16; + else + Canvas.Font.Size := IStrToInt(Prop); + end; + + end; + end; + end; + 'S':begin + TagChar := Upcase(s[3]); + + if TagChar = '>' then + Canvas.Font.Style := Canvas.font.Style + [fsStrikeOut] + else + begin + if TagChar = 'H' then + isShad := True + else + begin + if ipos('',s)=1 then + isSub := True + else + if ipos('',s)=1 then + isSup := True; + end; + end; + end; + 'R':begin + TagProp := Copy(s,3,pos('>',s)-1); + prop := Copy(TagProp,ipos('a',TagProp)+2,Length(TagProp)); + prop := Copy(prop,pos('"',prop)+1,Length(prop)); + prop := Copy(prop,1,pos('"',prop)-1); + Val(prop,Indent,err); + StartRotated(Canvas,indent); + end; + 'Z':Invisible := True; + end; + end; + + if (VarPos('>',s,TagPos)>0) and not ImgBreak then + begin + Res := Res + Copy(s,1,TagPos); + Delete(s,1,TagPos); + end + else + if not Imgbreak then + Delete(s,1,Length(s)); + end; + end; + + w := w - sw; + + if w > xsize then + xsize := w + 2; + + if (FocusLink = Hyperlinks - 1) and Anchor and not Calc then + begin + rr.Right := cr.Left; + rr.Bottom := cr.Bottom; + InflateRect(rr,1,0); + if not Calc then + Canvas.DrawFocusRect(rr); + rr.Left := r.Left + 1; + rr.Top := rr.Bottom; + end; + + Result := Res; + end; + + +begin + Anchor := False; + Error := False; + OldFont := TFont.Create; + OldFont.Assign(Canvas.Font); + DrawFont := TFont.Create; + DrawFont.Assign(Canvas.Font); + CalcFont := TFont.Create; + CalcFont.Assign(Canvas.Font); + OldDrawfont := TFont.Create; + OldDrawFont.Assign(Canvas.Font); + OldCalcFont := TFont.Create; + OldCalcFont.Assign(Canvas.Font); + BlnkColor := Canvas.Brush.color; + Canvas.Brush.Color := clNone; + BGColor := clNone; + ParaColor := clNone; + isPara := False; + isShad := False; + Invisible := False; + + OfsX := 0; + NewOfsX := 0; + + Result := False; + + r := fr; + r.Left := r.Left + 1; {required to add offset for DrawText problem with first capital W letter} + + Align := taLeftJustify; + PIndent := 0; + + XSize := 0; + YSize := 0; + HyperLinks := 0; + HlCount := 0; + ListIndex := 0; + LiCount := 0; + StripVal := ''; + FocusAnchor := ''; + MouseLink := -1; + MouseInAnchor := False; + + ImgIdx := 0; + AltImg := -1; + + SetBKMode(Canvas.Handle,TRANSPARENT); + + DrawStyle := DT_LEFT or DT_SINGLELINE or DT_EXTERNALLEADING or DT_BOTTOM or DT_EXPANDTABS; // or DT_NOPREFIX; + + if Pos(' & ',s) > 0 then + DrawStyle := DrawStyle or DT_NOPREFIX; + + + if not WordWrap then + DrawStyle := DrawStyle or DT_END_ELLIPSIS; + + if Pos('&',s) > 0 then + begin + repeat + Foundtag := False; + //if TagReplacestring('<','<',s) then Foundtag := True; + //if TagReplacestring('>','>',s) then Foundtag := True; + + if TagReplacestring('&','&&',s) then Foundtag := True; + if TagReplacestring('"','"',s) then Foundtag := True; + + if TagReplacestring('§','§',s) then Foundtag := True; + if TagReplacestring('‰','®‰',s) then Foundtag := True; + if TagReplacestring('®','®',s) then Foundtag := True; + + if TagReplacestring('©','©',s) then Foundtag := True; + if TagReplacestring('¶','¶',s) then Foundtag := True; + + if TagReplacestring('™','™',s) then Foundtag := True; + if TagReplacestring('€','€',s) then Foundtag := True; + + until not Foundtag; + end; + + s := DBTagStrip(s); + s := CRLFStrip(s,True); + + InsPoint := 0; + + while Length(s) > 0 do + begin + {calculate part of the HTML text fitting on the next line} + Oldfont.Assign(OldCalcFont); + Canvas.Font.Assign(CalcFont); + Oldanchor := Anchor; + OldAnchorVal := LastAnchor; + suph := 0; + subh := 0; + imgali := 0; + isSup := False; + isSub := False; + + HtmlHeight := Canvas.TextHeight('gh'); + txtHeight := HtmlHeight; + + OldImgIdx := ImgIdx; + + su := HTMLDrawLine(Canvas,s,r,True,HtmlWidth,HtmlHeight,subh,suph,imgali,Align,PIndent,XPos,YPos,HotSpot,ImageHotSpot,ofsx,newofsx); + + Anchor := OldAnchor; + LastAnchor := OldAnchorVal; + + CalcFont.Assign(Canvas.Font); + OldCalcFont.Assign(OldFont); + + HTMLHeight := HTMLHeight + LineSpacing; + + dr := r; + + case Align of + taCenter:if (r.right - r.left - htmlwidth > 0) then + dr.left := r.left+((r.right - r.left - htmlwidth) shr 1); + taRightJustify:if r.right - htmlwidth > r.left then + dr.left := r.right - htmlwidth; + end; + + dr.Left := dr.Left + PIndent; + + dr.Bottom := dr.Top + HtmlHeight + Subh + Suph; + + if not CheckHeight then + begin + OldFont.Assign(OldDrawFont); + Canvas.Font.Assign(DrawFont); + + HyperLinks := HlCount; + ListIndex := LiCount; + ImgIdx := OldImgIdx; + + HTMLDrawLine(Canvas,su,dr,CheckHotSpot,HtmlWidth,HtmlHeight,subh,suph,ImgAli,Align,PIndent,XPos,YPos,HotSpot,ImageHotspot,ofsx,newofsx); + + HlCount := HyperLinks; + LiCount := ListIndex; + + if (HotSpot and + (YPos > dr.Bottom - ImgAli - Canvas.TextHeight('gh')) and + (YPos < dr.Bottom - ImgAli)) or ImageHotSpot then + begin + Result := True; + end; + + ofsx := newofsx; + + DrawFont.Assign(Canvas.Font); + OldDrawFont.Assign(OldFont); + end; + + r.top := r.top + HtmlHeight + subh + suph; + ysize := ysize + HtmlHeight + subh + suph; + + {do not draw below bottom} + if (r.top + TxtHeight > r.bottom) and not CheckHeight then + s := ''; + end; + + if (ysize = 0) then + ysize := Canvas.TextHeight('gh'); + + //ysize := ysize + 2; + + InsPoint := InsPoint shr 1; + + Canvas.Brush.Color := BlnkColor; + Canvas.Font.Assign(OldFont); + OldFont.Free; + DrawFont.Free; + CalcFont.Free; + OldDrawfont.Free; + OldCalcfont.Free; +end; +{$WARNINGS ON} + +{$IFNDEF REMOVEDRAW} +function HTMLDraw(Canvas:TCanvas;s:string;fr:trect; + FImages:TImageList; + xpos,ypos:integer; + checkhotspot,checkheight,print,selected,blink:boolean; + resfactor:double; + URLColor:tcolor; + var Anchorval,StripVal:string; + var XSize,YSize:integer):boolean; +var + HyperLinks,MouseLink: Integer; + Focusanchor: string; + r: TRect; +begin + Result := HTMLDrawEx(Canvas,s,fr,FImages,xpos,ypos,-1,-1,1,checkhotspot,checkheight,print,selected,blink,false, + False,resfactor,URLColor,clNone,clNone,clGray,anchorval,stripval,focusanchor,xsize,ysize,HyperLinks,MouseLink,r,nil,nil,0); +end; + +{$IFNDEF REMOVEIPOSFROM} +function IPosFrom(su,s:string;frm:integer):Integer; +var + i:Integer; +begin + i := Pos(UpperCase(su),UpperCase(s)); + if i > frm then + Result := i + else + Result := 0; +end; +{$ENDIF} + +{$ENDIF} + + +{$IFNDEF DELPHI4_LVL} +function StringReplace(const S, OldPattern, NewPattern: string): string; +var + SearchStr, Patt, NewStr: string; + Offset: Integer; +begin + SearchStr := S; + Patt := OldPattern; + + NewStr := S; + Result := ''; + while SearchStr <> '' do + begin + {$IFDEF DELPHI3_LVL} + Offset := AnsiPos(Patt, SearchStr); + {$ELSE} + Offset := Pos(Patt, SearchStr); + {$ENDIF} + + if Offset = 0 then + begin + Result := Result + NewStr; + Break; + end; + Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern; + NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt); + Result := Result + NewStr; + Break; + end; +end; +{$ENDIF} + +{$IFNDEF REMOVESTRIP} + +function HTMLStrip(s:string):string; +var + TagPos: integer; +begin + Result := ''; + // replace line breaks by linefeeds + {$IFNDEF DELPHI4_LVL} + while (pos('
',uppercase(s))>0) do s := StringReplace(s,'
',chr(13)+chr(10)); + while (pos('
',uppercase(s))>0) do s := StringReplace(s,'
',chr(13)+chr(10)); + while (pos('
',uppercase(s))>0) do s := StringReplace(s,'
',chr(13)+chr(10)); + while (pos('
',uppercase(s))>0) do s := StringReplace(s,'
',chr(13)+chr(10)); + {$ELSE} + while (pos('
',uppercase(s))>0) do s := StringReplace(s,'
',chr(13)+chr(10),[rfIgnoreCase]); + while (pos('
',uppercase(s))>0) do s := StringReplace(s,'
',chr(13)+chr(10),[rfIgnoreCase]); + {$ENDIF} + + while (VarPos('',s,TagPos) > 0) do + begin + Result := Result + Copy(s,1,TagPos - 1); // copy till Z tag + if (VarPos('',s,TagPos) > 0) then + Delete(s,1,TagPos + 3) + else + Break; + end; + + while (VarPos('',s,TagPos) > 0) do + begin + Result := Result + Copy(s,1,TagPos - 1); // copy till Z tag + if (VarPos('',s,TagPos) > 0) then + Delete(s,1,TagPos + 3) + else + Break; + end; + + + // remove all other tags + while (VarPos('<',s,TagPos) > 0) do + begin + Result := Result + Copy(s,1,TagPos - 1); + if (VarPos('>',s,TagPos)>0) then + Delete(s,1,TagPos) + else + Break; + end; + Result := Result + s; +end; +{$ENDIF} + +{$IFDEF HILIGHT} + +function HTMLStripAll(s:string):string; +var + TagPos: integer; +begin + Result := ''; + + // remove all tags + while (VarPos('<',s,TagPos)>0) do + begin + Result := Result + Copy(s,1,TagPos-1); + if (VarPos('>',s,TagPos)>0) then + Delete(s,1,TagPos); + end; + Result := Result + s; +end; + +function StripPos2HTMLPos(s:string; i: Integer): Integer; +var + j,k: Integer; + Skip: Boolean; +begin + Result := 0; + k := 1; + Skip := False; + + for j := 1 to Length(s) do + begin + if s[j] = '<' then + Skip := True; + + if k = i then + begin + Result := j; + Exit; + end; + + if not Skip then + Inc(k); + + if s[j] = '>' then + Skip := False; + + end; + + if k = i then + begin + Result := Length(s) + 1; + end; +end; + + +function PosFrom(su,s:string; h: Integer;DoCase: boolean; var Res: Integer): Integer; +var + r: Integer; +begin + Result := 0; + Res := 0; + + if h > 0 then + Delete(s,1,h); + + if DoCase then + r := Pos(su,s) + else + r := Pos(UpperCase(su),UpperCase(s)); + + if r > 0 then + begin + Res := h + r; + Result := Res; + end; +end; + +function HiLight(s,h,tag:string;DoCase:boolean):string; +var + hs: string; + l,k: Integer; +begin + hs := HTMLStripAll(s); + + l := 0; + + while PosFrom(h,hs,l,DoCase,k) > 0 do + begin + l := k + Length(h); + Insert('<'+tag+'>',s,StripPos2HTMLPos(s,k)); + Insert('',s,StripPos2HTMLPos(s,l)); + end; + + Result := s; +end; + +function UnHiLight(s,tag:string):string; +begin + Result := ''; + // replace line breaks by linefeeds + {$IFNDEF DELPHI4_LVL} + while Pos('<'+tag+'>',s) > 0 do s := StringReplace(s,'<'+tag+'>',''); + while Pos('',s) > 0 do s := StringReplace(s,'',''); + tag := Uppercase(tag); + while Pos('<'+tag+'>',s) > 0 do s := StringReplace(s,'<'+tag+'>',''); + while Pos('',s) > 0 do s := StringReplace(s,'',''); + {$ELSE} + tag := Uppercase(tag); + while Pos('<'+tag+'>',Uppercase(s)) > 0 do s := StringReplace(s,'<'+tag+'>','',[rfIgnoreCase]); + while Pos('',Uppercase(s)) > 0 do s := StringReplace(s,'','',[rfIgnoreCase]); + {$ENDIF} + Result := s; +end; + +{$ENDIF} + +{$IFDEF PARAMS} + +function IPosv(su,s:string;var vp:integer):integer; +begin + vp := pos(UpperCase(su),UpperCase(s)); + Result := vp; +end; + + +function GetHREFValue(html,href:string;var value:string):boolean; +var + lp: Integer; +begin + Result := False; + while IPosv('href="',html,lp) > 0 do + begin + Delete(html,1,lp+5); {delete all before} + if IPosv('"',html,lp) > 0 then + begin + if CompareText(href,copy(html,1,lp-1))=0 then + begin + {href match - get the value now} + Delete(html,1,lp); + if (iposv('>',html,lp)>0) then + begin + Delete(html,1,lp); + if (iposv('<',html,lp)>0) then + begin + Value := Copy(html,1,lp-1); + Result := True; + Break; + end; + end; + end; + end; + end; +end; + + +function SetHREFValue(var html:string;href,value:string):boolean; +var + h:string; + p:string; +begin + {get current value and do a stringreplace} + + Result := False; + if GetHREFValue(html,href,h) then + begin + p := Copy(html,pos('href="' + href,html),Length(html)); + + {$IFNDEF DELPHI4_LVL} + p := StringReplace(p,'>' + h + '' + value + '' + h + '' + value + ' 0) then + begin + //manipulate the stream here for animated GIF ? + Gifstream := TMemoryStream.Create; + + ImgIdx := 1; + SkipImg := False; + + FDataStream.Position := 6; + FDataStream.Read(FAnimMaxX,2); + FDataStream.Read(FAnimMaxY,2); + + for i := 1 to FDataStream.Size do + begin + FDataStream.Position := i - 1; + FDataStream.Read(b,1); + + if (b = $21) and (i + 8 < FDataStream.Size) then + begin + FDataStream.Read(c,1); + FDataStream.Read(d,1); + FDataStream.Position := FDataStream.Position + 5; + + FDataStream.Read(e,1); + if (c = $F9) and (d = $4) and (e = $2C) then + begin + if imgidx = FFrame then + begin + FDataStream.Read(FFrameXPos,2); + FDataStream.Read(FFrameYPos,2); + FDataStream.Read(FFrameXSize,2); + FDataStream.Read(FFrameYSize,2); + end; + + Inc(ImgIdx); + if ImgIdx <= FFrame then + SkipImg := True + else + SkipImg := False; + end; + end; + if not SkipImg then GifStream.Write(b,1); + end; + GifStream.Position := 0; + GifStream.ReadBuffer(pvData^,GifStream.Size); + GifStream.Free; + end + else + begin + FDataStream.ReadBuffer(pvData^,fDataStream.Size); + end; + + GlobalUnlock(hGlobal); + + pstm := nil; + + // Create IStream* from global memory + hr := CreateStreamOnHGlobal(hGlobal, TRUE, pstm); + + if (not hr=S_OK) then + raise Exception.Create('Could not create image stream') + else + if (pstm = nil) then + raise Exception.Create('Empty image stream created'); + + // Create IPicture from image file + hr := OleLoadPicture(pstm, FDataStream.Size,FALSE,IID_IPicture,gpPicture); + + if not (hr = S_OK) then + raise Exception.Create('Could not load image. Invalid format') + else + if gpPicture = nil then + raise Exception.Create('Could not load image'); + + finally + GlobalFree(hGlobal); + end; + {$ENDIF} +end; + +procedure THTMLPicture.Draw(ACanvas: TCanvas; const Rect: TRect); +var + hmWidth:integer; + hmHeight:integer; + nPixX,nPixY:integer; + pnWidth,pnHeight:integer; + +begin + if Empty then Exit; + + if gpPicture = nil then Exit; + + hmWidth := 0; + hmHeight := 0; + gpPicture.get_Width(hmWidth); + gpPicture.get_Height(hmHeight); + + if Stretch then + begin + gpPicture.Render(ACanvas.Handle,Rect.Left,Rect.Bottom,Rect.Right - Rect.Left,-(Rect.Bottom - Rect.Top),0,0, + hmWidth,hmHeight, Rect); + end + else + begin + nPixX := GetDeviceCaps(ACanvas.Handle,LOGPIXELSX); + nPixY := GetDeviceCaps(ACanvas.Handle,LOGPIXELSY); + //Convert to device units + pnWidth := MulDiv(hmWidth, nPixX, HIMETRIC_INCH); + pnHeight := MulDiv(hmHeight, nPixY, HIMETRIC_INCH); + + //gpPicture.Render(ACanvas.Handle,Rect.Left,Rect.Top + pnHeight,pnWidth,-pnHeight,0,0, + // hmWidth,hmHeight, Rect); + gpPicture.Render(ACanvas.Handle,Rect.Left,Rect.Top, + pnWidth,pnHeight,0,hmHeight, hmWidth,-hmHeight, Rect); + end; + +end; + +function THTMLPicture.GetEmpty: Boolean; +begin + Result := FIsEmpty; +end; + +function THTMLPicture.GetHeight: integer; +var + hmHeight:integer; +begin + if gpPicture = nil then + Result := 0 + else + begin + gpPicture.get_Height(hmHeight); + Result := MulDiv(hmHeight, FLogPixY, HIMETRIC_INCH); + end; +end; + +function THTMLPicture.GetWidth: Integer; +var + hmWidth: Integer; +begin + if gpPicture = nil then + Result := 0 + else + begin + gpPicture.get_Width(hmWidth); + Result := MulDiv(hmWidth, FLogPixX, HIMETRIC_INCH); + end; +end; + +procedure THTMLPicture.LoadFromFile(const FileName: string); +begin + try + FDataStream.LoadFromFile(Filename); + FIsEmpty:=false; + LoadPicture; + if Assigned(OnChange) then + OnChange(self); + except + FIsEmpty:=true; + end; +end; + +procedure THTMLPicture.LoadFromStream(Stream: TStream); +begin + if Assigned(Stream) then + begin + FDataStream.LoadFromStream(Stream); + FIsEmpty := False; + LoadPicture; + if Assigned(OnChange) then + OnChange(self); + end; +end; + +procedure THTMLPicture.ReadData(Stream: TStream); +begin + + if assigned(Stream) then + begin + fDataStream.LoadFromStream(stream); + fIsEmpty:=false; + LoadPicture; + end; +end; + +procedure THTMLPicture.SaveToStream(Stream: TStream); +begin + if Assigned(Stream) then fDataStream.SaveToStream(Stream); +end; + +procedure THTMLPicture.LoadFromResourceName(Instance: THandle; const ResName: string); +var + Stream: TCustomMemoryStream; +begin + {$IFNDEF TMSDOTNET} + if FindResource(Instance,pchar(ResName),RT_RCDATA)<>0 then + {$ENDIF} + {$IFDEF TMSDOTNET} + if FindResource(Instance,ResName,RT_RCDATA)<>0 then + {$ENDIF} + begin + Stream := TResourceStream.Create(Instance, ResName, RT_RCDATA); + try + LoadFromStream(Stream); + finally + Stream.Free; + end; + end; +end; + +procedure THTMLPicture.LoadFromResourceID(Instance: THandle; ResID: Integer); +var + Stream: TCustomMemoryStream; +begin + Stream := TResourceStream.CreateFromID(Instance, ResID, RT_RCDATA); + try + LoadFromStream(Stream); + finally + Stream.Free; + end; +end; + + +procedure THTMLPicture.SetHeight(Value: integer); +begin + +end; + +procedure THTMLPicture.SetWidth(Value: integer); +begin + +end; + +procedure THTMLPicture.WriteData(Stream: TStream); +begin + if Assigned(Stream) then + begin + FDataStream.savetostream(stream); + end; +end; + +procedure THTMLPicture.LoadFromURL(url: string); +var + UUrl: string; +begin + UUrl := UpperCase(url); + + if Pos('RES://',UUrl) = 1 then + begin + ID := url; + Delete(url,1,6); + if url <> '' then + LoadFromResourceName(hinstance,url); + Exit; + end; + + if Pos('FILE://',Uurl) = 1 then + begin + ID := url; + Delete(url,1,7); + if url <> '' then + LoadFromFile(url); + Exit; + end; + + if FAsynch then + begin + if FThreadBusy then + Exit; + FURL := url; + FThreadBusy := True; + TDownLoadThread.Create(self); + end + else + begin + FURL := url; + ID := url; + {$IFDEF USEWININET} + DownLoad; + {$ENDIF} + end; +end; + +{$IFDEF USEWININET} +procedure THTMLPicture.DownLoad; +var + RBSIZE:dword; + httpstatus,httpsize,err:integer; + dwIdx:dword; + dwBufSize:dword; + ms:TMemoryStream; + len:dword; + cbuf:array[0..255] of char; + rb:array[0..4095] of byte; + + FISession:hinternet; + FIHttp:hinternet; + Cancel:boolean; + +begin + fISession:=InternetOpen('HTMLImage',INTERNET_OPEN_TYPE_PRECONFIG,nil,nil,0); + if (fISession=nil) then + begin + DownLoadError('Cannot open internet session'); + fThreadBusy:=false; + Exit; + end; + + fIHttp:=InternetOpenURL(fISession,pchar(furl),nil,0, + INTERNET_FLAG_PRAGMA_NOCACHE or INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_RELOAD,0); + + if (fIHttp=nil) then + begin + InternetCloseHandle(fISession); + DownLoadError('Cannot open http connection'); + fThreadBusy:=false; + Exit; + end; + + dwBufSize := SizeOf(cbuf); + dwidx := 0; + HttpQueryInfo(fIHttp,HTTP_QUERY_STATUS_CODE,@cbuf,dwBufSize,dwIdx); + + val(cbuf,httpstatus,err); + if (httpstatus <> 200) or (err <> 0) then + begin + InternetCloseHandle(fISession); + InternetCloseHandle(fIHttp); + DownLoadError('Cannot open URL '+furl); + FThreadBusy:=false; + Exit; + end; + + dwBufSize := SizeOf(cbuf); + dwidx := 0; + HttpQueryInfo(fIHttp,HTTP_QUERY_CONTENT_TYPE,@cbuf,dwBufSize,dwIdx); + + if Pos('IMAGE',UpperCase(StrPas(cbuf))) = 0 then + begin + InternetCloseHandle(fISession); + InternetCloseHandle(fIHttp); + DownLoadError('Resource is not of image type : ' + FUrl); + fThreadBusy := false; + Exit; + end; + + dwBufSize := SizeOf(cbuf); + dwidx := 0; + HttpQueryInfo(fIHttp,HTTP_QUERY_CONTENT_LENGTH,@cbuf,dwBufSize,dwIdx); + + val(cbuf,httpsize,err); + if (httpsize = 0) or (err <> 0) then + begin + InternetCloseHandle(fISession); + InternetCloseHandle(fIHttp); + DownLoadError('Image size is 0'); + fThreadBusy:=false; + Exit; + end; + + DownLoadProgress(0,httpsize); + + len := 4096; + RBSIZE := 4096; + + ms := TMemoryStream.Create; + + cancel:=false; + + while (len=RBSIZE) and not Cancel do + begin + InternetReadFile(fIHttp,@rb,RBSIZE,len); + if len>0 then ms.WriteBuffer(rb,len); + DownLoadProgress(ms.Size,httpsize); + DownLoadCancel(cancel); + end; + + if not cancel then + begin + ms.Position := 0; + LoadFromStream(ms); + end; + + ms.Free; + + InternetCloseHandle(fIHttp); + InternetCloseHandle(fISession); + FThreadBusy:=false; +end; +{$ENDIF} + +procedure THTMLPicture.DownLoadCancel(var cancel: boolean); +begin + if assigned(FOnDownLoadCancel) then + FOnDownLoadCancel(self,cancel); +end; + +procedure THTMLPicture.DownLoadComplete; +begin + if Assigned(FOnDownLoadComplete) then + FOnDownLoadComplete(self); +end; + +procedure THTMLPicture.DownLoadError(err: string); +begin + if Assigned(fOnDownloadError) then + FOnDownLoadError(self,err); +end; + +procedure THTMLPicture.DownLoadProgress(dwSize, dwTotSize: dword); +begin + if Assigned(FOnDownLoadProgress) then + FOnDownLoadProgress(self,dwSize,dwTotSize); +end; + + +procedure THTMLPicture.LoadFromClipboardFormat(AFormat: Word; + AData: THandle; APalette: HPALETTE); +begin +end; + +procedure THTMLPicture.SaveToClipboardFormat(var AFormat: Word; + var AData: THandle; var APalette: HPALETTE); +begin +end; + +function THTMLPicture.GetFrameCount: Integer; +var + i: Integer; + b,c,d,e: Byte; + Res: Integer; +begin + Result := -1; + + if FFrameCount <> -1 then + Result := FFrameCount + else + if IsGIFFile then + begin + Res := 0; + for i := 1 to FDataStream.Size do + begin + FDataStream.Position := i - 1; + FDataStream.Read(b,1); + if (b = $21) and (i + 8 < FDataStream.Size) then + begin + FDataStream.Read(c,1); + FDataStream.Read(d,1); + FDataStream.Position := FDataStream.Position+5; + FDataStream.Read(e,1); + if (c = $F9) and (d = $4) and (e = $2C) then Inc(res); + end; + end; + FFrameCount := Res; + Result := Res; + FDataStream.Position := 0; + end; +end; + +function THTMLPicture.IsGIFFile: Boolean; +var + buf: array[0..4] of char; +begin + Result := False; + if FDataStream.Size>4 then + begin + FDataStream.Position := 0; + {$IFNDEF TMSDOTNET} + FDataStream.Read(buf,4); + buf[4] := #0; + Result := Strpas(buf) = 'GIF8'; + {$ENDIF} + FDataStream.Position := 0; + + end; +end; + +function THTMLPicture.GetFrameTime(i: Integer): Integer; +var + j: Integer; + b,c,d,e: Byte; + res: Integer; + ft: Word; + +begin + Result := -1; + + if IsGIFFile then + begin + Res := 0; + for j := 1 to FDataStream.Size do + begin + FDataStream.Position := j-1; + FDataStream.Read(b,1); + if (b = $21) and (i + 8 < FDataStream.Size) then + begin + FDataStream.Read(c,1); + FDataStream.Read(d,1); + FDataStream.Read(b,1); + {transp. flag here} + + FDataStream.Read(ft,2); + FDataStream.Position := FDataStream.Position + 2; + + FDataStream.Read(e,1); + if (c = $F9) and (d = $4) and (e = $2C) then + begin + Inc(res); + if res = i then + begin + Result := ft; + FFrameTransp := b and $01=$01; + FFrameDisposal := (b shr 3) and $7; + end; + end; + end; + end; + end; + FDataStream.Position := 0; +end; + +function THTMLPicture.GetMaxHeight: Integer; +var + hmHeight: Integer; +begin + {$IFNDEF TMSDOTNET} + if gpPicture = nil then + Result := 0 + else + begin + if FAnimMaxY>0 then Result:=FAnimMaxY + else + begin + gpPicture.get_Height(hmHeight); + Result := MulDiv(hmHeight, fLogPixY, HIMETRIC_INCH); + end; + end; + {$ENDIF} +end; + +function THTMLPicture.GetMaxWidth: Integer; +var + hmWidth: Integer; +begin + if gpPicture = nil then + Result := 0 + else + begin + if FAnimMaxX > 0 then + Result := FAnimMaxX + else + begin + gpPicture.get_Width(hmWidth); + Result := MulDiv(hmWidth, fLogPixX, HIMETRIC_INCH); + end; + end; +end; + + +procedure THTMLPicture.SetFrame(const Value: Integer); +begin + FFrame := Value; + if FDataStream.Size > 0 then + begin + LoadPicture; + if Assigned(OnFrameChange) then + OnFrameChange(self); + end; +end; + +procedure THTMLPicture.FrameNext; +begin + if FFrame < FFrameCount then + Inc(FFrame) + else + FFrame := 1; +end; + +function THTMLPicture.Step: Boolean; +begin + Result := False; + if (FFrameCount <= 1) or FIsEmpty then + Exit; + + if FNextCount = -1 then + FrameTime[FFrame]; + + if FTimerCount*10 >= FNextCount then + begin + FrameNext; + LoadPicture; + FNextCount := FNextCount + FrameTime[FFrame]; + Result := True; + end; + + Inc(FTimerCount); +end; + +procedure THTMLPicture.FramePrev; +begin + if FFrame > 1 then + Dec(FFrame) + else + FFrame := FFrameCount; +end; + +function THTMLPicture.GetStretched: boolean; +begin + Result := FStretched; +end; + +procedure THTMLPicture.SetStretched(const Value: boolean); +begin + FStretched := Value; +end; + +{ THTMLImage } + +constructor THTMLImage.Create(aOwner: TComponent); +begin + inherited; + fHTMLPicture:=THTMLPicture.Create; + fHTMLPicture.OnChange:=PictureChanged; + Width:=100; + Height:=100; + fHTMLPicture.OnDownLoadError:=DownLoadError; + fHTMLPicture.OnDownLoadCancel:=DownLoadCancel; + fHTMLPicture.OnDownLoadProgress:=DownLoadProgress; + fHTMLPicture.OnDownLoadComplete:=DownLoadComplete; +end; + +destructor THTMLImage.Destroy; +begin + fHTMLPicture.Free; + inherited; +end; + +procedure THTMLImage.Loaded; +begin + inherited; + fHTMLPicture.fLogPixX := GetDeviceCaps(canvas.handle,LOGPIXELSX); + fHTMLPicture.fLogPixY := GetDeviceCaps(canvas.handle,LOGPIXELSY); +end; + +procedure THTMLImage.Paint; +var + xo,yo:integer; + + function Max(a,b:integer):integer; + begin + if (a>b) then result:=a else result:=b; + end; + +begin + inherited; + if assigned(fHTMLPicture) then + begin + if not fHTMLPicture.Empty then + case fPicturePosition of + bpTopLeft:Canvas.Draw(0,0,fHTMLPicture); + bpTopRight:Canvas.Draw(Max(0,width-fHTMLPicture.Width),0,fHTMLPicture); + bpBottomLeft:Canvas.Draw(0,Max(0,height-fHTMLPicture.Height),fHTMLPicture); + bpBottomRight:Canvas.Draw(Max(0,width-fHTMLPicture.Width),Max(0,height-fHTMLPicture.Height),fHTMLPicture); + bpCenter:Canvas.Draw(Max(0,width-fHTMLPicture.Width) shr 1,Max(0,height-fHTMLPicture.Height) shr 1,fHTMLPicture); + bpTiled:begin + yo:=0; + while (yo Value) then + begin + fPicturePosition := Value; + Invalidate; + end; +end; + +procedure THTMLImage.DownLoadCancel(Sender: TObject; var cancel: boolean); +begin + if assigned(fOnDownLoadCancel) then fOnDownLoadCancel(self,cancel); +end; + +procedure THTMLImage.DownLoadComplete(Sender: TObject); +begin + if assigned(fOnDownLoadComplete) then fOnDownLoadComplete(self); +end; + +procedure THTMLImage.DownLoadError(Sender: TObject; err: string); +begin + if Assigned(FOnDownloadError) then + FOnDownLoadError(self,err); +end; + +procedure THTMLImage.DownLoadProgress(Sender: TObject; dwSize, + dwTotSize: dword); +begin + if Assigned(FOnDownLoadProgress) then + FOnDownLoadProgress(self,dwSize,dwTotSize); +end; + +{ TDownLoadThread } + +constructor TDownLoadThread.Create(aHTMLPicture: THTMLPicture); +begin + inherited Create(false); + HTMLPicture := aHTMLPicture; + FreeOnTerminate := True; +end; + +procedure TDownLoadThread.Execute; +begin + {$IFDEF USEWININET} + HTMLPicture.DownLoad; + {$ENDIF} +end; + +{ THTMLPictureCache } + +destructor THTMLPictureCache.Destroy; +begin + ClearPictures; + inherited; +end; + +function THTMLPictureCache.AddPicture: THTMLPicture; +begin + Result := THTMLPicture.Create; + {$IFNDEF TMSDOTNET} + Add(pointer(result)); + {$ENDIF} + {$IFDEF TMSDOTNET} + Add(TObject(Result)); + {$ENDIF} +end; + +procedure THTMLPictureCache.ClearPictures; +var + i: Integer; +begin + for i := 1 to Count do + Items[i - 1].Free; + + Clear; + //inherited; +end; + +function THTMLPictureCache.FindPicture(ID: string): THTMLPicture; +var + i: Integer; +begin + Result := nil; + for i := 1 to Count do + begin + if (Items[i - 1].ID = ID) then + begin + Result := Items[i - 1]; + Break; + end; + end; +end; + +function THTMLPictureCache.GetPicture(Index: Integer): THTMLPicture; +begin + Result := THTMLPicture(inherited Items[Index]); +end; + +procedure THTMLPictureCache.SetPicture(Index: Integer; Value: THTMLPicture); +begin + {$IFNDEF TMSDOTNET} + inherited Items[index] := Pointer(Value); + {$ENDIF} + {$IFDEF TMSDOTNET} + inherited Items[index] := Value; + {$ENDIF} +end; + +function THTMLPictureCache.Animate: Boolean; +var + i: Integer; +begin + Result := False; + for i := 1 to Count do + begin + if Items[i - 1].Step then + Result := True; + end; +end;