• R/O
  • SSH
  • HTTPS

akdf: Commit


Commit MetaInfo

Revision572 (tree)
Time2022-03-04 03:30:25
Authorderekwildstar

Log Message

Projetos para todos os Delphi adicionados
Algumas melhorias e criação do TKRKToolTip ainda em andamento

Change Summary

Incremental Difference

--- trunk/rtp/prj/Delphi 10 (Delphi 2006)/KRKLib.dpk (revision 571)
+++ trunk/rtp/prj/Delphi 10 (Delphi 2006)/KRKLib.dpk (revision 572)
@@ -1,32 +1,15 @@
11 package KRKLib;
22
33 {$R *.res}
4-{$ALIGN 8}
5-{$ASSERTIONS ON}
6-{$BOOLEVAL OFF}
7-{$DEBUGINFO ON}
8-{$EXTENDEDSYNTAX ON}
9-{$IMPORTEDDATA ON}
10-{$IOCHECKS ON}
11-{$LOCALSYMBOLS ON}
12-{$LONGSTRINGS ON}
13-{$OPENSTRINGS ON}
14-{$OPTIMIZATION ON}
15-{$OVERFLOWCHECKS OFF}
16-{$RANGECHECKS OFF}
17-{$REFERENCEINFO ON}
18-{$SAFEDIVIDE OFF}
19-{$STACKFRAMES OFF}
20-{$TYPEDADDRESS OFF}
21-{$VARSTRINGCHECKS ON}
22-{$WRITEABLECONST OFF}
23-{$MINENUMSIZE 1}
24-{$IMAGEBASE $400000}
4+
255 {$DESCRIPTION 'Anak Krakatoa Library'}
6+{$LIBPREFIX ''}
267 {$LIBSUFFIX '100'}
8+{$LIBVERSION ''}
9+{$IMPLICITBUILD OFF}
2710 {$RUNONLY}
28-{$IMPLICITBUILD OFF}
2911
12+
3013 requires
3114 designide,
3215 PNGComponentsR,
@@ -36,11 +19,11 @@
3619 vcldb,
3720 dsnap,
3821 dclstd,
39- vclie,
40- webdsnap;
22+ dsnapxml,
23+ soapmidas,
24+ vclie;
4125
4226 contains
43- crtl,
4427 KRK.ToolsAPI in '..\..\SRC\ToolsAPI\KRK.ToolsAPI.pas',
4528 KRK.Rtl.Common.Classes.Interposer in '..\..\SRC\Rtl\Common\KRK.Rtl.Common.Classes.Interposer.pas',
4629 KRK.Rtl.Common.Classes in '..\..\SRC\Rtl\Common\KRK.Rtl.Common.Classes.pas',
@@ -159,6 +142,6 @@
159142 KRK.Network.WS2Def in '..\..\src\Network\KRK.Network.WS2Def.pas',
160143 KRK.Network.WinSock2 in '..\..\src\Network\KRK.Network.WinSock2.pas',
161144 KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas',
162- KRK.Rtl.Win.CommCtrl in '..\..\SRC\Rtl\Win\KRK.Rtl.Win.CommCtrl.pas';
145+ KRK.Rtl.Win.CommCtrl in '..\..\src\Rtl\Win\KRK.Rtl.Win.CommCtrl.pas';
163146
164147 end.
--- trunk/rtp/prj/Delphi 11 (Delphi 2007)/KRKLib.dpk (revision 571)
+++ trunk/rtp/prj/Delphi 11 (Delphi 2007)/KRKLib.dpk (revision 572)
@@ -141,6 +141,7 @@
141141 KRK.Internet.WebView2 in '..\..\src\Internet\KRK.Internet.WebView2.pas',
142142 KRK.Network.WS2Def in '..\..\src\Network\KRK.Network.WS2Def.pas',
143143 KRK.Network.WinSock2 in '..\..\src\Network\KRK.Network.WinSock2.pas',
144- KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas';
144+ KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas',
145+ KRK.Rtl.Win.CommCtrl in '..\..\src\Rtl\Win\KRK.Rtl.Win.CommCtrl.pas';
145146
146147 end.
--- trunk/rtp/prj/Delphi 11 (Delphi 2007)/KRKLib.dproj (revision 571)
+++ trunk/rtp/prj/Delphi 11 (Delphi 2007)/KRKLib.dproj (revision 572)
@@ -1,6 +1,6 @@
11 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
22 <PropertyGroup>
3- <ProjectGuid>{EDACE720-CE4D-4FE4-99B1-C0F35883F0F0}</ProjectGuid>
3+ <ProjectGuid>{615F8E22-85E1-4850-8E24-A876F6F1D9B8}</ProjectGuid>
44 <MainSource>KRKLib.dpk</MainSource>
55 <Base>True</Base>
66 <Config Condition="'$(Config)'==''">Base</Config>
--- trunk/rtp/prj/Delphi 12 (Delphi 2009)/KRKLib.dpk (revision 571)
+++ trunk/rtp/prj/Delphi 12 (Delphi 2009)/KRKLib.dpk (revision 572)
@@ -141,6 +141,7 @@
141141 KRK.Internet.WebView2 in '..\..\src\Internet\KRK.Internet.WebView2.pas',
142142 KRK.Network.WS2Def in '..\..\src\Network\KRK.Network.WS2Def.pas',
143143 KRK.Network.WinSock2 in '..\..\src\Network\KRK.Network.WinSock2.pas',
144- KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas';
144+ KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas',
145+ KRK.Rtl.Win.CommCtrl in '..\..\src\Rtl\Win\KRK.Rtl.Win.CommCtrl.pas';
145146
146147 end.
--- trunk/rtp/prj/Delphi 12 (Delphi 2009)/KRKLib.dproj (revision 571)
+++ trunk/rtp/prj/Delphi 12 (Delphi 2009)/KRKLib.dproj (revision 572)
@@ -1,6 +1,6 @@
11 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
22 <PropertyGroup>
3- <ProjectGuid>{83929DA3-CB42-4CD5-95A8-AB3BDAAE5508}</ProjectGuid>
3+ <ProjectGuid>{3529562A-D817-4425-9B73-1A16485D3E87}</ProjectGuid>
44 <MainSource>KRKLib.dpk</MainSource>
55 <Base>True</Base>
66 <Config Condition="'$(Config)'==''">Base</Config>
--- trunk/rtp/prj/Delphi 14 (Delphi 2010)/KRKLib.dpk (revision 571)
+++ trunk/rtp/prj/Delphi 14 (Delphi 2010)/KRKLib.dpk (revision 572)
@@ -141,6 +141,7 @@
141141 KRK.Internet.WebView2 in '..\..\src\Internet\KRK.Internet.WebView2.pas',
142142 KRK.Network.WS2Def in '..\..\src\Network\KRK.Network.WS2Def.pas',
143143 KRK.Network.WinSock2 in '..\..\src\Network\KRK.Network.WinSock2.pas',
144- KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas';
144+ KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas',
145+ KRK.Rtl.Win.CommCtrl in '..\..\src\Rtl\Win\KRK.Rtl.Win.CommCtrl.pas';
145146
146147 end.
--- trunk/rtp/prj/Delphi 14 (Delphi 2010)/KRKLib.dproj (revision 571)
+++ trunk/rtp/prj/Delphi 14 (Delphi 2010)/KRKLib.dproj (revision 572)
@@ -1,6 +1,6 @@
11 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
22 <PropertyGroup>
3- <ProjectGuid>{41603BA8-2BCE-4929-AA5A-66C16C1C3F96}</ProjectGuid>
3+ <ProjectGuid>{60F265EC-88E3-457A-B00D-213B5DAAC81A}</ProjectGuid>
44 <MainSource>KRKLib.dpk</MainSource>
55 <Base>True</Base>
66 <Config Condition="'$(Config)'==''">Base</Config>
--- trunk/rtp/prj/Delphi 15 (Delphi XE)/KRKLib.dpk (revision 571)
+++ trunk/rtp/prj/Delphi 15 (Delphi XE)/KRKLib.dpk (revision 572)
@@ -141,6 +141,7 @@
141141 KRK.Internet.WebView2 in '..\..\src\Internet\KRK.Internet.WebView2.pas',
142142 KRK.Network.WS2Def in '..\..\src\Network\KRK.Network.WS2Def.pas',
143143 KRK.Network.WinSock2 in '..\..\src\Network\KRK.Network.WinSock2.pas',
144- KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas';
144+ KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas',
145+ KRK.Rtl.Win.CommCtrl in '..\..\src\Rtl\Win\KRK.Rtl.Win.CommCtrl.pas';
145146
146147 end.
--- trunk/rtp/prj/Delphi 15 (Delphi XE)/KRKLib.dproj (revision 571)
+++ trunk/rtp/prj/Delphi 15 (Delphi XE)/KRKLib.dproj (revision 572)
@@ -1,6 +1,6 @@
11 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
22 <PropertyGroup>
3- <ProjectGuid>{F8913DDF-4307-4FBE-8988-511EEB0B617D}</ProjectGuid>
3+ <ProjectGuid>{434590FE-5628-46F4-A190-BE48ADAE8F4C}</ProjectGuid>
44 <MainSource>KRKLib.dpk</MainSource>
55 <Base>True</Base>
66 <Config Condition="'$(Config)'==''">Base</Config>
--- trunk/rtp/prj/Delphi 16 (Delphi XE2)/KRKLib.dpk (revision 571)
+++ trunk/rtp/prj/Delphi 16 (Delphi XE2)/KRKLib.dpk (revision 572)
@@ -141,6 +141,7 @@
141141 KRK.Internet.WebView2 in '..\..\src\Internet\KRK.Internet.WebView2.pas',
142142 KRK.Network.WS2Def in '..\..\src\Network\KRK.Network.WS2Def.pas',
143143 KRK.Network.WinSock2 in '..\..\src\Network\KRK.Network.WinSock2.pas',
144- KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas';
144+ KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas',
145+ KRK.Rtl.Win.CommCtrl in '..\..\src\Rtl\Win\KRK.Rtl.Win.CommCtrl.pas';
145146
146147 end.
--- trunk/rtp/prj/Delphi 16 (Delphi XE2)/KRKLib.dproj (revision 571)
+++ trunk/rtp/prj/Delphi 16 (Delphi XE2)/KRKLib.dproj (revision 572)
@@ -1,6 +1,6 @@
11 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
22 <PropertyGroup>
3- <ProjectGuid>{7F842868-2CB2-44F9-86E9-2AFFE0D69441}</ProjectGuid>
3+ <ProjectGuid>{7B75EB77-7A69-4921-92EC-A9CE9DBB1A59}</ProjectGuid>
44 <MainSource>KRKLib.dpk</MainSource>
55 <Base>True</Base>
66 <Config Condition="'$(Config)'==''">Base</Config>
--- trunk/rtp/prj/Delphi 17 (Delphi XE3)/KRKLib.dpk (revision 571)
+++ trunk/rtp/prj/Delphi 17 (Delphi XE3)/KRKLib.dpk (revision 572)
@@ -141,6 +141,7 @@
141141 KRK.Internet.WebView2 in '..\..\src\Internet\KRK.Internet.WebView2.pas',
142142 KRK.Network.WS2Def in '..\..\src\Network\KRK.Network.WS2Def.pas',
143143 KRK.Network.WinSock2 in '..\..\src\Network\KRK.Network.WinSock2.pas',
144- KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas';
144+ KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas',
145+ KRK.Rtl.Win.CommCtrl in '..\..\src\Rtl\Win\KRK.Rtl.Win.CommCtrl.pas';
145146
146147 end.
--- trunk/rtp/prj/Delphi 17 (Delphi XE3)/KRKLib.dproj (revision 571)
+++ trunk/rtp/prj/Delphi 17 (Delphi XE3)/KRKLib.dproj (revision 572)
@@ -1,6 +1,6 @@
11 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
22 <PropertyGroup>
3- <ProjectGuid>{03F54892-0BB5-445E-B508-0CEEEDDF8801}</ProjectGuid>
3+ <ProjectGuid>{21D84C42-D4B1-4E0A-B749-F037CFAFCE07}</ProjectGuid>
44 <MainSource>KRKLib.dpk</MainSource>
55 <Base>True</Base>
66 <Config Condition="'$(Config)'==''">Base</Config>
--- trunk/rtp/prj/Delphi 18 (Delphi XE4)/KRKLib.dpk (revision 571)
+++ trunk/rtp/prj/Delphi 18 (Delphi XE4)/KRKLib.dpk (revision 572)
@@ -141,6 +141,7 @@
141141 KRK.Internet.WebView2 in '..\..\src\Internet\KRK.Internet.WebView2.pas',
142142 KRK.Network.WS2Def in '..\..\src\Network\KRK.Network.WS2Def.pas',
143143 KRK.Network.WinSock2 in '..\..\src\Network\KRK.Network.WinSock2.pas',
144- KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas';
144+ KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas',
145+ KRK.Rtl.Win.CommCtrl in '..\..\src\Rtl\Win\KRK.Rtl.Win.CommCtrl.pas';
145146
146147 end.
--- trunk/rtp/prj/Delphi 18 (Delphi XE4)/KRKLib.dproj (revision 571)
+++ trunk/rtp/prj/Delphi 18 (Delphi XE4)/KRKLib.dproj (revision 572)
@@ -1,6 +1,6 @@
11 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
22 <PropertyGroup>
3- <ProjectGuid>{BB967D70-6FCC-4F35-8B0B-502E57150A9A}</ProjectGuid>
3+ <ProjectGuid>{5BCA27CF-29FE-4FD5-A77E-D6419AFEB13B}</ProjectGuid>
44 <MainSource>KRKLib.dpk</MainSource>
55 <Base>True</Base>
66 <Config Condition="'$(Config)'==''">Base</Config>
--- trunk/rtp/prj/Delphi 19 (Delphi XE5)/KRKLib.dpk (revision 571)
+++ trunk/rtp/prj/Delphi 19 (Delphi XE5)/KRKLib.dpk (revision 572)
@@ -141,6 +141,7 @@
141141 KRK.Internet.WebView2 in '..\..\src\Internet\KRK.Internet.WebView2.pas',
142142 KRK.Network.WS2Def in '..\..\src\Network\KRK.Network.WS2Def.pas',
143143 KRK.Network.WinSock2 in '..\..\src\Network\KRK.Network.WinSock2.pas',
144- KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas';
144+ KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas',
145+ KRK.Rtl.Win.CommCtrl in '..\..\src\Rtl\Win\KRK.Rtl.Win.CommCtrl.pas';
145146
146147 end.
--- trunk/rtp/prj/Delphi 19 (Delphi XE5)/KRKLib.dproj (revision 571)
+++ trunk/rtp/prj/Delphi 19 (Delphi XE5)/KRKLib.dproj (revision 572)
@@ -1,6 +1,6 @@
11 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
22 <PropertyGroup>
3- <ProjectGuid>{9B048DD8-F740-4A93-A523-7CD7C95FB3BD}</ProjectGuid>
3+ <ProjectGuid>{118F92E9-6826-4EE2-AA10-0A718B782179}</ProjectGuid>
44 <MainSource>KRKLib.dpk</MainSource>
55 <Base>True</Base>
66 <Config Condition="'$(Config)'==''">Base</Config>
--- trunk/rtp/prj/Delphi 20 (Delphi XE6)/KRKLib.dpk (revision 571)
+++ trunk/rtp/prj/Delphi 20 (Delphi XE6)/KRKLib.dpk (revision 572)
@@ -141,6 +141,7 @@
141141 KRK.Internet.WebView2 in '..\..\src\Internet\KRK.Internet.WebView2.pas',
142142 KRK.Network.WS2Def in '..\..\src\Network\KRK.Network.WS2Def.pas',
143143 KRK.Network.WinSock2 in '..\..\src\Network\KRK.Network.WinSock2.pas',
144- KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas';
144+ KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas',
145+ KRK.Rtl.Win.CommCtrl in '..\..\src\Rtl\Win\KRK.Rtl.Win.CommCtrl.pas';
145146
146147 end.
--- trunk/rtp/prj/Delphi 20 (Delphi XE6)/KRKLib.dproj (revision 571)
+++ trunk/rtp/prj/Delphi 20 (Delphi XE6)/KRKLib.dproj (revision 572)
@@ -1,6 +1,6 @@
11 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
22 <PropertyGroup>
3- <ProjectGuid>{998E2ED5-09FA-4DE0-818B-C8DA10D69D7C}</ProjectGuid>
3+ <ProjectGuid>{33EC0F8F-C75D-435E-B170-B4C91AE05324}</ProjectGuid>
44 <MainSource>KRKLib.dpk</MainSource>
55 <Base>True</Base>
66 <Config Condition="'$(Config)'==''">Base</Config>
--- trunk/rtp/prj/Delphi 21 (Delphi XE7)/KRKLib.dpk (revision 571)
+++ trunk/rtp/prj/Delphi 21 (Delphi XE7)/KRKLib.dpk (revision 572)
@@ -141,6 +141,7 @@
141141 KRK.Internet.WebView2 in '..\..\src\Internet\KRK.Internet.WebView2.pas',
142142 KRK.Network.WS2Def in '..\..\src\Network\KRK.Network.WS2Def.pas',
143143 KRK.Network.WinSock2 in '..\..\src\Network\KRK.Network.WinSock2.pas',
144- KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas';
144+ KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas',
145+ KRK.Rtl.Win.CommCtrl in '..\..\src\Rtl\Win\KRK.Rtl.Win.CommCtrl.pas';
145146
146147 end.
--- trunk/rtp/prj/Delphi 21 (Delphi XE7)/KRKLib.dproj (revision 571)
+++ trunk/rtp/prj/Delphi 21 (Delphi XE7)/KRKLib.dproj (revision 572)
@@ -1,6 +1,6 @@
11 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
22 <PropertyGroup>
3- <ProjectGuid>{631F420A-D6C7-433E-AB93-DA38D6ABAE1B}</ProjectGuid>
3+ <ProjectGuid>{999E2F96-FB6D-473A-B268-117956821F00}</ProjectGuid>
44 <MainSource>KRKLib.dpk</MainSource>
55 <Base>True</Base>
66 <Config Condition="'$(Config)'==''">Base</Config>
--- trunk/rtp/prj/Delphi 22 (Delphi XE8)/KRKLib.dpk (revision 571)
+++ trunk/rtp/prj/Delphi 22 (Delphi XE8)/KRKLib.dpk (revision 572)
@@ -141,6 +141,7 @@
141141 KRK.Internet.WebView2 in '..\..\src\Internet\KRK.Internet.WebView2.pas',
142142 KRK.Network.WS2Def in '..\..\src\Network\KRK.Network.WS2Def.pas',
143143 KRK.Network.WinSock2 in '..\..\src\Network\KRK.Network.WinSock2.pas',
144- KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas';
144+ KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas',
145+ KRK.Rtl.Win.CommCtrl in '..\..\src\Rtl\Win\KRK.Rtl.Win.CommCtrl.pas';
145146
146147 end.
--- trunk/rtp/prj/Delphi 22 (Delphi XE8)/KRKLib.dproj (revision 571)
+++ trunk/rtp/prj/Delphi 22 (Delphi XE8)/KRKLib.dproj (revision 572)
@@ -1,6 +1,6 @@
11 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
22 <PropertyGroup>
3- <ProjectGuid>{9A99974F-AC96-43FD-88D8-9D23026B1FA4}</ProjectGuid>
3+ <ProjectGuid>{51D1B24E-CF2A-4F1A-8DFA-7538FC27E147}</ProjectGuid>
44 <MainSource>KRKLib.dpk</MainSource>
55 <Base>True</Base>
66 <Config Condition="'$(Config)'==''">Base</Config>
--- trunk/rtp/prj/Delphi 23 (Delphi Seattle)/KRKLib.dpk (revision 571)
+++ trunk/rtp/prj/Delphi 23 (Delphi Seattle)/KRKLib.dpk (revision 572)
@@ -141,6 +141,7 @@
141141 KRK.Internet.WebView2 in '..\..\src\Internet\KRK.Internet.WebView2.pas',
142142 KRK.Network.WS2Def in '..\..\src\Network\KRK.Network.WS2Def.pas',
143143 KRK.Network.WinSock2 in '..\..\src\Network\KRK.Network.WinSock2.pas',
144- KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas';
144+ KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas',
145+ KRK.Rtl.Win.CommCtrl in '..\..\src\Rtl\Win\KRK.Rtl.Win.CommCtrl.pas';
145146
146147 end.
--- trunk/rtp/prj/Delphi 23 (Delphi Seattle)/KRKLib.dproj (revision 571)
+++ trunk/rtp/prj/Delphi 23 (Delphi Seattle)/KRKLib.dproj (revision 572)
@@ -1,6 +1,6 @@
11 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
22 <PropertyGroup>
3- <ProjectGuid>{9BA65C04-60D7-439C-B003-0B30B51AD111}</ProjectGuid>
3+ <ProjectGuid>{B5217B0C-0093-45C9-A7E4-FC479BD2E0C5}</ProjectGuid>
44 <MainSource>KRKLib.dpk</MainSource>
55 <Base>True</Base>
66 <Config Condition="'$(Config)'==''">Base</Config>
--- trunk/rtp/prj/Delphi 24 (Delphi Berlin)/KRKLib.dpk (revision 571)
+++ trunk/rtp/prj/Delphi 24 (Delphi Berlin)/KRKLib.dpk (revision 572)
@@ -141,6 +141,7 @@
141141 KRK.Internet.WebView2 in '..\..\src\Internet\KRK.Internet.WebView2.pas',
142142 KRK.Network.WS2Def in '..\..\src\Network\KRK.Network.WS2Def.pas',
143143 KRK.Network.WinSock2 in '..\..\src\Network\KRK.Network.WinSock2.pas',
144- KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas';
144+ KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas',
145+ KRK.Rtl.Win.CommCtrl in '..\..\src\Rtl\Win\KRK.Rtl.Win.CommCtrl.pas';
145146
146147 end.
--- trunk/rtp/prj/Delphi 24 (Delphi Berlin)/KRKLib.dproj (revision 571)
+++ trunk/rtp/prj/Delphi 24 (Delphi Berlin)/KRKLib.dproj (revision 572)
@@ -1,6 +1,6 @@
11 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
22 <PropertyGroup>
3- <ProjectGuid>{EC6A7349-6E2F-4698-82DC-2BCB97A777A6}</ProjectGuid>
3+ <ProjectGuid>{A30D2560-3F4E-4D8A-B7B7-3DD50414A17B}</ProjectGuid>
44 <MainSource>KRKLib.dpk</MainSource>
55 <Base>True</Base>
66 <Config Condition="'$(Config)'==''">Base</Config>
--- trunk/rtp/prj/Delphi 25 (Delphi Tokyo)/KRKLib.dpk (revision 571)
+++ trunk/rtp/prj/Delphi 25 (Delphi Tokyo)/KRKLib.dpk (revision 572)
@@ -141,6 +141,7 @@
141141 KRK.Internet.WebView2 in '..\..\src\Internet\KRK.Internet.WebView2.pas',
142142 KRK.Network.WS2Def in '..\..\src\Network\KRK.Network.WS2Def.pas',
143143 KRK.Network.WinSock2 in '..\..\src\Network\KRK.Network.WinSock2.pas',
144- KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas';
144+ KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas',
145+ KRK.Rtl.Win.CommCtrl in '..\..\src\Rtl\Win\KRK.Rtl.Win.CommCtrl.pas';
145146
146147 end.
--- trunk/rtp/prj/Delphi 25 (Delphi Tokyo)/KRKLib.dproj (revision 571)
+++ trunk/rtp/prj/Delphi 25 (Delphi Tokyo)/KRKLib.dproj (revision 572)
@@ -1,6 +1,6 @@
11 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
22 <PropertyGroup>
3- <ProjectGuid>{3BF772B6-54A9-4C23-A2FB-33DCD844F18B}</ProjectGuid>
3+ <ProjectGuid>{488F18BD-478C-42A3-A708-DEF1BE3E6B67}</ProjectGuid>
44 <MainSource>KRKLib.dpk</MainSource>
55 <Base>True</Base>
66 <Config Condition="'$(Config)'==''">Base</Config>
--- trunk/rtp/prj/Delphi 26 (Delphi Rio)/KRKLib.dproj (revision 571)
+++ trunk/rtp/prj/Delphi 26 (Delphi Rio)/KRKLib.dproj (revision 572)
@@ -39,6 +39,7 @@
3939 <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
4040 <VerInfo_Locale>1033</VerInfo_Locale>
4141 <DllPrefixDefined>false</DllPrefixDefined>
42+ <Debugger_HostApplication>D:\Desenvolvimento\Delphi\Projetos\OnStepper\bin\OnStepper.exe</Debugger_HostApplication>
4243 </PropertyGroup>
4344 <ItemGroup>
4445 <DelphiCompile Include="$(MainSource)">
--- trunk/rtp/prj/Delphi 27 (Delphi Sydney)/KRKLib.dpk (revision 571)
+++ trunk/rtp/prj/Delphi 27 (Delphi Sydney)/KRKLib.dpk (revision 572)
@@ -141,6 +141,7 @@
141141 KRK.Internet.WebView2 in '..\..\src\Internet\KRK.Internet.WebView2.pas',
142142 KRK.Network.WS2Def in '..\..\src\Network\KRK.Network.WS2Def.pas',
143143 KRK.Network.WinSock2 in '..\..\src\Network\KRK.Network.WinSock2.pas',
144- KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas';
144+ KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas',
145+ KRK.Rtl.Win.CommCtrl in '..\..\src\Rtl\Win\KRK.Rtl.Win.CommCtrl.pas';
145146
146147 end.
--- trunk/rtp/prj/Delphi 27 (Delphi Sydney)/KRKLib.dproj (revision 571)
+++ trunk/rtp/prj/Delphi 27 (Delphi Sydney)/KRKLib.dproj (revision 572)
@@ -1,6 +1,6 @@
11 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
22 <PropertyGroup>
3- <ProjectGuid>{D124ABD4-D435-4DBB-81BE-AB1AC090B9A5}</ProjectGuid>
3+ <ProjectGuid>{64A8BE8C-5867-4339-BCF9-283D3701964C}</ProjectGuid>
44 <MainSource>KRKLib.dpk</MainSource>
55 <Base>True</Base>
66 <Config Condition="'$(Config)'==''">Base</Config>
--- trunk/rtp/prj/Delphi 28 (Delphi Alexandria)/KRKLib.dpk (revision 571)
+++ trunk/rtp/prj/Delphi 28 (Delphi Alexandria)/KRKLib.dpk (revision 572)
@@ -141,6 +141,7 @@
141141 KRK.Internet.WebView2 in '..\..\src\Internet\KRK.Internet.WebView2.pas',
142142 KRK.Network.WS2Def in '..\..\src\Network\KRK.Network.WS2Def.pas',
143143 KRK.Network.WinSock2 in '..\..\src\Network\KRK.Network.WinSock2.pas',
144- KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas';
144+ KRK.Network.WS2TcpIp in '..\..\src\Network\KRK.Network.WS2TcpIp.pas',
145+ KRK.Rtl.Win.CommCtrl in '..\..\src\Rtl\Win\KRK.Rtl.Win.CommCtrl.pas';
145146
146147 end.
--- trunk/rtp/prj/Delphi 28 (Delphi Alexandria)/KRKLib.dproj (revision 571)
+++ trunk/rtp/prj/Delphi 28 (Delphi Alexandria)/KRKLib.dproj (revision 572)
@@ -1,6 +1,6 @@
11 <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
22 <PropertyGroup>
3- <ProjectGuid>{0D5B533C-4470-4080-AD55-8003AAA315C1}</ProjectGuid>
3+ <ProjectGuid>{839C1D59-E2A1-40AE-A24E-349DAA3F5B0D}</ProjectGuid>
44 <MainSource>KRKLib.dpk</MainSource>
55 <Base>True</Base>
66 <Config Condition="'$(Config)'==''">Base</Config>
--- trunk/rtp/src/Rtl/Win/KRK.Rtl.Win.CommCtrl.pas (revision 571)
+++ trunk/rtp/src/Rtl/Win/KRK.Rtl.Win.CommCtrl.pas (revision 572)
@@ -6,48 +6,184 @@
66 Windows, Messages, CommCtrl, Graphics, Controls;
77 //https://www.devmedia.com.br/tooltips-em-aplicacoes-delphi-dica/16252
88 type
9- TDefaultIcon = (diNone,tiInfo,diWarning,diError,diInfoLarge,diWarningLarge,diErrorLarge);
10-
11- TMaxCharsPerTextLine = 50..500;
12-
13- TKRKBalloonHintParams = record
14- Control: TControl;
15- Icon: HICON;
16- IconId: String;
17- Title: String;
18- Text: String;
19- MaxCharsPerTextLine: TMaxCharsPerTextLine;
20- BackColor: TColor;
21- ForeColor: TColor;
22-
23- ActivateOnShow: Boolean;
24- end;
25-
26- // Use esta classe para criar balões em runtime
27- TKRKBalloonHint = class
9+ //: Use esta classe para criar dicas (ToolTips) em runtime.
10+ //: Para criar e exibir um ToolTip, primeiramente se cria a janela deste
11+ //: ToolTip. Literalmente a janela do ToolTip é o próprio ToolTip, isto é,
12+ //: aquilo que aparece flutando com um texto é uma janela porque toda janela
13+ //: de ToolTip possui implicitamente os estilos WS_POPUP (uma janela que fica
14+ //: sobre a janela principal da aplicação) e WS_EX_TOOLWINDOW (uma janela que
15+ //: não mostra um botão na barra de tarefas e não é mostrada quando se usa
16+ //: ALT+TAB).
17+ //:
18+ //: Como um ToolTip é basicamente uma janela, usar a classe atual só permite
19+ //: exibir um ToolTip de cada vez, porém é possível adicionar várias
20+ //: "ferramentas", que basicamente são cópias da estrutura TToolInfo, onde os
21+ //: membros hwnd e uid são usados para identificá-las. A fim de facilitar o
22+ //: entendimento, podemos pensar nisso como uma lista de possíveis opções de
23+ //: visualização de uma mesma janela (a janela de ToolTip), ou seja, a mesma
24+ //: janela de ToolTip aparece de formas distintas de acordo com a opção de
25+ //: visualização selecionada e para adicionar um conjunto de opções usa-se a
26+ //: mensagem TTM_ADDTOOL (método AddToolInfo). Cada opção de visualização
27+ //: (TOOLINFO) possui seu proprio conjunto de uFlags, rect, hInst, lpszText e
28+ //: lParam. Veja o MSDN a respeito de TOOLINFO para entender estes membros.
29+ //:
30+ //: Três outras características do ToolTip não são salvas em suas várias
31+ //: possiveis configurações de exibição, pois estão intimamente ligadas a
32+ //: janela de ToolTip e são, seu título, o seu ícone e sua posição, isto é,
33+ //: estas configurações afetam a exibição do ToolTip para todas as
34+ //: configurações de exibição registradas. Em outras palavras, caso estas
35+ //: configurações não sejam alteradas imediatamente antes da exibição do
36+ //: ToolTip, serão usadas as configurações que foram setadas anteriormente.
37+ //: Por exemplo, se você adicionar 2 configurações de exibição (TTM_ADDTOOL) à
38+ //: janela de ToolTip e exibir cada uma delas com um título e local diferentes
39+ //: e depois ocultá-las, caso você apenas exiba o ToolTip usando
40+ //: TTM_TRACKACTIVATE, os últimos título, ícone, e posição definidas serão
41+ //: usados para todos os ToolTips, o que nos obriga a, toda vez que exibirmos
42+ //: um tooltip, também configurar seu título, ícone e posição.
43+ //:
44+ //: Cada configuração de exibição adicionada por meio de AddToolInfo precisa
45+ //: ter sua própria identificação, por isso este método tem os
46+ //: parâmetros Ahwnd e AuId. Estes parâmetros representam, respectivamente, os
47+ //: membros hwnd e uId de uma estrutura TToolInfo exclusiva para a
48+ //: configuração de exibição sendo adicionada
49+ //:
50+ //: hwnd é o handle da janela pai, cujo significado depende de outros membros
51+ //: de TToolInfo. Ao atribuir este membro com um handle válido, o membro rect
52+ //: usa a área cliente da janela deste handle como base para definir seu
53+ //: retângulo. Caso este este membro não contenha um handle válido, o membro
54+ //: rect usa como base a tela (desktop) o que não é muito útil, portanto,
55+ //: sempre que quiser utilizar rect é essencial definir também Ahwnd, do
56+ //: contrário não serão obtidos os efeitos desejados. Outra utilização deste
57+ //: membro é indicar qual janela vai receber a mensagem WM_NOTIFY com o código
58+ //: TTN_GETDISPINFO, quando o membro lpszText contiver LPSTR_TEXTCALLBACK
59+ //: (leia a documentação de TOOLINFO). De acordo com a documentação do MSDN a
60+ //: janela indicada neste membro recebe outras notificações, tais como
61+ //: NM_CUSTOMDRAW, TTN_LINKCLICK, TTN_NEEDTEXT, TTN_POP e TTN_SHOW. Este
62+ //: membro pode ser zero, neste caso, sempre que se adicionar uma nova
63+ //: configuração de exibição o membro uId precisa ter um valor diferente a fim
64+ //: de manter a unicidade desta configuração
65+ //:
66+ //: uId serve para definir um id único para a configuração de exibição ou,
67+ //: caso o flag TTF_IDISHWND esteja definido, informe neste membro o handle da
68+ //: ferramenta associada (TWinControl). Quando TTF_IDISHWND está definido, o
69+ //: membro rect é completamente ignorado, porque a região será obtida
70+ //: diretamente da ferramenta cujo handle é agora conhecido por meio de uId
71+ //: @SeeAlso(DelToolInfo)
72+ //: @SeeAlso(AddToolInfo)
73+ TKRKTrackingToolTip = class
2874 private
29- FOwnerHandle: HWND;
30- FHandle: THandle;
31- FToolInfo: TToolInfo;
32-
33- procedure CreateToolTip;
34- procedure DestroyToolTip;
35- procedure UnlinkToolTip;
36- procedure LinkToolTip;
37- procedure RefreshToolTip;
38- procedure SetIconAndTitle(const AIcon: HICON; const ATitle: String);
39- procedure SetText(const AText: String; const MaxCharsPerTextLine: TMaxCharsPerTextLine);
75+ FToolTipWindowHandle: HWND;
76+ FDefaultWidth: SmallInt;
77+ FDefaultTitle: LPTSTR;
78+ FDefaultIcon: HICON;
79+ FActive: Boolean;
80+ //: Cria a janela do ToolTip, a qual receberá mensagens de ToolTip (TTM)
81+ function CreateToolTipWindow(AOwnerHandle: HWND; AToolTipStyles: Cardinal): HWND;
82+ //: Destrói a janela do ToolTip
83+ procedure DestroyToolTipWindow;
84+ //: (Re)Configura um ToolTip com alguns dos membros de TToolInfo. Use este
85+ //: método para atribuir vários membros de TToolInfo de uma só vez.
86+ //: A mensagem TTM_SETTOOLINFO utiliza os membros hwnd e id para identificar
87+ //: o ToolTip a ser modificado, isso significa que não é possível alterar
88+ //: estes membros após eles terem sido definidos. É responsabilidade do
89+ //: chamador configurar o membro cbSize de AToolInfo. Os únicos membros
90+ //: válidos para alteração são uFlags, rect, hinst, lpszText e lParam. O
91+ //: membro lpszText, se alterado aqui, precisa ter no máximo 80 caracteres.
92+ //: Para definir textos maiores use a mensagem TTM_UPDATETIPTEXT
93+ //: @SeeAlso(DelToolInfo)
94+ //: @SeeAlso(AddToolInfo)
95+ procedure SetToolInfo(const AToolInfo: TToolInfo);
96+ //: Atualiza as informações existentes na estrutura TOOLINFO identificada
97+ //: por Ahwnd e AuId. Basicamente este método atribui os membros uFlags,
98+ //: rect, hinst e lParam. O membro lpszText será atribuído usando o
99+ //: método SetText
100+ procedure UpdateToolInfo(const Ahwnd: HWND;
101+ const AuId: UINT_PTR;
102+ const AuFlags: UINT;
103+ const Arect: TRect;
104+ const AhInst: HINST;
105+ const AlpszText: LPTSTR;
106+ const AlParam: LPARAM);
107+ //: Obtém a estrutura TToolInfo associada ao ToolTip identificado pelos
108+ //: membros hwnd (AParentHandle) e uId (AId). Use este método para obter as
109+ //: configurações de um ToolTip de forma que seja possível alterar algumas
110+ //: destas configurações e aplicá-las posteriormente usando
111+ //: @Link(SetToolInfo). O membro lpszText retorna apenas os primeiros 80
112+ //: caracteres do texto configurado. Para obter o texto completo de um
113+ //: ToolTip use a mensagem TTM_GETTEXT
114+ function GetToolInfo(const AParentHandle: HWND; const AId: UINT_PTR; out AToolInfo: TToolInfo; out AMustDeallocateText: Boolean): Boolean;
115+ procedure SetText(const Ahwnd: HWND; const AuId: UINT_PTR; const AlpszText: PChar);
116+ { Os métodos a seguir afetam a exibição de todos os ToolTips que podem ser }
117+ { exibidos pela classe atual }
118+ procedure SetMaxTipWidth(const ATipWidth: SmallInt = -1);
119+ procedure SetPosition(const AX, AY: Word);
120+ procedure ResetToDefaultToolTipWindowProperties;
121+ procedure SetActive(const AValue: Boolean);
40122 public
41- constructor Create(AOwnerHandle: HWND);
123+ constructor Create(AOwnerHandle: HWND; AToolTipStyles: Cardinal = TTS_NOPREFIX or TTS_ALWAYSTIP or TTS_BALLOON; ADefaultWidth: SmallInt = -1; ADefaultTitle: String = 'Nenhum título definido'; ADefaultIcon: HICON = TTI_INFO);
42124 destructor Destroy; override;
125+ //: Adiciona uma configuração de exibição para a janela de ToolTip atual
126+ //: identificada pelos parâmetros informados de forma única. Os membros
127+ //: Ahwnd e AuId são, respectivamente, os membro hwnd e uId de TToolInfo e
128+ //: são usados como identificadores desta configuração no momento de sua
129+ //: adição. Este método meramente usa TTM_ADDTOOL para registrar uma
130+ //: estrutura TOOLINFO cujos membros são informados nos seus parâmetros
131+ //: cujos nomes correspondem aos membros de TToolInfo
132+ //: @SeeAlso(UpdateToolInfo)
133+ //: @SeeAlso(DelToolTipConfig)
134+ //: @SeeAlso(Show)
135+ procedure AddToolInfo(const Ahwnd: HWND;
136+ const AuId: UINT_PTR;
137+ AuFlags: Cardinal;
138+ Arect: TRect;
139+ AhInst: HINST;
140+ AlpszText: LPTSTR;
141+ AlParam: LPARAM);
142+ //: Remove a configuração de exibição identificada pelos perâmetros
143+ //: informados da janela de ToolTip criada por esta classe. Os membros hwnd
144+ //: (Ahwnd) e uId (AuId) de TToolInfo são usados como identificadores da
145+ //: configuração de exibição no momento de sua remoção
146+ //: @SeeAlso(UpdateToolInfo)
147+ //: @SeeAlso(AddToolInfo)
148+ procedure DelToolInfo(const Ahwnd: HWND; const AuId: UINT_PTR);
43149
44150 procedure Hide;
45- procedure Show(AParams: TKRKBalloonHintParams);
151+ //: Retorna True caso o ToolTip esteja sendo exibido na tela. Mais
152+ //: espeificamente, retorna True se a janela de ToolTip está visível. Quando
153+ //: a janela de ToolTip está visível, o ToolTip está visível. A ajuda da
154+ //: Microsoft chama de "tool" o ToolTip, mas isso só serve mesmo para
155+ //: confundir as coisas
156+ function IsVisible: Boolean;
157+ procedure Show(const Ahwnd: HWND; const AuId: UINT_PTR; const AuFlags: UINT; const Arect: TRect; const AhInst: HINST; const AlpszText: LPTSTR; const AlParam: LPARAM; const ATitle: LPTSTR; const AIconHandle: HICON; const AIconResourceId: LPTSTR; AMaxTipWidth: SmallInt; const AX, AY: Word; const AActivateOnShow: Boolean = True); overload;
158+ //: Exibe o ToolTip com as suas configurações originais. As configurações
159+ //: originais de um ToolTip encontram-se na estrutura TOOLINFO identificada
160+ //: por Ahwnd e AuId e são, uFlags, rect, hinst, lpszText e lParam. O ícone
161+ //: o título, e a posição do ToolTip são propriedades da janela de ToolTip,
162+ //: que é única, e por isso tais propriedades são compartilhadas entre todas
163+ //: as configurações selecionáveis por meio de Ahwnd e AuId, isto é, ao usar
164+ //: esta versão do método show, o título, o ícone e a posição do ToolTip
165+ //: serão aqueles que foram definidos inicialmente ou por meio de uma
166+ //: chamada anterior à outra versão do método Show
167+ procedure Show(const Ahwnd: HWND; const AuId: UINT_PTR; const AActivateOnShow: Boolean = True); overload;
168+ //: Obtém o handle para um ícone adicionado aos recursos da aplicação e
169+ //: identificado por AResourceId
170+ function IconResourceId2IconHandle(AIconResourceId: LPTSTR): HICON;
171+ { Os métodos a seguir afetam a exibição de todos os ToolTips que podem ser }
172+ { exibidos pela classe atual }
173+ procedure SetIconAndTitle(const AIconHandle: HICON; const ATitle: LPTSTR);
174+
175+ property ToolTipWindowHandle: HWND read FToolTipWindowHandle;
176+ //: Quando False, nenhum dos ToolTips registrados por esta classe aparecerá.
177+ //: Quando da criação desta classe, esta propriedade é sempre true, o que
178+ //: significa que todos os ToolTips registrados poderão aparecer, seja
179+ //: automaticamente ou por demanda
180+ property Active: Boolean read FActive write SetActive;
46181 end;
47182
48183 const
49184 {$IF RTLVersion <= 18} { Delphi 2006}
50185 TOOLTIPS_CLASS = 'tooltips_class32';
186+
51187 // Mensagens de Tool Tip (TTM)
52188 TTM_SETTITLEA = WM_USER + 32; { wParam = TTI_*, lParam = char* szTitle }
53189 TTM_SETTITLEW = WM_USER + 33; { wParam = TTI_*, lParam = wchar* szTitle }
@@ -67,15 +203,12 @@
67203 // mensagens que são recebidas pelo controle pai, são estas WM_LBUTTONDOWN,
68204 // WM_LBUTTONUP, WM_MBUTTONDOWN, WM_MBUTTONUP, WM_MOUSEMOVE, WM_RBUTTONDOWN e
69205 // WM_RBUTTONUP. Este flag tem de ser setado caso queira fazer o balão
70- // aparecer quando o cursor estiver sobre o controle pai. O comportamento
71- // descrito aqui acontece na teoria, mas na prática não! Apenas ative
72- // TTF_SUBCLASS se quiser que a dica seja exibida quando o cursor passar por
73- // cima do controle pai
206+ // aparecer quando o cursor estiver sobre o controle associado.
74207 TTF_PARSELINKS = $1000;
75208 {$IFEND}
76209 // Notificações de Tool Tip (TTN). Provavelmente são códigos usados para
77210 // diferenciar vários tipos de mensagens que são enviadas como notificação.
78- // Concluí isso observando o código de TKRKBalloonHint.CustomizedWindowProc em
211+ // Concluí isso observando o código de TKRKTrackingToolTip.CustomizedWindowProc em
79212 // KRK.Vcl.Controls
80213 TTN_LINKCLICK = TTN_FIRST - 3;
81214
@@ -82,43 +215,55 @@
82215 implementation
83216
84217 uses
85- Classes{, UITypes}, SysUtils;
218+ Classes, UITypes, SysUtils;
86219
87-{ TKRKBalloonHint }
220+const
221+ // Tamanho máximo do texto do ToolTip, em caracteres. O texto do ToolTip pode
222+ // ter qualquer tamanho, entretanto eu impus esta limitação para facilitar a
223+ // manipulação deste texto, pois limitar desta forma facilita na criação de
224+ // buffers, os quais terão sempre um tamanho conhecido. Os requisitos de
225+ // memória para este texto variam de acordo com a plataforma (ANSI ou
226+ // UNICODE). Em plataformas ANSI (1 Byte por caractere), serão usados 1024
227+ // Bytes para representar o texto + 1 Byte para o terminador (null). Em
228+ // plataformas UNICODE serão usados 2048 Bytes para representar o texto + 2
229+ // Bytes para os terminadores (null). O código desta unit usa esta constante
230+ // para limitar a quantidade de texto que o ToolTip aceita verificando o
231+ // length de uma string
232+ TOOLTIPTEXTMAXLENGTH = 1024;
88233
89-constructor TKRKBalloonHint.Create(AOwnerHandle: HWND);
234+{ TKRKTrackingToolTip }
235+
236+constructor TKRKTrackingToolTip.Create(AOwnerHandle: HWND; AToolTipStyles: Cardinal = TTS_NOPREFIX or TTS_ALWAYSTIP or TTS_BALLOON; ADefaultWidth: SmallInt = -1; ADefaultTitle: String = 'Nenhum título definido'; ADefaultIcon: HICON = TTI_INFO);
90237 begin
91- FOwnerHandle := AOwnerHandle;
92- // TToolInfo tem capacidade de receber no membro hwnd o handle de um
93- // TWinControl e assim algumas outras mensagens que usam este handle
94- // funcionarão, como por exemplo TTM_TRACKACTIVATE. O problema com isso é que
95- // existem então duas formas de criar o balão. Uma forma é atrelada a um
96- // TWinControl por meio de hwnd como foi dito e a outra forma é posicionar o
97- // balão de forma livre em qualquer controle ou qualquer lugar da tela de
98- // forma "manual". A forma manual permite posicionar o balão em qualquer
99- // coisa, por isso eu estou aqui optando por usar FToolInfo apenas como uma
100- // estrutura para guardar um record e o texto do balão. Todos os outros usos
101- // estão descartados para simplificar as coisas
102- ZeroMemory(@FToolInfo, SizeOf(TToolInfo));
103- FToolInfo.cbSize := SizeOf(TToolInfo);
238+ // Cria a janela do ToolTip com os parâmetros especificados e coloca seu
239+ // Handle em FToolTipWindowHandle
240+ FToolTipWindowHandle := CreateToolTipWindow(AOwnerHandle, AToolTipStyles);
104241
105- CreateToolTip;
242+ FActive := True;
243+
244+ FDefaultWidth := ADefaultWidth;
245+ FDefaultTitle := PChar(ADefaultTitle);
246+ FDefaultIcon := ADefaultIcon;
247+
248+ ResetToDefaultToolTipWindowProperties;
106249 end;
107250
108251 var
109- OriginalToolTipWNDPROC: Pointer = nil;
252+ // OTTWNDPROC = Original ToolTip WndProc
253+ OTTWNDPROC: Pointer = nil;
110254
111-function NewToolTipWNDPROC(AWindowHandle: HWND; AMessage: UINT; AWParam: WPARAM; ALParam: LPARAM): LRESULT; stdcall;
255+// NTTWNDPROC = New ToolTip WndProc
256+function NTTWNDPROC(AWindowHandle: HWND; AMessage: UINT; AWParam: WPARAM; ALParam: LPARAM): LRESULT; stdcall;
112257 //var
258+// KRBH: TKRKTrackingToolTip;
113259 // ShiftState: TShiftState;
114260 // Button: TMouseButton;
115-// KRBH: TKRKBalloonHint;
116261 begin
117262 // Button := mbLeft;
118263
119264 // Obtendo a instância do balão atual, a fim de obter acesso facilitado a suas
120265 // propriedades e eventos
121-// KRBH := TKRKBalloonHint(GetWindowLong(AWindowHandle,GWL_USERDATA));
266+// KRBH := TKRKTrackingToolTip(GetWindowLong(AWindowHandle,GWL_USERDATA));
122267
123268 // if KRBH.FShowWhenRequested then
124269 // case AMessage of
@@ -231,150 +376,437 @@
231376 // end;
232377 // // o que raios acontece quando se fecha o tooltip clicando o X?
233378 // end;
379+
380+ if AMessage = WM_SHOWWINDOW then
381+ OutputDebugString('WM_SHOWWINDOW ao ocultar o tooltip');
382+// obtenha a instancia da classe aqui e execute o hide diretamente.
383+// verifique se ao fazer isso, torna desnecessário usar o hide antes do show de alguma forma
384+
385+ if AMessage = WM_SIZE then
386+ OutputDebugString('WM_SIZE ');
387+
388+ if AMessage = WM_WINDOWPOSCHANGED then
389+ OutputDebugString('WM_WINDOWPOSCHANGED ');
390+
391+ if AMessage = WM_DESTROY then
392+ OutputDebugString('WM_DESTROY ');
393+
394+
234395 // Deixa o procedimento de jenala original lidar com as mensagens também
235- Result := CallWindowProc(OriginalToolTipWNDPROC,AWindowHandle,AMessage,AWParam,ALParam);
396+ Result := CallWindowProc(OTTWNDPROC,AWindowHandle,AMessage,AWParam,ALParam);
236397 end;
237398
238399 // [1] https://docs.microsoft.com/en-us/windows/win32/controls/create-a-tooltip-for-a-control
239400
240-procedure TKRKBalloonHint.CreateToolTip;
241-var
242- Style: Cardinal;
401+function TKRKTrackingToolTip.CreateToolTipWindow(AOwnerHandle: HWND; AToolTipStyles: Cardinal): HWND;
243402 begin
244- // Estilos padrão que sempre são configurados incondicionalmente
245- Style := TTS_NOPREFIX or TTS_BALLOON;
246-
247- // Cria a janela do balão mais básica possível. Por padrão
248-
249- // FOwnerHandle é de fato o "dono" do balão, não necessariamente seu pai. É
403+ // AOwnerHandle é de fato o "dono" do ToolTip, não necessariamente seu pai. É
250404 // que para o Windows, na função CreateWindow, hWndParent é o handle do Owner,
251405 // diferente do Delphi que deixa bem claro quem é Owner e quem é Parent. A
252- // página [1] contém um exemplo que cria um balão para um um controle (também
253- // conhecido como ferramenta [tool]) dentro de uma caixa de diálogo e o
254- // parâmetro hWndParent de CreateWindowEx recebe o handle da caixa de diálogo,
255- // que é, neste caso, ao mesmo tempo pai e dono do controle/tool
256- FHandle := CreateWindowEx(WS_EX_NOACTIVATE or WS_EX_TOPMOST,TOOLTIPS_CLASS,nil,Style,0,0,0,0,FOwnerHandle,0,0,nil);
406+ // página [1] contém um exemplo que cria um balão para um um controle
407+ // (TWinControl/ferramenta/tool) dentro de uma caixa de diálogo e o parâmetro
408+ // hWndParent de CreateWindowEx recebe o handle da caixa de diálogo, que é,
409+ // neste caso, ao mesmo tempo pai e dono do controle/tool. FHandle é retornado
410+ // e é o handle da janela do balão que acaba de ser criado
411+ Result := CreateWindowEx(WS_EX_NOACTIVATE // A jenala do ToolTip não ficará ativa e portanto nunca será a janela da frente
412+ or WS_EX_TOPMOST // A janela do ToolTip ficará em cima de outras janelas não top-most e fica lá mesmo se desativada
413+ ,TOOLTIPS_CLASS
414+ ,nil
415+ ,AToolTipStyles // Estilos aplicados a janela do ToolTip
416+ ,0,0,0,0
417+ ,AOwnerHandle // Handle do dono do ToolTip
418+ ,0
419+ ,HInstance // Não influencia em nada mas acho boa prática
420+ ,nil);
257421
258- // Seta GWL_USERDATA do balão para que o mesmo seja o ponteiro para esta
259- // classe, o que facilita o acesso a partir de funções de callback
260- SetWindowLong(FHandle,GWL_USERDATA,Integer(Self));
422+ // Associa a instância da classe atual à janela do ToolTip, o que facilita o
423+ // acesso ao objeto que a classe atual define, a partir de funções de callback
424+ SetWindowLongPtr(Result,GWL_USERDATA,Integer(Self));
261425
262426 // Seta o ponteiro para GWL_WNDPROC do nosso procedimento de janela
263427 // customizado, e retorna o ponteiro para o procedimento de janela original.
264- // Como cada instância de TKRKBalloonHint usa o mesmo tipo de processamento
428+ // Como cada instância de TKRKTrackingToolTip usa o mesmo tipo de processamento
265429 // para suas mensagens, basta apenas um ponteiro para o WndProc original que
266430 // todos os ToolTips vão usar de forma compartilhada. Dentro de
267- // NewToolTipWNDPROC é possível acessar a instância da classe atual e assim
268- // diferenciar qual ToolTip está tendo suas mensagens manipuladas
269- OriginalToolTipWNDPROC := Pointer(SetWindowLong(FHandle,GWL_WNDPROC,LongInt(@NewToolTipWNDPROC)));
431+ // NewToolTipWNDPROC é possível acessar a instância da classe atual, informada
432+ // no comando SetWindowLongPtr anterior, e assim diferenciar qual ToolTip está
433+ // tendo suas mensagens manipuladas
270434
271- LinkToolTip;
435+ OTTWNDPROC := Pointer(SetWindowLong(Result,GWL_WNDPROC,LongInt(@NTTWNDPROC)));
272436 end;
273437
274-destructor TKRKBalloonHint.Destroy;
438+destructor TKRKTrackingToolTip.Destroy;
275439 begin
276- DestroyToolTip;
440+ DestroyToolTipWindow;
277441 inherited;
278442 end;
279443
280-procedure TKRKBalloonHint.DestroyToolTip;
444+procedure TKRKTrackingToolTip.DestroyToolTipWindow;
281445 begin
282- if FHandle <> 0 then
446+ if FToolTipWindowHandle <> 0 then
447+ DestroyWindow(FToolTipWindowHandle);
448+end;
449+
450+//procedure TKRKTrackingToolTip.Hide(const AParentHandle: HWND; const AId: UINT_PTR);
451+//var
452+// ToolInfo: TToolInfo;
453+//begin
454+// if FToolTipWindowHandle <> 0 then
455+// begin
456+// ToolInfo.cbSize := SizeOf(TToolInfo);
457+// ToolInfo.hwnd := AParentHandle;
458+// ToolInfo.uId := AId;
459+//
460+// SendMessage(FToolTipWindowHandle,TTM_TRACKACTIVATE,WPARAM(False),LPARAM(@ToolInfo));
461+// end;
462+//end;
463+
464+procedure TKRKTrackingToolTip.Hide;
465+var
466+ ToolInfo: TToolInfo;
467+begin
468+ if FToolTipWindowHandle <> 0 then
283469 begin
284- UnlinkToolTip; { Não tinha isso }
285- DestroyWindow(FHandle);
470+ ZeroMemory(@ToolInfo,SizeOf(TToolInfo));
471+ ToolInfo.cbSize := SizeOf(TToolInfo);
472+ // Pra falar a verdade, ao se ocultar o ToolTip estamos ocultando a janela
473+ // de ToolTip, que é apenas uma, neste caso os membros hwnd e uId são
474+ // irrelevantes. Eles só são relevantes quando estamos exibindo o ToolTip,
475+ // pois sua jenala precisa ser configurada antes de ser exibida com as
476+ // configurações contidas na estrutura TToolInfo identificada pelos
477+ // membros hwnd e uId
478+ SendMessage(FToolTipWindowHandle,TTM_TRACKACTIVATE,WPARAM(False),LPARAM(@ToolInfo));
479+ // A exibição de um ToolTip do tipo tracking pode ter alterado a largura
480+ // da janela de ToolTip, neste caso, garantimos aqui que quando um ToolTip
481+ // não tracking for exibido ele terá a largura padrão definida na
482+ // propriedade FDefaultToolTipWidth
483+ SetMaxTipWidth(FDefaultWidth);
286484 end;
287485 end;
288486
289-procedure TKRKBalloonHint.Hide;
487+function TKRKTrackingToolTip.IsVisible: Boolean;
290488 begin
291- if FHandle <> 0 then
292- SendMessage(FHandle,TTM_TRACKACTIVATE,0,LPARAM(@FToolInfo));
489+ Result := SendMessage(FToolTipWindowHandle,TTM_GETCURRENTTOOL,0,0) > 0;
293490 end;
294491
295-procedure TKRKBalloonHint.LinkToolTip;
492+procedure TKRKTrackingToolTip.AddToolInfo(const Ahwnd: HWND;
493+ const AuId: UINT_PTR;
494+ AuFlags: Cardinal;
495+ Arect: TRect;
496+ AhInst: HINST;
497+ AlpszText: LPTSTR;
498+ AlParam: LPARAM);
499+var
500+ ToolInfo: TToolInfo;
296501 begin
297- if FHandle <> 0 then
298- SendMessage(FHandle,TTM_ADDTOOL,0,LPARAM(@FToolInfo));
502+ if FToolTipWindowHandle <> 0 then
503+ begin
504+ ZeroMemory(@ToolInfo,SizeOf(TToolInfo));
505+
506+ ToolInfo.cbSize := SizeOf(TToolInfo);
507+ ToolInfo.hwnd := Ahwnd;
508+ ToolInfo.uId := AuId;
509+ ToolInfo.uFlags := AuFlags;
510+ ToolInfo.Rect := Arect;
511+ ToolInfo.hInst := AhInst;
512+ ToolInfo.lpszText := AlpszText;
513+ ToolInfo.lParam := AlParam;
514+
515+ // O membro lpszText tem dupla funcionalidade, a principal é aceitar um
516+ // texto de até 80 caracteres, que é o texto do ToolTip. A outra
517+ // funcionalidade é receber identificadores especiais de forma que o texto
518+ // do ToolTip seja obtido a partir de uma string de recurso ou a partir de
519+ // uma mensagem de notificação (TTN_GETDISPINFO). O texto de 80 caracteres é
520+ // inútil, visto que é possível configurar um texto de qualquer tamanho via
521+ // TTM_UPDATETIPTEXT, por este motivo aqui eu estou utilizando lpszText
522+ // apenas para configurar identificadores. Caso um texto tenha sido
523+ // informado em AlpszText, será usado TTM_UPDATETIPTEXT após o envio da
524+ // mensagem TTM_ADDTOOL
525+
526+ SendMessage(FToolTipWindowHandle,TTM_ADDTOOL,0,LPARAM(@ToolInfo));
527+
528+ // Caso haja algo em AlpszText...
529+ if Assigned(AlpszText) then
530+ begin
531+ // Caso AlpszText não seja nem um identificador de string de recurso e nem
532+ // LPSTR_TEXTCALLBACK, significa que há um texto propriamente dito e neste
533+ // caso, enviamos a mensagem TTM_UPDATETIPTEXT. A identificação do que
534+ // AlpszText representa é feita por meio do endereço do ponteiro que há
535+ // neste parâmetro. Um ponteiro padrão é um número de 32 bits, onde os
536+ // dois Words que o representam tem valores maiores que zero. Quando o
537+ // Word de ordem superior contido em AlpszText é zero significa que
538+ // estamos informando o identificador de uma string de recurso, pois
539+ // fatalmente o Word de ordem inferior terá um valor maior que zero (do
540+ // contrário AlpszText seria nil). Quando o ponteiro em AlpszText é
541+ // LPSTR_TEXTCALLBACK (-1 ou $FFFFFFFF), significa que o texto do ToolTip
542+ // será obitdo por meio de TTN_GETDISPINFO
543+ if (Cardinal(AlpszText) <> High(Cardinal)) and (HiWord(Cardinal(AlpszText)) > 0) then
544+ SetText(Ahwnd,AuId,PChar(Copy(AlpszText,1,TOOLTIPTEXTMAXLENGTH)));
545+ // Caso a condição acima não seja satisfeita, significa que AlpszText
546+ // contém um identificador de string de recurso ou LPSTR_TEXTCALLBACK e
547+ // neste caso não precisamos fazer mais nada, pois a mensagem TTM_ADDTOOL
548+ // já foi enviada com este identificador preenchido.
549+ end
550+ // Caso AlpszText seja nill, atribuimos um texto padrão de propósito de
551+ // forma que o ToolTip apareça. Não fazer isso faria com que o ToolTip não
552+ // aparecesse e isso poderia confundir o programador, que não saberia por
553+ // que isso aconteceu. Caso o programador informe uma string vazia aí
554+ // realmente não tem jeito, pois o ToolTip não vai aparecer
555+ else
556+ SetText(Ahwnd,AuId,'Nenhum texto foi definido, por isso você está vendo isso');
557+ end;
299558 end;
300559
301-procedure TKRKBalloonHint.RefreshToolTip;
560+procedure TKRKTrackingToolTip.DelToolInfo(const Ahwnd: HWND; const AuId: UINT_PTR);
561+var
562+ ToolInfo: TToolInfo;
302563 begin
303- if FHandle <> 0 then
304- SendMessage(FHandle,TTM_UPDATE,0,0);
564+ if FToolTipWindowHandle <> 0 then
565+ begin
566+ Hide;
567+
568+ ToolInfo.cbSize := SizeOf(TToolInfo);
569+ ToolInfo.hwnd := Ahwnd;
570+ ToolInfo.uId := AuId;
571+
572+ SendMessage(FToolTipWindowHandle,TTM_DELTOOL,0,LPARAM(@ToolInfo));
573+ end;
305574 end;
306575
307-procedure TKRKBalloonHint.SetIconAndTitle(const AIcon: HICON; const ATitle: String);
576+procedure TKRKTrackingToolTip.SetToolInfo(const AToolInfo: TToolInfo);
308577 begin
309- if FHandle <> 0 then
578+ if FToolTipWindowHandle <> 0 then
579+ SendMessage(FToolTipWindowHandle,TTM_SETTOOLINFO,0,LPARAM(@AToolInfo));
580+end;
581+
582+function TKRKTrackingToolTip.GetToolInfo(const AParentHandle: HWND; const AId: UINT_PTR; out AToolInfo: TToolInfo; out AMustDeallocateText: Boolean): Boolean;
583+begin
584+ ZeroMemory(@AToolInfo,SizeOf(TToolInfo));
585+ AMustDeallocateText := False;
586+ Result := False;
587+
588+ if FToolTipWindowHandle <> 0 then
310589 begin
311- SendMessage(FHandle,TTM_SETTITLE,AIcon,LPARAM(PChar(ATitle)));
312- RefreshToolTip;
590+ AToolInfo.cbSize := SizeOf(TToolInfo);
591+ AToolInfo.hwnd := AParentHandle;
592+ AToolInfo.uId := AId;
593+ Result := Boolean(SendMessage(FToolTipWindowHandle,TTM_GETTOOLINFO,0,LPARAM(@AToolInfo)));
594+ // Eu descobri que ao enviar a mensagem com AToolInfo zerado eu obtenho dois
595+ // valores possíveis em lpszText. Caso ele retorne como nil, significa que
596+ // ou não há texto algum ou há algum texto que precisa ser obtido, portanto,
597+ // no caso de lpszText voltar como nil, alocamos a memória em lpszText a fim
598+ // de tentar retornar um possível texto e definimos o parâmetro
599+ // "AMustDeallocateText" como true de forma que o chamador possa desalocar a
600+ // memória alocada aqui. Caso após a primeira mensagem, lpszText não seja
601+ // nil, significa que há um identificador atribuído (LPTSTR(n) ou
602+ // LPSTR_TEXTCALLBACK). Neste segundo caso, não há necessidade de alocar
603+ // memória (e nem sua posterior desalocação)
604+ if not Assigned(AToolInfo.lpszText) then
605+ begin
606+ GetMem(AToolInfo.lpszText,TOOLTIPTEXTMAXLENGTH * SizeOf(Char) + SizeOf(Char));
607+ Result := Boolean(SendMessage(FToolTipWindowHandle,TTM_GETTOOLINFO,0,LPARAM(@AToolInfo)));
608+ AMustDeallocateText := True;
609+ end;
313610 end;
314611 end;
315612
316-procedure TKRKBalloonHint.SetText(const AText: String; const MaxCharsPerTextLine: TMaxCharsPerTextLine);
613+procedure TKRKTrackingToolTip.UpdateToolInfo(const Ahwnd: HWND; const AuId: UINT_PTR; const AuFlags: UINT; const Arect: TRect; const AhInst: HINST; const AlpszText: LPTSTR; const AlParam: LPARAM);
614+var
615+ ToolInfo: TToolInfo;
616+ MustDeallocateText: Boolean;
317617 begin
318- FToolInfo.lpszText := PChar(WrapText(AText,MaxCharsPerTextLine));
618+ if FToolTipWindowHandle <> 0 then
619+ begin
620+ // Obtém as configurações do ToolTip identificado por Ahwnd e AuId.
621+ if GetToolInfo(Ahwnd,AuId,ToolInfo,MustDeallocateText) then
622+ try
623+ // Configura os flags caso o valor passado seja diferente de zero. Caso
624+ // o valor seja zero, os flags preexistetes em ToolInfo serão usados.
625+ // Estes flags preexistentes podem ter sido informados quando da adição
626+ // da configuração de exibição identificada aqui por Ahwnd e AuId,
627+ // usando o método AddToolInfo. Ao alterar estes flags, eles passam a
628+ // ser os flags vigentes para a combinação Ahwnd + AuId
629+ if AuFlags <> 0 then
630+ ToolInfo.uFlags := AuFlags;
631+ // Configura o rect que define a "região-quente" do ToolTip. Esta
632+ // configuração só é relevante se AuFlags NÃO contiver TTF_IDISHWND.
633+ // Primeiro verificamos se foi passado um rect não nulo para só assim
634+ // alterarmos o valor do membro rect, pois após a configuração deste
635+ // membro, seu novo valor passará a ser o valor vigente e salvo na
636+ // estrutra TOOLINFO identificada por Ahwnd e AuId. A ideia da condição
637+ // abaixo foi obtida do método IsEmpty do record TRect no Delphi Rio
638+ if (Arect.Right > Arect.Left) or (Arect.Bottom > Arect.Top) then
639+ ToolInfo.Rect := Arect;
640+ // Configura o handle do módulo (executável, por exemplo) de forma que
641+ // seja possível obter strings de recurso diretamente dele, informando o
642+ // id de tais strings diretamente em AParams.Text. Isso só vai acontecer
643+ // caso AhInst seja diferente de zero
644+ if AhInst <> 0 then
645+ ToolInfo.hInst := AhInst;
646+ // Configura o membro lParam de significado livre
647+ if AlParam <> 0 then
648+ ToolInfo.lParam := AlParam;
649+ // Configura o ToolTip identificado por hwnd e id com as opções acima
650+ SetToolInfo(ToolInfo);
651+ // Definindo o texto do ToolTip aqui para permitir que um texto de
652+ // qualquer tamanho seja informado (TTM_UPDATETIPTEXT)
653+ if Assigned(AlpszText) then
654+ SetText(Ahwnd,AuId,AlpszText);
655+ finally
656+ if MustDeallocateText then
657+ FreeMem(ToolInfo.lpszText);
658+ end;
659+ end;
660+end;
319661
320- if FHandle <> 0 then
662+procedure TKRKTrackingToolTip.ResetToDefaultToolTipWindowProperties;
663+begin
664+ SetMaxTipWidth(FDefaultWidth);
665+ SetIconAndTitle(FDefaultIcon,FDefaultTitle);
666+end;
667+
668+function TKRKTrackingToolTip.IconResourceId2IconHandle(AIconResourceId: LPTSTR): HICON;
669+begin
670+ Result := 0;
671+
672+ if Assigned(AIconResourceId) then
673+ Result := LoadIcon(HInstance,AIconResourceId);
674+end;
675+
676+procedure TKRKTrackingToolTip.SetActive(const AValue: Boolean);
677+begin
678+ if FToolTipWindowHandle <> 0 then
321679 begin
322- SendMessage(FHandle,TTM_UPDATETIPTEXT,0,LPARAM(@FToolInfo));
323- RefreshToolTip;
680+ FActive := AValue;
681+
682+ SendMessage(FToolTipWindowHandle,TTM_ACTIVATE,WPARAM(FActive),0);
324683 end;
325684 end;
326685
686+procedure TKRKTrackingToolTip.SetIconAndTitle(const AIconHandle: HICON; const ATitle: LPTSTR);
687+begin
688+ if FToolTipWindowHandle <> 0 then
689+ if (AIconHandle > 0) or Assigned(ATitle) then
690+ SendMessage(FToolTipWindowHandle,TTM_SETTITLE,AIconHandle,LPARAM(ATitle));
691+end;
327692
693+procedure TKRKTrackingToolTip.SetMaxTipWidth(const ATipWidth: SmallInt = -1);
694+begin
695+ if FToolTipWindowHandle <> 0 then
696+ SendMessage(FToolTipWindowHandle,TTM_SETMAXTIPWIDTH,0,ATipWidth);
697+end;
698+
699+procedure TKRKTrackingToolTip.SetPosition(const AX, AY: Word);
700+begin
701+ if FToolTipWindowHandle <> 0 then
702+ SendMessage(FToolTipWindowHandle,TTM_TRACKPOSITION,0,MAKELONG(AX,AY));
703+end;
704+
705+procedure TKRKTrackingToolTip.SetText(const Ahwnd: HWND; const AuId: UINT_PTR; const AlpszText: PChar);
706+var
707+ ToolInfo: TToolInfo;
708+begin
709+ if FToolTipWindowHandle <> 0 then
710+ begin
711+ ZeroMemory(@ToolInfo,SizeOf(TToolInfo));
712+ ToolInfo.cbSize := SizeOf(TToolInfo);
713+
714+ ToolInfo.hwnd := Ahwnd;
715+ ToolInfo.uId := AuId;
716+ ToolInfo.lpszText := AlpszText;
717+
718+ SendMessage(FToolTipWindowHandle,TTM_UPDATETIPTEXT,0,LPARAM(@ToolInfo));
719+ end;
720+end;
721+
328722 // https://docs.microsoft.com/en-us/windows/win32/controls/tooltip-controls
329723 // https://docs.microsoft.com/en-us/windows/win32/controls/using-tooltip-contro
330724
331-procedure TKRKBalloonHint.Show(AParams: TKRKBalloonHintParams);
725+procedure TKRKTrackingToolTip.Show(const Ahwnd: HWND; const AuId: UINT_PTR; const AActivateOnShow: Boolean = True);
332726 var
333- Icon: HICON;
727+ ToolInfo: TToolInfo;
334728 begin
335- if FHandle <> 0 then
729+ if FToolTipWindowHandle <> 0 then
336730 begin
337- Icon := 0;
338- // AParams.Icon tem precedência sobre AParams.IconId
339- if Trim(AParams.IconId) <> '' then
340- begin
341- // carregar hicon
342- end
343- else if AParams.Icon > 0 then
344- begin
345- Icon := AParams.Icon;
346- end;
731+ ToolInfo.cbSize := SizeOf(TToolInfo);
732+ ToolInfo.hwnd := Ahwnd;
733+ ToolInfo.uId := AuId;
734+ // Quando um ToolTip do tipo balão possui um botão de fechar (TTS_CLOSE) e
735+ // este botão é clicado, o ToolTip é fechado normalmente, mas não parece
736+ // novamente de jeito nenhum, a não ser que, antes de enviar a mensagem de
737+ // exibição, enviemos uma mensagem de ocultação, o que parece (e é)
738+ // redundante aqui, mas necessário. Deve ser algum bug da API do Windows
739+ Hide;
347740
348- SetIconAndTitle(Icon,AParams.Title);
741+ SendMessage(FToolTipWindowHandle,TTM_TRACKACTIVATE,WPARAM(True),LPARAM(@ToolInfo));
349742
350-// if AParams.MaxCharsPerTextLine < Low(TMaxCharsPerTextLine) then
351-// AParams.MaxCharsPerTextLine := 50;
743+ // Coloca o foco na janela de ToolTip de acordo com a opção
744+ if AActivateOnShow then
745+ SetForegroundWindow(FToolTipWindowHandle);
746+ end;
747+end;
352748
353- SetText(AParams.Text,AParams.MaxCharsPerTextLine);
749+procedure TKRKTrackingToolTip.Show(const Ahwnd: HWND; const AuId: UINT_PTR; const AuFlags: UINT; const Arect: TRect; const AhInst: HINST; const AlpszText: LPTSTR; const AlParam: LPARAM; const ATitle: LPTSTR; const AIconHandle: HICON; const AIconResourceId: LPTSTR; AMaxTipWidth: SmallInt; const AX, AY: Word; const AActivateOnShow: Boolean = True);
750+var
751+ Icon: HICON;
752+begin
753+ if FToolTipWindowHandle <> 0 then
754+ begin
755+ // Exibir um ToolTip enquanto outro está sendo exibido provoca vários
756+ // problemas. Eu já havia percebido isso quando usei o ToolTip do ícone da
757+ // bandeja do sistema. Caso um ToolTip esteja sendo exibido e outro seja
758+ // definido para ser exibido sem que o anterior seja ocultado, haverá a
759+ // mudança apenas do título do ToolTip, mas o texto permanecerá o mesmo.
760+ // Isso parece ser um bug (ou uma feature) dos ToolTips mesmo. Não é erro
761+ // de implementação minha. O código abaixo oculta um ToolTip que estiver
762+ // visível. Apenas um ToolTip pode ser visível de cada vez, mas para ser
763+ // mais preciso, apenas uma configuração de exibição pode ser exibida de
764+ // cada vez. Alterar uma configuração de exibição sem antes ocultar um
765+ // ToolTip que esteja sendo exibido, causa problemas. Talvez usar uma
766+ // mensagem TTM_UPDATE após a reconfiguração da janela de ToolTip seja
767+ // suficiente contudo eu acho que ocultar o ToolTip antes de mudar sua
768+ // configuração e exibí-lo de novo seja uma boa prática
769+ Hide;
770+ // -------------------------------------------------------------------------
771+ // Primeiramente configura-se tudo que é atribuído diretamente a ToolInfo.
772+ // -------------------------------------------------------------------------
773+ UpdateToolInfo(Ahwnd,AuId,AuFlags,Arect,AhInst,AlpszText,AlParam);
774+ // -------------------------------------------------------------------------
775+ // Agora configura-se o que não pode ser atribuído diretamente a ToolInfo
776+ // -------------------------------------------------------------------------
777+ // Definindo o título do ToolTip e seu ícone. Isso só será efetivo se a
778+ // janela de ToolTip tiver sido criada com o estilo TTS_BALLOON. AIconHandle
779+ // tem precedência sobre AIconResourceId, caso ambos sejam informados
780+ Icon := 0;
354781
355- // TTM_UPDATETIPTEXT mudar o texto após ttm_addtool ter sido usada
782+ if AIconHandle > 0 then
783+ Icon := AIconHandle
784+ else if Assigned(AIconResourceId) then
785+ Icon := IconResourceId2IconHandle(AIconResourceId);
356786
787+ SetIconAndTitle(Icon,ATitle);
788+ // Definindo a largura máxima do ToolTip. Se o texto não couber no tamanho
789+ // especificado (em pixels) ele será quebrado. Caso AMaxTipWidth seja menor
790+ // que -1 ou seja zero, o seu valor deve ser -1, que indica que o ToolTip
791+ // pode ter qualquer tamanho horizontal. Por outro lado, caso AMaxTipWidth
792+ // seja < 100 o seu valor deve ser 100 para garantir uma melhor
793+ // legibilidade do texto. O tamanho mínimo aceitável portanto é 100, mas as
794+ // condições abaixo permitem o uso de -1 para indicar qualquer largura
795+ if (AMaxTipWidth < -1) or (AMaxTipWidth = 0) then
796+ AMaxTipWidth := -1
797+ else if AMaxTipWidth < 100 then
798+ AMaxTipWidth := 100;
357799
358-// do jeito que está agora o balão é mostrado no ponto onde o curso do mouse estiver
359-// como eu to executando show no onenter, o balão aparece com a ponta nas bordas onde o mouse tocou primeiro
360-// isso pode ser interessante de manter, mas o que eu quero mesmo é configurar o ponto exato onde o balao aparece
800+ if (AMaxTipWidth = -1) or (AMaxTipWidth >= 100) then
801+ SetMaxTipWidth(AMaxTipWidth);
361802
362- SendMessage(FHandle,TTM_TRACKACTIVATE,1,LPARAM(@FToolInfo));
363-
364- if AParams.ActivateOnShow then
365- SetForegroundWindow(FHandle);
803+ // Definindo a posição de exibição da janela de ToolTip
804+ SetPosition(AX,AY);
805+ // Efetivamente exibe a janela de ToolTip
806+ Show(Ahwnd,AuId,AActivateOnShow);
366807 end
367808 else
368809 raise Exception.Create('Não é possível exibir o balão, pois o mesmo não foi criado. Use o método CreateToolTip antes de chamar o método Show');
369810 end;
370811
371-procedure TKRKBalloonHint.UnlinkToolTip;
372-begin
373- if FHandle <> 0 then
374- begin
375- Hide;
376- SendMessage(FHandle,TTM_DELTOOL,0,LPARAM(@FToolInfo));
377- end;
378-end;
379-
380812 end.
--- trunk/utl/TESTADOR/prj/Testador.dpr (revision 571)
+++ trunk/utl/TESTADOR/prj/Testador.dpr (revision 572)
@@ -1,11 +1,14 @@
11 program Testador;
22
3+{$R 'resources.res' 'resources.rc'}
4+{$R *.dres}
5+
36 uses
47 Forms,
58 {$IF RTLVersion < 20}
69 XPMan,
710 {$IFEND }
8- UPrincipal in '..\src\UPrincipal.pas' {Form8},
11+ UPrincipal in '..\src\UPrincipal.pas' {FormPrincipal},
912 UFormInterno in '..\src\UFormInterno.pas' {FORMInterno},
1013 UDAMOPrincipal in '..\src\UDAMOPrincipal.pas' {DAMOPrincipal: TDataModule},
1114 UFRAMAssinaturaEmXML in '..\src\UFRAMAssinaturaEmXML.pas' {FRAMAssinaturaEmXML: TFrame},
@@ -18,6 +21,6 @@
1821 ReportMemoryLeaksOnShutdown := true;
1922 Application.Initialize;
2023 Application.CreateForm(TDAMOPrincipal, DAMOPrincipal);
21- Application.CreateForm(TForm8, Form8);
24+ Application.CreateForm(TFormPrincipal, FormPrincipal);
2225 Application.Run;
2326 end.
--- trunk/utl/TESTADOR/prj/Testador.dproj (revision 571)
+++ trunk/utl/TESTADOR/prj/Testador.dproj (revision 572)
@@ -58,6 +58,7 @@
5858 <DCC_F>false</DCC_F>
5959 <DCC_K>false</DCC_K>
6060 <SanitizedProjectName>Testador</SanitizedProjectName>
61+ <BRCC_Verbose>true</BRCC_Verbose>
6162 </PropertyGroup>
6263 <PropertyGroup Condition="'$(Base_Win32)'!=''">
6364 <DCC_UsePackage>FireDACSqliteDriver;rbUSER1519;OverbyteIcsDXE5Run;DBXSqliteDriver;FireDACPgDriver;fmx;IndySystem;TeeDB;frx19;inetdbbde;DBXInterBaseDriver;DataSnapClient;DataSnapCommon;DataSnapServer;officeXPrt;DataSnapProviderClient;DBXSybaseASEDriver;DbxCommonDriver;rbDIDE1519;vclimg;dbxcds;DatasnapConnectorsFreePascal;MetropolisUILiveTile;rbADO1519;rbFireDAC1519;vcldb;vcldsnap;fmxFireDAC;DBXDb2Driver;rbIDE1519;rbTCUI1519;DBXOracleDriver;CustomIPTransport;rbBDE1519;SynEdit_RXE5;vclribbon;dsnap;IndyIPServer;IndyCore;vcl;IndyIPCommon;CloudService;DBXMSSQLDriver;FmxTeeUI;FireDACIBDriver;DataSnapFireDAC;FireDACDBXDriver;dclRBE1519;rbCIDE1519;inetdbxpress;dclRBDBE1519;frxe19;FireDACDb2Driver;adortl;frxDB19;FireDACASADriver;bindcompfmx;vcldbx;FireDACODBCDriver;rbUSERDesign1519;rbRAP1519;rtl;dbrtl;DbxClientDriver;rbDBDE1519;FireDACCommon;bindcomp;inetdb;Tee;DBXOdbcDriver;vclFireDAC;UCDataConnector;xmlrtl;svnui;UserControlR;IndyProtocols;DBXMySQLDriver;FireDACCommonDriver;soaprtl;bindengine;vclactnband;bindcompdbx;FMXTee;TeeUI;bindcompvcl;rbDAD1519;vclie;FireDACADSDriver;vcltouch;rbTC1519;VclSmp;FireDACMSSQLDriver;FireDAC;VCLRESTComponents;Intraweb;DBXInformixDriver;rbDBE1519;DataSnapConnectors;FireDACDataSnapDriver;dclRBADO1519;dclRBFireDAC1519;dsnapcon;DBXFirebirdDriver;rbRCL1519;inet;KRKLib;FireDACMySQLDriver;vclx;rbDB1519;svn;DBXSybaseASADriver;FireDACOracleDriver;RESTComponents;rbRIDE1519;bdertl;dclRBBDE1519;FireDACMSAccDriver;DataSnapIndy10ServerTransport;dbexpress;IndyIPClient;$(DCC_UsePackage)</DCC_UsePackage>
@@ -88,7 +89,6 @@
8889 <DCC_RemoteDebug>false</DCC_RemoteDebug>
8990 <BT_BuildType>Debug</BT_BuildType>
9091 <VerInfo_Keys>CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)</VerInfo_Keys>
91- <AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
9292 <DCC_DebugInfoInExe>false</DCC_DebugInfoInExe>
9393 </PropertyGroup>
9494 <PropertyGroup Condition="'$(Cfg_2)'!=''">
@@ -106,8 +106,11 @@
106106 <DelphiCompile Include="$(MainSource)">
107107 <MainSource>MainSource</MainSource>
108108 </DelphiCompile>
109+ <RcCompile Include="resources.rc">
110+ <Form>resources.res</Form>
111+ </RcCompile>
109112 <DCCReference Include="..\src\UPrincipal.pas">
110- <Form>Form8</Form>
113+ <Form>FormPrincipal</Form>
111114 </DCCReference>
112115 <DCCReference Include="..\src\UFormInterno.pas">
113116 <Form>FORMInterno</Form>
@@ -128,6 +131,10 @@
128131 <DesignClass>TFrame</DesignClass>
129132 </DCCReference>
130133 <DCCReference Include="..\src\UClasses.pas"/>
134+ <RcItem Include="..\res\icons8-ide-do-delphi-80.ico">
135+ <ResourceType>ICON</ResourceType>
136+ <ResourceId>IMGDELPHI</ResourceId>
137+ </RcItem>
131138 <BuildConfiguration Include="Release">
132139 <Key>Cfg_2</Key>
133140 <CfgParent>Base</CfgParent>
@@ -198,11 +205,15 @@
198205 <Source>
199206 <Source Name="MainSource">Testador.dpr</Source>
200207 </Source>
201- <Excluded_Packages>
202- <Excluded_Packages Name="$(BDSBIN)\dclofficexp260.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
203- </Excluded_Packages>
208+ <Excluded_Packages/>
204209 </Delphi.Personality>
205210 <Deployment Version="3">
211+ <DeployFile LocalName="..\res\icons8-ide-do-delphi-80.ico" Configuration="Debug" Class="ProjectFile">
212+ <Platform Name="Win32">
213+ <RemoteDir>.\</RemoteDir>
214+ <Overwrite>true</Overwrite>
215+ </Platform>
216+ </DeployFile>
206217 <DeployFile LocalName="..\bin\Testador.exe" Configuration="Debug" Class="ProjectOutput">
207218 <Platform Name="Win32">
208219 <RemoteName>Testador.exe</RemoteName>
--- trunk/utl/TESTADOR/src/UDAMOPrincipal.pas (revision 571)
+++ trunk/utl/TESTADOR/src/UDAMOPrincipal.pas (revision 572)
@@ -5,7 +5,8 @@
55 uses
66 SysUtils, Classes, Menus, ActnPopup, XPStyleActnCtrls,
77 Dialogs, System.ImageList, Vcl.ImgList, Vcl.Controls, System.Actions,
8- Vcl.ActnList, Vcl.StdActns, Vcl.ExtActns, KRK.Vcl.ExtActns;
8+ Vcl.ActnList, Vcl.StdActns, Vcl.ExtActns, KRK.Vcl.ExtActns,
9+ KRK.Rtl.Win.CommCtrl, Winapi.Messages;
910
1011 type
1112 TDAMOPrincipal = class(TDataModule)
@@ -36,16 +37,22 @@
3637 procedure MNUItextxml1Click(Sender: TObject);
3738 procedure MNUIapplicationjson1Click(Sender: TObject);
3839 procedure MNUIAuthorizationClick(Sender: TObject);
39- procedure ContentTypeapplicationxwwwformurlencodedcharsetutf81Click(
40- Sender: TObject);
41- procedure ContentTypemultipartformdataboundaryWININET1Click(
42- Sender: TObject);
40+ procedure ContentTypeapplicationxwwwformurlencodedcharsetutf81Click(Sender: TObject);
41+ procedure ContentTypemultipartformdataboundaryWININET1Click(Sender: TObject);
4342 procedure CookieClick(Sender: TObject);
4443 procedure MNUMultipartFormDataClick(Sender: TObject);
44+ procedure DataModuleCreate(Sender: TObject);
45+ procedure DataModuleDestroy(Sender: TObject);
4546 private
4647 { Private declarations }
48+ FKRTT: TKRKTrackingToolTip;
4749 public
4850 { Public declarations }
51+ procedure AddToolTipConfigurations;
52+ procedure ShowTrackingToolTip1;
53+ procedure ShowTrackingToolTip2;
54+ procedure ShowTrackingToolTip3;
55+ procedure HandleTTNMessages(var AMessage: TWMNotify);
4956 end;
5057
5158 var
@@ -56,43 +63,417 @@
5663 {%CLASSGROUP 'Vcl.Controls.TControl'}
5764
5865 uses
59- UPrincipal;
66+ UPrincipal, Forms, CommCtrl, Winapi.Windows, Vcl.Graphics;
6067
6168 {$R *.dfm}
6269
70+// [1] https://docs.microsoft.com/en-us/windows/win32/controls/bumper-tooltip-control-reference-notifications
71+// [2] https://docs.microsoft.com/pt-br/windows/win32/menurc/stringtable-resource
72+// [3] https://docs.microsoft.com/en-us/windows/win32/api/commctrl/ns-commctrl-tttoolinfoa
73+// [4] https://docs.microsoft.com/en-us/windows/win32/controls/ttm-setdelaytime
74+
75+procedure TDAMOPrincipal.AddToolTipConfigurations;
76+begin
77+ {
78+ AddToolInfo registra uma ferramenta com a janela de ToolTip. Registrar uma
79+ ferramenta, significa registrar estruturas TOOLINFO com informações diferentes
80+ de lpszText, uFlags, rect, hinst e lParam, assim uma mesma janela de ToolTip
81+ pode ser exibida com diferentes textos e diferentes comportamentos governados
82+ pelos seus flags. A combinação de Ahwnd e AuId identificam completamente cada
83+ uma das diversas configurações (ferramentas) registradas. Considere estas
84+ informações como sendo as informações básicas de cada configuração. Você pode
85+ exibir um ToolTip, carregando uma destas configurações sem precisar alterar
86+ nenhuma delas ou alterar uma configuração específica e depois exibir o ToolTip
87+ para aquela configuração específica
88+ }
89+ // Handle da jenela que é pai da janela de ToolTip.
90+ // Trata-se do membro hwnd de TOOLINFO. A janela pai, recebe
91+ // algumas mensagens de notificação especiais. Acesse [1]
92+ // para saber sobre estas notificações. A janela pai também
93+ // é usada como referência quando se usa o membro rect de
94+ // TOOLINFO de forma que as posições relativas sejam
95+ // calculadas usando como base o rect da área cliente da
96+ // janela cujo handle é informado aqui. Esse parâmetro pode
97+ // ser zero, mas neste caso tudo que é possível com a
98+ // presença de um handle válido não será mais possível, por
99+ // isso recomenda-se sempre usar um handle aqui, porque se
100+ // um ToolTip vai aparecer, ele aparece para algo que está
101+ // na tela, e esse algo certamente estará em uma janela
102+ // (form)
103+ FKRTT.AddToolInfo(FormPrincipal.Handle
104+ // Identificador da ferramenta dentro da janela de ToolTip
105+ // indicada em AParentHandle. Trata-se do membro uId de
106+ // TOOLINFO, portanto, este é um identificador genérico,
107+ // controlado pela aplicação e seu significado depende da
108+ // implementação. Muitas mensagens de configuração utilizam
109+ // os membros hwnd e uId juntos para identificar
110+ // completamente uma configuração que foi registrada com
111+ // TTM_ADDTOOL, assim é possível modificar um conjunto de
112+ // configurações específico
113+ ,1
114+ // Flags de configuração e comportamentos do ToolTip.
115+ // Trata-se do membro uFlags de TOOLINFO. Configura este
116+ // ToolTip como sendo do tipo tracking, que aparece por
117+ // demanda e não automaticamente. Além disso os links
118+ // presentes no texto do ToolTip serão processados
119+ ,TTF_TRACK or TTF_PARSELINKS
120+ // "Região-quente", que delimitaria a ferramenta para a qual
121+ // este ToolTip está sendo configurado. Não vamos usar isso
122+ // nesta configuração, portanto passamos um Rect zerado
123+ ,Rect(0,0,0,0)
124+ // Handle da instância (executável, dll, etc.) que contém
125+ // strings de recuros usadas por este ToolTip quando o
126+ // parâmero AText contém o identificador de uma string de
127+ // recurso. Nesta configuração, eu não vou usar isso, logo,
128+ // zero
129+ ,0
130+ // Texto a ser exibido no ToolTip, que pode ter qualquer
131+ // tamanho. Este parâmetro pode também ser usado para
132+ // informar um identificador de uma string de recurso quando
133+ // o parâmetro AhInst contém um handle válido de um módulo
134+ // (executável, dll, etc.) que contém tais strings de
135+ // recurso. Atribua LPSTR_TEXTCALLBACK a este parâmetro para
136+ // que quando o ToolTip for exibido, uma mensagem
137+ // TTN_GETDISPINFO seja enviada a janela cujo handle foi
138+ // informado em Ahwnd com o intuito de que seja informado
139+ // ali o texto do ToolTip. Você pode passar nil neste
140+ // parâmetro caso pretenda alterar posteriormente esta
141+ // configuração específica informando seu texto no método
142+ // Show
143+ ,'Este ToolTip é do tipo Tracking, isto é, ele aparece ' +
144+ 'no ponto especificado de forma manual e não automátic' +
145+ 'a. Clique <a id="maisinfo" href="http://www.exemplo.c' +
146+ 'om">neste link</a> para obter mais informações ou cli' +
147+ 'que <a id="segundolink">aqui</a> para exibir uma mens' +
148+ 'agem motivacional e fechar o ToolTip'
149+ // Trata-se de um valor arbitrário que depende da aplicação
150+ // e que pode ser informado para ficar associado a esta
151+ // configuração de exibição deste ToolTip. Como não vou usar
152+ // isso neste momento, eu passo zero. Você pode informar
153+ // neste parâmetro o ponteiro para algum controle ou
154+ // componente de forma que seja possível acessar este
155+ // controle ou componente através de seu ToolTip.
156+ ,0);
157+
158+ FKRTT.AddToolInfo(FormPrincipal.Handle
159+ // Como usamos o mesmo Ahwnd, precisamos alterar o parâmetro
160+ // AuId, pois como foi dito, este parâmetro juntamente com
161+ // Ahwnd, é usado para identificar qual configuração
162+ // (TOOLINFO) usar
163+ ,2
164+ ,TTF_TRACK
165+ ,Rect(0,0,0,0)
166+ ,0
167+ // Usando esta constante, o texto desse ToolTip será obtido
168+ // por meio de uma mensagem enviada para a janela cujo
169+ // handle é informado em Ahwnd
170+ ,LPSTR_TEXTCALLBACK
171+ ,0);
172+
173+ FKRTT.AddToolInfo(FormPrincipal.Handle
174+ ,3
175+ ,TTF_TRACK or TTF_PARSELINKS
176+ ,Rect(0,0,0,0)
177+ // HInstance é o handle do executável o qual será usado pelo
178+ // ToolTip para obter seu texto diretamente de uma string de
179+ // recurso cujo identificador é passado no parâmetro
180+ // AlpszText
181+ ,HInstance
182+ // O arquivo resources.rc contém uma string de recurso cujo
183+ // id é 1, logo, basta informar este id como mostrado acima
184+ ,LPTSTR(1)
185+ ,0);
186+
187+ FKRTT.AddToolInfo(FormPrincipal.Handle
188+ // Handle do controle (TWinControl) para o qual o ToolTip
189+ // deverá aparecer
190+ ,FormPrincipal.BUTNHint4.Handle
191+ // TTF_IDISHWND informa que o membro uId é o handle da
192+ // ferramenta (controle TWinControl) e TTF_SUBCLASS
193+ // encaminha mensagens que são enviadas a ferramenta para a
194+ // janela de ToolTip, como por exemplo WM_MOUSEMOVE, desta
195+ // forma, o ToolTip aparece automaticamente quando o cursor
196+ // do mouse está em cima da área-cliente (região-quente) da
197+ // janela da ferramenta.
198+ ,TTF_IDISHWND or TTF_SUBCLASS or TTF_PARSELINKS
199+ // Como TTF_IDISHWND está definido, mesmo que tivéssemos
200+ // atribuído um rect, não adiantaria, porque quando este
201+ // flag está definido, este parâmetro é ignorado
202+ ,Rect(0,0,0,0)
203+ ,0
204+ ,'Este ToolTip aparece quando o cursor do mouse entra na á' +
205+ 'rea-cliente do controle cujo handle foi informado no par' +
206+ 'âmetro AuId de AddToolInfo. O indicador do ToolTip do ti' +
207+ 'po balão, aparece no ponto exato do cursor do mouse, den' +
208+ 'tro da área-cliente, quando a mensagem WM_MOUSEMOVE é pr' +
209+ 'ocessada pela janela de ToolTip, o que ocorre sempre alg' +
210+ 'uns milissegundos após o cursor do mouse parar dentro da' +
211+ ' área-cliente.'#13#10#13#10'ToolTips automáticos somem d' +
212+ 'entro de alguns segundos após sua exibição ou quando o c' +
213+ 'ursor do mouse sai da área-quente. É possível definir os' +
214+ ' tempos relacionados ao aparecimento, desaparecimento e ' +
215+ 'reaparecimento de um ToolTip usando a mensagem TTM_SETDE' +
216+ 'LAYTIME. A classe TKRKToolTip não possui propriedades ne' +
217+ 'm métodos para configurar estes valores porque por ora e' +
218+ 'u acho que eles são ideais e ninguem precisa mudá-los'
219+ ,0);
220+
221+ // Sobre a mensagem acima, que fala a respeito de tempos do ToolTip, acesse
222+ // [4] para saber mais
223+
224+ FKRTT.AddToolInfo(FormPrincipal.Handle
225+ // Handle do controle (TWinControl) para o qual o ToolTip
226+ // deverá aparecer
227+ ,FormPrincipal.BUTNHint5.Handle
228+ // TTF_CENTERTIP tenta centralizar o ToolTip embaixo do
229+ // controle indicado em AuId. Acredito que isso só faça
230+ // sentido se o flag TTF_IDISHWND também for definido
231+ ,TTF_IDISHWND or TTF_SUBCLASS or TTF_CENTERTIP
232+ ,Rect(0,0,0,0)
233+ ,0
234+ ,'Este ToolTip aparece quando o cursor do mouse entra na á' +
235+ 'rea-cliente do controle cujo handle foi informado no par' +
236+ 'âmetro AuId de AddToolInfo. O indicador do ToolTip do ti' +
237+ 'po balão, aparece sempre no centro e na parte de baixo d' +
238+ 'a ferramenta (AuId). Caso não haja espaço para o balão a' +
239+ 'parecer, ele será movido para aparecer na tela, mas semp' +
240+ 're o seu indicador (ponta) aparecerá no meio da ferramen' +
241+ 'ta, seja embaixo, seja em cima dela. Esta é uma boa form' +
242+ 'a de fazer um balão aparecer sem que ele oculte a ferram' +
243+ 'enta que está associada com ele'
244+ ,0);
245+
246+ //verifique agora o uso de rect com e sem hwnd
247+end;
248+
63249 procedure TDAMOPrincipal.ContentTypeapplicationxwwwformurlencodedcharsetutf81Click(Sender: TObject);
64250 begin
65- Form8.MEMOOpenRequestHeaders.Lines.Add('Content-Type: application/x-www-form-urlencoded; charset=utf-8');
251+ FormPrincipal.MEMOOpenRequestHeaders.Lines.Add('Content-Type: application/x-www-form-urlencoded; charset=utf-8');
66252 end;
67253
68254 procedure TDAMOPrincipal.ContentTypemultipartformdataboundaryWININET1Click(Sender: TObject);
69255 begin
70- Form8.MEMOOpenRequestHeaders.Lines.Add('Content-Type: multipart/form-data; boundary=WININET');
256+ FormPrincipal.MEMOOpenRequestHeaders.Lines.Add('Content-Type: multipart/form-data; boundary=WININET');
71257 end;
72258
73259 procedure TDAMOPrincipal.CookieClick(Sender: TObject);
74260 begin
75- Form8.MEMOOpenRequestHeaders.Lines.Add('Cookie: portal[ses]=3008b76fd1ff586487c1ec330bce3a9c');
261+ FormPrincipal.MEMOOpenRequestHeaders.Lines.Add('Cookie: portal[ses]=3008b76fd1ff586487c1ec330bce3a9c');
76262 end;
77263
264+procedure TDAMOPrincipal.DataModuleCreate(Sender: TObject);
265+begin
266+ // Cria a janela de ToolTip, que é a janela que é exibida quando o ToolTip
267+ // aparece. Aqui criamos uma jenale de ToolTip que exibe ToolTips em forma de
268+ // balão mesmo quando a janela que for "dona" do controle associado ao ToolTip
269+ // esteja inativa
270+ // Handle da janela que é dona da janela
271+ // de ToolTip que será criada. O Owner
272+ // deste TDataModule é um TApplication,
273+ // que tem um handle de janela! Não
274+ // confundir esse handle isso com Handle
275+ // de ferramenta. Este parâmetro é na
276+ // verdade o handle da janela dona/pai do
277+ // ToolTip
278+ FKRTT := TKRKTrackingToolTip.Create(TApplication(Owner).Handle
279+ // Estilos da janela de ToolTip afetam a
280+ // forma como esta janela é exibida.
281+ // Consulte o MSDN para saber o que estes
282+ // estilos representam
283+ ,TTS_NOPREFIX or TTS_ALWAYSTIP or TTS_BALLOON or TTS_CLOSE
284+ // Tamanho padrão das janelas de ToolTip.
285+ // ToolTips automáticos terão esta largura
286+ // sempre!
287+ ,500);
288+end;
289+
290+procedure TDAMOPrincipal.DataModuleDestroy(Sender: TObject);
291+begin
292+ FKRTT.Free;
293+end;
294+
295+procedure TDAMOPrincipal.HandleTTNMessages(var AMessage: TWMNotify);
296+var
297+ Link: PNMLink;
298+ Disp: PNMTTDispInfo;
299+begin
300+ if Assigned(AMessage.NMHdr) then
301+ case AMessage.NMHdr.code of
302+ // Caso a mensagem de notificação seja um TTN_LINKCLICK, significa que
303+ // clicamos em um link dentro de um ToolTip
304+ TTN_LINKCLICK: begin
305+ // Não estou fazendo nenuma verificação a respeito de qual ToolTip
306+ // apareceu porque tomei o cuidado de definir ids diferentes nos links
307+ // de todos os ToolTips que aparecem. Caso seja necessário identificar
308+ // qual "ferramenta" ativou o ToolTip verifique o que foi feito ao
309+ // manipular a notificação TTN_SHOW mais adiante
310+ Link := PNMLink(AMessage.NMHdr);
311+
312+ if Link.item.szID = 'maisinfo' then
313+ Application.MessageBox(PChar('Você está vendo esta mensagem porque clicou '+
314+ 'num link dentro de um ToolTip. As informações obtidas ao clicar no link '+
315+ 'são, seu href, seu id e seu índice. O índice é a posição do link dentro '+
316+ 'do texto, onde 0 = primeiro, 1 = segundo e assim por diante. Por exemplo,'+
317+ ' o índice do link clicado é "' + IntToStr(Link.item.iLink) + '", seu href'+
318+ ' = "' + Link.item.szUrl + '" e seu id = "'+ Link.item.szID +'". A largura '+
319+ 'do ToolTip foi limitada em 250 pixels e quando isso é feito o texto dentro'+
320+ ' dele é automaticamente quebrado, o que é muito conveniente'),'Mais informações',MB_ICONINFORMATION);
321+
322+ if Link.item.szID = 'segundolink' then
323+ begin
324+ Application.MessageBox(PChar('"A vida te derruba hoje preparando você para'+
325+ ' a queda de amanhã"'#13#10#13#10'O link tem id="' + Link.item.szID + '" e seu índice é "' + IntToStr(Link.item.iLink) + '"'),'Modo coach ativado!',MB_ICONINFORMATION);
326+ FKRTT.Hide;
327+ end;
328+
329+ if Link.item.szID = 'tt1' then
330+ Application.MessageBox('O texto deste ToolTip veio de uma string' +
331+ ' de recuros incluída em resources.rc. Esta seria uma ótima maneira de' +
332+ ' atribuir strings a ToolTips não fosse o fato de que aparentemente as' +
333+ ' strings de recurso devem ter no máximo 80 caracteres! Isso foi bem f' +
334+ 'rustrante de descobrir. Não achei documentação na web mencionando iss' +
335+ 'o mas nos experimetos que eu fiz, apenas os 80 primeiros caracteres d' +
336+ 'as strings de recurso são usados, o que torna esse meio de obtenção d' +
337+ 'e texto do ToolTip bastante inútil, ou no mínimo, limitado.'#13#10#13#10 +
338+ 'Uma solução de meio termo que eu vi em alguns exemplos na web foi com' +
339+ 'binar a obtenção automática do texto com a notificação TTN_GETDISPINF' +
340+ 'O da seguinte forma: configura-se lpszText como LPSTR_TEXTCALLBACK e ' +
341+ 'hinst como a instância do módulo onde estão as strings de recurso. Fe' +
342+ 'ito isso, no manipulador da notificação TTN_GETDISPINFO basta usar hin' +
343+ 'st para obter strings de recurso. Para saber qual string de recurso c' +
344+ 'arregar, é possível usar o membro lParam de NMTTDISPINFO ou o membro ' +
345+ 'idFrom de NMHDR (membro hdr de NMTTDISPINFO)'#13#10#13#10'O ícone mos' +
346+ 'trado no ToolTip foi obtido a partir de um recurso adicionado a aplic' +
347+ 'ação de nome IMGDELPHI. Aparentemente este ícone pode ter dois tamanh' +
348+ 'os, sendo o maior deles o que atualmente está sendo exibido.','Texto vindo de uma string de recurso!',MB_ICONINFORMATION);
349+
350+ AMessage.Result := NativeInt(True);
351+ end;
352+ // Caso a mensagem de notificação seja um TTN_GETDISPINFO, significa que o
353+ // ToolTip usou LPSTR_TEXTCALLBACK e precisa obter seu texto (e
354+ // opcionalmente outras informações) aqui
355+ TTN_GETDISPINFO: begin
356+ Disp := PNMTTDispInfo(AMessage.NMHdr);
357+
358+ Disp.lpszText := 'Esta mensagem está sendo definida no manipulador da ' +
359+ 'mensagem WM_NOTIFY definido no FormPrincipal, o qual executa o método' +
360+ ' HandleTTNMessages que está declarado em DAMOPrincipal. Toda vez que ' +
361+ 'este ToolTip é chamado, o seu texto é obtido dessa forma.'#13#10#13#10 +
362+ 'Além desta funcionalidade, é possível alterar os membros hInst e uFla' +
363+ 'gs imediatamente antes da exibição do ToolTip. uFlags não aceita todo' +
364+ 's os flags que TOOLINFO define, ao invés disso, apenas os flags a seg' +
365+ 'uir são suportados: TTF_IDISHWND, TTF_RTLREADING e TTF_DI_SETITEM. Pa' +
366+ 'ra maiores informações, leia a documentação de NMTTDISPINFO no MSDN';
367+
368+ AMessage.Result := NativeInt(True);
369+ end;
370+ // Toda vez que a janela de ToolTip aparece ela envia esta notificação
371+ // para a janela pai definida em AddToolInfo. Aqui verificamos o membro
372+ // AMessage.NMHdr.idFrom a fim de sabermos se trata-se do handle de um dos
373+ // controles de tela que possuem um ToolTip associado. O intuito disso é
374+ // configurar o título e o ícone do ToolTip automático de acordo com a
375+ // ferramenta (controle) associada, pois não fazer isso faz com que ao ser
376+ // exibido, o ToolTip automático exiba sempre o ícone e o título que foram
377+ // definidos anteriormente, por exemplo, em chamadas a ToolTips do tipo
378+ // tracking (método Show, versão que tem mais parâmetros)
379+ TTN_SHOW: begin
380+ if AMessage.NMHdr.idFrom = FormPrincipal.BUTNHint4.Handle then
381+ FKRTT.SetIconAndTitle(TTI_INFO,'ToolTip automático 1')
382+ else if AMessage.NMHdr.idFrom = FormPrincipal.BUTNHint5.Handle then
383+ FKRTT.SetIconAndTitle(TTI_WARNING,'ToolTip automático 2');
384+
385+ // Eu tentei de várias formas alterar a largura do ToolTip automático de
386+ // forma dinâmica, tanto aqui quanto dentro de NM_CUSTOMDRAW, mas não
387+ // fui bem sucedido, por isso, estabeleci que os ToolTips automáticos
388+ // sempre vão ter a largura padrão definida no construtor da nossa
389+ // classe de ToolTips. Acredito que esta abordagem seja a melhor mesmo
390+
391+ AMessage.Result := NativeInt(True);
392+ end;
393+ end;
394+end;
395+
396+procedure TDAMOPrincipal.ShowTrackingToolTip1;
397+begin
398+ if not FKRTT.IsVisible then
399+ FKRTT.Show(FormPrincipal.Handle
400+ ,1
401+ ,0
402+ ,Rect(0,0,0,0)
403+ ,0
404+ ,nil
405+ ,0
406+ ,'Tracking ToolTip 1'
407+ ,TTI_INFO_LARGE
408+ ,nil
409+ ,100
410+ ,100
411+ ,100
412+ ,False)
413+ else
414+ FKRTT.Hide;
415+end;
416+
417+procedure TDAMOPrincipal.ShowTrackingToolTip2;
418+begin
419+ if not FKRTT.IsVisible then
420+ FKRTT.Show(FormPrincipal.Handle
421+ ,2
422+ ,0
423+ ,Rect(0,0,0,0)
424+ ,0
425+ ,nil
426+ ,0
427+ ,'Tracking ToolTip 2'
428+ ,TTI_WARNING
429+ ,nil
430+ ,200
431+ ,200
432+ ,200
433+ ,False)
434+ else
435+ FKRTT.Hide;
436+end;
437+
438+procedure TDAMOPrincipal.ShowTrackingToolTip3;
439+begin
440+ if not FKRTT.IsVisible then
441+ FKRTT.Show(FormPrincipal.Handle
442+ ,3
443+ ,0
444+ ,Rect(0,0,0,0)
445+ ,0
446+ ,nil
447+ ,0
448+ ,'Tracking ToolTip 3'
449+ ,0
450+ ,'IMGDELPHI'
451+ ,300
452+ ,300
453+ ,300
454+ ,False)
455+ else
456+ FKRTT.Hide;
457+end;
458+
78459 procedure TDAMOPrincipal.MNUIapplicationjson1Click(Sender: TObject);
79460 begin
80- Form8.MEMOOpenRequestHeaders.Lines.Add('Content-Type: application/json; charset=utf-8');
461+ FormPrincipal.MEMOOpenRequestHeaders.Lines.Add('Content-Type: application/json; charset=utf-8');
81462 end;
82463
83464 procedure TDAMOPrincipal.MNUIAuthorizationClick(Sender: TObject);
84465 begin
85- Form8.MEMOOpenRequestHeaders.Lines.Add('Authorization: Basic Base64(login:senha)');
466+ FormPrincipal.MEMOOpenRequestHeaders.Lines.Add('Authorization: Basic Base64(login:senha)');
86467 end;
87468
88469 procedure TDAMOPrincipal.MNUIJSONvazio1Click(Sender: TObject);
89470 begin
90- Form8.MEMORequest.Text := '[]';
471+ FormPrincipal.MEMORequest.Text := '[]';
91472 end;
92473
93474 procedure TDAMOPrincipal.MNUISICASE1Click(Sender: TObject);
94475 begin
95- Form8.MEMORequest.Text :=
476+ FormPrincipal.MEMORequest.Text :=
96477 '<soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" xmlns:sic="http://sicase.tjpe.jus.br/v01/SicaseServico">'#13#10 +
97478 ' <soapenv:Header/>'#13#10 +
98479 ' <soapenv:Body>'#13#10 +
@@ -115,12 +496,12 @@
115496
116497 procedure TDAMOPrincipal.MNUItextxml1Click(Sender: TObject);
117498 begin
118- Form8.MEMOOpenRequestHeaders.Lines.Add('Content-Type: text/xml; charset=utf-8');
499+ FormPrincipal.MEMOOpenRequestHeaders.Lines.Add('Content-Type: text/xml; charset=utf-8');
119500 end;
120501
121502 procedure TDAMOPrincipal.MNUMultipartFormDataClick(Sender: TObject);
122503 begin
123- Form8.MEMOSendRequestHeaders.Lines.Add(TMenuItem(Sender).Caption);
504+ FormPrincipal.MEMOSendRequestHeaders.Lines.Add(TMenuItem(Sender).Caption);
124505 end;
125506
126507 end.
--- trunk/utl/TESTADOR/src/UPrincipal.pas (revision 571)
+++ trunk/utl/TESTADOR/src/UPrincipal.pas (revision 572)
@@ -8,7 +8,7 @@
88 KRK.Vcl.StdCtrls, Tabs, UFRAMAssinaturaEmXML;
99
1010 type
11- TForm8 = class(TForm)
11+ TFormPrincipal = class(TForm)
1212 PACO: TPageControl;
1313 TASHKRKLibRtlWinWinCrypt: TTabSheet;
1414 TASHKRKLibRtlWinWinInet: TTabSheet;
@@ -97,6 +97,12 @@
9797 Panel3: TPanel;
9898 TASHAssinturaEmXML: TTabSheet;
9999 FRAMAssinaturaEmXML: TFRAMAssinaturaEmXML;
100+ TASHKRKRtlWinCommCtrl: TTabSheet;
101+ BUTNHint2: TButton;
102+ BUTNHint1: TButton;
103+ BUTNHint3: TButton;
104+ BUTNHint4: TButton;
105+ BUTNHint5: TButton;
100106 procedure BUTNGetStringCheckSumClick(Sender: TObject);
101107 procedure MNUIPackagesCreationToolClick(Sender: TObject);
102108 procedure MNUITranslationManagerClick(Sender: TObject);
@@ -121,11 +127,19 @@
121127 procedure BUTNGetFileCheckSumClick(Sender: TObject);
122128 procedure FormShow(Sender: TObject);
123129 procedure FormDestroy(Sender: TObject);
130+ procedure BUTNHint2Click(Sender: TObject);
131+ procedure BUTNHint1Click(Sender: TObject);
132+ procedure BUTNHint3Click(Sender: TObject);
124133 private
125134 { Private declarations }
126135 MM: TMainMenu;
127136 PM: TPopUpMenu;
128137 procedure HandleOnNewLine(AProcessHandle: THandle; AThreadHandle: THandle; const ALine: String);
138+ // Os ToolTips podem enviar mensagens de notificação para a janela
139+ // identificada no membro hwnd de TOOLINFO. Em todos os exemplos aqui usamos
140+ // a janela de FormPrincipal como membro hwnd, portanto, aqui capturamos
141+ // estas mensagens
142+ procedure HandleNotifyMessages(var AMessage: TWMNotify); message WM_NOTIFY;
129143 procedure LoadComboBoxes;
130144 procedure UnloadComboBoxes;
131145 public
@@ -133,7 +147,7 @@
133147 end;
134148
135149 var
136- Form8: TForm8;
150+ FormPrincipal: TFormPrincipal;
137151
138152 implementation
139153
@@ -146,7 +160,7 @@
146160
147161 {$R *.dfm}
148162
149-procedure TForm8.BUTNGenerateHMACClick(Sender: TObject);
163+procedure TFormPrincipal.BUTNGenerateHMACClick(Sender: TObject);
150164 var
151165 Input: UTF8String;
152166 Key: PByte;
@@ -173,7 +187,7 @@
173187 end;
174188 end;
175189
176-procedure TForm8.BUTNGetExecutableInfoTranslateExeInfoClick(Sender: TObject);
190+procedure TFormPrincipal.BUTNGetExecutableInfoTranslateExeInfoClick(Sender: TObject);
177191 var
178192 ExecutableInfo: TExecutableInfo;
179193 begin
@@ -181,7 +195,7 @@
181195 ShowMessage(TranslateExeInfo(ExecutableInfo));
182196 end;
183197
184-procedure TForm8.BUTNGetFileCheckSumClick(Sender: TObject);
198+procedure TFormPrincipal.BUTNGetFileCheckSumClick(Sender: TObject);
185199 begin
186200 with TOpenDialog.Create(Self) do
187201 try
@@ -192,7 +206,7 @@
192206 end;
193207 end;
194208
195-procedure TForm8.BUTNGetStringCheckSumClick(Sender: TObject);
209+procedure TFormPrincipal.BUTNGetStringCheckSumClick(Sender: TObject);
196210 var
197211 InputString: UTF8String;
198212 begin
@@ -203,8 +217,23 @@
203217 EDITCheckSumHmac.Text := GetStringCheckSum(InputString,[THashAlgorithm(CBBXHashAlgorithms.ItemIndex)]);
204218 end;
205219
206-procedure TForm8.BUTNLoadDLLClick(Sender: TObject);
220+procedure TFormPrincipal.BUTNHint2Click(Sender: TObject);
207221 begin
222+ DAMOPrincipal.ShowTrackingToolTip2;
223+end;
224+
225+procedure TFormPrincipal.BUTNHint3Click(Sender: TObject);
226+begin
227+ DAMOPrincipal.ShowTrackingToolTip3;
228+end;
229+
230+procedure TFormPrincipal.BUTNHint1Click(Sender: TObject);
231+begin
232+ DAMOPrincipal.ShowTrackingToolTip1;
233+end;
234+
235+procedure TFormPrincipal.BUTNLoadDLLClick(Sender: TObject);
236+begin
208237 // mp_MemoryModule := BTMemoryLoadLibary(@DemoDLL, Length(DemoDLL));
209238 // try
210239 // if mp_MemoryModule = nil then
@@ -267,7 +296,7 @@
267296 // ResStream.Free;
268297 end;
269298
270-procedure TForm8.BUTN1Click(Sender: TObject);
299+procedure TFormPrincipal.BUTN1Click(Sender: TObject);
271300 //var
272301 // SCP: TSelectCertificateParams; // SelectCertificate Paramenters
273302 // SCC: PCCERT_CONTEXT; // Sign Certificate Context
@@ -448,7 +477,7 @@
448477 raise Exception.Create('Não foi possével abrir o arquivo especificado ou o arquivo não foi especificado');
449478 end;
450479
451-procedure TForm8.BUTN2Click(Sender: TObject);
480+procedure TFormPrincipal.BUTN2Click(Sender: TObject);
452481 var
453482 CryptProvHandle: HCRYPTPROV;
454483 CryptHashHandle: HCRYPTHASH;
@@ -537,7 +566,7 @@
537566 end;
538567 end;
539568
540-procedure TForm8.BUTN3Click(Sender: TObject);
569+procedure TFormPrincipal.BUTN3Click(Sender: TObject);
541570 begin
542571 CloneMainMenu(DAMOPrincipal.MAME,MM);
543572 Menu := MM;
@@ -545,12 +574,12 @@
545574 Panel3.PopupMenu := PM;
546575 end;
547576
548-procedure TForm8.BUTN4Click(Sender: TObject);
577+procedure TFormPrincipal.BUTN4Click(Sender: TObject);
549578 begin
550579 KRKGroupBox1.Enabled := not KRKGroupBox1.Enabled;
551580 end;
552581
553-procedure TForm8.BUTNExecConsoleAppClick(Sender: TObject);
582+procedure TFormPrincipal.BUTNExecConsoleAppClick(Sender: TObject);
554583 begin
555584 MEMOConsoleOutput.Clear;
556585 MEMOConsoleOutput.Lines.Add('Executando ' + CMBXApplicationName.Text);
@@ -557,7 +586,7 @@
557586 MEMOConsoleOutput.Lines.Add(Format('%s retornou %d', [CMBXApplicationName.Text, ExecConsoleApp(CMBXApplicationName.Text, EDITParams.Text, HandleOnNewLine, ExtractFilePath(CMBXApplicationName.Text))]))
558587 end;
559588
560-procedure TForm8.BUTNFormBlenderModalClick(Sender: TObject);
589+procedure TFormPrincipal.BUTNFormBlenderModalClick(Sender: TObject);
561590 begin
562591 case TKRKFormBlender.ShowMe(Self,TFORMInterno) of
563592 mrOk: ShowMessage('OK');
@@ -567,7 +596,7 @@
567596 end;
568597 end;
569598
570-procedure TForm8.BUTNFormBlenderNormalClick(Sender: TObject);
599+procedure TFormPrincipal.BUTNFormBlenderNormalClick(Sender: TObject);
571600 var
572601 FB: TKRKFormBlender;
573602 begin
@@ -579,7 +608,7 @@
579608 TFormInterno(FB.InternalFormInstance).BUTNOK.Hide;
580609 end;
581610
582-procedure TForm8.BUTNSelectCertificateClick(Sender: TObject);
611+procedure TFormPrincipal.BUTNSelectCertificateClick(Sender: TObject);
583612 var
584613 P: TSelectCertificateParams;
585614 P2: PCCERT_CONTEXT;
@@ -623,7 +652,7 @@
623652 Result := xmlDoc.FormatXMLData(oXml.XML.Text);
624653 end;
625654
626-procedure TForm8.BUTNWinInetRequestClick(Sender: TObject);
655+procedure TFormPrincipal.BUTNWinInetRequestClick(Sender: TObject);
627656 var
628657 RO: TRequestOptions;
629658 RE: TResponse;
@@ -748,28 +777,28 @@
748777 end;
749778 end;
750779
751-procedure TForm8.CHBXUseOpenRequestHeadersClick(Sender: TObject);
780+procedure TFormPrincipal.CHBXUseOpenRequestHeadersClick(Sender: TObject);
752781 begin
753782 MEMOOpenRequestHeaders.Enabled := CHBXUseOpenRequestHeaders.Checked;
754783 end;
755784
756-procedure TForm8.CHBXUseRequestContentClick(Sender: TObject);
785+procedure TFormPrincipal.CHBXUseRequestContentClick(Sender: TObject);
757786 begin
758787 MEMORequest.Enabled := CHBXUseRequestContent.Checked;
759788 CHBXFileUpload.Enabled := MEMORequest.Enabled;
760789 end;
761790
762-procedure TForm8.CHBXUseSendRequestHeadersClick(Sender: TObject);
791+procedure TFormPrincipal.CHBXUseSendRequestHeadersClick(Sender: TObject);
763792 begin
764793 MEMOSendRequestHeaders.Enabled := CHBXUseSendRequestHeaders.Checked;
765794 end;
766795
767-procedure TForm8.FormDestroy(Sender: TObject);
796+procedure TFormPrincipal.FormDestroy(Sender: TObject);
768797 begin
769798 UnloadComboBoxes;
770799 end;
771800
772-procedure TForm8.LoadComboBoxes;
801+procedure TFormPrincipal.LoadComboBoxes;
773802 begin
774803 // LoadAll, carrega todos os combos do frame e todos os outros combos de
775804 // subframes se existirem
@@ -776,7 +805,7 @@
776805 FRAMAssinaturaEmXML.LoadAll;
777806 end;
778807
779-procedure TForm8.UnloadComboBoxes;
808+procedure TFormPrincipal.UnloadComboBoxes;
780809 begin
781810 // UnloadAll, descarrega todos os combos do frame e todos os outros combos de
782811 // subframes se existirem
@@ -784,38 +813,50 @@
784813 end;
785814
786815
787-procedure TForm8.FormShow(Sender: TObject);
816+procedure TFormPrincipal.FormShow(Sender: TObject);
788817 begin
789818 LoadComboBoxes;
819+ // Como neste ponto já temos FormPrincipal criado, podemos adicionar as várias
820+ // configurações de ToolTips que podem usar o handle deste form
821+ DAMOPrincipal.AddToolTipConfigurations;
790822 end;
791823
792-procedure TForm8.HandleOnNewLine(AProcessHandle, AThreadHandle: THandle; const ALine: String);
824+procedure TFormPrincipal.HandleNotifyMessages(var AMessage: TWMNotify);
793825 begin
826+ // Manipula as mensagens no datamodule a fim de centralizar todos os uses
827+ // referentes a ToolTips por lá e manter este form mais limpo
828+ DAMOPrincipal.HandleTTNMessages(AMessage);
829+ // Continua processando mensagens de notificação
830+ inherited;
831+end;
832+
833+procedure TFormPrincipal.HandleOnNewLine(AProcessHandle, AThreadHandle: THandle; const ALine: String);
834+begin
794835 MEMOConsoleOutput.Lines.Add(ALine);
795836 SendMessage(MEMOConsoleOutput.Handle,EM_SCROLLCARET,0,0);
796837 end;
797838
798-procedure TForm8.MEMOAcceptTypesClick(Sender: TObject);
839+procedure TFormPrincipal.MEMOAcceptTypesClick(Sender: TObject);
799840 begin
800841 MEMOAcceptTypes.Enabled := CHBXUseAcceptTypes.Checked;
801842 end;
802843
803-procedure TForm8.MNUIPackagesCreationToolClick(Sender: TObject);
844+procedure TFormPrincipal.MNUIPackagesCreationToolClick(Sender: TObject);
804845 begin
805846 showmessage(TMenuItem(Sender).Name);
806847 end;
807848
808-procedure TForm8.MNUIPlaceHolderClick(Sender: TObject);
849+procedure TFormPrincipal.MNUIPlaceHolderClick(Sender: TObject);
809850 begin
810851 showmessage(TMenuItem(Sender).Name);
811852 end;
812853
813-procedure TForm8.MNUITranslationManagerClick(Sender: TObject);
854+procedure TFormPrincipal.MNUITranslationManagerClick(Sender: TObject);
814855 begin
815856 showmessage(TMenuItem(Sender).Name);
816857 end;
817858
818-procedure TForm8.MNUMultipartFormDataClick(Sender: TObject);
859+procedure TFormPrincipal.MNUMultipartFormDataClick(Sender: TObject);
819860 begin
820861 MEMOSendRequestHeaders.Lines.Add(TMenuItem(Sender).Caption);
821862 end;
Show on old repository browser