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

Importación inicial

Browse Source 
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.TMSSoftware@8 ccf39c52-e665-a648-be6a-52d81bcb5567
This commit is contained in:
David Arranz 2008-05-30 11:49:33 +00:00
parent f0bcb68156
commit f410727ca1
52 changed files with 22743 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
TAdvTaskDialog/internal/1.5.0.2/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.0.2/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.0.2/1/Demo/AdvInputTaskDialogDemo.res Normal file
View File

Binary file not shown.

14
TAdvTaskDialog/internal/1.5.0.2/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.0.2/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.0.2/1/Demo/AdvMsgBoxExplorer.res Normal file
View File

Binary file not shown.

14
TAdvTaskDialog/internal/1.5.0.2/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.0.2/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.0.2/1/Demo/TaskDialogExplorer.res Normal file
View File

Binary file not shown.

100
TAdvTaskDialog/internal/1.5.0.2/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.0.2/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.0.2/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.0.2/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.0.2/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.0.2/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.0.2/1/Lib/D11/AdvGDIP.dcu Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.0.2/1/Lib/D11/AdvGlowButton.dcu Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.0.2/1/Lib/D11/AdvGroupBox.dcu Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.0.2/1/Lib/D11/AdvHintInfo.dcu Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.0.2/1/Lib/D11/AdvOfficeButtons.dcu Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.0.2/1/Lib/D11/AdvStyleIF.dcu Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.0.2/1/Lib/D11/GDIPicture.dcu Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.0.2/1/Lib/D11/PictureContainer.dcu Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.0.2/1/Lib/D11/TaskDialog.dcu Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.0.2/1/Lib/D11/TaskDialogDE.dcu Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.0.2/1/Lib/D11/TaskDialogEx.dcu Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.0.2/1/Lib/D11/TaskDialogPkgD2007.bpl Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.0.2/1/Lib/D11/TaskDialogPkgD2007.dcp Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.0.2/1/Lib/D11/TaskDialogPkgD2007.dcu Normal file
View File

Binary file not shown.

BIN
TAdvTaskDialog/internal/1.5.0.2/1/Lib/D11/TaskDialogRegDE.dcu Normal file
View File

Binary file not shown.

661
TAdvTaskDialog/internal/1.5.0.2/1/Source/AdvGroupBox.pas Normal file
View File

