Archivado/Componentes.Terceros.TMSSoftware
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.TMSSoftware@15 ccf39c52-e665-a648-be6a-52d81bcb5567

Browse Source
This commit is contained in:
David Arranz 2009-06-29 15:42:26 +00:00
parent c762b5fe15
commit 89f731e463
39 changed files with 10636 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvInputTaskDialogDemo.dpr Normal file
View File

@ -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.

113
TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvInputTaskDialogDemo.dproj Normal file
View File

@ -0,0 +1,113 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{40ed30c4-44b3-4d9c-8bf7-596b00214c5a}</ProjectGuid>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
<DCC_DependencyCheckOutputName>AdvInputTaskDialogDemo.exe</DCC_DependencyCheckOutputName>
<MainSource>AdvInputTaskDialogDemo.dpr</MainSource>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<Version>7.0</Version>
<DCC_DebugInformation>False</DCC_DebugInformation>
<DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_Define>RELEASE</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<Version>7.0</Version>
<DCC_Define>DEBUG</DCC_Define>
</PropertyGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality</Borland.Personality>
<Borland.ProjectType />
<BorlandProject>
<BorlandProject xmlns=""> <Delphi.Personality> <Parameters>
<Parameters Name="UseLauncher">False</Parameters>
<Parameters Name="LoadAllSymbols">True</Parameters>
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
</Parameters>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">0</VersionInfo>
<VersionInfo Name="Build">0</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo>
<VersionInfo Name="Private">False</VersionInfo>
<VersionInfo Name="DLL">False</VersionInfo>
<VersionInfo Name="Locale">1033</VersionInfo>
<VersionInfo Name="CodePage">1252</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName"></VersionInfoKeys>
<VersionInfoKeys Name="FileDescription"></VersionInfoKeys>
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="InternalName"></VersionInfoKeys>
<VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys>
<VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
<VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys>
<VersionInfoKeys Name="ProductName"></VersionInfoKeys>
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments"></VersionInfoKeys>
</VersionInfoKeys>
<Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dclofficexp100.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dcloffice2k100.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\bcboffice2k100.bpl">CodeGear C++Builder Office 2000 Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\bcbofficexp100.bpl">CodeGear C++Builder Office XP Servers Package</Excluded_Packages>
</Excluded_Packages>
<Source>
<Source Name="MainSource">AdvInputTaskDialogDemo.dpr</Source>
</Source>
</Delphi.Personality> </BorlandProject></BorlandProject>
</ProjectExtensions>
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
<ItemGroup>
<DelphiCompile Include="AdvInputTaskDialogDemo.dpr">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="UAdvInputTaskDialogDemo.pas">
<Form>Form1</Form>
</DCCReference>
</ItemGroup>
</Project>

BIN
TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvInputTaskDialogDemo.res Normal file
View File

Binary file not shown.

14
TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvMsgBoxExplorer.dpr Normal file
View File

@ -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.

41
TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvMsgBoxExplorer.dproj Normal file
View File

@ -0,0 +1,41 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{3be14241-b500-4048-b206-8a73172c37f9}</ProjectGuid>
<MainSource>AdvMsgBoxExplorer.dpr</MainSource>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
<DCC_DependencyCheckOutputName>AdvMsgBoxExplorer.exe</DCC_DependencyCheckOutputName>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<Version>7.0</Version>
<DCC_DebugInformation>False</DCC_DebugInformation>
<DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_Define>RELEASE</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<Version>7.0</Version>
<DCC_Define>DEBUG</DCC_Define>
</PropertyGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality</Borland.Personality>
<Borland.ProjectType>VCLApplication</Borland.ProjectType>
<BorlandProject>
<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><VersionInfo><VersionInfo Name="IncludeVerInfo">False</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">0</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">1033</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName"></VersionInfoKeys><VersionInfoKeys Name="FileDescription"></VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dclofficexp100.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dcloffice2k100.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\bcboffice2k100.bpl">CodeGear C++Builder Office 2000 Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\bcbofficexp100.bpl">CodeGear C++Builder Office XP Servers Package</Excluded_Packages>
</Excluded_Packages><Source><Source Name="MainSource">AdvMsgBoxExplorer.dpr</Source></Source></Delphi.Personality></BorlandProject></BorlandProject>
</ProjectExtensions>
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
<ItemGroup>
<DelphiCompile Include="AdvMsgBoxExplorer.dpr">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="Unit1.pas">
<Form>Form1</Form>
</DCCReference>
</ItemGroup>
</Project>

BIN
TAdvTaskDialog/internal/1.5.1.6/1/Demo/AdvMsgBoxExplorer.res Normal file
View File

Binary file not shown.

14
TAdvTaskDialog/internal/1.5.1.6/1/Demo/TaskDialogExplorer.dpr Normal file
View File

