Compare commits
No commits in common. "78a1ac564783cc3e021044e667dcf1588bbb58df" and "2ac4b610f3147c90c79b11289d6c75ce775bebab" have entirely different histories.
78a1ac5647
...
2ac4b610f3
@ -1,13 +0,0 @@
|
||||
program AdvInputTaskDialogDemo;
|
||||
|
||||
uses
|
||||
Forms,
|
||||
UAdvInputTaskDialogDemo in 'UAdvInputTaskDialogDemo.pas' {Form1};
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
@ -1,113 +0,0 @@
|
||||
<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>
|
||||
Binary file not shown.
@ -1,14 +0,0 @@
|
||||
program AdvMsgBoxExplorer;
|
||||
|
||||
uses
|
||||
Forms,
|
||||
Unit1 in 'Unit1.pas' {Form1};
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.MainFormOnTaskbar := True;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
@ -1,41 +0,0 @@
|
||||
<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>
|
||||
Binary file not shown.
@ -1,14 +0,0 @@
|
||||
program TaskDialogExplorer;
|
||||
|
||||
uses
|
||||
Forms,
|
||||
fmMain in 'fmMain.pas' {MainForm};
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.MainFormOnTaskbar := True;
|
||||
Application.CreateForm(TMainForm, MainForm);
|
||||
Application.Run;
|
||||
end.
|
||||
@ -1,41 +0,0 @@
|
||||
<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>
|
||||
Binary file not shown.
@ -1,100 +0,0 @@
|
||||
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
|
||||
@ -1,69 +0,0 @@
|
||||
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.
|
||||
@ -1,130 +0,0 @@
|
||||
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
|
||||
@ -1,125 +0,0 @@
|
||||
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.
|
||||
@ -1,310 +0,0 @@
|
||||
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
|
||||
@ -1,293 +0,0 @@
|
||||
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.
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@ -1,661 +0,0 @@
|
||||
{***************************************************************************}
|
||||
{ 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.
|
||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@ -1,84 +0,0 @@
|
||||
{***************************************************************************}
|
||||
{ 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.
|
||||
@ -1,300 +0,0 @@
|
||||
{***************************************************************************}
|
||||
{ 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.
|
||||
@ -1,50 +0,0 @@
|
||||
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.
|
||||
@ -1,543 +0,0 @@
|
||||
<?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 -->
|
||||
Binary file not shown.
@ -1,49 +0,0 @@
|
||||
{***************************************************************************}
|
||||
{ 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.
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@ -1,92 +0,0 @@
|
||||
{***************************************************************************}
|
||||
{ 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.
|
||||
@ -1,62 +0,0 @@
|
||||
{***************************************************************************}
|
||||
{ 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.
|
||||
@ -1,384 +0,0 @@
|
||||
{***************************************************************************}
|
||||
{ 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.
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,241 +0,0 @@
|
||||
{**************************************************************************}
|
||||
{ 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.
|
||||
@ -1,189 +0,0 @@
|
||||
{$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
|
||||
@ -1,255 +0,0 @@
|
||||
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;
|
||||
@ -1,897 +0,0 @@
|
||||
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;
|
||||
@ -1,13 +0,0 @@
|
||||
program AdvInputTaskDialogDemo;
|
||||
|
||||
uses
|
||||
Forms,
|
||||
UAdvInputTaskDialogDemo in 'UAdvInputTaskDialogDemo.pas' {Form1};
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
@ -1,113 +0,0 @@
|
||||
<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>
|
||||
Binary file not shown.
@ -1,14 +0,0 @@
|
||||
program AdvMsgBoxExplorer;
|
||||
|
||||
uses
|
||||
Forms,
|
||||
Unit1 in 'Unit1.pas' {Form1};
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.MainFormOnTaskbar := True;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
@ -1,41 +0,0 @@
|
||||
<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>
|
||||
Binary file not shown.
@ -1,14 +0,0 @@
|
||||
program TaskDialogExplorer;
|
||||
|
||||
uses
|
||||
Forms,
|
||||
fmMain in 'fmMain.pas' {MainForm};
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.MainFormOnTaskbar := True;
|
||||
Application.CreateForm(TMainForm, MainForm);
|
||||
Application.Run;
|
||||
end.
|
||||
@ -1,41 +0,0 @@
|
||||
<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>
|
||||
Binary file not shown.
@ -1,100 +0,0 @@
|
||||
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
|
||||
@ -1,69 +0,0 @@
|
||||
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.
|
||||
@ -1,130 +0,0 @@
|
||||
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
|
||||
@ -1,125 +0,0 @@
|
||||
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.
|
||||
@ -1,310 +0,0 @@
|
||||
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
|
||||
@ -1,293 +0,0 @@
|
||||
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.
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@ -1,21 +0,0 @@
|
||||
unit SpanishContst;
|
||||
|
||||
interface
|
||||
|
||||
resourcestring
|
||||
SSpanishMsgDlgOK = 'OK';
|
||||
SSpanishMsgDlgYes = '&Si';
|
||||
SSpanishMsgDlgNo = '&No';
|
||||
SSpanishMsgDlgCancel = 'Cancelar';
|
||||
SSpanishMsgDlgAbort = '&Abortar';
|
||||
SSpanishMsgDlgRetry = '&Reintentar';
|
||||
|
||||
SSpanishMsgDlgWarning = 'Aviso';
|
||||
SSpanishMsgDlgError = 'Error';
|
||||
SSpanishMsgDlgInformation = 'Información';
|
||||
SSpanishMsgDlgConfirm = 'Confirmación';
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
@ -1,84 +0,0 @@
|
||||
{***************************************************************************}
|
||||
{ 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.
|
||||
@ -1,40 +0,0 @@
|
||||
package TaskDialogPkg;
|
||||
|
||||
{$R *.res}
|
||||
{$ALIGN 8}
|
||||
{$ASSERTIONS ON}
|
||||
{$BOOLEVAL OFF}
|
||||
{$DEBUGINFO OFF}
|
||||
{$EXTENDEDSYNTAX ON}
|
||||
{$IMPORTEDDATA ON}
|
||||
{$IOCHECKS ON}
|
||||
{$LOCALSYMBOLS OFF}
|
||||
{$LONGSTRINGS ON}
|
||||
{$OPENSTRINGS ON}
|
||||
{$OPTIMIZATION ON}
|
||||
{$OVERFLOWCHECKS OFF}
|
||||
{$RANGECHECKS OFF}
|
||||
{$REFERENCEINFO OFF}
|
||||
{$SAFEDIVIDE OFF}
|
||||
{$STACKFRAMES OFF}
|
||||
{$TYPEDADDRESS OFF}
|
||||
{$VARSTRINGCHECKS ON}
|
||||
{$WRITEABLECONST OFF}
|
||||
{$MINENUMSIZE 1}
|
||||
{$IMAGEBASE $400000}
|
||||
{$DESCRIPTION 'TMS TaskDialog'}
|
||||
{$IMPLICITBUILD OFF}
|
||||
|
||||
requires
|
||||
rtl,
|
||||
vcl,
|
||||
designide;
|
||||
|
||||
contains
|
||||
TaskDialogRegDE in 'TaskDialogRegDE.pas',
|
||||
SpanishContst in 'SpanishContst.pas',
|
||||
TaskDialog in 'TaskDialog.pas',
|
||||
TaskDialogDE in 'TaskDialogDE.pas',
|
||||
picturecontainer in 'picturecontainer.pas';
|
||||
|
||||
end.
|
||||
@ -1,91 +0,0 @@
|
||||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{322e4f51-9fd5-43be-8659-42e8edcc60b1}</ProjectGuid>
|
||||
<MainSource>TaskDialogPkg.dpk</MainSource>
|
||||
<Configuration Condition=" '$(Configuration)' == '' ">Release</Configuration>
|
||||
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
|
||||
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
|
||||
<DCC_DependencyCheckOutputName>..\Lib\D11\TaskDialogPkgD2007.bpl</DCC_DependencyCheckOutputName>
|
||||
<ProjectVersion>12.0</ProjectVersion>
|
||||
<Config Condition="'$(Config)'==''">Base</Config>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base)'!=''">
|
||||
<DCC_DependencyCheckOutputName>..\Lib\D12\TaskDialogPkg.bpl</DCC_DependencyCheckOutputName>
|
||||
<DCC_ImageBase>00400000</DCC_ImageBase>
|
||||
<DesignOnlyPackage>false</DesignOnlyPackage>
|
||||
<DCC_BplOutput>..\Lib\D12</DCC_BplOutput>
|
||||
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
|
||||
<DCC_Description>TMS TaskDialog</DCC_Description>
|
||||
<DCC_DebugInformation>false</DCC_DebugInformation>
|
||||
<DCC_OutputNeverBuildDcps>true</DCC_OutputNeverBuildDcps>
|
||||
<DCC_DcpOutput>..\Lib\D12</DCC_DcpOutput>
|
||||
<GenDll>true</GenDll>
|
||||
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
|
||||
<GenPackage>true</GenPackage>
|
||||
<DCC_DcuOutput>..\Lib\D12</DCC_DcuOutput>
|
||||
</PropertyGroup>
|
||||
<ProjectExtensions>
|
||||
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
|
||||
<Borland.ProjectType>Package</Borland.ProjectType>
|
||||
<BorlandProject>
|
||||
<Delphi.Personality>
|
||||
<Parameters>
|
||||
<Parameters Name="UseLauncher">False</Parameters>
|
||||
<Parameters Name="LoadAllSymbols">True</Parameters>
|
||||
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
|
||||
</Parameters>
|
||||
<VersionInfo>
|
||||
<VersionInfo Name="IncludeVerInfo">True</VersionInfo>
|
||||
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
|
||||
<VersionInfo Name="MajorVer">1</VersionInfo>
|
||||
<VersionInfo Name="MinorVer">0</VersionInfo>
|
||||
<VersionInfo Name="Release">0</VersionInfo>
|
||||
<VersionInfo Name="Build">0</VersionInfo>
|
||||
<VersionInfo Name="Debug">False</VersionInfo>
|
||||
<VersionInfo Name="PreRelease">False</VersionInfo>
|
||||
<VersionInfo Name="Special">False</VersionInfo>
|
||||
<VersionInfo Name="Private">False</VersionInfo>
|
||||
<VersionInfo Name="DLL">False</VersionInfo>
|
||||
<VersionInfo Name="Locale">2067</VersionInfo>
|
||||
<VersionInfo Name="CodePage">1252</VersionInfo>
|
||||
</VersionInfo>
|
||||
<VersionInfoKeys>
|
||||
<VersionInfoKeys Name="CompanyName"/>
|
||||
<VersionInfoKeys Name="FileDescription"/>
|
||||
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="InternalName"/>
|
||||
<VersionInfoKeys Name="LegalCopyright"/>
|
||||
<VersionInfoKeys Name="LegalTrademarks"/>
|
||||
<VersionInfoKeys Name="OriginalFilename"/>
|
||||
<VersionInfoKeys Name="ProductName"/>
|
||||
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="Comments"/>
|
||||
</VersionInfoKeys>
|
||||
<Source>
|
||||
<Source Name="MainSource">TaskDialogPkg.dpk</Source>
|
||||
</Source>
|
||||
</Delphi.Personality>
|
||||
</BorlandProject>
|
||||
<ProjectFileVersion>12</ProjectFileVersion>
|
||||
</ProjectExtensions>
|
||||
<ItemGroup>
|
||||
<DelphiCompile Include="TaskDialogPkg.dpk">
|
||||
<MainSource>MainSource</MainSource>
|
||||
</DelphiCompile>
|
||||
<DCCReference Include="rtl.dcp"/>
|
||||
<DCCReference Include="vcl.dcp"/>
|
||||
<DCCReference Include="designide.dcp"/>
|
||||
<DCCReference Include="TaskDialogRegDE.pas"/>
|
||||
<DCCReference Include="SpanishContst.pas"/>
|
||||
<DCCReference Include="TaskDialog.pas"/>
|
||||
<DCCReference Include="TaskDialogDE.pas"/>
|
||||
<DCCReference Include="picturecontainer.pas"/>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
</ItemGroup>
|
||||
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
|
||||
</Project>
|
||||
Binary file not shown.
@ -1,49 +0,0 @@
|
||||
{***************************************************************************}
|
||||
{ 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.
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,241 +0,0 @@
|
||||
{**************************************************************************}
|
||||
{ TPictureContainer component }
|
||||
{ for Delphi & C++Builder }
|
||||
{ version 1.0 }
|
||||
{ }
|
||||
{ Copyright © 2001 - 2005 }
|
||||
{ TMS Software }
|
||||
{ Email : info@tmssoftware.com }
|
||||
{ Web : http://www.tmssoftware.com }
|
||||
{ }
|
||||
{ The source code is given as is. The author is not responsible }
|
||||
{ for any possible damage done due to the use of this code. }
|
||||
{ The component can be freely used in any application. The complete }
|
||||
{ source code remains property of the author and may not be distributed, }
|
||||
{ published, given or sold in any form as such. No parts of the source }
|
||||
{ code can be included in any other component or application without }
|
||||
{ written authorization of the author. }
|
||||
{**************************************************************************}
|
||||
|
||||
unit PictureContainer;
|
||||
|
||||
{$I TMSDEFS.INC}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
||||
ComObj, ActiveX
|
||||
{$IFDEF USEWININET}
|
||||
, WinInet
|
||||
{$ENDIF}
|
||||
{$IFDEF TMSDOTNET}
|
||||
, System.Runtime.InteropServices
|
||||
{$ENDIF}
|
||||
;
|
||||
|
||||
const
|
||||
MAJ_VER = 1; // Major version nr.
|
||||
MIN_VER = 0; // Minor version nr.
|
||||
REL_VER = 0; // Release nr.
|
||||
BLD_VER = 0; // Build nr.
|
||||
|
||||
|
||||
type
|
||||
{$I WIIF.PAS}
|
||||
|
||||
TPictureItem = class(TCollectionItem)
|
||||
private
|
||||
FPicture: THTMLPicture;
|
||||
FTag: Integer;
|
||||
FName: string;
|
||||
procedure SetPicture(const Value: THTMLPicture);
|
||||
public
|
||||
constructor Create(Collection: TCollection); override;
|
||||
destructor Destroy; override;
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
published
|
||||
property Picture: THTMLPicture read FPicture write SetPicture;
|
||||
property Name: string read FName write FName;
|
||||
property Tag: Integer read FTag write FTag;
|
||||
end;
|
||||
|
||||
TPictureCollection = class(TCollection)
|
||||
private
|
||||
FOwner: TComponent;
|
||||
function GetItem(Index: Integer): TPictureItem;
|
||||
procedure SetItem(Index: Integer; Value: TPictureItem);
|
||||
protected
|
||||
function GetOwner: TPersistent; override;
|
||||
public
|
||||
constructor Create(AOwner:TComponent);
|
||||
function Add: TPictureItem;
|
||||
function Insert(index:integer): TPictureItem;
|
||||
property Items[Index: Integer]: TPictureItem read GetItem write SetItem; default;
|
||||
function Animate:Boolean;
|
||||
end;
|
||||
|
||||
TPictureContainer = class(TComponent)
|
||||
private
|
||||
FItems: TPictureCollection;
|
||||
procedure SetItems(const Value: TPictureCollection);
|
||||
function GetVersion: string;
|
||||
procedure SetVersion(const Value: string);
|
||||
function GetVersionNr: Integer;
|
||||
{ Private declarations }
|
||||
protected
|
||||
{ Protected declarations }
|
||||
public
|
||||
{ Public declarations }
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
function FindPicture(s:string): THTMLPicture; virtual;
|
||||
published
|
||||
{ Published declarations }
|
||||
property Items: TPictureCollection read FItems write SetItems;
|
||||
property Version: string read GetVersion write SetVersion;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{$IFDEF TMSDOTNET}
|
||||
uses
|
||||
Types, WinUtils;
|
||||
{$ENDIF}
|
||||
|
||||
{$I WIIMPL.PAS}
|
||||
|
||||
{ TPictureItem }
|
||||
|
||||
procedure TPictureItem.Assign(Source: TPersistent);
|
||||
begin
|
||||
Name := (Source as TPictureItem).Name;
|
||||
Tag := (Source as TPictureItem).Tag;
|
||||
Picture.Assign((Source as TPictureItem).Picture)
|
||||
end;
|
||||
|
||||
constructor TPictureItem.Create(Collection: TCollection);
|
||||
begin
|
||||
inherited;
|
||||
FPicture := THTMLPicture.Create;
|
||||
end;
|
||||
|
||||
destructor TPictureItem.Destroy;
|
||||
begin
|
||||
FPicture.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TPictureItem.SetPicture(const Value: THTMLPicture);
|
||||
begin
|
||||
FPicture.Assign(Value);
|
||||
end;
|
||||
|
||||
{ TPictureCollection }
|
||||
|
||||
function TPictureCollection.Add: TPictureItem;
|
||||
begin
|
||||
Result := TPictureItem(inherited Add);
|
||||
end;
|
||||
|
||||
function TPictureCollection.Animate: Boolean;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
for i := 1 to Count do
|
||||
begin
|
||||
if Items[i - 1].Picture.Step then
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
constructor TPictureCollection.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TPictureItem);
|
||||
FOwner := AOwner;
|
||||
end;
|
||||
|
||||
function TPictureCollection.GetItem(Index: Integer): TPictureItem;
|
||||
begin
|
||||
Result := TPictureItem(inherited Items[Index]);
|
||||
end;
|
||||
|
||||
function TPictureCollection.GetOwner: TPersistent;
|
||||
begin
|
||||
Result := FOwner;
|
||||
end;
|
||||
|
||||
function TPictureCollection.Insert(index: Integer): TPictureItem;
|
||||
begin
|
||||
{$IFDEF DELPHI4_LVL}
|
||||
Result := TPictureItem(inherited Insert(Index));
|
||||
{$ELSE}
|
||||
Result := TPictureItem(inherited Add);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TPictureCollection.SetItem(Index: Integer;
|
||||
Value: TPictureItem);
|
||||
begin
|
||||
inherited SetItem(Index, Value);
|
||||
end;
|
||||
|
||||
{ TPictureContainer }
|
||||
|
||||
constructor TPictureContainer.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
FItems := TPictureCollection.Create(Self);
|
||||
end;
|
||||
|
||||
destructor TPictureContainer.Destroy;
|
||||
begin
|
||||
FItems.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TPictureContainer.FindPicture(s: string): THTMLPicture;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := nil;
|
||||
s := Uppercase(s);
|
||||
i := 1;
|
||||
while i <= Items.Count do
|
||||
begin
|
||||
if Uppercase(Items.Items[i - 1].Name) = s then
|
||||
begin
|
||||
Result := Items.Items[i - 1].Picture;
|
||||
Break;
|
||||
end;
|
||||
Inc(i);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPictureContainer.SetItems(const Value: TPictureCollection);
|
||||
begin
|
||||
FItems := Value;
|
||||
end;
|
||||
|
||||
function TPictureContainer.GetVersion: string;
|
||||
var
|
||||
vn: Integer;
|
||||
begin
|
||||
vn := GetVersionNr;
|
||||
Result := IntToStr(Hi(Hiword(vn)))+'.'+IntToStr(Lo(Hiword(vn)))+'.'+IntToStr(Hi(Loword(vn)))+'.'+IntToStr(Lo(Loword(vn)));
|
||||
end;
|
||||
|
||||
function TPictureContainer.GetVersionNr: Integer;
|
||||
begin
|
||||
Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER));
|
||||
end;
|
||||
|
||||
procedure TPictureContainer.SetVersion(const Value: string);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -1,214 +0,0 @@
|
||||
{$J+}
|
||||
{$R-}
|
||||
{$B-}
|
||||
{$C+}
|
||||
|
||||
{$DEFINE TMSNOADO}
|
||||
{$DEFINE TMSPACK}
|
||||
{$DEFINE TMSTOOLBAR}
|
||||
|
||||
|
||||
{$IFDEF LINUX}
|
||||
{$DEFINE TMSCLX}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER90}
|
||||
{$DEFINE DELPHI2_LVL}
|
||||
{$DEFINE ISDELPHI}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER93}
|
||||
{$DEFINE DELPHI2_LVL}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER100}
|
||||
{$DEFINE DELPHI2_LVL}
|
||||
{$DEFINE DELPHI3_LVL}
|
||||
{$DEFINE ISDELPHI}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER110}
|
||||
{$DEFINE DELPHI2_LVL}
|
||||
{$DEFINE DELPHI3_LVL}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER120}
|
||||
{$DEFINE DELPHI2_LVL}
|
||||
{$DEFINE DELPHI3_LVL}
|
||||
{$DEFINE DELPHI4_LVL}
|
||||
{$DEFINE ISDELPHI}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER125}
|
||||
{$DEFINE DELPHI2_LVL}
|
||||
{$DEFINE DELPHI3_LVL}
|
||||
{$DEFINE DELPHI4_LVL}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER130}
|
||||
{$DEFINE DELPHI2_LVL}
|
||||
{$DEFINE DELPHI3_LVL}
|
||||
{$DEFINE DELPHI4_LVL}
|
||||
{$DEFINE DELPHI5_LVL}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER140}
|
||||
{$DEFINE DELPHI2_LVL}
|
||||
{$DEFINE DELPHI3_LVL}
|
||||
{$DEFINE DELPHI4_LVL}
|
||||
{$DEFINE DELPHI5_LVL}
|
||||
{$DEFINE DELPHI6_LVL}
|
||||
{$IFNDEF BCB}
|
||||
{$DEFINE ISDELPHI}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER150}
|
||||
{$DEFINE DELPHI2_LVL}
|
||||
{$DEFINE DELPHI3_LVL}
|
||||
{$DEFINE DELPHI4_LVL}
|
||||
{$DEFINE DELPHI5_LVL}
|
||||
{$DEFINE DELPHI6_LVL}
|
||||
{$DEFINE DELPHI7_LVL}
|
||||
{$IFNDEF BCB}
|
||||
{$DEFINE ISDELPHI}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER160}
|
||||
{$DEFINE DELPHI2_LVL}
|
||||
{$DEFINE DELPHI3_LVL}
|
||||
{$DEFINE DELPHI4_LVL}
|
||||
{$DEFINE DELPHI5_LVL}
|
||||
{$DEFINE DELPHI6_LVL}
|
||||
{$DEFINE DELPHI7_LVL}
|
||||
{$DEFINE TMSDOTNET}
|
||||
{$IFNDEF BCB}
|
||||
{$DEFINE ISDELPHI}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER170}
|
||||
{$DEFINE DELPHI2_LVL}
|
||||
{$DEFINE DELPHI3_LVL}
|
||||
{$DEFINE DELPHI4_LVL}
|
||||
{$DEFINE DELPHI5_LVL}
|
||||
{$DEFINE DELPHI6_LVL}
|
||||
{$DEFINE DELPHI7_LVL}
|
||||
{$DEFINE DELPHI9_LVL}
|
||||
{$IFDEF CLR}
|
||||
{$DEFINE TMSDOTNET}
|
||||
{$ENDIF}
|
||||
{$IFNDEF BCB}
|
||||
{$DEFINE ISDELPHI}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER180}
|
||||
{$DEFINE DELPHI2_LVL}
|
||||
{$DEFINE DELPHI3_LVL}
|
||||
{$DEFINE DELPHI4_LVL}
|
||||
{$DEFINE DELPHI5_LVL}
|
||||
{$DEFINE DELPHI6_LVL}
|
||||
{$DEFINE DELPHI7_LVL}
|
||||
{$DEFINE DELPHI9_LVL}
|
||||
{$DEFINE DELPHI2006_LVL}
|
||||
{$IFDEF CLR}
|
||||
{$DEFINE TMSDOTNET}
|
||||
{$ENDIF}
|
||||
{$IFNDEF BCB}
|
||||
{$DEFINE ISDELPHI}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER185}
|
||||
{$DEFINE DELPHI2_LVL}
|
||||
{$DEFINE DELPHI3_LVL}
|
||||
{$DEFINE DELPHI4_LVL}
|
||||
{$DEFINE DELPHI5_LVL}
|
||||
{$DEFINE DELPHI6_LVL}
|
||||
{$DEFINE DELPHI7_LVL}
|
||||
{$DEFINE DELPHI9_LVL}
|
||||
{$DEFINE DELPHI2006_LVL}
|
||||
{$DEFINE DELPHI2007_LVL}
|
||||
{$IFDEF CLR}
|
||||
{$DEFINE TMSDOTNET}
|
||||
{$ENDIF}
|
||||
{$IFNDEF BCB}
|
||||
{$DEFINE ISDELPHI}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER190}
|
||||
{$DEFINE DELPHI2_LVL}
|
||||
{$DEFINE DELPHI3_LVL}
|
||||
{$DEFINE DELPHI4_LVL}
|
||||
{$DEFINE DELPHI5_LVL}
|
||||
{$DEFINE DELPHI6_LVL}
|
||||
{$DEFINE DELPHI7_LVL}
|
||||
{$DEFINE DELPHI9_LVL}
|
||||
{$DEFINE DELPHI2006_LVL}
|
||||
{$DEFINE DELPHI2007_LVL}
|
||||
{$IFDEF CLR}
|
||||
{$DEFINE TMSDOTNET}
|
||||
{$ENDIF}
|
||||
{$IFNDEF BCB}
|
||||
{$DEFINE ISDELPHI}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER200}
|
||||
{$DEFINE DELPHI2_LVL}
|
||||
{$DEFINE DELPHI3_LVL}
|
||||
{$DEFINE DELPHI4_LVL}
|
||||
{$DEFINE DELPHI5_LVL}
|
||||
{$DEFINE DELPHI6_LVL}
|
||||
{$DEFINE DELPHI7_LVL}
|
||||
{$DEFINE DELPHI9_LVL}
|
||||
{$DEFINE DELPHI2006_LVL}
|
||||
{$DEFINE DELPHI2007_LVL}
|
||||
{$DEFINE DELPHI_UNICODE}
|
||||
{$IFDEF CLR}
|
||||
{$DEFINE TMSDOTNET}
|
||||
{$ENDIF}
|
||||
{$IFNDEF BCB}
|
||||
{$DEFINE ISDELPHI}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
{$IFDEF VER110}
|
||||
{$ObjExportAll On}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER125}
|
||||
{$ObjExportAll On}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF VER130}
|
||||
{$IFDEF BCB}
|
||||
{$ObjExportAll On}
|
||||
{$ELSE}
|
||||
{$DEFINE ISDELPHI}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF ISDELPHI}
|
||||
{$IFDEF DELPHI3_LVL}
|
||||
{$DEFINE DELPHI_ONLY_LVL3}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF DELPHI7_LVL}
|
||||
{$WARN UNIT_PLATFORM OFF}
|
||||
{$WARN SYMBOL_PLATFORM OFF}
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
{$IFNDEF TMSDOTNET}
|
||||
|
||||
{$DEFINE TMSGDIPLUS} // comment this line to disable GDI+ use in TAdvStringGrid
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
//{$DEFINE TMSDISABLEOLE} // uncomment this line to disable OLE initialization by TAdvStringGrid
|
||||
@ -1,257 +0,0 @@
|
||||
TPicturePosition = (bpTopLeft,bpTopRight,bpBottomLeft,bpBottomRight,bpCenter,bpTiled,bpStretched);
|
||||
|
||||
THTMLPicture = class;
|
||||
|
||||
{$IFDEF TMSDOTNET}
|
||||
|
||||
{$EXTERNALSYM OLE_HANDLE}
|
||||
OLE_HANDLE = LongWord;
|
||||
|
||||
{$EXTERNALSYM OLE_XPOS_PIXELS}
|
||||
OLE_XPOS_PIXELS = Longint;
|
||||
{$EXTERNALSYM OLE_YPOS_PIXELS}
|
||||
OLE_YPOS_PIXELS = Longint;
|
||||
{$EXTERNALSYM OLE_XSIZE_PIXELS}
|
||||
OLE_XSIZE_PIXELS = Longint;
|
||||
{$EXTERNALSYM OLE_YSIZE_PIXELS}
|
||||
OLE_YSIZE_PIXELS = Longint;
|
||||
|
||||
{$EXTERNALSYM OLE_XPOS_HIMETRIC}
|
||||
OLE_XPOS_HIMETRIC = Longint;
|
||||
{$EXTERNALSYM OLE_YPOS_HIMETRIC}
|
||||
OLE_YPOS_HIMETRIC = Longint;
|
||||
{$EXTERNALSYM OLE_XSIZE_HIMETRIC}
|
||||
OLE_XSIZE_HIMETRIC = Longint;
|
||||
{$EXTERNALSYM OLE_YSIZE_HIMETRIC}
|
||||
OLE_YSIZE_HIMETRIC = Longint;
|
||||
|
||||
{$EXTERNALSYM OLE_XPOS_CONTAINER}
|
||||
OLE_XPOS_CONTAINER = Single;
|
||||
{$EXTERNALSYM OLE_YPOS_CONTAINER}
|
||||
OLE_YPOS_CONTAINER = Single;
|
||||
{$EXTERNALSYM OLE_XSIZE_CONTAINER}
|
||||
OLE_XSIZE_CONTAINER = Single;
|
||||
{$EXTERNALSYM OLE_YSIZE_CONTAINER}
|
||||
OLE_YSIZE_CONTAINER = Single;
|
||||
|
||||
|
||||
[ComImport,
|
||||
GuidAttribute('7BF80980-BF32-101A-8BBB-00AA00300CAB')]
|
||||
// InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)]
|
||||
IPicture = interface
|
||||
function get_Handle(out handle: OLE_HANDLE): HResult;
|
||||
function get_hPal(out handle: OLE_HANDLE): HResult;
|
||||
function get_Type(out typ: Smallint): HResult;
|
||||
function get_Width(out width: OLE_XSIZE_HIMETRIC): HResult;
|
||||
function get_Height(out height: OLE_YSIZE_HIMETRIC): HResult;
|
||||
function Render(dc: HDC; x, y, cx, cy: Longint;
|
||||
xSrc: OLE_XPOS_HIMETRIC; ySrc: OLE_YPOS_HIMETRIC;
|
||||
cxSrc: OLE_XSIZE_HIMETRIC; cySrc: OLE_YSIZE_HIMETRIC;
|
||||
const rcWBounds: TRect): HResult;
|
||||
function set_hPal(hpal: OLE_HANDLE): HResult;
|
||||
function get_CurDC(out dcOut: HDC): HResult;
|
||||
function SelectPicture(dcIn: HDC; out hdcOut: HDC;
|
||||
out bmpOut: OLE_HANDLE): HResult;
|
||||
function get_KeepOriginalFormat(out fkeep: BOOL): HResult;
|
||||
function put_KeepOriginalFormat(fkeep: BOOL): HResult;
|
||||
function PictureChanged: HResult;
|
||||
function SaveAsFile(const stream: IStream; fSaveMemCopy: BOOL;
|
||||
out cbSize: Longint): HResult;
|
||||
function get_Attributes(out dwAttr: Longint): HResult;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
PInternetContent = ^TInternetContent;
|
||||
TInternetContent = record
|
||||
{$IFDEF USEWININET}
|
||||
hresource: hinternet;
|
||||
{$ENDIF}
|
||||
Complete: Boolean;
|
||||
HTMLPicture:THTMLPicture;
|
||||
end;
|
||||
|
||||
TDownloadErrorEvent = procedure(Sender:TObject;err:string) of object;
|
||||
TDownloadCompleteEvent = procedure(Sender:TObject) of object;
|
||||
TDownloadCancelEvent = procedure(Sender:TObject;var Cancel:boolean) of object;
|
||||
TDownloadProgressEvent = procedure(Sender:TObject;dwSize,dwTotSize:dword) of object;
|
||||
|
||||
TDownLoadThread = class(TThread)
|
||||
private
|
||||
HTMLPicture:THTMLPicture;
|
||||
protected
|
||||
procedure Execute; override;
|
||||
public
|
||||
constructor Create(aHTMLPicture:THTMLPicture);
|
||||
end;
|
||||
|
||||
THTMLPicture = class(TGraphic)
|
||||
private
|
||||
{ Private declarations }
|
||||
FDatastream:TMemoryStream;
|
||||
FIsEmpty: Boolean;
|
||||
FStretched: Boolean;
|
||||
gpPicture: IPicture;
|
||||
FLogPixX,FLogPixY: Integer;
|
||||
FURL:string;
|
||||
FID:string;
|
||||
FIsDB: Boolean;
|
||||
FAsynch: Boolean;
|
||||
FThreadBusy: Boolean;
|
||||
FFrame: Integer;
|
||||
FFrameCount: Integer;
|
||||
FOnFrameChange: TNotifyEvent;
|
||||
FFrameXPos: Word;
|
||||
FFrameYPos: Word;
|
||||
FFrameXSize: Word;
|
||||
FFrameYSize: Word;
|
||||
FFrameTransp: Boolean;
|
||||
FFrameDisposal: Word;
|
||||
FAnimMaxX,FAnimMaxY: Word;
|
||||
FNextCount: Integer;
|
||||
FTimerCount: Integer;
|
||||
FOnDownLoadProgress: TDownLoadProgressEvent;
|
||||
FOnDownLoadCancel: TDownLoadCancelEvent;
|
||||
FOnDownLoadComplete: TDownLoadCompleteEvent;
|
||||
FOnDownLoadError: TDownLoadErrorEvent;
|
||||
procedure LoadPicture;
|
||||
function GetFrameCount: Integer;
|
||||
function IsGIFFile: Boolean;
|
||||
function GetFrameTime(i: Integer): Integer;
|
||||
protected
|
||||
{ Protected declarations }
|
||||
function GetEmpty: Boolean; override;
|
||||
function GetHeight: integer; override;
|
||||
function GetWidth: integer; override;
|
||||
procedure SetHeight(Value: integer); override;
|
||||
procedure SetWidth(Value: integer); override;
|
||||
procedure ReadData(Stream: TStream); override;
|
||||
procedure WriteData(Stream: TStream); override;
|
||||
procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
|
||||
procedure DownLoadError(err:string);
|
||||
procedure DownLoadComplete;
|
||||
procedure DownLoadCancel(var cancel:boolean);
|
||||
procedure DownLoadProgress(dwSize,dwTotSize:dword);
|
||||
function GetStretched: boolean;
|
||||
procedure SetStretched(const Value: boolean);
|
||||
{$IFDEF USEWININET}
|
||||
procedure DownLoad;
|
||||
{$ENDIF}
|
||||
public
|
||||
{ Public declarations }
|
||||
constructor Create; override;
|
||||
destructor Destroy; override;
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
procedure LoadFromFile(const FileName: string); override;
|
||||
procedure LoadFromStream(Stream: TStream); override;
|
||||
procedure SaveToStream(Stream: TStream); override;
|
||||
procedure LoadFromResourceName(Instance: THandle; const ResName: String);
|
||||
procedure LoadFromResourceID(Instance: THandle; ResID: Integer);
|
||||
procedure LoadFromURL(url:string);
|
||||
procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
|
||||
APalette: HPALETTE); override;
|
||||
procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
|
||||
var APalette: HPALETTE); override;
|
||||
property Busy: Boolean read fThreadBusy;
|
||||
property Asynch: Boolean read fAsynch write fAsynch;
|
||||
property ID: string read FID write FID;
|
||||
property IsDB: boolean read FIsDB write FIsDB;
|
||||
property IsGIF: Boolean read IsGIFFile;
|
||||
property FrameCount:Integer read GetFrameCount;
|
||||
property FrameTime[i:Integer]:Integer read GetFrameTime;
|
||||
function GetMaxHeight: Integer;
|
||||
function GetMaxWidth: Integer;
|
||||
procedure SetFrame(const Value:Integer);
|
||||
procedure FrameNext;
|
||||
procedure FramePrev;
|
||||
function Step: Boolean;
|
||||
property MaxWidth: integer read GetMaxWidth;
|
||||
property MaxHeight: integer read GetMaxHeight;
|
||||
property FrameXPos: word read FFrameXPos;
|
||||
property FrameYPos: word read FFrameYPos;
|
||||
published
|
||||
{ Published declarations }
|
||||
property Stretch:boolean read GetStretched write SetStretched;
|
||||
property Frame:Integer read FFrame write SetFrame;
|
||||
property OnFrameChange: TNotifyEvent read FOnFrameChange write FOnFrameChange;
|
||||
property OnDownLoadError:TDownLoadErrorEvent read fOnDownLoadError write fOnDownLoadError;
|
||||
property OnDownLoadComplete:TDownLoadCompleteEvent read fOnDownLoadComplete write fOnDownLoadComplete;
|
||||
property OnDownLoadCancel:TDownLoadCancelEvent read fOnDownLoadCancel write fOnDownLoadCancel;
|
||||
property OnDownLoadProgress:TDownLoadProgressEvent read fOnDownLoadProgress write fOnDownLoadProgress;
|
||||
end;
|
||||
|
||||
THTMLPictureCache = class(TList)
|
||||
private
|
||||
procedure SetPicture(Index: Integer; Value: THTMLPicture);
|
||||
function GetPicture(Index: Integer):THTMLPicture;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
property Items[index: Integer]: THTMLPicture read GetPicture write SetPicture; default;
|
||||
function AddPicture:THTMLPicture;
|
||||
function FindPicture(ID:string):THTMLPicture;
|
||||
procedure ClearPictures;
|
||||
function Animate: boolean;
|
||||
end;
|
||||
|
||||
THTMLImage = class(TGraphicControl)
|
||||
private
|
||||
{ Private declarations }
|
||||
FHTMLPicture:THTMLPicture;
|
||||
FPicturePosition:TPicturePosition;
|
||||
FOnDownLoadCancel: TDownLoadCancelEvent;
|
||||
FOnDownLoadComplete: TDownLoadCompleteEvent;
|
||||
FOnDownLoadError: TDownLoadErrorEvent;
|
||||
FOnDownLoadProgress: TDownLoadProgressEvent;
|
||||
procedure SetHTMLPicture(const Value: THTMLPicture);
|
||||
procedure PictureChanged(sender:TObject);
|
||||
procedure SetPicturePosition(const Value: TPicturePosition);
|
||||
procedure DownLoadError(Sender:TObject;err:string);
|
||||
procedure DownLoadComplete(Sender:TObject);
|
||||
procedure DownLoadCancel(Sender:TObject;var Cancel: Boolean);
|
||||
procedure DownLoadProgress(Sender:TObject;dwSize,dwTotSize:dword);
|
||||
protected
|
||||
{ Protected declarations }
|
||||
procedure Paint; override;
|
||||
procedure Loaded; override;
|
||||
public
|
||||
{ Public declarations }
|
||||
constructor Create(aOwner:TComponent); override;
|
||||
destructor Destroy; override;
|
||||
published
|
||||
{ Published declarations }
|
||||
property HTMLPicture:THTMLPicture read FHTMLPicture write SetHTMLPicture;
|
||||
property PicturePosition:TPicturePosition read FPicturePosition write SetPicturePosition;
|
||||
{ inherited published properties}
|
||||
property Align;
|
||||
{$IFDEF DELPHI4_LVL}
|
||||
property Anchors;
|
||||
property Constraints;
|
||||
property DragKind;
|
||||
{$ENDIF}
|
||||
property DragCursor;
|
||||
property DragMode;
|
||||
property Hint;
|
||||
property ParentShowHint;
|
||||
property ShowHint;
|
||||
property Visible;
|
||||
property OnClick;
|
||||
{$IFDEF DELPHI5_LVL}
|
||||
property OnContextPopup;
|
||||
{$ENDIF}
|
||||
property OnDblClick;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
{$IFDEF DELPHI4_LVL}
|
||||
property OnEndDock;
|
||||
property OnStartDock;
|
||||
{$ENDIF}
|
||||
property OnEndDrag;
|
||||
property OnMouseDown;
|
||||
property OnMouseUp;
|
||||
property OnMouseMove;
|
||||
property OnStartDrag;
|
||||
property OnDownLoadError:TDownLoadErrorEvent read FOnDownLoadError write FOnDownLoadError;
|
||||
property OnDownLoadComplete:TDownLoadCompleteEvent read FOnDownLoadComplete write FOnDownLoadComplete;
|
||||
property OnDownLoadCancel:TDownLoadCancelEvent read FOnDownLoadCancel write FOnDownLoadCancel;
|
||||
property OnDownLoadProgress:TDownLoadProgressEvent read FOnDownLoadProgress write FOnDownLoadProgress;
|
||||
end;
|
||||
@ -1,908 +0,0 @@
|
||||
const
|
||||
HIMETRIC_INCH = 2540;
|
||||
|
||||
|
||||
{ THTMLPicture }
|
||||
|
||||
procedure THTMLPicture.Assign(Source: TPersistent);
|
||||
begin
|
||||
FIsEmpty := true;
|
||||
gpPicture := nil;
|
||||
FFrameCount := -1;
|
||||
FNextCount := -1;
|
||||
FTimerCount := -1;
|
||||
Frame := 1;
|
||||
|
||||
if Source = nil then
|
||||
FDataStream.Clear
|
||||
else
|
||||
begin
|
||||
if (Source is THTMLPicture) then
|
||||
begin
|
||||
FStretched := (Source as THTMLPicture).Stretch;
|
||||
FFrame := (Source as THTMLPicture).Frame;
|
||||
FID := (Source as THTMLPicture).ID;
|
||||
FDataStream.LoadFromStream(THTMLPicture(Source).fDataStream);
|
||||
FIsEmpty := False;
|
||||
LoadPicture;
|
||||
if Assigned(OnChange) then
|
||||
OnChange(self);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor THTMLPicture.Create;
|
||||
begin
|
||||
inherited;
|
||||
FDataStream := TMemoryStream.Create;
|
||||
FIsEmpty := True;
|
||||
gpPicture := nil;
|
||||
FLogPixX := 96;
|
||||
FLogPixY := 96;
|
||||
FThreadBusy := False;
|
||||
FAsynch := True;
|
||||
FFrameCount := -1;
|
||||
FNextCount := -1;
|
||||
FTimerCount := -1;
|
||||
FFrame := 1;
|
||||
FIsDB := False;
|
||||
end;
|
||||
|
||||
destructor THTMLPicture.Destroy;
|
||||
begin
|
||||
FDataStream.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure THTMLPicture.LoadPicture;
|
||||
{$IFNDEF TMSDOTNET}
|
||||
const
|
||||
IID_IPicture: TGUID = (
|
||||
D1:$7BF80980;D2:$BF32;D3:$101A;D4:($8B,$BB,$00,$AA,$00,$30,$0C,$AB));
|
||||
{$ENDIF}
|
||||
|
||||
var
|
||||
hGlobal: THandle;
|
||||
{$IFNDEF TMSDOTNET}
|
||||
pvData: Pointer;
|
||||
{$ENDIF}
|
||||
{$IFDEF TMSDOTNET}
|
||||
pvData: IntPtr;
|
||||
{$ENDIF}
|
||||
pstm: IStream;
|
||||
hr: hResult;
|
||||
GifStream: TMemoryStream;
|
||||
i: Integer;
|
||||
b,c,d,e: Byte;
|
||||
skipimg: Boolean;
|
||||
imgidx: Integer;
|
||||
begin
|
||||
{$IFNDEF TMSDOTNET}
|
||||
hGlobal := GlobalAlloc(GMEM_MOVEABLE, FDataStream.Size);
|
||||
if hGlobal = 0 then
|
||||
raise Exception.Create('Could not allocate memory for image');
|
||||
|
||||
try
|
||||
pvData := GlobalLock(hGlobal);
|
||||
FDataStream.Position := 0;
|
||||
|
||||
FFrameXPos := 0;
|
||||
FFrameYPos := 0;
|
||||
FAnimMaxX := 0;
|
||||
FAnimMaxY := 0;
|
||||
|
||||
{skip first image ctrl}
|
||||
|
||||
if IsGIF and (FrameCount > 0) then
|
||||
begin
|
||||
//manipulate the stream here for animated GIF ?
|
||||
Gifstream := TMemoryStream.Create;
|
||||
|
||||
ImgIdx := 1;
|
||||
SkipImg := False;
|
||||
|
||||
FDataStream.Position := 6;
|
||||
FDataStream.Read(FAnimMaxX,2);
|
||||
FDataStream.Read(FAnimMaxY,2);
|
||||
|
||||
for i := 1 to FDataStream.Size do
|
||||
begin
|
||||
FDataStream.Position := i - 1;
|
||||
FDataStream.Read(b,1);
|
||||
|
||||
if (b = $21) and (i + 8 < FDataStream.Size) then
|
||||
begin
|
||||
FDataStream.Read(c,1);
|
||||
FDataStream.Read(d,1);
|
||||
FDataStream.Position := FDataStream.Position + 5;
|
||||
|
||||
FDataStream.Read(e,1);
|
||||
if (c = $F9) and (d = $4) and (e = $2C) then
|
||||
begin
|
||||
if imgidx = FFrame then
|
||||
begin
|
||||
FDataStream.Read(FFrameXPos,2);
|
||||
FDataStream.Read(FFrameYPos,2);
|
||||
FDataStream.Read(FFrameXSize,2);
|
||||
FDataStream.Read(FFrameYSize,2);
|
||||
end;
|
||||
|
||||
Inc(ImgIdx);
|
||||
if ImgIdx <= FFrame then
|
||||
SkipImg := True
|
||||
else
|
||||
SkipImg := False;
|
||||
end;
|
||||
end;
|
||||
if not SkipImg then GifStream.Write(b,1);
|
||||
end;
|
||||
GifStream.Position := 0;
|
||||
GifStream.ReadBuffer(pvData^,GifStream.Size);
|
||||
GifStream.Free;
|
||||
end
|
||||
else
|
||||
begin
|
||||
FDataStream.ReadBuffer(pvData^,fDataStream.Size);
|
||||
end;
|
||||
|
||||
GlobalUnlock(hGlobal);
|
||||
|
||||
pstm := nil;
|
||||
|
||||
// Create IStream* from global memory
|
||||
hr := CreateStreamOnHGlobal(hGlobal, TRUE, pstm);
|
||||
|
||||
if (not hr=S_OK) then
|
||||
raise Exception.Create('Could not create image stream')
|
||||
else
|
||||
if (pstm = nil) then
|
||||
raise Exception.Create('Empty image stream created');
|
||||
|
||||
// Create IPicture from image file
|
||||
hr := OleLoadPicture(pstm, FDataStream.Size,FALSE,IID_IPicture,gpPicture);
|
||||
|
||||
if not (hr = S_OK) then
|
||||
raise Exception.Create('Could not load image. Invalid format')
|
||||
else
|
||||
if gpPicture = nil then
|
||||
raise Exception.Create('Could not load image');
|
||||
|
||||
finally
|
||||
GlobalFree(hGlobal);
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure THTMLPicture.Draw(ACanvas: TCanvas; const Rect: TRect);
|
||||
var
|
||||
hmWidth:integer;
|
||||
hmHeight:integer;
|
||||
nPixX,nPixY:integer;
|
||||
pnWidth,pnHeight:integer;
|
||||
|
||||
begin
|
||||
if Empty then Exit;
|
||||
|
||||
if gpPicture = nil then Exit;
|
||||
|
||||
hmWidth := 0;
|
||||
hmHeight := 0;
|
||||
gpPicture.get_Width(hmWidth);
|
||||
gpPicture.get_Height(hmHeight);
|
||||
|
||||
if Stretch then
|
||||
begin
|
||||
gpPicture.Render(ACanvas.Handle,Rect.Left,Rect.Bottom,Rect.Right - Rect.Left,-(Rect.Bottom - Rect.Top),0,0,
|
||||
hmWidth,hmHeight, Rect);
|
||||
end
|
||||
else
|
||||
begin
|
||||
nPixX := GetDeviceCaps(ACanvas.Handle,LOGPIXELSX);
|
||||
nPixY := GetDeviceCaps(ACanvas.Handle,LOGPIXELSY);
|
||||
//Convert to device units
|
||||
pnWidth := MulDiv(hmWidth, nPixX, HIMETRIC_INCH);
|
||||
pnHeight := MulDiv(hmHeight, nPixY, HIMETRIC_INCH);
|
||||
|
||||
//gpPicture.Render(ACanvas.Handle,Rect.Left,Rect.Top + pnHeight,pnWidth,-pnHeight,0,0,
|
||||
// hmWidth,hmHeight, Rect);
|
||||
gpPicture.Render(ACanvas.Handle,Rect.Left,Rect.Top,
|
||||
pnWidth,pnHeight,0,hmHeight, hmWidth,-hmHeight, Rect);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
function THTMLPicture.GetEmpty: Boolean;
|
||||
begin
|
||||
Result := FIsEmpty;
|
||||
end;
|
||||
|
||||
function THTMLPicture.GetHeight: integer;
|
||||
var
|
||||
hmHeight:integer;
|
||||
begin
|
||||
if gpPicture = nil then
|
||||
Result := 0
|
||||
else
|
||||
begin
|
||||
gpPicture.get_Height(hmHeight);
|
||||
Result := MulDiv(hmHeight, FLogPixY, HIMETRIC_INCH);
|
||||
end;
|
||||
end;
|
||||
|
||||
function THTMLPicture.GetWidth: Integer;
|
||||
var
|
||||
hmWidth: Integer;
|
||||
begin
|
||||
if gpPicture = nil then
|
||||
Result := 0
|
||||
else
|
||||
begin
|
||||
gpPicture.get_Width(hmWidth);
|
||||
Result := MulDiv(hmWidth, FLogPixX, HIMETRIC_INCH);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THTMLPicture.LoadFromFile(const FileName: string);
|
||||
begin
|
||||
try
|
||||
FDataStream.LoadFromFile(Filename);
|
||||
FIsEmpty:=false;
|
||||
LoadPicture;
|
||||
if Assigned(OnChange) then
|
||||
OnChange(self);
|
||||
except
|
||||
FIsEmpty:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THTMLPicture.LoadFromStream(Stream: TStream);
|
||||
begin
|
||||
if Assigned(Stream) then
|
||||
begin
|
||||
FDataStream.LoadFromStream(Stream);
|
||||
FIsEmpty := False;
|
||||
LoadPicture;
|
||||
if Assigned(OnChange) then
|
||||
OnChange(self);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THTMLPicture.ReadData(Stream: TStream);
|
||||
begin
|
||||
|
||||
if assigned(Stream) then
|
||||
begin
|
||||
fDataStream.LoadFromStream(stream);
|
||||
fIsEmpty:=false;
|
||||
LoadPicture;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THTMLPicture.SaveToStream(Stream: TStream);
|
||||
begin
|
||||
if Assigned(Stream) then fDataStream.SaveToStream(Stream);
|
||||
end;
|
||||
|
||||
procedure THTMLPicture.LoadFromResourceName(Instance: THandle; const ResName: string);
|
||||
var
|
||||
Stream: TCustomMemoryStream;
|
||||
begin
|
||||
{$IFNDEF TMSDOTNET}
|
||||
if FindResource(Instance,pchar(ResName),RT_RCDATA)<>0 then
|
||||
{$ENDIF}
|
||||
{$IFDEF TMSDOTNET}
|
||||
if FindResource(Instance,ResName,RT_RCDATA)<>0 then
|
||||
{$ENDIF}
|
||||
begin
|
||||
Stream := TResourceStream.Create(Instance, ResName, RT_RCDATA);
|
||||
try
|
||||
LoadFromStream(Stream);
|
||||
finally
|
||||
Stream.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THTMLPicture.LoadFromResourceID(Instance: THandle; ResID: Integer);
|
||||
var
|
||||
Stream: TCustomMemoryStream;
|
||||
begin
|
||||
Stream := TResourceStream.CreateFromID(Instance, ResID, RT_RCDATA);
|
||||
try
|
||||
LoadFromStream(Stream);
|
||||
finally
|
||||
Stream.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure THTMLPicture.SetHeight(Value: integer);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure THTMLPicture.SetWidth(Value: integer);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure THTMLPicture.WriteData(Stream: TStream);
|
||||
begin
|
||||
if Assigned(Stream) then
|
||||
begin
|
||||
FDataStream.savetostream(stream);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THTMLPicture.LoadFromURL(url: string);
|
||||
var
|
||||
UUrl: string;
|
||||
begin
|
||||
UUrl := UpperCase(url);
|
||||
|
||||
if Pos('RES://',UUrl) = 1 then
|
||||
begin
|
||||
ID := url;
|
||||
Delete(url,1,6);
|
||||
if url <> '' then
|
||||
LoadFromResourceName(hinstance,url);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if Pos('FILE://',Uurl) = 1 then
|
||||
begin
|
||||
ID := url;
|
||||
Delete(url,1,7);
|
||||
if url <> '' then
|
||||
LoadFromFile(url);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if FAsynch then
|
||||
begin
|
||||
if FThreadBusy then
|
||||
Exit;
|
||||
FURL := url;
|
||||
FThreadBusy := True;
|
||||
TDownLoadThread.Create(self);
|
||||
end
|
||||
else
|
||||
begin
|
||||
FURL := url;
|
||||
ID := url;
|
||||
{$IFDEF USEWININET}
|
||||
DownLoad;
|
||||
{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
|
||||
{$IFDEF USEWININET}
|
||||
procedure THTMLPicture.DownLoad;
|
||||
var
|
||||
RBSIZE:dword;
|
||||
httpstatus,httpsize,err:integer;
|
||||
dwIdx:dword;
|
||||
dwBufSize:dword;
|
||||
ms:TMemoryStream;
|
||||
len:dword;
|
||||
cbuf:array[0..255] of char;
|
||||
rb:array[0..4095] of byte;
|
||||
|
||||
FISession:hinternet;
|
||||
FIHttp:hinternet;
|
||||
Cancel:boolean;
|
||||
|
||||
begin
|
||||
fISession:=InternetOpen('HTMLImage',INTERNET_OPEN_TYPE_PRECONFIG,nil,nil,0);
|
||||
if (fISession=nil) then
|
||||
begin
|
||||
DownLoadError('Cannot open internet session');
|
||||
fThreadBusy:=false;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
fIHttp:=InternetOpenURL(fISession,pchar(furl),nil,0,
|
||||
INTERNET_FLAG_PRAGMA_NOCACHE or INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_RELOAD,0);
|
||||
|
||||
if (fIHttp=nil) then
|
||||
begin
|
||||
InternetCloseHandle(fISession);
|
||||
DownLoadError('Cannot open http connection');
|
||||
fThreadBusy:=false;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
dwBufSize := SizeOf(cbuf);
|
||||
dwidx := 0;
|
||||
HttpQueryInfo(fIHttp,HTTP_QUERY_STATUS_CODE,@cbuf,dwBufSize,dwIdx);
|
||||
|
||||
val(cbuf,httpstatus,err);
|
||||
if (httpstatus <> 200) or (err <> 0) then
|
||||
begin
|
||||
InternetCloseHandle(fISession);
|
||||
InternetCloseHandle(fIHttp);
|
||||
DownLoadError('Cannot open URL '+furl);
|
||||
FThreadBusy:=false;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
dwBufSize := SizeOf(cbuf);
|
||||
dwidx := 0;
|
||||
HttpQueryInfo(fIHttp,HTTP_QUERY_CONTENT_TYPE,@cbuf,dwBufSize,dwIdx);
|
||||
|
||||
if Pos('IMAGE',UpperCase(StrPas(cbuf))) = 0 then
|
||||
begin
|
||||
InternetCloseHandle(fISession);
|
||||
InternetCloseHandle(fIHttp);
|
||||
DownLoadError('Resource is not of image type : ' + FUrl);
|
||||
fThreadBusy := false;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
dwBufSize := SizeOf(cbuf);
|
||||
dwidx := 0;
|
||||
HttpQueryInfo(fIHttp,HTTP_QUERY_CONTENT_LENGTH,@cbuf,dwBufSize,dwIdx);
|
||||
|
||||
val(cbuf,httpsize,err);
|
||||
if (httpsize = 0) or (err <> 0) then
|
||||
begin
|
||||
InternetCloseHandle(fISession);
|
||||
InternetCloseHandle(fIHttp);
|
||||
DownLoadError('Image size is 0');
|
||||
fThreadBusy:=false;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
DownLoadProgress(0,httpsize);
|
||||
|
||||
len := 4096;
|
||||
RBSIZE := 4096;
|
||||
|
||||
ms := TMemoryStream.Create;
|
||||
|
||||
cancel:=false;
|
||||
|
||||
while (len=RBSIZE) and not Cancel do
|
||||
begin
|
||||
InternetReadFile(fIHttp,@rb,RBSIZE,len);
|
||||
if len>0 then ms.WriteBuffer(rb,len);
|
||||
DownLoadProgress(ms.Size,httpsize);
|
||||
DownLoadCancel(cancel);
|
||||
end;
|
||||
|
||||
if not cancel then
|
||||
begin
|
||||
ms.Position := 0;
|
||||
LoadFromStream(ms);
|
||||
end;
|
||||
|
||||
ms.Free;
|
||||
|
||||
InternetCloseHandle(fIHttp);
|
||||
InternetCloseHandle(fISession);
|
||||
FThreadBusy:=false;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
procedure THTMLPicture.DownLoadCancel(var cancel: boolean);
|
||||
begin
|
||||
if assigned(FOnDownLoadCancel) then
|
||||
FOnDownLoadCancel(self,cancel);
|
||||
end;
|
||||
|
||||
procedure THTMLPicture.DownLoadComplete;
|
||||
begin
|
||||
if Assigned(FOnDownLoadComplete) then
|
||||
FOnDownLoadComplete(self);
|
||||
end;
|
||||
|
||||
procedure THTMLPicture.DownLoadError(err: string);
|
||||
begin
|
||||
if Assigned(fOnDownloadError) then
|
||||
FOnDownLoadError(self,err);
|
||||
end;
|
||||
|
||||
procedure THTMLPicture.DownLoadProgress(dwSize, dwTotSize: dword);
|
||||
begin
|
||||
if Assigned(FOnDownLoadProgress) then
|
||||
FOnDownLoadProgress(self,dwSize,dwTotSize);
|
||||
end;
|
||||
|
||||
|
||||
procedure THTMLPicture.LoadFromClipboardFormat(AFormat: Word;
|
||||
AData: THandle; APalette: HPALETTE);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure THTMLPicture.SaveToClipboardFormat(var AFormat: Word;
|
||||
var AData: THandle; var APalette: HPALETTE);
|
||||
begin
|
||||
end;
|
||||
|
||||
function THTMLPicture.GetFrameCount: Integer;
|
||||
var
|
||||
i: Integer;
|
||||
b,c,d,e: Byte;
|
||||
Res: Integer;
|
||||
begin
|
||||
Result := -1;
|
||||
|
||||
if FFrameCount <> -1 then
|
||||
Result := FFrameCount
|
||||
else
|
||||
if IsGIFFile then
|
||||
begin
|
||||
Res := 0;
|
||||
for i := 1 to FDataStream.Size do
|
||||
begin
|
||||
FDataStream.Position := i - 1;
|
||||
FDataStream.Read(b,1);
|
||||
if (b = $21) and (i + 8 < FDataStream.Size) then
|
||||
begin
|
||||
FDataStream.Read(c,1);
|
||||
FDataStream.Read(d,1);
|
||||
FDataStream.Position := FDataStream.Position+5;
|
||||
FDataStream.Read(e,1);
|
||||
if (c = $F9) and (d = $4) and (e = $2C) then Inc(res);
|
||||
end;
|
||||
end;
|
||||
FFrameCount := Res;
|
||||
Result := Res;
|
||||
FDataStream.Position := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
function THTMLPicture.IsGIFFile: Boolean;
|
||||
var
|
||||
buf: array[0..4] of char;
|
||||
begin
|
||||
Result := False;
|
||||
if FDataStream.Size>4 then
|
||||
begin
|
||||
FDataStream.Position := 0;
|
||||
{$IFNDEF TMSDOTNET}
|
||||
FDataStream.Read(buf,4);
|
||||
buf[4] := #0;
|
||||
Result := Strpas(buf) = 'GIF8';
|
||||
{$ENDIF}
|
||||
FDataStream.Position := 0;
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
function THTMLPicture.GetFrameTime(i: Integer): Integer;
|
||||
var
|
||||
j: Integer;
|
||||
b,c,d,e: Byte;
|
||||
res: Integer;
|
||||
ft: Word;
|
||||
|
||||
begin
|
||||
Result := -1;
|
||||
|
||||
if IsGIFFile then
|
||||
begin
|
||||
Res := 0;
|
||||
for j := 1 to FDataStream.Size do
|
||||
begin
|
||||
FDataStream.Position := j-1;
|
||||
FDataStream.Read(b,1);
|
||||
if (b = $21) and (i + 8 < FDataStream.Size) then
|
||||
begin
|
||||
FDataStream.Read(c,1);
|
||||
FDataStream.Read(d,1);
|
||||
FDataStream.Read(b,1);
|
||||
{transp. flag here}
|
||||
|
||||
FDataStream.Read(ft,2);
|
||||
FDataStream.Position := FDataStream.Position + 2;
|
||||
|
||||
FDataStream.Read(e,1);
|
||||
if (c = $F9) and (d = $4) and (e = $2C) then
|
||||
begin
|
||||
Inc(res);
|
||||
if res = i then
|
||||
begin
|
||||
Result := ft;
|
||||
FFrameTransp := b and $01=$01;
|
||||
FFrameDisposal := (b shr 3) and $7;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
FDataStream.Position := 0;
|
||||
end;
|
||||
|
||||
function THTMLPicture.GetMaxHeight: Integer;
|
||||
var
|
||||
hmHeight: Integer;
|
||||
begin
|
||||
{$IFNDEF TMSDOTNET}
|
||||
if gpPicture = nil then
|
||||
Result := 0
|
||||
else
|
||||
begin
|
||||
if FAnimMaxY>0 then Result:=FAnimMaxY
|
||||
else
|
||||
begin
|
||||
gpPicture.get_Height(hmHeight);
|
||||
Result := MulDiv(hmHeight, fLogPixY, HIMETRIC_INCH);
|
||||
end;
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function THTMLPicture.GetMaxWidth: Integer;
|
||||
var
|
||||
hmWidth: Integer;
|
||||
begin
|
||||
if gpPicture = nil then
|
||||
Result := 0
|
||||
else
|
||||
begin
|
||||
if FAnimMaxX > 0 then
|
||||
Result := FAnimMaxX
|
||||
else
|
||||
begin
|
||||
gpPicture.get_Width(hmWidth);
|
||||
Result := MulDiv(hmWidth, fLogPixX, HIMETRIC_INCH);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure THTMLPicture.SetFrame(const Value: Integer);
|
||||
begin
|
||||
FFrame := Value;
|
||||
if FDataStream.Size > 0 then
|
||||
begin
|
||||
LoadPicture;
|
||||
if Assigned(OnFrameChange) then
|
||||
OnFrameChange(self);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THTMLPicture.FrameNext;
|
||||
begin
|
||||
if FFrame < FFrameCount then
|
||||
Inc(FFrame)
|
||||
else
|
||||
FFrame := 1;
|
||||
end;
|
||||
|
||||
function THTMLPicture.Step: Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if (FFrameCount <= 1) or FIsEmpty then
|
||||
Exit;
|
||||
|
||||
if FNextCount = -1 then
|
||||
FrameTime[FFrame];
|
||||
|
||||
if FTimerCount*10 >= FNextCount then
|
||||
begin
|
||||
FrameNext;
|
||||
LoadPicture;
|
||||
FNextCount := FNextCount + FrameTime[FFrame];
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
Inc(FTimerCount);
|
||||
end;
|
||||
|
||||
procedure THTMLPicture.FramePrev;
|
||||
begin
|
||||
if FFrame > 1 then
|
||||
Dec(FFrame)
|
||||
else
|
||||
FFrame := FFrameCount;
|
||||
end;
|
||||
|
||||
function THTMLPicture.GetStretched: boolean;
|
||||
begin
|
||||
Result := FStretched;
|
||||
end;
|
||||
|
||||
procedure THTMLPicture.SetStretched(const Value: boolean);
|
||||
begin
|
||||
FStretched := Value;
|
||||
end;
|
||||
|
||||
{ THTMLImage }
|
||||
|
||||
constructor THTMLImage.Create(aOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
fHTMLPicture:=THTMLPicture.Create;
|
||||
fHTMLPicture.OnChange:=PictureChanged;
|
||||
Width:=100;
|
||||
Height:=100;
|
||||
fHTMLPicture.OnDownLoadError:=DownLoadError;
|
||||
fHTMLPicture.OnDownLoadCancel:=DownLoadCancel;
|
||||
fHTMLPicture.OnDownLoadProgress:=DownLoadProgress;
|
||||
fHTMLPicture.OnDownLoadComplete:=DownLoadComplete;
|
||||
end;
|
||||
|
||||
destructor THTMLImage.Destroy;
|
||||
begin
|
||||
fHTMLPicture.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure THTMLImage.Loaded;
|
||||
begin
|
||||
inherited;
|
||||
fHTMLPicture.fLogPixX := GetDeviceCaps(canvas.handle,LOGPIXELSX);
|
||||
fHTMLPicture.fLogPixY := GetDeviceCaps(canvas.handle,LOGPIXELSY);
|
||||
end;
|
||||
|
||||
procedure THTMLImage.Paint;
|
||||
var
|
||||
xo,yo:integer;
|
||||
|
||||
function Max(a,b:integer):integer;
|
||||
begin
|
||||
if (a>b) then result:=a else result:=b;
|
||||
end;
|
||||
|
||||
begin
|
||||
inherited;
|
||||
if assigned(fHTMLPicture) then
|
||||
begin
|
||||
if not fHTMLPicture.Empty then
|
||||
case fPicturePosition of
|
||||
bpTopLeft:Canvas.Draw(0,0,fHTMLPicture);
|
||||
bpTopRight:Canvas.Draw(Max(0,width-fHTMLPicture.Width),0,fHTMLPicture);
|
||||
bpBottomLeft:Canvas.Draw(0,Max(0,height-fHTMLPicture.Height),fHTMLPicture);
|
||||
bpBottomRight:Canvas.Draw(Max(0,width-fHTMLPicture.Width),Max(0,height-fHTMLPicture.Height),fHTMLPicture);
|
||||
bpCenter:Canvas.Draw(Max(0,width-fHTMLPicture.Width) shr 1,Max(0,height-fHTMLPicture.Height) shr 1,fHTMLPicture);
|
||||
bpTiled:begin
|
||||
yo:=0;
|
||||
while (yo<Height) do
|
||||
begin
|
||||
xo:=0;
|
||||
while (xo<Width) do
|
||||
begin
|
||||
Canvas.Draw(xo,yo,fHTMLPicture);
|
||||
xo:=xo+fHTMLPicture.Width;
|
||||
end;
|
||||
yo:=yo+fHTMLPicture.Height;
|
||||
end;
|
||||
end;
|
||||
bpStretched:canvas.StretchDraw(rect(0,0,width,height),fHTMLPicture) else
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure THTMLImage.PictureChanged(sender: TObject);
|
||||
begin
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure THTMLImage.SetHTMLPicture(const Value: THTMLPicture);
|
||||
begin
|
||||
FHTMLPicture.Assign(Value);
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure THTMLImage.SetPicturePosition(const Value: TPicturePosition);
|
||||
begin
|
||||
if ( fPicturePosition <> Value) then
|
||||
begin
|
||||
fPicturePosition := Value;
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure THTMLImage.DownLoadCancel(Sender: TObject; var cancel: boolean);
|
||||
begin
|
||||
if assigned(fOnDownLoadCancel) then fOnDownLoadCancel(self,cancel);
|
||||
end;
|
||||
|
||||
procedure THTMLImage.DownLoadComplete(Sender: TObject);
|
||||
begin
|
||||
if assigned(fOnDownLoadComplete) then fOnDownLoadComplete(self);
|
||||
end;
|
||||
|
||||
procedure THTMLImage.DownLoadError(Sender: TObject; err: string);
|
||||
begin
|
||||
if Assigned(FOnDownloadError) then
|
||||
FOnDownLoadError(self,err);
|
||||
end;
|
||||
|
||||
procedure THTMLImage.DownLoadProgress(Sender: TObject; dwSize,
|
||||
dwTotSize: dword);
|
||||
begin
|
||||
if Assigned(FOnDownLoadProgress) then
|
||||
FOnDownLoadProgress(self,dwSize,dwTotSize);
|
||||
end;
|
||||
|
||||
{ TDownLoadThread }
|
||||
|
||||
constructor TDownLoadThread.Create(aHTMLPicture: THTMLPicture);
|
||||
begin
|
||||
inherited Create(false);
|
||||
HTMLPicture := aHTMLPicture;
|
||||
FreeOnTerminate := True;
|
||||
end;
|
||||
|
||||
procedure TDownLoadThread.Execute;
|
||||
begin
|
||||
{$IFDEF USEWININET}
|
||||
HTMLPicture.DownLoad;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{ THTMLPictureCache }
|
||||
|
||||
destructor THTMLPictureCache.Destroy;
|
||||
begin
|
||||
ClearPictures;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function THTMLPictureCache.AddPicture: THTMLPicture;
|
||||
begin
|
||||
Result := THTMLPicture.Create;
|
||||
{$IFNDEF TMSDOTNET}
|
||||
Add(pointer(result));
|
||||
{$ENDIF}
|
||||
{$IFDEF TMSDOTNET}
|
||||
Add(TObject(Result));
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure THTMLPictureCache.ClearPictures;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 1 to Count do
|
||||
Items[i - 1].Free;
|
||||
|
||||
Clear;
|
||||
//inherited;
|
||||
end;
|
||||
|
||||
function THTMLPictureCache.FindPicture(ID: string): THTMLPicture;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := nil;
|
||||
for i := 1 to Count do
|
||||
begin
|
||||
if (Items[i - 1].ID = ID) then
|
||||
begin
|
||||
Result := Items[i - 1];
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function THTMLPictureCache.GetPicture(Index: Integer): THTMLPicture;
|
||||
begin
|
||||
Result := THTMLPicture(inherited Items[Index]);
|
||||
end;
|
||||
|
||||
procedure THTMLPictureCache.SetPicture(Index: Integer; Value: THTMLPicture);
|
||||
begin
|
||||
{$IFNDEF TMSDOTNET}
|
||||
inherited Items[index] := Pointer(Value);
|
||||
{$ENDIF}
|
||||
{$IFDEF TMSDOTNET}
|
||||
inherited Items[index] := Value;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function THTMLPictureCache.Animate: Boolean;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
for i := 1 to Count do
|
||||
begin
|
||||
if Items[i - 1].Step then
|
||||
Result := True;
|
||||
end;
|
||||
end;
|
||||
@ -1,13 +0,0 @@
|
||||
program AdvInputTaskDialogDemo;
|
||||
|
||||
uses
|
||||
Forms,
|
||||
UAdvInputTaskDialogDemo in 'UAdvInputTaskDialogDemo.pas' {Form1};
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
@ -1,113 +0,0 @@
|
||||
<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>
|
||||
Binary file not shown.
@ -1,14 +0,0 @@
|
||||
program AdvMsgBoxExplorer;
|
||||
|
||||
uses
|
||||
Forms,
|
||||
Unit1 in 'Unit1.pas' {Form1};
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.MainFormOnTaskbar := True;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
@ -1,41 +0,0 @@
|
||||
<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>
|
||||
Binary file not shown.
@ -1,14 +0,0 @@
|
||||
program TaskDialogExplorer;
|
||||
|
||||
uses
|
||||
Forms,
|
||||
fmMain in 'fmMain.pas' {MainForm};
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.MainFormOnTaskbar := True;
|
||||
Application.CreateForm(TMainForm, MainForm);
|
||||
Application.Run;
|
||||
end.
|
||||
@ -1,41 +0,0 @@
|
||||
<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>
|
||||
Binary file not shown.
@ -1,100 +0,0 @@
|
||||
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
|
||||
@ -1,69 +0,0 @@
|
||||
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.
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user