@ -0,0 +1,661 @@
{***************************************************************************}
{ TAdvGroupBox component }
{ for Delphi & C++Builder }
{ version 1.0 }
{ }
{ written by TMS Software }
{ copyright © 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 AdvGroupBox;
{$I TMSDEFS.INC}
interface
uses
Classes, Windows, Forms, Dialogs, Controls, Graphics, Messages, ExtCtrls,
SysUtils, Math, StdCtrls, ImgList;
const
MAJ_VER = 1; // Major version nr.
MIN_VER = 0; // Minor version nr.
REL_VER = 0; // Release nr.
BLD_VER = 0; // Build nr.
type
TCaptionPosition = (cpTopLeft, cpTopRight, cpTopCenter, cpBottomLeft, cpBottomRight, cpBottomCenter);
TBorderStyle = (bsNone, bsSingle, bsDouble);
TWinCtrl = class(TWinControl)
public
procedure PaintCtrls(DC: HDC; First: TControl);
end;
TAdvCustomGroupBox = class(TCustomGroupBox)
private
FTransparent: Boolean;
FBorderColor: TColor;
FImageIndex: Integer;
FImages: TCustomImageList;
FBorderStyle: TBorderStyle;
FCaptionPosition: TCaptionPosition;
FRoundEdges: Boolean;
Procedure WMEraseBkGnd( Var msg: TWMEraseBkGnd ); message WM_ERASEBKGND;
procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
procedure SetTransparent(const Value: Boolean);
procedure SetBorderColor(const Value: TColor);
procedure SetImageIndex(const Value: Integer);
procedure SetImages(const Value: TCustomImageList);
function GetVersion: string;
procedure SetVersion(const Value: string);
procedure SetBorderStyle(const Value: TBorderStyle);
procedure SetCaptionPosition(const Value: TCaptionPosition);
procedure SetRoundEdges(const Value: Boolean);
protected
procedure Loaded; override;
procedure Paint; override;
procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
procedure AdjustClientRect(var Rect: TRect); override;
procedure CreateParams(var Params: TCreateParams); override;
function GetCaptionHeight: Integer;
function GetCaptionRect: TRect;
function GetBorderWidth: Integer;
function GetBorderRect: TRect;
property CaptionPosition: TCaptionPosition read FCaptionPosition write SetCaptionPosition default cpTopLeft;
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
property Transparent: Boolean read FTransparent write SetTransparent default true;
property BorderColor: TColor read FBorderColor write SetBorderColor default clSilver;
property Images: TCustomImageList read FImages write SetImages;
property ImageIndex: Integer read FImageIndex write SetImageIndex default -1;
property Version: string read GetVersion write SetVersion stored false;
property RoundEdges: Boolean read FRoundEdges write SetRoundEdges default False;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetVersionNr: integer;
end;
TAdvGroupBox = class(TAdvCustomGroupBox)
published
property BorderColor;
property BorderStyle;
property CaptionPosition;
property Images;
property ImageIndex;
property Transparent;
property RoundEdges;
property Version;
property Align;
property Anchors;
property BiDiMode;
property Caption;
property Color;
property Constraints;
property Ctl3D default False;
property DockSite;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
{$IFDEF DELPHI7_LVL}
property ParentBackground default True;
{$ENDIF}
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D default False;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDockDrop;
property OnDockOver;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetSiteInfo;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
end;
implementation
//------------------------------------------------------------------------------
{TWinCtrl}
procedure TWinCtrl.PaintCtrls(DC: HDC; First: TControl);
begin
PaintControls(DC, First);
end;
//------------------------------------------------------------------------------
{ TAdvCustomGroupBox }
constructor TAdvCustomGroupBox.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := ControlStyle - [csOpaque];
FTransparent := True;
FImages := nil;
FImageIndex := -1;
FBorderStyle := bsSingle;
FCaptionPosition := cpTopLeft;
FRoundEdges := false;
Ctl3D := false;
ParentCtl3D := false;
FBorderColor := clSilver;
end;
//------------------------------------------------------------------------------
procedure TAdvCustomGroupBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams( params );
//params.ExStyle := params.ExStyle or WS_EX_TRANSPARENT;
end;
//------------------------------------------------------------------------------
destructor TAdvCustomGroupBox.Destroy;
begin
inherited;
end;
//------------------------------------------------------------------------------
procedure TAdvCustomGroupBox.Loaded;
begin
inherited;
end;
//------------------------------------------------------------------------------
procedure TAdvCustomGroupBox.Notification(AComponent: TComponent;
AOperation: TOperation);
begin
inherited;
if not (csDestroying in ComponentState) and (AOperation = opRemove) then
begin
if (AComponent = Images) then
begin
Images := nil;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TAdvCustomGroupBox.AdjustClientRect(var Rect: TRect);
var
R: TRect;
begin
R := Rect;
inherited AdjustClientRect(Rect);
Rect := R;
if CaptionPosition in [cpTopLeft, cpTopCenter, cpTopRight] then
begin
Inc(Rect.Top, Max(GetBorderWidth,GetCaptionHeight));
Rect := Classes.Rect(Rect.Left +GetBorderWidth, Rect.Top, Rect.Right -GetBorderWidth, Rect.Bottom-GetBorderWidth);
end
else if CaptionPosition in [cpBottomLeft, cpBottomCenter, cpBottomRight] then
begin
Dec(Rect.Bottom, Max(GetBorderWidth,GetCaptionHeight));
Rect := Classes.Rect(Rect.Left +GetBorderWidth, Rect.Top + GetBorderWidth, Rect.Right -GetBorderWidth, Rect.Bottom);
end;
InflateRect(Rect, -1, -1);
end;
//------------------------------------------------------------------------------
procedure TAdvCustomGroupBox.Paint;
var
R, CapR: TRect;
i, rt: Integer;
P: TPoint;
bmp: TBitmap;
begin
if Transparent then
begin
i := SaveDC(Canvas.Handle);
p := ClientOrigin;
Windows.ScreenToClient(Parent.Handle, p);
p.x := -p.x;
p.y := -p.y;
MoveWindowOrg(Canvas.Handle, p.x, p.y);
SendMessage(Parent.Handle, WM_ERASEBKGND, Canvas.Handle, 0);
// transparency ?
SendMessage(Parent.Handle, WM_PAINT, Canvas.Handle, 0);
if (Parent is TWinCtrl) then
(Parent as TWinCtrl).PaintCtrls(Canvas.Handle, nil);
RestoreDC(Canvas.Handle, i);
end;
R := ClientRect;
CapR := GetCaptionRect;
bmp := TBitmap.Create;
bmp.Height := (CapR.Bottom - CapR.Top);
bmp.Width := (CapR.Right - CapR.Left) + 2;
i := CapR.Left;
rt := 6;
//--- Draw Image
if Assigned(Images) and (ImageIndex >= 0) then
begin
Images.Draw(Canvas, CapR.Left, CapR.Top, ImageIndex, Enabled);
i := CapR.Left + Images.Width + 3;
end;
Canvas.Brush.Style := bsClear;
//--- Draw Caption
if (Caption <> '') then
begin
Canvas.Font.Assign(Self.Font);
R := Rect(i, CapR.Top, CapR.Right, CapR.Bottom);
DrawText(Canvas.Handle,PChar(Caption),Length(Caption), R, DT_SINGLELINE or DT_LEFT or DT_VCENTER);
end;
bmp.Canvas.CopyRect(Rect(0, 0, bmp.Width, bmp.Height), Canvas, Rect(CapR.Left-1, CapR.Top, CapR.Right+1, CapR.Bottom));
R := GetBorderRect;
//--- Draw Borders
case BorderStyle of
bsSingle:
begin
if Ctl3D then
begin
Canvas.Brush.Style := bsClear;
Canvas.Pen.Color := clWhite;
R.Left := R.Left + 1;
R.Top := R.Top + 1;
if FRoundEdges then
Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, rt, rt)
else
Canvas.Rectangle(R);
Canvas.Pen.Color := clGray;
R.Bottom := R.Bottom -1;
R.Right := R.Right - 1;
R.Left := R.Left - 1;
R.Top := R.Top - 1;
if FRoundEdges then
Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, rt, rt)
else
Canvas.Rectangle(R);
end
else
begin
Canvas.Brush.Style := bsClear;
Canvas.Pen.Color := BorderColor;
if FRoundEdges then
Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, rt, rt)
else
Canvas.Rectangle(R);
end;
end;
bsDouble:
begin
if Ctl3D then
begin
Canvas.Brush.Style := bsClear;
Canvas.Pen.Color := clWhite;
R.Left := R.Left + 1;
R.Top := R.Top + 1;
if FRoundEdges then
Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, rt, rt)
else
Canvas.Rectangle(R);
Canvas.Pen.Color := clGray;
R.Bottom := R.Bottom -1;
R.Right := R.Right - 1;
R.Left := R.Left - 1;
R.Top := R.Top - 1;
if FRoundEdges then
Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, rt, rt)
else
Canvas.Rectangle(R);
R.Bottom := R.Bottom +1;
R.Right := R.Right + 1;
R := Rect(R.Left+2, R.Top+2, R.Right-2, R.Bottom-2);
Canvas.Pen.Color := clWhite;
R.Left := R.Left + 1;
R.Top := R.Top + 1;
if FRoundEdges then
Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, rt, rt)
else
Canvas.Rectangle(R);
Canvas.Pen.Color := clGray;
R.Bottom := R.Bottom -1;
R.Right := R.Right - 1;
R.Left := R.Left - 1;
R.Top := R.Top - 1;
if FRoundEdges then
Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, rt, rt)
else
Canvas.Rectangle(R);
end
else
begin
Canvas.Brush.Style := bsClear;
Canvas.Pen.Color := BorderColor;
if FRoundEdges then
Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, rt, rt)
else
Canvas.Rectangle(R);
R := Rect(R.Left+2, R.Top+2, R.Right-2, R.Bottom-2);
if FRoundEdges then
Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom, rt, rt)
else
Canvas.Rectangle(R);
end;
end;
end;
if ((Caption <> '') or (Assigned(Images) and (ImageIndex >= 0))) then
begin
Canvas.CopyRect(Rect(CapR.Left-1, CapR.Top, CapR.Right+1, CapR.Bottom), bmp.Canvas, Rect(0, 0, bmp.Width, bmp.Height));
end;
bmp.Free;
end;
//------------------------------------------------------------------------------
procedure TAdvCustomGroupBox.SetBorderColor(const Value: TColor);
begin
if (FBorderColor <> Value) then
begin
FBorderColor := Value;
Invalidate;
end;
end;
//------------------------------------------------------------------------------
procedure TAdvCustomGroupBox.SetImageIndex(const Value: Integer);
begin
if (FImageIndex <> Value) then
begin
FImageIndex := Value;
Invalidate;
Realign;
end;
end;
//------------------------------------------------------------------------------
procedure TAdvCustomGroupBox.SetImages(const Value: TCustomImageList);
begin
if (FImages <> Value) then
begin
FImages := Value;
if not Assigned(FImages) then
begin
ImageIndex := -1;
end;
Invalidate;
Realign;
end;
end;
//------------------------------------------------------------------------------
procedure TAdvCustomGroupBox.SetTransparent(const Value: Boolean);
begin
if (FTransparent <> Value) then
begin
FTransparent := Value;
Invalidate;
end;
end;
//------------------------------------------------------------------------------
procedure TAdvCustomGroupBox.WMEraseBkGnd(var msg: TWMEraseBkGnd);
begin
inherited;
//SetBkMode( msg.DC, TRANSPARENT );
//msg.result := 1;
end;
//------------------------------------------------------------------------------
function TAdvCustomGroupBox.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 TAdvCustomGroupBox.GetVersionNr: integer;
begin
Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER));
end;
//------------------------------------------------------------------------------
procedure TAdvCustomGroupBox.SetVersion(const Value: string);
begin
end;
//------------------------------------------------------------------------------
function TAdvCustomGroupBox.GetCaptionHeight: Integer;
var
R: TRect;
begin
R := GetCaptionRect;
Result := Max(GetBorderWidth, R.Bottom - R.Top);
end;
//------------------------------------------------------------------------------
function TAdvCustomGroupBox.GetBorderWidth: Integer;
begin
Result := 0;
case BorderStyle of
bsNone: Result := 1;
bsSingle:
begin
Result := 1;
if Ctl3D then
Result := Result + 1;
end;
bsDouble:
begin
Result := 2;
if Ctl3D then
Result := Result + 2;
end;
end;
end;
//------------------------------------------------------------------------------
function TAdvCustomGroupBox.GetBorderRect: TRect;
begin
Result := ClientRect;
if CaptionPosition in [cpTopLeft, cpTopCenter, cpTopRight] then
begin
Result.Top := Result.Top + (GetCaptionHeight div 2);
end
else if CaptionPosition in [cpBottomLeft, cpBottomCenter, cpBottomRight] then
begin
if ((Caption <> '') or (Assigned(Images) and (ImageIndex >= 0))) then
begin
Result.Bottom := Result.Bottom - (GetCaptionHeight div 2);
if (BorderStyle = bsDouble) then
Result.Bottom := Result.Bottom + 1;
end;
end;
end;
//------------------------------------------------------------------------------
function TAdvCustomGroupBox.GetCaptionRect: TRect;
var
ImgH, ImgW, CapH, CapW, sp, st, w, h: Integer;
R: TRect;
begin
Result := Rect(0, 0, 0, 0);
ImgH := 0;
ImgW := 0;
CapH := 0;
CapW := 0;
st := 8;
sp := 0;
if (Caption <> '') then
begin
Canvas.Font.Assign(Self.Font);
R := Rect(0, 0, 1000, 100);
DrawText(Canvas.Handle,PChar(Caption),Length(Caption), R, DT_CALCRECT or DT_LEFT or DT_SINGLELINE);
CapH := R.Bottom - R.Top;
CapW := R.Right - R.Left;
end;
if Assigned(Images) and (ImageIndex >= 0) then
begin
ImgH := Images.Height;
ImgW := Images.Width;
end;
if (CapW > 0) and (ImgW > 0) then
begin
sp := 3;
end;
w := ImgW + sp + CapW;
h := Max(ImgH, CapH) + 2;
case CaptionPosition of
cpTopLeft:
begin
Result.Left := st;
Result.Right := Result.Left + w;
Result.Bottom := Result.Top + h;
end;
cpTopRight:
begin
Result.Right := Width - st;
Result.Left := Result.Right - w;
Result.Bottom := Result.Top + h;
end;
cpTopCenter:
begin
Result.Left := (Width - w) div 2;
Result.Right := Result.Left + w;
Result.Bottom := Result.Top + h;
end;
cpBottomLeft:
begin
Result.Left := st;
Result.Right := Result.Left + w;
Result.Top := Height - h;
Result.Bottom := Result.Top + h;
end;
cpBottomRight:
begin
Result.Right := Width - st;
Result.Left := Result.Right - w;
Result.Top := Height - h;
Result.Bottom := Result.Top + h;
end;
cpBottomCenter:
begin
Result.Left := (Width - w) div 2;
Result.Right := Result.Left + w;
Result.Top := Height - h;
Result.Bottom := Result.Top + h;
end;
end;
end;
//------------------------------------------------------------------------------
procedure TAdvCustomGroupBox.CMCtl3DChanged(var Message: TMessage);
begin
inherited;
end;
//------------------------------------------------------------------------------
procedure TAdvCustomGroupBox.SetBorderStyle(const Value: TBorderStyle);
begin
if (FBorderStyle <> Value) then
begin
FBorderStyle := Value;
Invalidate;
Realign;
end;
end;
//------------------------------------------------------------------------------
procedure TAdvCustomGroupBox.SetCaptionPosition(
const Value: TCaptionPosition);
begin
if (FCaptionPosition <> Value) then
begin
FCaptionPosition := Value;
Invalidate;
Realign;
end;
end;
//------------------------------------------------------------------------------
procedure TAdvCustomGroupBox.SetRoundEdges(const Value: Boolean);
begin
if (FRoundEdges <> Value) then
begin
FRoundEdges := Value;
Invalidate;
end;
end;
//------------------------------------------------------------------------------
{$IFDEF FREEWARE}
{$I TRIAL.INC}
{$ENDIF}
end.