@ -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.

41
TAdvTaskDialog/internal/1.5.1.6/1/Demo/TaskDialogExplorer.dproj Normal file
View File

@ -0,0 +1,41 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{15a8d16e-1063-4b59-8cb3-07496f176779}</ProjectGuid>
<MainSource>TaskDialogExplorer.dpr</MainSource>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
<DCC_DependencyCheckOutputName>TaskDialogExplorer.exe</DCC_DependencyCheckOutputName>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<Version>7.0</Version>
<DCC_DebugInformation>False</DCC_DebugInformation>
<DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_Define>RELEASE</DCC_Define>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<Version>7.0</Version>
<DCC_Define>DEBUG</DCC_Define>
</PropertyGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality</Borland.Personality>
<Borland.ProjectType>VCLApplication</Borland.ProjectType>
<BorlandProject>
<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><VersionInfo><VersionInfo Name="IncludeVerInfo">False</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">0</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">1033</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName"></VersionInfoKeys><VersionInfoKeys Name="FileDescription"></VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dclofficexp100.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dcloffice2k100.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\bcboffice2k100.bpl">CodeGear C++Builder Office 2000 Servers Package</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\bcbofficexp100.bpl">CodeGear C++Builder Office XP Servers Package</Excluded_Packages>
</Excluded_Packages><Source><Source Name="MainSource">TaskDialogExplorer.dpr</Source></Source></Delphi.Personality></BorlandProject></BorlandProject>
</ProjectExtensions>
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
<ItemGroup>
<DelphiCompile Include="TaskDialogExplorer.dpr">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="fmMain.pas">
<Form>MainForm</Form>
</DCCReference>
</ItemGroup>
</Project>

BIN
TAdvTaskDialog/internal/1.5.1.6/1/Demo/TaskDialogExplorer.res Normal file
View File

Binary file not shown.

100
TAdvTaskDialog/internal/1.5.1.6/1/Demo/UAdvInputTaskDialogDemo.dfm Normal file
View File

@ -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

69
TAdvTaskDialog/internal/1.5.1.6/1/Demo/UAdvInputTaskDialogDemo.pas Normal file
View File

@ -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.

130
TAdvTaskDialog/internal/1.5.1.6/1/Demo/Unit1.dfm Normal file
View File

@ -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

125
TAdvTaskDialog/internal/1.5.1.6/1/Demo/Unit1.pas Normal file
View File

@ -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.

310
TAdvTaskDialog/internal/1.5.1.6/1/Demo/fmMain.dfm Normal file
View File

@ -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

293
TAdvTaskDialog/internal/1.5.1.6/1/Demo/fmMain.pas Normal file
View File

@ -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.

BIN
TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/PictureContainer.dcu Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/SpanishConsts.dcu Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/SpanishContst.dcu Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialog.dcu Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialog.res Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialogDE.dcu Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialogPkg.bpl Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialogPkg.dcp Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialogPkg.dcu Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.1.6/1/Lib/D12/TaskDialogRegDE.dcu Normal file
View File

Binary file not shown.

22
TAdvTaskDialog/internal/1.5.1.6/1/Source/SpanishConsts.pas Normal file
View File

@ -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.

4814
TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialog.pas Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialog.res Normal file
View File

Binary file not shown.

84
TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogDE.pas Normal file
View File

@ -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.

300
TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogEx.pas Normal file
View File

@ -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.

40
TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogPkg.dpk Normal file
View File

@ -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.

91
TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogPkg.dproj Normal file
View File

@ -0,0 +1,91 @@
 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{322e4f51-9fd5-43be-8659-42e8edcc60b1}</ProjectGuid>