2698
TAdvTaskDialog/internal/1.5.0.2/1/Source/AdvOfficeButtons.pas Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
TAdvTaskDialog/internal/1.5.0.2/1/Source/AdvOfficeButtons.res Normal file
View File

Binary file not shown.

4423
TAdvTaskDialog/internal/1.5.0.2/1/Source/TaskDialog.pas Normal file
View File

File diff suppressed because it is too large Load Diff

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

Binary file not shown.

84
TAdvTaskDialog/internal/1.5.0.2/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.0.2/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.

50
TAdvTaskDialog/internal/1.5.0.2/1/Source/TaskDialogPkgD2007.dpk Normal file
View File

@ -0,0 +1,50 @@
package TaskDialogPkgD2007;
{$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}
{$DEFINE RELEASE}
requires
rtl,
vcl,
designide,
dbrtl,
vcldb;
contains
TaskDialog in 'TaskDialog.pas',
PictureContainer in 'PictureContainer.pas',
TaskDialogDE in 'TaskDialogDE.pas',
TaskDialogRegDE in 'TaskDialogRegDE.pas',
TaskDialogEx in 'TaskDialogEx.pas',
advgdip in 'advgdip.pas',
advglowbutton in 'advglowbutton.pas',
AdvGroupBox in 'AdvGroupBox.pas',
advhintinfo in 'advhintinfo.pas',
AdvOfficeButtons in 'AdvOfficeButtons.pas',
advstyleif in 'advstyleif.pas',
gdipicture in 'gdipicture.pas';
end.

543
TAdvTaskDialog/internal/1.5.0.2/1/Source/TaskDialogPkgD2007.dproj Normal file
View File