<MainSource>TaskDialogPkg.dpk</MainSource>
<Configuration Condition=" '$(Configuration)' == '' ">Release</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
<DCC_DependencyCheckOutputName>..\Lib\D11\TaskDialogPkgD2007.bpl</DCC_DependencyCheckOutputName>
<ProjectVersion>12.0</ProjectVersion>
<Config Condition="'$(Config)'==''">Base</Config>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_DependencyCheckOutputName>..\Lib\D12\TaskDialogPkg.bpl</DCC_DependencyCheckOutputName>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DesignOnlyPackage>false</DesignOnlyPackage>
<DCC_BplOutput>..\Lib\D12</DCC_BplOutput>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Description>TMS TaskDialog</DCC_Description>
<DCC_DebugInformation>false</DCC_DebugInformation>
<DCC_OutputNeverBuildDcps>true</DCC_OutputNeverBuildDcps>
<DCC_DcpOutput>..\Lib\D12</DCC_DcpOutput>
<GenDll>true</GenDll>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<GenPackage>true</GenPackage>
<DCC_DcuOutput>..\Lib\D12</DCC_DcuOutput>
</PropertyGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType>Package</Borland.ProjectType>
<BorlandProject>
<Delphi.Personality>
<Parameters>
<Parameters Name="UseLauncher">False</Parameters>
<Parameters Name="LoadAllSymbols">True</Parameters>
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
</Parameters>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">True</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">0</VersionInfo>
<VersionInfo Name="Build">0</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo>
<VersionInfo Name="Private">False</VersionInfo>
<VersionInfo Name="DLL">False</VersionInfo>
<VersionInfo Name="Locale">2067</VersionInfo>
<VersionInfo Name="CodePage">1252</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName"/>
<VersionInfoKeys Name="FileDescription"/>
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="InternalName"/>
<VersionInfoKeys Name="LegalCopyright"/>
<VersionInfoKeys Name="LegalTrademarks"/>
<VersionInfoKeys Name="OriginalFilename"/>
<VersionInfoKeys Name="ProductName"/>
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments"/>
</VersionInfoKeys>
<Source>
<Source Name="MainSource">TaskDialogPkg.dpk</Source>
</Source>
</Delphi.Personality>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<ItemGroup>
<DelphiCompile Include="TaskDialogPkg.dpk">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="rtl.dcp"/>
<DCCReference Include="vcl.dcp"/>
<DCCReference Include="designide.dcp"/>
<DCCReference Include="TaskDialogRegDE.pas"/>
<DCCReference Include="TaskDialog.pas"/>
<DCCReference Include="TaskDialogDE.pas"/>
<DCCReference Include="picturecontainer.pas"/>
<DCCReference Include="SpanishConsts.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
</ItemGroup>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
</Project>

BIN
TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogPkg.res Normal file
View File

Binary file not shown.

49
TAdvTaskDialog/internal/1.5.1.6/1/Source/TaskDialogRegDE.pas Normal file
View File

@ -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.

2353
TAdvTaskDialog/internal/1.5.1.6/1/Source/htmlengo.pas Normal file
View File

File diff suppressed because it is too large Load Diff

241
TAdvTaskDialog/internal/1.5.1.6/1/Source/picturecontainer.pas Normal file
View File

@ -0,0 +1,241 @@
{**************************************************************************}
{ TPictureContainer component }
{ for Delphi & C++Builder }
{ version 1.0 }
{ }
{ Copyright © 2001 - 2005 }
{ TMS Software }
{ 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 PictureContainer;
{$I TMSDEFS.INC}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComObj, ActiveX
{$IFDEF USEWININET}
, WinInet
{$ENDIF}
{$IFDEF TMSDOTNET}
, System.Runtime.InteropServices
{$ENDIF}
;
const
MAJ_VER = 1; // Major version nr.
MIN_VER = 0; // Minor version nr.
REL_VER = 0; // Release nr.
BLD_VER = 0; // Build nr.
type
{$I WIIF.PAS}
TPictureItem = class(TCollectionItem)
private
FPicture: THTMLPicture;
FTag: Integer;
FName: string;
procedure SetPicture(const Value: THTMLPicture);
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
published
property Picture: THTMLPicture read FPicture write SetPicture;
property Name: string read FName write FName;
property Tag: Integer read FTag write FTag;
end;
TPictureCollection = class(TCollection)
private
FOwner: TComponent;
function GetItem(Index: Integer): TPictureItem;
procedure SetItem(Index: Integer; Value: TPictureItem);
protected
function GetOwner: TPersistent; override;
public
constructor Create(AOwner:TComponent);
function Add: TPictureItem;
function Insert(index:integer): TPictureItem;
property Items[Index: Integer]: TPictureItem read GetItem write SetItem; default;
function Animate:Boolean;
end;
TPictureContainer = class(TComponent)
private
FItems: TPictureCollection;
procedure SetItems(const Value: TPictureCollection);
function GetVersion: string;
procedure SetVersion(const Value: string);
function GetVersionNr: Integer;
{ Private declarations }
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function FindPicture(s:string): THTMLPicture; virtual;
published
{ Published declarations }
property Items: TPictureCollection read FItems write SetItems;
property Version: string read GetVersion write SetVersion;
end;
implementation
{$IFDEF TMSDOTNET}
uses
Types, WinUtils;
{$ENDIF}
{$I WIIMPL.PAS}
{ TPictureItem }
procedure TPictureItem.Assign(Source: TPersistent);
begin
Name := (Source as TPictureItem).Name;
Tag := (Source as TPictureItem).Tag;
Picture.Assign((Source as TPictureItem).Picture)
end;
constructor TPictureItem.Create(Collection: TCollection);
begin
inherited;
FPicture := THTMLPicture.Create;
end;
destructor TPictureItem.Destroy;
begin
FPicture.Free;
inherited;
end;
procedure TPictureItem.SetPicture(const Value: THTMLPicture);
begin
FPicture.Assign(Value);
end;
{ TPictureCollection }
function TPictureCollection.Add: TPictureItem;
begin
Result := TPictureItem(inherited Add);
end;
function TPictureCollection.Animate: Boolean;
var
i: Integer;
begin
Result := False;
for i := 1 to Count do
begin
if Items[i - 1].Picture.Step then
Result := True;
end;
end;
constructor TPictureCollection.Create(AOwner: TComponent);
begin
inherited Create(TPictureItem);
FOwner := AOwner;
end;
function TPictureCollection.GetItem(Index: Integer): TPictureItem;
begin
Result := TPictureItem(inherited Items[Index]);
end;
function TPictureCollection.GetOwner: TPersistent;
begin
Result := FOwner;
end;
function TPictureCollection.Insert(index: Integer): TPictureItem;
begin
{$IFDEF DELPHI4_LVL}
Result := TPictureItem(inherited Insert(Index));
{$ELSE}
Result := TPictureItem(inherited Add);
{$ENDIF}
end;
procedure TPictureCollection.SetItem(Index: Integer;
Value: TPictureItem);
begin
inherited SetItem(Index, Value);
end;
{ TPictureContainer }
constructor TPictureContainer.Create(AOwner: TComponent);
begin
inherited;
FItems := TPictureCollection.Create(Self);
end;
destructor TPictureContainer.Destroy;
begin
FItems.Free;
inherited;
end;
function TPictureContainer.FindPicture(s: string): THTMLPicture;
var
i: Integer;
begin
Result := nil;
s := Uppercase(s);
i := 1;
while i <= Items.Count do
begin
if Uppercase(Items.Items[i - 1].Name) = s then
begin
Result := Items.Items[i - 1].Picture;
Break;
end;
Inc(i);
end;
end;
procedure TPictureContainer.SetItems(const Value: TPictureCollection);
begin
FItems := Value;
end;
function TPictureContainer.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 TPictureContainer.GetVersionNr: Integer;
begin
Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER));
end;
procedure TPictureContainer.SetVersion(const Value: string);
begin
end;
end.

214
TAdvTaskDialog/internal/1.5.1.6/1/Source/tmsdefs.inc Normal file
View File

@ -0,0 +1,214 @@
{$J+}
{$R-}
{$B-}
{$C+}
{$DEFINE TMSNOADO}
{$DEFINE TMSPACK}
{$DEFINE TMSTOOLBAR}
{$IFDEF LINUX}
{$DEFINE TMSCLX}
{$ENDIF}
{$IFDEF VER90}
{$DEFINE DELPHI2_LVL}
{$DEFINE ISDELPHI}
{$ENDIF}
{$IFDEF VER93}
{$DEFINE DELPHI2_LVL}
{$ENDIF}
{$IFDEF VER100}
{$DEFINE DELPHI2_LVL}
{$DEFINE DELPHI3_LVL}
{$DEFINE ISDELPHI}
{$ENDIF}
{$IFDEF VER110}
{$DEFINE DELPHI2_LVL}
{$DEFINE DELPHI3_LVL}
{$ENDIF}
{$IFDEF VER120}
{$DEFINE DELPHI2_LVL}
{$DEFINE DELPHI3_LVL}
{$DEFINE DELPHI4_LVL}
{$DEFINE ISDELPHI}
{$ENDIF}
{$IFDEF VER125}
{$DEFINE DELPHI2_LVL}
{$DEFINE DELPHI3_LVL}
{$DEFINE DELPHI4_LVL}
{$ENDIF}
{$IFDEF VER130}
{$DEFINE DELPHI2_LVL}
{$DEFINE DELPHI3_LVL}
{$DEFINE DELPHI4_LVL}
{$DEFINE DELPHI5_LVL}
{$ENDIF}
{$IFDEF VER140}
{$DEFINE DELPHI2_LVL}
{$DEFINE DELPHI3_LVL}
{$DEFINE DELPHI4_LVL}
{$DEFINE DELPHI5_LVL}
{$DEFINE DELPHI6_LVL}
{$IFNDEF BCB}
{$DEFINE ISDELPHI}
{$ENDIF}
{$ENDIF}
{$IFDEF VER150}
{$DEFINE DELPHI2_LVL}
{$DEFINE DELPHI3_LVL}
{$DEFINE DELPHI4_LVL}
{$DEFINE DELPHI5_LVL}
{$DEFINE DELPHI6_LVL}
{$DEFINE DELPHI7_LVL}
{$IFNDEF BCB}
{$DEFINE ISDELPHI}
{$ENDIF}
{$ENDIF}
{$IFDEF VER160}
{$DEFINE DELPHI2_LVL}
{$DEFINE DELPHI3_LVL}
{$DEFINE DELPHI4_LVL}
{$DEFINE DELPHI5_LVL}
{$DEFINE DELPHI6_LVL}
{$DEFINE DELPHI7_LVL}
{$DEFINE TMSDOTNET}
{$IFNDEF BCB}
{$DEFINE ISDELPHI}
{$ENDIF}
{$ENDIF}
{$IFDEF VER170}
{$DEFINE DELPHI2_LVL}
{$DEFINE DELPHI3_LVL}
{$DEFINE DELPHI4_LVL}
{$DEFINE DELPHI5_LVL}
{$DEFINE DELPHI6_LVL}
{$DEFINE DELPHI7_LVL}
{$DEFINE DELPHI9_LVL}
{$IFDEF CLR}
{$DEFINE TMSDOTNET}
{$ENDIF}
{$IFNDEF BCB}
{$DEFINE ISDELPHI}
{$ENDIF}
{$ENDIF}
{$IFDEF VER180}
{$DEFINE DELPHI2_LVL}
{$DEFINE DELPHI3_LVL}
{$DEFINE DELPHI4_LVL}
{$DEFINE DELPHI5_LVL}
{$DEFINE DELPHI6_LVL}
{$DEFINE DELPHI7_LVL}
{$DEFINE DELPHI9_LVL}
{$DEFINE DELPHI2006_LVL}
{$IFDEF CLR}
{$DEFINE TMSDOTNET}
{$ENDIF}
{$IFNDEF BCB}
{$DEFINE ISDELPHI}
{$ENDIF}
{$ENDIF}
{$IFDEF VER185}
{$DEFINE DELPHI2_LVL}
{$DEFINE DELPHI3_LVL}
{$DEFINE DELPHI4_LVL}
{$DEFINE DELPHI5_LVL}
{$DEFINE DELPHI6_LVL}
{$DEFINE DELPHI7_LVL}
{$DEFINE DELPHI9_LVL}
{$DEFINE DELPHI2006_LVL}
{$DEFINE DELPHI2007_LVL}
{$IFDEF CLR}
{$DEFINE TMSDOTNET}
{$ENDIF}
{$IFNDEF BCB}
{$DEFINE ISDELPHI}
{$ENDIF}
{$ENDIF}
{$IFDEF VER190}
{$DEFINE DELPHI2_LVL}
{$DEFINE DELPHI3_LVL}
{$DEFINE DELPHI4_LVL}
{$DEFINE DELPHI5_LVL}
{$DEFINE DELPHI6_LVL}
{$DEFINE DELPHI7_LVL}
{$DEFINE DELPHI9_LVL}
{$DEFINE DELPHI2006_LVL}
{$DEFINE DELPHI2007_LVL}
{$IFDEF CLR}
{$DEFINE TMSDOTNET}
{$ENDIF}
{$IFNDEF BCB}
{$DEFINE ISDELPHI}
{$ENDIF}
{$ENDIF}
{$IFDEF VER200}
{$DEFINE DELPHI2_LVL}
{$DEFINE DELPHI3_LVL}
{$DEFINE DELPHI4_LVL}
{$DEFINE DELPHI5_LVL}
{$DEFINE DELPHI6_LVL}
{$DEFINE DELPHI7_LVL}
{$DEFINE DELPHI9_LVL}
{$DEFINE DELPHI2006_LVL}
{$DEFINE DELPHI2007_LVL}
{$DEFINE DELPHI_UNICODE}
{$IFDEF CLR}
{$DEFINE TMSDOTNET}
{$ENDIF}
{$IFNDEF BCB}
{$DEFINE ISDELPHI}
{$ENDIF}
{$ENDIF}
{$IFDEF VER110}
{$ObjExportAll On}
{$ENDIF}
{$IFDEF VER125}
{$ObjExportAll On}
{$ENDIF}
{$IFDEF VER130}
{$IFDEF BCB}
{$ObjExportAll On}
{$ELSE}
{$DEFINE ISDELPHI}
{$ENDIF}
{$ENDIF}
{$IFDEF ISDELPHI}
{$IFDEF DELPHI3_LVL}
{$DEFINE DELPHI_ONLY_LVL3}
{$ENDIF}
{$ENDIF}
{$IFDEF DELPHI7_LVL}
{$WARN UNIT_PLATFORM OFF}
{$WARN SYMBOL_PLATFORM OFF}
{$ENDIF}
{$IFNDEF TMSDOTNET}
{$DEFINE TMSGDIPLUS} // comment this line to disable GDI+ use in TAdvStringGrid
{$ENDIF}
//{$DEFINE TMSDISABLEOLE} // uncomment this line to disable OLE initialization by TAdvStringGrid