@ -0,0 +1,543 @@
<?xml version="1.0" encoding="utf-8"?>
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{322e4f51-9fd5-43be-8659-42e8edcc60b1}</ProjectGuid>
<MainSource>TaskDialogPkgD2007.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>
</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>
<DCC_DcuOutput>..\Lib\D11</DCC_DcuOutput>
<DCC_ObjOutput>..\Lib\D11</DCC_ObjOutput>
<DCC_HppOutput>..\Lib\D11</DCC_HppOutput>
<DCC_BplOutput>..\Lib\D11</DCC_BplOutput>
<DCC_DcpOutput>..\Lib\D11</DCC_DcpOutput>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<Version>7.0</Version>
<DCC_DcuOutput>..\Lib\D11</DCC_DcuOutput>
<DCC_ObjOutput>..\Lib\D11</DCC_ObjOutput>
<DCC_HppOutput>..\Lib\D11</DCC_HppOutput>
<DCC_BplOutput>..\Lib\D11</DCC_BplOutput>
<DCC_DcpOutput>..\Lib\D11</DCC_DcpOutput>
</PropertyGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality</Borland.Personality>
<Borland.ProjectType>Package</Borland.ProjectType>
<BorlandProject>
<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><Package_Options><Package_Options Name="PackageDescription">TMS TaskDialog</Package_Options><Package_Options Name="ImplicitBuild">False</Package_Options><Package_Options Name="DesigntimeOnly">False</Package_Options><Package_Options Name="RuntimeOnly">False</Package_Options></Package_Options><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><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><Source><Source Name="MainSource">TaskDialogPkgD2007.dpk</Source></Source></Delphi.Personality></BorlandProject></BorlandProject>
</ProjectExtensions>
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
<ItemGroup>
<DelphiCompile Include="TaskDialogPkgD2007.dpk">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="advgdip.pas" />
<DCCReference Include="advglowbutton.pas" />
<DCCReference Include="AdvGroupBox.pas" />
<DCCReference Include="advhintinfo.pas" />
<DCCReference Include="AdvOfficeButtons.pas" />
<DCCReference Include="advstyleif.pas" />
<DCCReference Include="dbrtl.dcp" />
<DCCReference Include="designide.dcp" />
<DCCReference Include="gdipicture.pas" />
<DCCReference Include="PictureContainer.pas" />
<DCCReference Include="rtl.dcp" />
<DCCReference Include="TaskDialog.pas" />
<DCCReference Include="TaskDialogDE.pas" />
<DCCReference Include="TaskDialogEx.pas" />
<DCCReference Include="TaskDialogRegDE.pas" />
<DCCReference Include="vcl.dcp" />
<DCCReference Include="vcldb.dcp" />
</ItemGroup>
</Project>
<!-- EurekaLog First Line
[Exception Log]
EurekaLog Version=6011
Activate=0
Activate Handle=1
Save Log File=1
Foreground Tab=0
Freeze Activate=0
Freeze Timeout=60
SMTP From=eurekalog@email.com
SMTP Host=
SMTP Port=25
SMTP UserID=
SMTP Password=
Append to Log=0
TerminateBtn Operation=2
Errors Number=32
Errors Terminate=3
Email Address=
Email Object=
Email Send Options=0
Output Path=
Encrypt Password=
AutoCloseDialogSecs=0
WebSendMode=0
SupportULR=
HTMLLayout Count=15
HTMLLine0="%3Chtml%3E"
HTMLLine1=" %3Chead%3E"
HTMLLine2=" %3C/head%3E"
HTMLLine3=" %3Cbody TopMargin=10 LeftMargin=10%3E"
HTMLLine4=" %3Ctable width="100%%" border="0"%3E"
HTMLLine5=" %3Ctr%3E"
HTMLLine6=" %3Ctd nowrap%3E"
HTMLLine7=" %3Cfont face="Lucida Console, Courier" size="2"%3E"
HTMLLine8=" %3C%%HTML_TAG%%%3E"
HTMLLine9=" %3C/font%3E"
HTMLLine10=" %3C/td%3E"
HTMLLine11=" %3C/tr%3E"
HTMLLine12=" %3C/table%3E"
HTMLLine13=" %3C/body%3E"
HTMLLine14="%3C/html%3E"
AutoCrashOperation=2
AutoCrashNumber=10
AutoCrashMinutes=1
WebURL=
WebUserID=
WebPassword=
WebPort=0
AttachedFiles=
ProxyURL=
ProxyUser=
ProxyPassword=
ProxyPort=8080
TrakerUser=
TrakerPassword=
TrakerAssignTo=
TrakerProject=
TrakerCategory=
TrakerTrialID=
ZipPassword=
PreBuildEvent=
PostSuccessfulBuildEvent=
PostFailureBuildEvent=
ExceptionDialogType=2
Count=0
EMail Message Line Count=0
loNoDuplicateErrors=0
loAppendReproduceText=0
loDeleteLogAtVersionChange=0
loAddComputerNameInLogFileName=0
loSaveModulesAndProcessesSections=1
loSaveAssemblerAndCPUSections=1
soAppStartDate=1
soAppName=1
soAppVersionNumber=1
soAppParameters=1
soAppCompilationDate=1
soAppUpTime=1
soExcDate=1
soExcAddress=1
soExcModuleName=1
soExcModuleVersion=1
soExcType=1
soExcMessage=1
soExcID=1
soExcCount=1
soExcStatus=1
soExcNote=1
soUserID=1
soUserName=1
soUserEmail=1
soUserPrivileges=1
soUserCompany=1
soActCtlsFormClass=1
soActCtlsFormText=1
soActCtlsControlClass=1
soActCtlsControlText=1
soCmpName=1
soCmpTotalMemory=1
soCmpFreeMemory=1
soCmpTotalDisk=1
soCmpFreeDisk=1
soCmpSysUpTime=1
soCmpProcessor=1
soCmpDisplayMode=1
soCmpDisplayDPI=1
soCmpVideoCard=1
soCmpPrinter=1
soOSType=1
soOSBuildN=1
soOSUpdate=1
soOSLanguage=1
soOSCharset=1
soNetIP=1
soNetSubmask=1
soNetGateway=1
soNetDNS1=1
soNetDNS2=1
soNetDHCP=1
soCustomData=1
sndShowSendDialog=1
sndShowSuccessFailureMsg=0
sndSendEntireLog=0
sndSendXMLLogCopy=0
sndSendScreenshot=1
sndUseOnlyActiveWindow=0
sndSendLastHTMLPage=1
sndSendInSeparatedThread=0
sndAddDateInFileName=0
sndAddComputerNameInFileName=0
edoSendErrorReportChecked=1
edoAttachScreenshotChecked=1
edoShowCopyToClipOption=1
edoShowDetailsButton=1
edoShowInDetailedMode=0
edoShowInTopMostMode=0
edoUseEurekaLogLookAndFeel=0
edoShowSendErrorReportOption=1
edoShowAttachScreenshotOption=1
edoShowCustomButton=0
csoShowDLLs=1
csoShowBPLs=1
csoShowBorlandThreads=1
csoShowWindowsThreads=1
csoDoNotStoreProcNames=0
boPauseBorlandThreads=0
boDoNotPauseMainThread=0
boPauseWindowsThreads=0
boUseMainModuleOptions=1
boCopyLogInCaseOfError=1
boSaveCompressedCopyInCaseOfError=0
boHandleSafeCallExceptions=1
boCallRTLExceptionEvent=0
boCatchHandledExceptions=0
loCatchLeaks=0
loGroupsSonLeaks=1
loHideBorlandLeaks=1
loFreeAllLeaks=1
loCatchLeaksExceptions=1
cfoReduceFileSize=1
cfoCheckFileCorruption=0
Count mtInformationMsgCaption=1
mtInformationMsgCaption0="Information."
Count mtQuestionMsgCaption=1
mtQuestionMsgCaption0="Question."
Count mtErrorMsgCaption=1
mtErrorMsgCaption0="Error."
Count mtDialog_Caption=1
mtDialog_Caption0="Error occurred"
Count mtDialog_ErrorMsgCaption=2
mtDialog_ErrorMsgCaption0="An error has occurred during program execution."
mtDialog_ErrorMsgCaption1="Please read the following information for further details."
Count mtDialog_GeneralCaption=1
mtDialog_GeneralCaption0="General"
Count mtDialog_GeneralHeader=1
mtDialog_GeneralHeader0="General Information"
Count mtDialog_CallStackCaption=1
mtDialog_CallStackCaption0="Call Stack"
Count mtDialog_CallStackHeader=1
mtDialog_CallStackHeader0="Call Stack Information"
Count mtDialog_ModulesCaption=1
mtDialog_ModulesCaption0="Modules"
Count mtDialog_ModulesHeader=1
mtDialog_ModulesHeader0="Modules Information"
Count mtDialog_ProcessesCaption=1
mtDialog_ProcessesCaption0="Processes"
Count mtDialog_ProcessesHeader=1
mtDialog_ProcessesHeader0="Processes Information"
Count mtDialog_AsmCaption=1
mtDialog_AsmCaption0="Assembler"
Count mtDialog_AsmHeader=1
mtDialog_AsmHeader0="Assembler Information"
Count mtDialog_CPUCaption=1
mtDialog_CPUCaption0="CPU"
Count mtDialog_CPUHeader=1
mtDialog_CPUHeader0="CPU Information"
Count mtDialog_OKButtonCaption=1
mtDialog_OKButtonCaption0="%26OK"
Count mtDialog_TerminateButtonCaption=1
mtDialog_TerminateButtonCaption0="%26Terminate"
Count mtDialog_RestartButtonCaption=1
mtDialog_RestartButtonCaption0="%26Restart"
Count mtDialog_DetailsButtonCaption=1
mtDialog_DetailsButtonCaption0="%26Details"
Count mtDialog_CustomButtonCaption=1
mtDialog_CustomButtonCaption0="%26Help"
Count mtDialog_SendMessage=1
mtDialog_SendMessage0="%26Send this error via Internet"
Count mtDialog_ScreenshotMessage=1
mtDialog_ScreenshotMessage0="%26Attach a Screenshot image"
Count mtDialog_CopyMessage=1
mtDialog_CopyMessage0="%26Copy to Clipboard"
Count mtDialog_SupportMessage=1
mtDialog_SupportMessage0="Go to the Support Page"
Count mtMSDialog_ErrorMsgCaption=1
mtMSDialog_ErrorMsgCaption0="The application has encountered a problem. We are sorry for the inconvenience."
Count mtMSDialog_RestartCaption=1
mtMSDialog_RestartCaption0="Restart application."
Count mtMSDialog_TerminateCaption=1
mtMSDialog_TerminateCaption0="Terminate application."
Count mtMSDialog_PleaseCaption=1
mtMSDialog_PleaseCaption0="Please tell us about this problem."
Count mtMSDialog_DescriptionCaption=1
mtMSDialog_DescriptionCaption0="We have created an error report that you can send to us. We will treat this report as confidential and anonymous."
Count mtMSDialog_SeeDetailsCaption=1
mtMSDialog_SeeDetailsCaption0="To see what data the error report contains,"
Count mtMSDialog_SeeClickCaption=1
mtMSDialog_SeeClickCaption0="click here."
Count mtMSDialog_HowToReproduceCaption=1
mtMSDialog_HowToReproduceCaption0="What were you doing when the problem happened (optional)?"
Count mtMSDialog_EmailCaption=1
mtMSDialog_EmailCaption0="Email address (optional):"
Count mtMSDialog_SendButtonCaption=1
mtMSDialog_SendButtonCaption0="%26Send Error Report"
Count mtMSDialog_NoSendButtonCaption=1
mtMSDialog_NoSendButtonCaption0="%26Don't Send"
Count mtLog_AppHeader=1
mtLog_AppHeader0="Application"
Count mtLog_AppStartDate=1
mtLog_AppStartDate0="Start Date"
Count mtLog_AppName=1
mtLog_AppName0="Name/Description"
Count mtLog_AppVersionNumber=1
mtLog_AppVersionNumber0="Version Number"
Count mtLog_AppParameters=1
mtLog_AppParameters0="Parameters"
Count mtLog_AppCompilationDate=1
mtLog_AppCompilationDate0="Compilation Date"
Count mtLog_AppUpTime=1
mtLog_AppUpTime0="Up Time"
Count mtLog_ExcHeader=1
mtLog_ExcHeader0="Exception"
Count mtLog_ExcDate=1
mtLog_ExcDate0="Date"
Count mtLog_ExcAddress=1
mtLog_ExcAddress0="Address"
Count mtLog_ExcModuleName=1
mtLog_ExcModuleName0="Module Name"
Count mtLog_ExcModuleVersion=1
mtLog_ExcModuleVersion0="Module Version"
Count mtLog_ExcType=1
mtLog_ExcType0="Type"
Count mtLog_ExcMessage=1
mtLog_ExcMessage0="Message"
Count mtLog_ExcID=1
mtLog_ExcID0="ID"
Count mtLog_ExcCount=1
mtLog_ExcCount0="Count"
Count mtLog_ExcStatus=1
mtLog_ExcStatus0="Status"
Count mtLog_ExcNote=1
mtLog_ExcNote0="Note"
Count mtLog_UserHeader=1
mtLog_UserHeader0="User"
Count mtLog_UserID=1
mtLog_UserID0="ID"
Count mtLog_UserName=1
mtLog_UserName0="Name"
Count mtLog_UserEmail=1
mtLog_UserEmail0="Email"
Count mtLog_UserCompany=1
mtLog_UserCompany0="Company"
Count mtLog_UserPrivileges=1
mtLog_UserPrivileges0="Privileges"
Count mtLog_ActCtrlsHeader=1
mtLog_ActCtrlsHeader0="Active Controls"
Count mtLog_ActCtrlsFormClass=1
mtLog_ActCtrlsFormClass0="Form Class"
Count mtLog_ActCtrlsFormText=1
mtLog_ActCtrlsFormText0="Form Text"
Count mtLog_ActCtrlsControlClass=1
mtLog_ActCtrlsControlClass0="Control Class"
Count mtLog_ActCtrlsControlText=1
mtLog_ActCtrlsControlText0="Control Text"
Count mtLog_CmpHeader=1
mtLog_CmpHeader0="Computer"
Count mtLog_CmpName=1
mtLog_CmpName0="Name"
Count mtLog_CmpTotalMemory=1
mtLog_CmpTotalMemory0="Total Memory"
Count mtLog_CmpFreeMemory=1
mtLog_CmpFreeMemory0="Free Memory"
Count mtLog_CmpTotalDisk=1
mtLog_CmpTotalDisk0="Total Disk"
Count mtLog_CmpFreeDisk=1
mtLog_CmpFreeDisk0="Free Disk"
Count mtLog_CmpSystemUpTime=1
mtLog_CmpSystemUpTime0="System Up Time"
Count mtLog_CmpProcessor=1
mtLog_CmpProcessor0="Processor"
Count mtLog_CmpDisplayMode=1
mtLog_CmpDisplayMode0="Display Mode"
Count mtLog_CmpDisplayDPI=1
mtLog_CmpDisplayDPI0="Display DPI"
Count mtLog_CmpVideoCard=1
mtLog_CmpVideoCard0="Video Card"
Count mtLog_CmpPrinter=1
mtLog_CmpPrinter0="Printer"
Count mtLog_OSHeader=1
mtLog_OSHeader0="Operating System"
Count mtLog_OSType=1
mtLog_OSType0="Type"
Count mtLog_OSBuildN=1
mtLog_OSBuildN0="Build #"
Count mtLog_OSUpdate=1
mtLog_OSUpdate0="Update"
Count mtLog_OSLanguage=1
mtLog_OSLanguage0="Language"
Count mtLog_OSCharset=1
mtLog_OSCharset0="Charset"
Count mtLog_NetHeader=1
mtLog_NetHeader0="Network"
Count mtLog_NetIP=1
mtLog_NetIP0="IP Address"
Count mtLog_NetSubmask=1
mtLog_NetSubmask0="Submask"
Count mtLog_NetGateway=1
mtLog_NetGateway0="Gateway"
Count mtLog_NetDNS1=1
mtLog_NetDNS10="DNS 1"
Count mtLog_NetDNS2=1
mtLog_NetDNS20="DNS 2"
Count mtLog_NetDHCP=1
mtLog_NetDHCP0="DHCP"
Count mtLog_CustInfoHeader=1
mtLog_CustInfoHeader0="Custom Information"
Count mtCallStack_Address=1
mtCallStack_Address0="Address"
Count mtCallStack_Name=1
mtCallStack_Name0="Module"
Count mtCallStack_Unit=1
mtCallStack_Unit0="Unit"
Count mtCallStack_Class=1
mtCallStack_Class0="Class"
Count mtCallStack_Procedure=1
mtCallStack_Procedure0="Procedure/Method"
Count mtCallStack_Line=1
mtCallStack_Line0="Line"
Count mtCallStack_MainThread=1
mtCallStack_MainThread0="Main"
Count mtCallStack_ExceptionThread=1
mtCallStack_ExceptionThread0="Exception Thread"
Count mtCallStack_RunningThread=1
mtCallStack_RunningThread0="Running Thread"
Count mtCallStack_CallingThread=1
mtCallStack_CallingThread0="Calling Thread"
Count mtCallStack_ThreadID=1
mtCallStack_ThreadID0="ID"
Count mtCallStack_ThreadPriority=1
mtCallStack_ThreadPriority0="Priority"
Count mtCallStack_ThreadClass=1
mtCallStack_ThreadClass0="Class"
Count mtCallStack_LeakCaption=1
mtCallStack_LeakCaption0="Memory Leak"
Count mtCallStack_LeakData=1
mtCallStack_LeakData0="Data"
Count mtCallStack_LeakType=1
mtCallStack_LeakType0="Type"
Count mtCallStack_LeakSize=1
mtCallStack_LeakSize0="Total size"
Count mtCallStack_LeakCount=1
mtCallStack_LeakCount0="Count"
Count mtSendDialog_Caption=1
mtSendDialog_Caption0="Send."
Count mtSendDialog_Message=1
mtSendDialog_Message0="Message"
Count mtSendDialog_Resolving=1
mtSendDialog_Resolving0="Resolving DNS..."
Count mtSendDialog_Login=1
mtSendDialog_Login0="Login..."
Count mtSendDialog_Connecting=1
mtSendDialog_Connecting0="Connecting with server..."
Count mtSendDialog_Connected=1
mtSendDialog_Connected0="Connected with server."
Count mtSendDialog_Sending=1
mtSendDialog_Sending0="Sending message..."
Count mtSendDialog_Sent=1
mtSendDialog_Sent0="Message sent."
Count mtSendDialog_SelectProject=1
mtSendDialog_SelectProject0="Select project..."
Count mtSendDialog_Searching=1
mtSendDialog_Searching0="Searching..."
Count mtSendDialog_Modifying=1
mtSendDialog_Modifying0="Modifying..."
Count mtSendDialog_Disconnecting=1
mtSendDialog_Disconnecting0="Disconnecting..."
Count mtSendDialog_Disconnected=1
mtSendDialog_Disconnected0="Disconnected."
Count mtReproduceDialog_Caption=1
mtReproduceDialog_Caption0="Request"
Count mtReproduceDialog_Request=1
mtReproduceDialog_Request0="Please describe the steps to reproduce the error:"
Count mtReproduceDialog_OKButtonCaption=1
mtReproduceDialog_OKButtonCaption0="%26OK"
Count mtModules_Handle=1
mtModules_Handle0="Handle"
Count mtModules_Name=1
mtModules_Name0="Name"
Count mtModules_Description=1
mtModules_Description0="Description"
Count mtModules_Version=1
mtModules_Version0="Version"
Count mtModules_Size=1
mtModules_Size0="Size"
Count mtModules_LastModified=1
mtModules_LastModified0="Modified"
Count mtModules_Path=1
mtModules_Path0="Path"
Count mtProcesses_ID=1
mtProcesses_ID0="ID"
Count mtProcesses_Name=1
mtProcesses_Name0="Name"
Count mtProcesses_Description=1
mtProcesses_Description0="Description"
Count mtProcesses_Version=1
mtProcesses_Version0="Version"
Count mtProcesses_Memory=1
mtProcesses_Memory0="Memory"
Count mtProcesses_Priority=1
mtProcesses_Priority0="Priority"
Count mtProcesses_Threads=1
mtProcesses_Threads0="Threads"
Count mtProcesses_Path=1
mtProcesses_Path0="Path"
Count mtCPU_Registers=1
mtCPU_Registers0="Registers"
Count mtCPU_Stack=1
mtCPU_Stack0="Stack"
Count mtCPU_MemoryDump=1
mtCPU_MemoryDump0="Memory Dump"
Count mtSend_SuccessMsg=1
mtSend_SuccessMsg0="The message was sent successfully."
Count mtSend_FailureMsg=1
mtSend_FailureMsg0="Sorry, sending the message didn't work."
Count mtSend_BugClosedMsg=2
mtSend_BugClosedMsg0="These BUG is just closed."
mtSend_BugClosedMsg1="Contact the program support to obtain an update."
Count mtSend_UnknownErrorMsg=1
mtSend_UnknownErrorMsg0="Unknown error."
Count mtSend_InvalidLoginMsg=1
mtSend_InvalidLoginMsg0="Invalid login request."
Count mtSend_InvalidSearchMsg=1
mtSend_InvalidSearchMsg0="Invalid search request."
Count mtSend_InvalidSelectionMsg=1
mtSend_InvalidSelectionMsg0="Invalid selection request."
Count mtSend_InvalidInsertMsg=1
mtSend_InvalidInsertMsg0="Invalid insert request."
Count mtSend_InvalidModifyMsg=1
mtSend_InvalidModifyMsg0="Invalid modify request."
Count mtFileCrackedMsg=2
mtFileCrackedMsg0="This file is cracked."
mtFileCrackedMsg1="The application will be closed."
Count mtException_LeakMultiFree=1
mtException_LeakMultiFree0="Multi Free memory leak."
Count mtException_LeakMemoryOverrun=1
mtException_LeakMemoryOverrun0="Memory Overrun leak."
Count mtException_AntiFreeze=1
mtException_AntiFreeze0="The application seems to be frozen."
Count mtInvalidEmailMsg=1
mtInvalidEmailMsg0="Invalid email."
TextsCollection=English
EurekaLog Last Line -->