257
TAdvTaskDialog/internal/1.5.1.6/1/Source/wiif.pas Normal file
View File

@ -0,0 +1,257 @@
TPicturePosition = (bpTopLeft,bpTopRight,bpBottomLeft,bpBottomRight,bpCenter,bpTiled,bpStretched);
THTMLPicture = class;
{$IFDEF TMSDOTNET}
{$EXTERNALSYM OLE_HANDLE}
OLE_HANDLE = LongWord;
{$EXTERNALSYM OLE_XPOS_PIXELS}
OLE_XPOS_PIXELS = Longint;
{$EXTERNALSYM OLE_YPOS_PIXELS}
OLE_YPOS_PIXELS = Longint;
{$EXTERNALSYM OLE_XSIZE_PIXELS}
OLE_XSIZE_PIXELS = Longint;
{$EXTERNALSYM OLE_YSIZE_PIXELS}
OLE_YSIZE_PIXELS = Longint;
{$EXTERNALSYM OLE_XPOS_HIMETRIC}
OLE_XPOS_HIMETRIC = Longint;
{$EXTERNALSYM OLE_YPOS_HIMETRIC}
OLE_YPOS_HIMETRIC = Longint;
{$EXTERNALSYM OLE_XSIZE_HIMETRIC}
OLE_XSIZE_HIMETRIC = Longint;
{$EXTERNALSYM OLE_YSIZE_HIMETRIC}
OLE_YSIZE_HIMETRIC = Longint;
{$EXTERNALSYM OLE_XPOS_CONTAINER}
OLE_XPOS_CONTAINER = Single;
{$EXTERNALSYM OLE_YPOS_CONTAINER}
OLE_YPOS_CONTAINER = Single;
{$EXTERNALSYM OLE_XSIZE_CONTAINER}
OLE_XSIZE_CONTAINER = Single;
{$EXTERNALSYM OLE_YSIZE_CONTAINER}
OLE_YSIZE_CONTAINER = Single;
[ComImport,
GuidAttribute('7BF80980-BF32-101A-8BBB-00AA00300CAB')]
// InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)]
IPicture = interface
function get_Handle(out handle: OLE_HANDLE): HResult;
function get_hPal(out handle: OLE_HANDLE): HResult;
function get_Type(out typ: Smallint): HResult;
function get_Width(out width: OLE_XSIZE_HIMETRIC): HResult;
function get_Height(out height: OLE_YSIZE_HIMETRIC): HResult;
function Render(dc: HDC; x, y, cx, cy: Longint;
xSrc: OLE_XPOS_HIMETRIC; ySrc: OLE_YPOS_HIMETRIC;
cxSrc: OLE_XSIZE_HIMETRIC; cySrc: OLE_YSIZE_HIMETRIC;
const rcWBounds: TRect): HResult;
function set_hPal(hpal: OLE_HANDLE): HResult;
function get_CurDC(out dcOut: HDC): HResult;
function SelectPicture(dcIn: HDC; out hdcOut: HDC;
out bmpOut: OLE_HANDLE): HResult;
function get_KeepOriginalFormat(out fkeep: BOOL): HResult;
function put_KeepOriginalFormat(fkeep: BOOL): HResult;
function PictureChanged: HResult;
function SaveAsFile(const stream: IStream; fSaveMemCopy: BOOL;
out cbSize: Longint): HResult;
function get_Attributes(out dwAttr: Longint): HResult;
end;
{$ENDIF}
PInternetContent = ^TInternetContent;
TInternetContent = record
{$IFDEF USEWININET}
hresource: hinternet;
{$ENDIF}
Complete: Boolean;
HTMLPicture:THTMLPicture;
end;
TDownloadErrorEvent = procedure(Sender:TObject;err:string) of object;
TDownloadCompleteEvent = procedure(Sender:TObject) of object;
TDownloadCancelEvent = procedure(Sender:TObject;var Cancel:boolean) of object;
TDownloadProgressEvent = procedure(Sender:TObject;dwSize,dwTotSize:dword) of object;
TDownLoadThread = class(TThread)
private
HTMLPicture:THTMLPicture;
protected
procedure Execute; override;
public
constructor Create(aHTMLPicture:THTMLPicture);
end;
THTMLPicture = class(TGraphic)
private
{ Private declarations }
FDatastream:TMemoryStream;
FIsEmpty: Boolean;
FStretched: Boolean;
gpPicture: IPicture;
FLogPixX,FLogPixY: Integer;
FURL:string;
FID:string;
FIsDB: Boolean;
FAsynch: Boolean;
FThreadBusy: Boolean;
FFrame: Integer;
FFrameCount: Integer;
FOnFrameChange: TNotifyEvent;
FFrameXPos: Word;
FFrameYPos: Word;
FFrameXSize: Word;
FFrameYSize: Word;
FFrameTransp: Boolean;
FFrameDisposal: Word;
FAnimMaxX,FAnimMaxY: Word;
FNextCount: Integer;
FTimerCount: Integer;
FOnDownLoadProgress: TDownLoadProgressEvent;
FOnDownLoadCancel: TDownLoadCancelEvent;
FOnDownLoadComplete: TDownLoadCompleteEvent;
FOnDownLoadError: TDownLoadErrorEvent;
procedure LoadPicture;
function GetFrameCount: Integer;
function IsGIFFile: Boolean;
function GetFrameTime(i: Integer): Integer;
protected
{ Protected declarations }
function GetEmpty: Boolean; override;
function GetHeight: integer; override;
function GetWidth: integer; override;
procedure SetHeight(Value: integer); override;
procedure SetWidth(Value: integer); override;
procedure ReadData(Stream: TStream); override;
procedure WriteData(Stream: TStream); override;
procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
procedure DownLoadError(err:string);
procedure DownLoadComplete;
procedure DownLoadCancel(var cancel:boolean);
procedure DownLoadProgress(dwSize,dwTotSize:dword);
function GetStretched: boolean;
procedure SetStretched(const Value: boolean);
{$IFDEF USEWININET}
procedure DownLoad;
{$ENDIF}
public
{ Public declarations }
constructor Create; override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure LoadFromFile(const FileName: string); override;
procedure LoadFromStream(Stream: TStream); override;
procedure SaveToStream(Stream: TStream); override;
procedure LoadFromResourceName(Instance: THandle; const ResName: String);
procedure LoadFromResourceID(Instance: THandle; ResID: Integer);
procedure LoadFromURL(url:string);
procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
APalette: HPALETTE); override;
procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
var APalette: HPALETTE); override;
property Busy: Boolean read fThreadBusy;
property Asynch: Boolean read fAsynch write fAsynch;
property ID: string read FID write FID;
property IsDB: boolean read FIsDB write FIsDB;
property IsGIF: Boolean read IsGIFFile;
property FrameCount:Integer read GetFrameCount;
property FrameTime[i:Integer]:Integer read GetFrameTime;
function GetMaxHeight: Integer;
function GetMaxWidth: Integer;
procedure SetFrame(const Value:Integer);
procedure FrameNext;
procedure FramePrev;
function Step: Boolean;
property MaxWidth: integer read GetMaxWidth;
property MaxHeight: integer read GetMaxHeight;
property FrameXPos: word read FFrameXPos;
property FrameYPos: word read FFrameYPos;
published
{ Published declarations }
property Stretch:boolean read GetStretched write SetStretched;
property Frame:Integer read FFrame write SetFrame;
property OnFrameChange: TNotifyEvent read FOnFrameChange write FOnFrameChange;
property OnDownLoadError:TDownLoadErrorEvent read fOnDownLoadError write fOnDownLoadError;
property OnDownLoadComplete:TDownLoadCompleteEvent read fOnDownLoadComplete write fOnDownLoadComplete;
property OnDownLoadCancel:TDownLoadCancelEvent read fOnDownLoadCancel write fOnDownLoadCancel;
property OnDownLoadProgress:TDownLoadProgressEvent read fOnDownLoadProgress write fOnDownLoadProgress;
end;
THTMLPictureCache = class(TList)
private
procedure SetPicture(Index: Integer; Value: THTMLPicture);
function GetPicture(Index: Integer):THTMLPicture;
public
destructor Destroy; override;
property Items[index: Integer]: THTMLPicture read GetPicture write SetPicture; default;
function AddPicture:THTMLPicture;
function FindPicture(ID:string):THTMLPicture;
procedure ClearPictures;
function Animate: boolean;
end;
THTMLImage = class(TGraphicControl)
private
{ Private declarations }
FHTMLPicture:THTMLPicture;
FPicturePosition:TPicturePosition;
FOnDownLoadCancel: TDownLoadCancelEvent;
FOnDownLoadComplete: TDownLoadCompleteEvent;
FOnDownLoadError: TDownLoadErrorEvent;
FOnDownLoadProgress: TDownLoadProgressEvent;
procedure SetHTMLPicture(const Value: THTMLPicture);
procedure PictureChanged(sender:TObject);
procedure SetPicturePosition(const Value: TPicturePosition);
procedure DownLoadError(Sender:TObject;err:string);
procedure DownLoadComplete(Sender:TObject);
procedure DownLoadCancel(Sender:TObject;var Cancel: Boolean);
procedure DownLoadProgress(Sender:TObject;dwSize,dwTotSize:dword);
protected
{ Protected declarations }
procedure Paint; override;
procedure Loaded; override;
public
{ Public declarations }
constructor Create(aOwner:TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property HTMLPicture:THTMLPicture read FHTMLPicture write SetHTMLPicture;
property PicturePosition:TPicturePosition read FPicturePosition write SetPicturePosition;
{ inherited published properties}
property Align;
{$IFDEF DELPHI4_LVL}
property Anchors;
property Constraints;
property DragKind;
{$ENDIF}
property DragCursor;
property DragMode;
property Hint;
property ParentShowHint;
property ShowHint;
property Visible;
property OnClick;
{$IFDEF DELPHI5_LVL}
property OnContextPopup;
{$ENDIF}
property OnDblClick;
property OnDragDrop;
property OnDragOver;
{$IFDEF DELPHI4_LVL}
property OnEndDock;
property OnStartDock;
{$ENDIF}
property OnEndDrag;
property OnMouseDown;
property OnMouseUp;
property OnMouseMove;
property OnStartDrag;
property OnDownLoadError:TDownLoadErrorEvent read FOnDownLoadError write FOnDownLoadError;
property OnDownLoadComplete:TDownLoadCompleteEvent read FOnDownLoadComplete write FOnDownLoadComplete;
property OnDownLoadCancel:TDownLoadCancelEvent read FOnDownLoadCancel write FOnDownLoadCancel;
property OnDownLoadProgress:TDownLoadProgressEvent read FOnDownLoadProgress write FOnDownLoadProgress;
end;

908
TAdvTaskDialog/internal/1.5.1.6/1/Source/wiimpl.pas Normal file
View File

@ -0,0 +1,908 @@
const
HIMETRIC_INCH = 2540;
{ THTMLPicture }
procedure THTMLPicture.Assign(Source: TPersistent);
begin
FIsEmpty := true;
gpPicture := nil;
FFrameCount := -1;
FNextCount := -1;
FTimerCount := -1;
Frame := 1;
if Source = nil then
FDataStream.Clear
else
begin
if (Source is THTMLPicture) then
begin
FStretched := (Source as THTMLPicture).Stretch;
FFrame := (Source as THTMLPicture).Frame;
FID := (Source as THTMLPicture).ID;
FDataStream.LoadFromStream(THTMLPicture(Source).fDataStream);
FIsEmpty := False;
LoadPicture;
if Assigned(OnChange) then
OnChange(self);
end;
end;
end;
constructor THTMLPicture.Create;
begin
inherited;
FDataStream := TMemoryStream.Create;
FIsEmpty := True;
gpPicture := nil;
FLogPixX := 96;
FLogPixY := 96;
FThreadBusy := False;
FAsynch := True;
FFrameCount := -1;
FNextCount := -1;
FTimerCount := -1;
FFrame := 1;
FIsDB := False;
end;
destructor THTMLPicture.Destroy;
begin
FDataStream.Free;
inherited;
end;
procedure THTMLPicture.LoadPicture;
{$IFNDEF TMSDOTNET}
const
IID_IPicture: TGUID = (
D1:$7BF80980;D2:$BF32;D3:$101A;D4:($8B,$BB,$00,$AA,$00,$30,$0C,$AB));
{$ENDIF}
var
hGlobal: THandle;
{$IFNDEF TMSDOTNET}
pvData: Pointer;
{$ENDIF}
{$IFDEF TMSDOTNET}
pvData: IntPtr;
{$ENDIF}
pstm: IStream;
hr: hResult;
GifStream: TMemoryStream;
i: Integer;
b,c,d,e: Byte;
skipimg: Boolean;
imgidx: Integer;
begin
{$IFNDEF TMSDOTNET}
hGlobal := GlobalAlloc(GMEM_MOVEABLE, FDataStream.Size);
if hGlobal = 0 then
raise Exception.Create('Could not allocate memory for image');
try
pvData := GlobalLock(hGlobal);
FDataStream.Position := 0;
FFrameXPos := 0;
FFrameYPos := 0;
FAnimMaxX := 0;
FAnimMaxY := 0;
{skip first image ctrl}
if IsGIF and (FrameCount > 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<Height) do
begin
xo:=0;
while (xo<Width) do
begin
Canvas.Draw(xo,yo,fHTMLPicture);
xo:=xo+fHTMLPicture.Width;
end;
yo:=yo+fHTMLPicture.Height;
end;
end;
bpStretched:canvas.StretchDraw(rect(0,0,width,height),fHTMLPicture) else
end;
end;
end;
procedure THTMLImage.PictureChanged(sender: TObject);
begin
Invalidate;
end;
procedure THTMLImage.SetHTMLPicture(const Value: THTMLPicture);
begin
FHTMLPicture.Assign(Value);
Invalidate;
end;
procedure THTMLImage.SetPicturePosition(const Value: TPicturePosition);
begin
if ( fPicturePosition <> 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;