BIN
TAdvTaskDialog/internal/1.5.0.2/1/Source/TaskDialogPkgD2007.res Normal file
View File

Binary file not shown.

49
TAdvTaskDialog/internal/1.5.0.2/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.

2897
TAdvTaskDialog/internal/1.5.0.2/1/Source/advgdip.pas Normal file
View File

File diff suppressed because it is too large Load Diff

5298
TAdvTaskDialog/internal/1.5.0.2/1/Source/advglowbutton.pas Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
TAdvTaskDialog/internal/1.5.0.2/1/Source/advglowbuttondb.res Normal file
View File

Binary file not shown.

92
TAdvTaskDialog/internal/1.5.0.2/1/Source/advhintinfo.pas Normal file
View File

@ -0,0 +1,92 @@
{***************************************************************************}
{ TAdvHintInfo component }
{ for Delphi & C++Builder }
{ version 1.0 }
{ }
{ written by TMS Software }
{ copyright © 2006 }
{ 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 AdvHintInfo;
interface
uses
Classes, GDIPicture;
type
TAdvHintInfo = class(TPersistent)
private
FPicture: TGDIPPicture;
FShowHelp: boolean;
FNotes: TStrings;
FTitle: string;
FWideTitle: widestring;
FWideNotes: widestring;
procedure SetNotes(const Value: TStrings);
procedure SetPicture(const Value: TGDIPPicture);
public
constructor Create;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
property WideTitle: widestring read FWideTitle write FWideTitle;
property WideNotes: widestring read FWideNotes write FWideNotes;
published
property Title: string read FTitle write FTitle;
property Notes: TStrings read FNotes write SetNotes;
property Picture: TGDIPPicture read FPicture write SetPicture;
property ShowHelp: boolean read FShowHelp write FShowHelp default false;
end;
implementation
{ TAdvHintInfo }
procedure TAdvHintInfo.Assign(Source: TPersistent);
begin
if (Source is TAdvHintInfo) then
begin
Title := (Source as TAdvHintInfo).Title;
Notes.Assign((Source as TAdvHintInfo).Notes);
ShowHelp := (Source as TAdvHintInfo).ShowHelp;
Picture.Assign((Source as TAdvHintInfo).Picture);
WideTitle := (Source as TAdvHintInfo).WideTitle;
WideNotes := (Source as TAdvHintInfo).WideNotes;
end;
end;
constructor TAdvHintInfo.Create;
begin
inherited;
FNotes := TStringList.Create;
FPicture := TGDIPPicture.Create;
end;
destructor TAdvHintInfo.Destroy;
begin
FNotes.Free;
FPicture.Free;
inherited;
end;
procedure TAdvHintInfo.SetNotes(const Value: TStrings);
begin
FNotes.Assign(Value);
end;
procedure TAdvHintInfo.SetPicture(const Value: TGDIPPicture);
begin
FPicture.Assign(Value);
end;
end.

62
TAdvTaskDialog/internal/1.5.0.2/1/Source/advstyleif.pas Normal file
View File

@ -0,0 +1,62 @@
{***************************************************************************}
{ TAdvStyleIF interface }
{ for Delphi & C++Builder }
{ }
{ 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 AdvStyleIF;
interface
uses
Classes;
type
TTMSStyle = (tsOffice2003Blue, tsOffice2003Silver, tsOffice2003Olive, tsOffice2003Classic,
tsOffice2007Luna, tsOffice2007Obsidian, tsWindowsXP, tsWhidbey, tsCustom, tsOffice2007Silver);
//
// ['{E1199D64-5AF9-4DB7-B363-FABE5D1EEE0F}']
// function GetComponentStyle: TTMSStyle;
ITMSStyle = interface
['{11AC2DDC-C087-4298-AB6E-EA1B5017511B}']
procedure SetComponentStyle(AStyle: TTMSStyle);
end;
function IsVista: boolean;
implementation
uses
Windows;
//------------------------------------------------------------------------------
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;
end.

384
TAdvTaskDialog/internal/1.5.0.2/1/Source/gdipicture.pas Normal file
View File

@ -0,0 +1,384 @@
{***************************************************************************}
{ TGDIPPicture class }
{ for Delphi & C++Builder }
{ version 1.0 }
{ }
{ 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 GDIPicture;
interface
uses
Windows, Classes, Graphics, Controls , SysUtils, AdvGDIP, ComObj, ActiveX;
{$I TMSDEFS.INC}
type
TGDIPPicture = class(TGraphic)
private
{ Private declarations }
FDatastream: TMemoryStream;
FIsEmpty: Boolean;
FWidth, FHeight: Integer;
FDoubleBuffered: Boolean;
FBackgroundColor: TColor;
FOnClear: TNotifyEvent;
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;
public
{ Public declarations }
constructor Create; override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure Draw(ACanvas: TCanvas; const Rect: TRect); 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 DoubleBuffered: Boolean read FDoubleBuffered write FDoubleBuffered;
property BackgroundColor: TColor read FBackgroundColor write FBackgroundColor;
function GetImageSizes: boolean;
published
{ Published declarations }
property OnClear: TNotifyEvent read FOnClear write FOnClear;
end;
implementation
{ TGDIPPicture }
procedure TGDIPPicture.Assign(Source: TPersistent);
var
st: TMemoryStream;
begin
FIsEmpty := True;
if Source = nil then
begin
FDataStream.Clear;
FIsEmpty := true;
if Assigned(OnChange) then
OnChange(Self);
if Assigned(OnClear) then
OnClear(self);
end
else
begin
if Source is TGDIPPicture then
begin
FDataStream.LoadFromStream(TGDIPPicture(Source).FDataStream);
FIsEmpty := False;
if Assigned(OnChange) then
OnChange(self);
end
else
if Source is TBitmap then
begin
st := TMemoryStream.Create;
(Source as TBitmap).SaveToStream(st);
st.Position := 0;
FDataStream.LoadFromStream(st);
st.Free;
FIsEmpty := false;
if Assigned(OnChange) then
OnChange(self);
end
else
if (Source is TPicture) then
begin
st := TMemoryStream.Create;
(Source as TPicture).Graphic.SaveToStream(st);
st.Position := 0;
FDataStream.LoadFromStream(st);
st.Free;
FIsEmpty := false;
if Assigned(OnChange) then
OnChange(self);
end;
GetImageSizes;
end;
end;
constructor TGDIPPicture.Create;
begin
inherited;
FDataStream := TMemoryStream.Create;
FIsEmpty := True;
end;
destructor TGDIPPicture.Destroy;
begin
FDataStream.Free;
inherited;
end;
procedure TGDIPPicture.Draw(ACanvas: TCanvas; const Rect: TRect);
var
dc: HDC;
multi: TGPImage;
graphic: TGPgraphics;
pstm: IStream;
hGlobal: THandle;
pcbWrite: Longint;
bmp: tbitmap;
begin
if Empty then
Exit;
if FDataStream.Size = 0 then
Exit;
hGlobal := GlobalAlloc(GMEM_MOVEABLE, FDataStream.Size);
if (hGlobal = 0) then
raise Exception.Create('Could not allocate memory for image');
try
pstm := nil;
// Create IStream* from global memory
CreateStreamOnHGlobal(hGlobal, TRUE, pstm);
pstm.Write(FDataStream.Memory, FDataStream.Size,@pcbWrite);
dc := ACanvas.Handle;
graphic:= TGPgraphics.Create(dc);
multi := TGPImage.Create(pstm);
if multi.GetFormat = ifBMP then
begin // use this alternative for easy bitmap auto transparent drawing
bmp := TBitmap.Create;
FDataStream.Position := 0;
bmp.LoadFromStream(FDataStream);
bmp.TransparentMode := tmAuto;
bmp.Transparent := true;
ACanvas.Draw(Rect.Left,Rect.Top, bmp);
bmp.Free;
end
else
begin
FWidth := multi.GetWidth;
FHeight := multi.GetHeight;
graphic.DrawImageRect(multi, Rect.Left, Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top);
end;
multi.Free;
graphic.Free;
finally
GlobalFree(hGlobal);
end;
end;
function TGDIPPicture.GetImageSizes: boolean;
var
multi: TGPImage;
pstm: IStream;
hGlobal: THandle;
pcbWrite: Longint;
begin
Result := false;
if Empty then
Exit;
if FDataStream.Size = 0 then
Exit;
hGlobal := GlobalAlloc(GMEM_MOVEABLE, FDataStream.Size);
if (hGlobal = 0) then
raise Exception.Create('Could not allocate memory for image');
try
pstm := nil;
// Create IStream* from global memory
CreateStreamOnHGlobal(hGlobal, TRUE, pstm);
pstm.Write(FDataStream.Memory, FDataStream.Size,@pcbWrite);
multi := TGPImage.Create(pstm);
FWidth := multi.GetWidth;
FHeight := multi.GetHeight;
Result := true;
multi.Free;
finally
GlobalFree(hGlobal);
end;
end;
function TGDIPPicture.GetEmpty: Boolean;
begin
Result := FIsEmpty;
end;
function TGDIPPicture.GetHeight: Integer;
begin
Result := FHeight;
end;
function TGDIPPicture.GetWidth: Integer;
begin
Result := FWidth;
end;
procedure TGDIPPicture.LoadFromFile(const FileName: string);
begin
try
FDataStream.LoadFromFile(Filename);
FIsEmpty := False;
if Assigned(OnClear) then
OnClear(self);
GetImageSizes;
if Assigned(OnChange) then
OnChange(self);
except
FIsEmpty:=true;
end;
end;
procedure TGDIPPicture.LoadFromStream(Stream: TStream);
begin
if Assigned(Stream) then
begin
FDataStream.LoadFromStream(Stream);
FIsEmpty := False;
GetImageSizes;
if Assigned(OnChange) then
OnChange(self);
end;
end;
procedure TGDIPPicture.ReadData(Stream: TStream);
begin
if Assigned(Stream) then
begin
FDataStream.LoadFromStream(stream);
FIsEmpty := False;
end;
end;
procedure TGDIPPicture.SaveToStream(Stream: TStream);
begin
if Assigned(Stream) then
FDataStream.SaveToStream(Stream);
end;
procedure TGDIPPicture.SetHeight(Value: Integer);
begin
{$IFDEF DELPHI6_LVL}
inherited;
{$ENDIF}
end;
procedure TGDIPPicture.SetWidth(Value: Integer);
begin
{$IFDEF DELPHI6_LVL}
inherited;
{$ENDIF}
end;
procedure TGDIPPicture.LoadFromResourceName(Instance: THandle; const ResName: string);
var
Stream: TCustomMemoryStream;
begin
if FindResource(Instance,PChar(ResName),RT_RCDATA) <> 0 then
begin
Stream := TResourceStream.Create(Instance, ResName, RT_RCDATA);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
end;
procedure TGDIPPicture.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 TGDIPPicture.WriteData(Stream: TStream);
begin
if Assigned(Stream) then
begin
FDataStream.SaveToStream(stream);
end;
end;
procedure TGDIPPicture.LoadFromURL(url: string);
begin
if (pos('RES://',UpperCase(url))=1) then
begin
Delete(url,1,6);
if (url<>'') then
LoadFromResourceName(hinstance,url);
Exit;
end;
if (pos('FILE://',uppercase(url))=1) then
begin
Delete(url,1,7);
if (url<>'')
then LoadFromFile(url);
end;
end;
procedure TGDIPPicture.LoadFromClipboardFormat(AFormat: Word;
AData: THandle; APalette: HPALETTE);
begin
end;
procedure TGDIPPicture.SaveToClipboardFormat(var AFormat: Word;
var AData: THandle; var APalette: HPALETTE);
begin
end;
end.

2357
TAdvTaskDialog/internal/1.5.0.2/1/Source/htmlengo.pas Normal file
View File

File diff suppressed because it is too large Load Diff

241
TAdvTaskDialog/internal/1.5.0.2/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;
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.

189
TAdvTaskDialog/internal/1.5.0.2/1/Source/tmsdefs.inc Normal file
View File

@ -0,0 +1,189 @@
{$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 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}
{$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

255
TAdvTaskDialog/internal/1.5.0.2/1/Source/wiif.pas Normal file
View File

@ -0,0 +1,255 @@
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);
{$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 FStretched write FStretched;
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;

897
TAdvTaskDialog/internal/1.5.0.2/1/Source/wiimpl.pas Normal file
View File

@ -0,0 +1,897 @@
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
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 FStretched 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;
{ 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;