OSDN -- Develop and Download Open Source Software
  • R/O
  • SSH
  • HTTPS

akdf: Commit


Commit MetaInfo

Revision576 (tree)
Time2022-03-16 06:40:47
Authorderekwildstar

Log Message

Recursos adicionados
TKRKToolTip concluído! Falta apenas mover os métodos Show para TToolTip
Classe TPersistentRect criada

Change Summary

Incremental Difference

--- trunk/dtp/AdditionalControls/src/KRK.AdditionalControls.pas (revision 575)
+++ trunk/dtp/AdditionalControls/src/KRK.AdditionalControls.pas (revision 576)
@@ -2,18 +2,16 @@
22
33 interface
44
5-uses Classes
6- , DesignIntf;
5+uses
6+ Classes, DesignIntf;
77
88 procedure Register;
99
1010 implementation
1111
12-uses Controls
13- , KRK.Vcl.Controls
14- , KRK.Vcl.ExtCtrls
15- , KRK.Vcl.ExtCtrls.Editors
16- , KRK.Vcl.Utilities;
12+uses
13+ Controls, KRK.Vcl.Controls, KRK.Rtl.Win.CommCtrl, KRK.Vcl.ExtCtrls,
14+ KRK.Vcl.ExtCtrls.Editors, KRK.Vcl.Utilities;
1715
1816 const
1917 PageName = 'Anak Krakatoa Additional Controls';
@@ -20,7 +18,8 @@
2018
2119 procedure Register;
2220 begin
23- RegisterComponents(PageName,[TKRKBalloonHint]);
21+ RegisterComponents(PageName, [TKRKBalloonHint]);
22+ RegisterComponents(PageName, [TKRKToolTip]);
2423 RegisterComponents(PageName, [TKRKLabeledEdit]);
2524 RegisterComponents(PageName, [TKRKRTFLabel]);
2625 RegisterComponents(PageName, [TKRKDefinedCrypt]);
--- trunk/rtp/prj/Delphi 26 (Delphi Rio)/KRKLib.dproj (revision 575)
+++ trunk/rtp/prj/Delphi 26 (Delphi Rio)/KRKLib.dproj (revision 576)
@@ -39,7 +39,8 @@
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>
42+ <Debugger_HostApplication>C:\Program Files (x86)\Embarcadero\Studio\20.0\bin\bds.exe</Debugger_HostApplication>
43+ <Debugger_RunParams>-r KRKExperts</Debugger_RunParams>
4344 </PropertyGroup>
4445 <ItemGroup>
4546 <DelphiCompile Include="$(MainSource)">
--- trunk/rtp/src/Rtl/Common/KRK.Rtl.Common.Classes.pas (revision 575)
+++ trunk/rtp/src/Rtl/Common/KRK.Rtl.Common.Classes.pas (revision 576)
@@ -290,6 +290,32 @@
290290 TTTNPop = function (ANMHdr: TNMHdr): Boolean of object;
291291 TTTNCustomDraw = function (ANMTTCustomDraw: TNMTTCustomDraw): Boolean of object;
292292
293+ TPersistentRect = class(TPersistent)
294+ private
295+ FRect: TRect;
296+ FOnChange: TNotifyEvent;
297+
298+ function GetRect: TRect;
299+
300+ procedure SetRect(const AValue: TRect);
301+ procedure SetRectBottom(const AValue: Integer);
302+ procedure SetRectLeft(const AValue: Integer);
303+ procedure SetRectRight(const AValue: Integer);
304+ procedure SetRectTop(const AValue: Integer);
305+ protected
306+ procedure AssignTo(ADest: TPersistent); override;
307+ public
308+ constructor Create; virtual;
309+
310+ property AsRect : TRect read GetRect Write SetRect;
311+ published
312+ property Left: Integer read FRect.Left write SetRectLeft;
313+ property Top: Integer read FRect.Top write SetRectTop;
314+ property Right: Integer read FRect.Right write SetRectRight;
315+ property Bottom: Integer read FRect.Bottom write SetRectBottom;
316+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
317+ end;
318+
293319 //: Use esta função para manipular mensagens de notificação de ToolTips (TTN_*).
294320 //: Esta função deve retornar true para indicar que a mensagem foi processada e
295321 //: que não é necessário propagá-la ao pai da janela que a recebeu. O retorno
@@ -461,7 +487,7 @@
461487 pTarget: ^Pointer; // @target
462488 Target: Pointer; // @MethodAddr
463489 end;
464- end;
490+ end;
465491
466492 var
467493 Mtp: ^TMethodToProc absolute Result;
@@ -1428,4 +1454,67 @@
14281454 inherited Create(ALastError,AMessage,'',{$IF Defined(NEXTGEN) and Declared(System.Embedded)}'kernelbase.dll'{$ELSE}'kernel32.dll'{$IFEND});
14291455 end;
14301456
1457+{ TPersistentRect }
1458+
1459+procedure TPersistentRect.AssignTo(ADest: TPersistent);
1460+begin
1461+ if ADest is TPersistentRect then
1462+ TPersistentRect(ADest).AsRect := Self.AsRect
1463+ else
1464+ inherited AssignTo(ADest);
1465+end;
1466+
1467+constructor TPersistentRect.Create;
1468+begin
1469+ FOnChange := nil;
1470+end;
1471+
1472+function TPersistentRect.GetRect: TRect;
1473+begin
1474+ Result := FRect;
1475+end;
1476+
1477+procedure TPersistentRect.SetRect(const AValue: TRect);
1478+begin
1479+ FRect.Left := AValue.Left;
1480+ FRect.Top := AValue.Top;
1481+ FRect.Right := AValue.Right;
1482+ FRect.Bottom := AValue.Bottom;
1483+
1484+ if Assigned(FOnChange) then
1485+ FOnChange(Self);
1486+end;
1487+
1488+procedure TPersistentRect.SetRectBottom(const AValue: Integer);
1489+begin
1490+ FRect.Bottom := AValue;
1491+
1492+ if assigned(FOnChange) then
1493+ FOnChange(Self);
1494+end;
1495+
1496+procedure TPersistentRect.SetRectLeft(const AValue: Integer);
1497+begin
1498+ FRect.Left := AValue;
1499+
1500+ if assigned(FOnChange) then
1501+ FOnChange(Self);
1502+end;
1503+
1504+procedure TPersistentRect.SetRectRight(const AValue: Integer);
1505+begin
1506+ FRect.Right := AValue;
1507+
1508+ if assigned(FOnChange) then
1509+ FOnChange(Self);
1510+end;
1511+
1512+procedure TPersistentRect.SetRectTop(const AValue: Integer);
1513+begin
1514+ FRect.Top := AValue;
1515+
1516+ if assigned(FOnChange) then
1517+ FOnChange(Self);
1518+end;
1519+
14311520 end.
--- trunk/rtp/src/Rtl/Win/KRK.Rtl.Win.CommCtrl.pas (revision 575)
+++ trunk/rtp/src/Rtl/Win/KRK.Rtl.Win.CommCtrl.pas (revision 576)
@@ -3,9 +3,19 @@
33 interface
44
55 uses
6- Windows, Messages, CommCtrl, Graphics, Controls, Classes;
6+ Windows, Messages, CommCtrl, Graphics, Controls, Classes,
7+ KRK.Rtl.Common.Classes;
78
89 type
10+ TToolTipStyle = (ttsAlwaysTip, ttsBalloon, ttsClose, ttsNoAnimate, ttsNoFade, ttsNoPrefix, ttsUseVisualStyle);
11+ TTipStyles = set of TToolTipStyle;
12+
13+ TToolTip = class;
14+
15+ TOnRegisterToolTip = procedure (const AToolTip: TToolTip) of object;
16+
17+ TToolTips = class;
18+
919 //: Use esta classe para criar dicas (ToolTips) em runtime.
1020 //: Para criar e exibir um ToolTip, primeiramente se cria a janela deste
1121 //: ToolTip. Literalmente a janela do ToolTip é o próprio ToolTip, isto é,
@@ -70,14 +80,18 @@
7080 //: diretamente da ferramenta cujo handle é agora conhecido por meio de uId
7181 //: @SeeAlso(DelToolInfo)
7282 //: @SeeAlso(AddToolInfo)
73- TKRKToolTip = class
83+ TCustomKRKToolTip = class (TComponent)
7484 private
7585 FToolTipWindowHandle: HWND;
76- FDefaultWidth: SmallInt;
77- FDefaultTitle: LPTSTR;
86+ FDefaultMaxWidth: SmallInt;
87+ FDefaultTitle: String;
7888 FDefaultIcon: HICON;
89+ FDefaultIconStr: String;
7990 FActive: Boolean;
8091 FOnHide: TNotifyEvent;
92+ FOnRegisterToolTip: TOnRegisterToolTip;
93+ FToolTipStyles: TTipStyles;
94+ FToolTips: TToolTips;
8195
8296 //: Retorna True caso a janela de ToolTip seja um balão (TTS_BALLOON)
8397 function IsBalloon: Boolean;
@@ -129,67 +143,42 @@
129143 function GetToolInfo(const Ahwnd: HWND; const AuId: UINT_PTR; out AToolInfo: TToolInfo; out AMustDeallocateText: Boolean): Boolean;
130144 //: Modifica o texto de um ToolTip cuja configurção registrada é
131145 //: identificada por Ahwnd e AuId
132- procedure SetText(const Ahwnd: HWND; const AuId: UINT_PTR; const AlpszText: PChar);
146+ procedure SetTipText(const Ahwnd: HWND; const AuId: UINT_PTR; const AlpszText: PChar);
133147 //: Altera a largura máxima da janela de ToolTip. Um texto que não couber
134148 //: nesta largura será quebrado em várias linhas de forma a manter a largura
135149 //: máxima configurada
136150 //: Atenção! Esta configuração afeta todas as configurações de exibição,
137151 //: pois trata-se de uma configuração da janela de ToolTip em si.
138- procedure SetMaxTipWidth(AMaxTipWidth: SmallInt = -1);
152+ procedure SetTipMaxWidth(ATipMaxWidth: SmallInt = -1);
139153 //: Altera a posição da janela de ToolTip. Estas são coordenadas relativas a
140154 //: tela do computador e não a janelas
141155 //: Atenção! Esta configuração afeta todas as configurações de exibição,
142156 //: pois trata-se de uma configuração da janela de ToolTip em si.
143- procedure SetPosition(const AX, AY: Word);
157+ procedure SetTipPosition(const AX, AY: Word);
144158 //: Ativa ou desativa a jenela de ToolTip. Uma janela desativada não pode
145159 //: ser exibida
146160 //: Atenção! Esta configuração afeta todas as configurações de exibição,
147161 //: pois trata-se de uma configuração da janela de ToolTip em si.
148- procedure SetActive(const AValue: Boolean);
162+ procedure SetTipActive(const AValue: Boolean);
149163 //: Configura as opções padrão da janela de ToolTip
150164 procedure SetDefaultToolTipWindowProperties;
165+ //: Retorna true caso o componente esteja sendo manipulado em tempo de
166+ //: desenvolvimento ou esteja sendo carregado a partir do DFM. Esta função é
167+ //: usada para bloquear a alteração de algumas propriedades que só podem ser
168+ //: definidas em tempo de desenvolvimento
169+ function CanModifyProperty: Boolean;
170+
171+ { A partir daqui temos os métodos Set/Get propriamente ditos }
172+
173+ procedure SetTipStyles(const AValue: TTipStyles);
174+ procedure SetDefaultIcon(const AValue: String);
175+ procedure SetDefaultMaxWidth(const AValue: SmallInt);
176+ procedure SetDefaultTitle(const AValue: String);
177+ protected
178+ procedure Loaded; override;
151179 public
152180 //: Cria uma instância da classe atual.
153- //: Ao criar a classe atual informe em ADefaultIcon o ID de um ícone do
154- //: tamanho correto que será usado durante todo o tempo de vida da aplicação
155- //: ou TTI_NONE, caso não se queira usar ícones. Informar um ícone menor ou
156- //: maior do que o tamanho que será usado na aplicação faz com que ao trocar
157- //: um ícone por outro de tamanho diferente (ou remover o ícone), o texto do
158- //: ToolTip apareça cortado ou o ToolTip apareça maior do que o necessário.
159- //: Nesta situação, exibir o mesmo ToolTip uma segunda vez, faz com que o
160- //: mesmo apareça corretamente, mas não queremos este comportamento,
161- //: portanto é necessário decidir desde o começo se os ToolTips exibidos
162- //: pela classe atual terão ícones e se tiverem, defina um ícone padrão que
163- //: tenha o tamanho dos ícones que devem ser apresentados no decorrer da
164- //: execução do programa.
165- //: Um problema similar ocorre com texto do título em ToolTips do tipo
166- //: balão, por isso existe o parâmetro ADefaultTitle o qual serve para que
167- //: seja informado o texto a ser apresentado por padrão no título de um
168- //: ToolTip deste tipo. Garanta que este texto seja menor ou igual a todos
169- //: os outros títulos que porventura sejam apresentados nos ToolTips
170- //: automáticos da classe sendo criada, pois toda vez que se oculta um
171- //: ToolTip, este texto é recuperado e caso ele seja maior que o título de
172- //: um ToolTip exibido posteriormente, haverá problemas nas dimensões do
173- //: ToolTip que precisarão ser corrigidos por meio do uso de SetIconAndTitle
174- //: dentro do evento OnHide desta classe (em suma, uma gambiarra mesmo).
175- //: Isso acontece porque o ToolTip só consegue se ajustar aumentando o
176- //: tamanho do texto do seu título ou mantendo este texto do mesmo tamanho.
177- //: Caso se tente mostrar um ToolTip com um título menor que o que foi
178- //: configurado anteriormente, a primeira exibição deste ToolTip mostrará o
179- //: balão maior do que deveria, pois ele ainda está achando que está com o
180- //: título maior. Uma segunda exibição mostrará o balão no tamanho correto!
181- //: Portanto, para mostrar o balão no tamanho correto sempre, o título do
182- //: mesmo tem que ser do mesmo tamanho ou ser maior do que o seu tamanho
183- //: padrão. Caso você não tenha intenção de mostrar o título padrão, você
184- //: pode definir aqui como padrão apenas uma letra pois evidentemente todo e
185- //: qualquer título válido será maior do que uma letra e assim o balão
186- //: aparecerá no tamanho correto.
187- //: Estes problemas relacionados a linha de título de um balão só afetam os
188- //: ToolTips automáticos, pois os ToolTips tracking podem ser
189- //: preconfigurados antes de serem exibidos e isso resolve os problemas de
190- //: dimensionamento e limitações de tamanho e troca de ícones e textos de
191- //: título (não testei isso)
192- constructor Create(AToolTipStyles: Cardinal = TTS_NOPREFIX or TTS_ALWAYSTIP or TTS_BALLOON; ADefaultWidth: SmallInt = -1; ADefaultTitle: String = 'Sem título'; ADefaultIcon: HICON = TTI_INFO);
181+ constructor Create(AOwner: TComponent); override;
193182 destructor Destroy; override;
194183
195184 //: Adiciona uma configuração de exibição para a janela de ToolTip atual
@@ -208,7 +197,8 @@
208197 Arect: TRect;
209198 AhInst: HINST;
210199 AlpszText: LPTSTR;
211- AlParam: LPARAM);
200+ AlParam: LPARAM); overload;
201+ procedure AddToolInfo(const AToolInfo: TToolInfo); overload;
212202 //: Remove a configuração de exibição identificada pelos perâmetros
213203 //: informados da janela de ToolTip criada por esta classe. Os membros hwnd
214204 //: e uId de TToolInfo são usados como identificadores da configuração de
@@ -238,13 +228,18 @@
238228 //: identificado por AResourceId
239229 class function IconResourceId2IconHandle(AIconResourceId: LPTSTR): HICON;
240230 //: Atribui o ícone e o título da janela de ToolTip
241- procedure SetIconAndTitle(const AIconHandle: HICON; const ATitle: LPTSTR);
242-
231+ procedure SetTipIconAndTitle(const AIcon: HICON; const ATitle: LPTSTR);
232+ //: Registra todos os ToolTips da coleção "ToolTips". Este procedure precisa
233+ //: ser chamado em um local onde todos os controles referenciados nos itens
234+ //: da coleção já estejam disponíveis, de forma que as informações a
235+ //: respeito destes controles possam ser obtidas e registradas juntamente
236+ //: com cada estrutura TOOLINFO
237+ procedure RegisterToolTips;
243238 //: Quando False, nenhum dos ToolTips registrados por esta classe aparecerá.
244239 //: Quando da criação desta classe, esta propriedade é sempre true, o que
245240 //: significa que todos os ToolTips registrados poderão aparecer, seja
246241 //: automaticamente ou por demanda
247- property Active: Boolean read FActive write SetActive;
242+ property Active: Boolean read FActive write SetTipActive default True;
248243 //: O evento OnHide ocorre quando a jenela do ToolTip está prestes a ser
249244 //: ocultada. Se agora você agora estiver se perguntando como saber quando
250245 //: um ToolTip está prestes a ser exibido, consulte a respeito de TTN_SHOW,
@@ -257,9 +252,209 @@
257252 //: estas notificações em uma janela cujo handle tenha sido informado no
258253 //: membro hwnd de uma das estruturas TOOLINFO registradas
259254 property OnHide: TNotifyEvent read FOnHide write FOnHide;
255+ //: O evento OnRegisterToolTip ocorre imediatamente antes de cada um dos
256+ //: ToolTips listados na propriedade @Link(ToolTips) ser registrado por meio
257+ //: da mensagem TTM_ADDTOOL. É neste evento onde se tem a última chance de
258+ //: alterar cada um dos membros de TOOLINFO antes de o ToolTip ser
259+ //: registrado fornecendo assim um controle maior na criação dos ToolTips
260+ property OnRegisterToolTip: TOnRegisterToolTip read FOnRegisterToolTip write FOnRegisterToolTip;
261+ //: Trata-se do Handle da janela de ToolTip, a qual foi criada
262+ //: automaticamente por esta classe dutrante a criação da mesma
260263 property ToolTipWindowHandle: HWND read FToolTipWindowHandle;
264+ //: Esta propriedade contém os estilos que são aplicados à janela de ToolTip
265+ //: no momento de sua criação, que se dá no método Loaded, não sendo
266+ //: portanto alteráveis após o carregamento da classe atual. Para alterar os
267+ //: estilos da janela de ToolTip em runtime utilize seu handle
268+ //: (ToolTipWindowHandle) em chamadas a SetWindowLong
269+ property ToolTipStyles: TTipStyles read FToolTipStyles write SetTipStyles default [ttsNoPrefix, ttsAlwaysTip, ttsBalloon];
270+ //: DefaultMaxWidth serve para que seja informada a largura máxima padrão
271+ //: dos ToolTips e textos que não couberem nesta largura serão quebrados
272+ //: automaticamente. O tamanho máximo mínimo é definido na constante
273+ //: TOOLTIPMINIMUMMAXWIDTH, o que significa que ao informar em
274+ //: DefaultMaxWidth um valor menor do que o definido nesta constante, ele
275+ //: será automaticamente alterado para o valor da constante. Informar nesta
276+ //: propriedade o valor -1, faz com que a largura do ToolTip seja
277+ //: automática, neste caso, excepcionalmente a largura de um ToolTip poderá
278+ //: ser menor do que a definida na constante TOOLTIPMINIMUMMAXWIDTH. Caso
279+ //: seja informado um valor menor ou igual a zero nesta propriedade, ela
280+ //: assumirá o valor -1
281+ //: Os problemas relacionados ao tamanho do ToolTip só afetam os ToolTips
282+ //: automáticos, pois os ToolTips tracking podem ser preconfigurados antes
283+ //: de serem exibidos e isso resolve os problemas de dimensionamento e
284+ //: limitações de tamanho e troca de ícones e textos de título
285+ property DefaultMaxWidth: SmallInt read FDefaultMaxWidth write SetDefaultMaxWidth default -1;
286+ //: DefaultTitle serve para que seja informado o texto a ser apresentado por
287+ //: padrão no título de um ToolTip do tipo balão. Garanta que este texto
288+ //: seja menor ou igual a todos os outros títulos que porventura sejam
289+ //: apresentados nos ToolTips automáticos da classe sendo criada, pois toda
290+ //: vez que se oculta um ToolTip, este texto é recuperado e caso ele seja
291+ //: maior que o título de um ToolTip exibido posteriormente, haverá
292+ //: problemas nas dimensões do ToolTip que precisarão ser corrigidos por
293+ //: meio do uso de SetIconAndTitle dentro do evento OnHide desta classe (em
294+ //: suma, uma gambiarra mesmo!). Um problema similar ocorre com os ícones
295+ //: dos ToolTips. Isso acontece porque o ToolTip só consegue se ajustar
296+ //; aumentando o tamanho do texto do seu título ou mantendo este texto do
297+ //: mesmo tamanho. Caso se tente mostrar um ToolTip com um título menor que
298+ //: o que foi configurado anteriormente, a primeira exibição deste ToolTip
299+ //: mostrará o balão maior do que deveria, pois ele ainda está achando que
300+ //: está com o título maior. Uma segunda exibição mostrará o balão no
301+ //: tamanho correto! Portanto, para mostrar o balão no tamanho correto
302+ //: sempre, o título do mesmo tem que ser do mesmo tamanho ou ser maior do
303+ //: que o seu tamanho padrão. Caso você não tenha intenção de mostrar o
304+ //: título padrão, você pode definir aqui como padrão apenas uma letra pois
305+ //: evidentemente todo e qualquer título válido será maior do que uma letra
306+ //: e assim o balão aparecerá no tamanho correto. Ao informar um título em
307+ //: branco será usada a frase "Sem título", ou seja, um título sempre
308+ //: existirá
309+ //: Os problemas relacionados ao tamanho do ToolTip só afetam os ToolTips
310+ //: automáticos, pois os ToolTips tracking podem ser preconfigurados antes
311+ //: de serem exibidos e isso resolve os problemas de dimensionamento e
312+ //: limitações de tamanho e troca de ícones e textos de título
313+ property DefaultTitle: String read FDefaultTitle write SetDefaultTitle;
314+ //: DefaultIcon é a referência a um ícone do tamanho correto que será usado
315+ //: durante todo o tempo de vida da aplicação ou TTI_NONE, caso não se
316+ //: queira usar ícones. Informar um ícone menor ou maior do que o tamanho
317+ //: que será usado na aplicação faz com que ao trocar um ícone por outro de
318+ //: tamanho diferente (ou remover o ícone), o texto do ToolTip apareça
319+ //: cortado ou o ToolTip apareça maior do que o necessário. Nesta situação,
320+ //: exibir o mesmo ToolTip uma segunda vez, faz com que o mesmo apareça
321+ //: corretamente, mas não queremos este comportamento, portanto é necessário
322+ //: decidir desde o começo se os ToolTips exibidos pela classe atual terão
323+ //: ícones e se tiverem, defina um ícone padrão que tenha o tamanho dos
324+ //: ícones que devem ser apresentados no decorrer da execução do programa.
325+ //: Esta propriedade é uma string que aceita tanto os identificadores padrão
326+ //: (TTI_*) como identificadores de recurso da aplicação, além de
327+ //: identificadores numéricos.
328+ //: Os problemas relacionados ao tamanho do ToolTip só afetam os ToolTips
329+ //: automáticos, pois os ToolTips tracking podem ser preconfigurados antes
330+ //: de serem exibidos e isso resolve os problemas de dimensionamento e
331+ //: limitações de tamanho e troca de ícones e textos de título
332+ property DefaultIcon: String read FDefaultIconStr write SetDefaultIcon;
333+ //: Coleção de ToolTips que serão registradas mediante execução do método
334+ //: @Link(RegisterToolTips). Cada item desta coleção possui propriedades do
335+ //: tipo TControl e TWinControl nas quase se inforam referências a
336+ //: controles. A lista de controles só aparece após o Form/Frame que contém
337+ //: tais controles ser exibido em tempo de projeto.
338+ //: @SeeAlso(RegisterToolTips)
339+ property ToolTips: TToolTips read FToolTips write FToolTips;
340+ // No futuro crie um editor de propriedade para um propriedae de nome
341+ // ToolTips, onde essa propriedade seria do tipo string usada apenas como
342+ // ponto para chamar este editor de propriedade. Utilize DefineProperties
343+ // (veja o exemplo em UserControl) e manipule via editor uma propriedade
344+ // privada do tipo tcollection. Existe
345+ // procedure WriteCollection(const Value: TCollection); que pode ser usado
346+ // para escrever a coleção!
261347 end;
262348
349+ TTTFlag = (ttfAbsolute, ttfCenterTip, ttfIDIsHwnd, ttfParseLinks, ttfRtlReading, ttfSubclass, ttfTrack, ttfTransparent);
350+ TTTFlags = set of TTTFlag;
351+
352+ TToolTip = class (TCollectionItem)
353+ private
354+ FTool: TControl;
355+ FParent: TWinControl;
356+ FId: Cardinal;
357+ FFlags: TTTFlags;
358+ FToolIsAssigned: Boolean;
359+ FTag: LPARAM;
360+ FText: String;
361+
362+ function GetParentName: String;
363+ function GetId: Cardinal;
364+
365+ procedure SetTool(const AValue: TControl);
366+ procedure SetFlags(const AValue: TTTFlags);
367+ procedure SetId(const AValue: Cardinal);
368+
369+ function CanModifyProperty: Boolean;
370+ function CanModifyTool: Boolean;
371+ function GetParentHandle: HWND;
372+ function IsTrackingToolTip: Boolean;
373+ protected
374+ function GetDisplayName: String; override;
375+ public
376+ constructor Create(ACollection: TCollection); override;
377+ destructor Destroy; override;
378+
379+ function GetToolInfoHwnd: HWND;
380+ function GetToolInfoUId: UIntPtr;
381+ function GetToolInfoRect: TRect;
382+ function GetToolInfoUFlags: UINT;
383+ function GetToolInfoLParam: LPARAM;
384+ function GetToolInfoLpszText: LPTSTR;
385+
386+ //: Referência à instância do pai da ferramenta
387+ property Parent: TWinControl read FParent;
388+ published
389+ //: Controle para o qual deverá ser exibido o ToolTip. A partir desta
390+ //: propriedade serão obtidos os membros hwnd e uId de TOOLINFO. hwnd será
391+ //: sempre o handle do pai deste controle, pois todo controle visual tem um
392+ //: pai, já uId terá um valor calculado de acordo com a ferramenta
393+ //: selecionada. Veja a descrição da propriedade @Link(Id) para entender
394+ //: como o uId é calculado
395+ //: @SeeAlso(Id);
396+ property Tool: TControl read FTool write SetTool;
397+ //: Exibe o nome qualificado do pai da ferramenta informada na propriedade
398+ //: Tool, em tempo de desenvolvimento. Em tempo de execução o campo FParent
399+ //: contém a referência ao pai da ferramenta ou nil caso a ferramenta não
400+ //: tenha um pai
401+ property ParentName: String read GetParentName;
402+ //: Flags usados pelo ToolTip atual, correspondendo ao membro uFlags de
403+ //: TOOLINFO. Esta propriedade não pode ser alterada diretamente em tempo de
404+ //: execução
405+ property Flags: TTTFlags read FFlags write SetFlags default [];
406+ //: Identificação da ferramenta para a qual o ToolTip será exibido. Esse
407+ //: valor é calculado automaticamente dependendo da ferramenta selecionada
408+ //: em @Link(Tool). Caso a ferramenta seja um TWinControl, Id será
409+ //: simplesmente seu handle. Caso a ferramenta não seja um TWinControl ela
410+ //: não terá handle, portanto o Id será o somatório do handle do pai do
411+ //: controle com o valor da propriedade ComponentIndex
412+ property Id: Cardinal read GetId write SetId stored IsTrackingToolTip;
413+ //: Valor arbitrário que pode ser associado com o ToolTip. Trata-se do
414+ //: membro lParam de TOOLINFO
415+ property Tag: LPARAM read FTag write FTag;
416+ //: Texto que é exibido por este ToolTip. Trata-se do membro lpszText de
417+ //: TOOLINFO
418+ property Text: String read FText write FText;
419+ end;
420+
421+ TToolTipsEnumerator = class
422+ private
423+ FIndex: Integer;
424+ FCollection: TToolTips;
425+
426+ function GetCurrent: TToolTip; inline;
427+ public
428+ constructor Create(AToolTips: TToolTips);
429+
430+ function MoveNext: Boolean;
431+
432+ property Current: TToolTip read GetCurrent;
433+ end;
434+
435+ TToolTips = class (TOwnedCollection)
436+ private
437+ function GetItem(AIndex: Integer): TToolTip;
438+ public
439+ function GetEnumerator: TToolTipsEnumerator;
440+
441+ property Items[AIndex: Integer]: TToolTip read GetItem; default;
442+ end;
443+ { ========================================================================== }
444+
445+ TKRKToolTip = class(TCustomKRKToolTip)
446+ published
447+ property Active;
448+ property ToolTipStyles;
449+ property DefaultMaxWidth;
450+ property DefaultTitle;
451+ property DefaultIcon;
452+ property ToolTips;
453+
454+ property OnHide;
455+ property OnRegisterToolTip;
456+ end;
457+
263458 const
264459 {$IF RTLVersion <= 18} { Delphi 2006}
265460 TOOLTIPS_CLASS = 'tooltips_class32';
@@ -296,7 +491,7 @@
296491 implementation
297492
298493 uses
299- UITypes, SysUtils, Forms;
494+ UITypes, SysUtils, Forms, Types;
300495
301496 const
302497 // Tamanho máximo do texto do ToolTip, em caracteres. O texto do ToolTip pode
@@ -311,26 +506,42 @@
311506 // para limitar a quantidade de texto que o ToolTip aceita verificando o
312507 // length de uma string
313508 TOOLTIPTEXTMAXLENGTH = 1024;
509+ // Tamanho mínimo que um ToolTip pode ter quando sua largura máxima é
510+ // configurada com um valor diferente de automático (-1). ToolTips de tamanho
511+ // automático podem ficar menores do que o valor desta constante, dependendo
512+ // do texto nele apresentado
513+ TOOLTIPMINIMUMMAXWIDTH = 175;
314514
315-{ TKRKTrackingToolTip }
515+{ TCustomKRKToolTip }
316516
317-constructor TKRKToolTip.Create(AToolTipStyles: Cardinal = TTS_NOPREFIX or TTS_ALWAYSTIP or TTS_BALLOON; ADefaultWidth: SmallInt = -1; ADefaultTitle: String = 'Sem título'; ADefaultIcon: HICON = TTI_INFO);
517+procedure TCustomKRKToolTip.AddToolInfo(const AToolInfo: TToolInfo);
318518 begin
319- // Cria a janela do ToolTip com os parâmetros especificados e coloca seu
320- // Handle em FToolTipWindowHandle
321- FToolTipWindowHandle := CreateToolTipWindow(AToolTipStyles);
519+ if FToolTipWindowHandle <> 0 then
520+ AddToolInfo(AToolInfo.hwnd
521+ ,AToolInfo.uId
522+ ,AToolInfo.uFlags
523+ ,AToolInfo.Rect
524+ ,AToolInfo.hInst
525+ ,AToolInfo.lpszText
526+ ,AToolInfo.lParam);
527+end;
322528
323- // Sobrepõe o procedimento de janela original
324- ReplaceOriginalWndProc;
529+function TCustomKRKToolTip.CanModifyProperty: Boolean;
530+begin
531+ Result := (csDesigning in ComponentState) or (csLoading in ComponentState);
532+end;
325533
534+constructor TCustomKRKToolTip.Create(AOwner: TComponent);
535+begin
536+ inherited;
537+
538+ FDefaultMaxWidth := -1;
539+ FDefaultTitle := 'Sem título';
540+ FDefaultIcon := TTI_INFO;
541+ FDefaultIconStr := 'TTI_INFO';
542+ FToolTipStyles := [ttsNoPrefix, ttsAlwaysTip, ttsBalloon];
326543 FActive := True;
327- // A respeito das propriedades Default abaixo, leia a descrição da classe
328- FDefaultWidth := ADefaultWidth;
329- FDefaultTitle := PChar(ADefaultTitle);
330- FDefaultIcon := ADefaultIcon;
331-
332- // Definindo as opções padão
333- SetDefaultToolTipWindowProperties;
544+ FToolTips := TToolTips.Create(Self,TToolTip);
334545 end;
335546
336547 // Original ToolTip WndProc
@@ -342,11 +553,11 @@
342553 // ToolTip WndProc
343554 function NTTWNDPROC(AWindowHandle: HWND; AMessage: UINT; AWParam: WPARAM; ALParam: LPARAM): LRESULT; stdcall;
344555 var
345- KRTT: TKRKToolTip;
556+ KRTT: TCustomKRKToolTip;
346557 begin
347558 // Obtendo a instância do ToolTip atual, a fim de obter acesso facilitado as
348559 // suas propriedades e eventos
349- KRTT := TKRKToolTip(GetWindowLong(AWindowHandle,GWL_USERDATA));
560+ KRTT := TCustomKRKToolTip(GetWindowLong(AWindowHandle,GWL_USERDATA));
350561
351562 // Sempre que uma janela de ToolTip é ocultada, uma mensagem WM_SHOWWINDOW é
352563 // envida para a janela do ToolTip (com AWParam = 0)
@@ -378,11 +589,9 @@
378589 end;
379590
380591 // A exibição de um ToolTip do tipo tracking pode alterar a largura da
381- // janela de ToolTip, neste caso, garantimos aqui que quando um ToolTip for
382- // exibido ele terá a largura padrão definida na propriedade FDefaultWidth.
383- // O mesmo se aplica ao ícone e ao título de um ToolTip do tipo balão.
384- // Sempre que se ocultar um ToolTip, o ícone e o título padrões serão
385- // recuperados
592+ // janela de ToolTip, neste caso, garantimos aqui que quando um ToolTip
593+ // automático for exibido ele terá as características padrões definidas nas
594+ // propriedade DefaultMaxWidth, DefaultTitle e DefaultIcon
386595 KRTT.SetDefaultToolTipWindowProperties;
387596
388597 if Assigned(KRTT.FOnHide) then
@@ -528,8 +737,38 @@
528737 {$ENDREGION}
529738 end;
530739
531-procedure TKRKToolTip.ReplaceOriginalWndProc;
740+procedure TCustomKRKToolTip.RegisterToolTips;
741+var
742+ ToolTip: TToolTip;
743+ ToolInfo: TToolInfo;
532744 begin
745+ ZeroMemory(@ToolInfo,SizeOf(TToolInfo));
746+ ToolInfo.cbSize := SizeOf(TToolInfo);
747+ ToolInfo.hInst := HInstance;
748+
749+ for ToolTip in FToolTips do
750+ begin
751+ // Última chance para alterar os dados que serão usados para registrar um
752+ // ToolTip
753+ if Assigned(FOnRegisterToolTip) then
754+ FOnRegisterToolTip(ToolTip);
755+
756+ ToolInfo.uFlags := ToolTip.GetToolInfoUFlags;
757+ ToolInfo.hwnd := ToolTip.GetToolInfoHwnd;
758+ ToolInfo.uId := ToolTip.GetToolInfoUId;
759+ ToolInfo.Rect := ToolTip.GetToolInfoRect;
760+ ToolInfo.lParam := ToolTip.GetToolInfoLParam;
761+ ToolInfo.lpszText := ToolTip.GetToolInfoLpszText;
762+
763+ // Apenas vai adicionar o ToolTip se houver o handle do pai (hwnd) e o id
764+ // (uId)
765+ if (ToolInfo.hwnd > 0) and (ToolInfo.uId > 0) then
766+ AddToolInfo(ToolInfo);
767+ end;
768+end;
769+
770+procedure TCustomKRKToolTip.ReplaceOriginalWndProc;
771+begin
533772 // Seta o ponteiro para GWL_WNDPROC do nosso procedimento de janela
534773 // customizado, e retorna o ponteiro para o procedimento de janela original.
535774 // Como cada instância de TKRKToolTip usa o mesmo tipo de processamento para
@@ -543,7 +782,7 @@
543782 OTTWNDPROC := Pointer(SetWindowLong(FToolTipWindowHandle,GWL_WNDPROC,LongInt(@NTTWNDPROC)));
544783 end;
545784
546-procedure TKRKToolTip.RestoreOriginalWndProc;
785+procedure TCustomKRKToolTip.RestoreOriginalWndProc;
547786 begin
548787 if FToolTipWindowHandle > 0 then
549788 begin
@@ -552,7 +791,7 @@
552791 end;
553792 end;
554793
555-function TKRKToolTip.CreateToolTipWindow(AToolTipStyles: Cardinal): HWND;
794+function TCustomKRKToolTip.CreateToolTipWindow(AToolTipStyles: Cardinal): HWND;
556795 begin
557796 Result := CreateWindowEx(WS_EX_NOACTIVATE // A jenala do ToolTip não ficará ativa e portanto nunca será a janela da frente
558797 or WS_EX_TOPMOST // A janela do ToolTip ficará em cima de outras janelas não top-most e fica lá mesmo se desativada
@@ -570,19 +809,21 @@
570809 SetWindowLongPtr(Result,GWL_USERDATA,Integer(Self));
571810 end;
572811
573-destructor TKRKToolTip.Destroy;
812+destructor TCustomKRKToolTip.Destroy;
574813 begin
814+ FToolTips.Free;
575815 DestroyToolTipWindow;
816+
576817 inherited;
577818 end;
578819
579-procedure TKRKToolTip.DestroyToolTipWindow;
820+procedure TCustomKRKToolTip.DestroyToolTipWindow;
580821 begin
581822 if FToolTipWindowHandle <> 0 then
582823 DestroyWindow(FToolTipWindowHandle);
583824 end;
584825
585-procedure TKRKToolTip.Hide;
826+procedure TCustomKRKToolTip.Hide;
586827 var
587828 ToolInfo: TToolInfo;
588829 begin
@@ -598,7 +839,7 @@
598839 // membros hwnd e uId
599840 SendMessage(FToolTipWindowHandle,TTM_TRACKACTIVATE,WPARAM(False),LPARAM(@ToolInfo));
600841 // Aqui havia uma chamada a SetMaxTipWidth que foi movida para a manipulação
601- // da mensagem WM_SHOWWINDOW. Se você estiver lendo isso e não estivere
842+ // da mensagem WM_SHOWWINDOW. Se você estiver lendo isso e não estiver
602843 // resolvendo algum problema relacionado a largura do ToolTip, então muito
603844 // provavelmente esse problema não existe mais e você pode remover este
604845 // comentário
@@ -605,12 +846,12 @@
605846 end;
606847 end;
607848
608-function TKRKToolTip.HasCloseButton: Boolean;
849+function TCustomKRKToolTip.HasCloseButton: Boolean;
609850 begin
610851 Result := IsBalloon and (GetWindowLongPtr(FToolTipWindowHandle,GWL_STYLE) and TTS_CLOSE = TTS_CLOSE);
611852 end;
612853
613-function TKRKToolTip.IsBalloon: Boolean;
854+function TCustomKRKToolTip.IsBalloon: Boolean;
614855 begin
615856 Result := False;
616857
@@ -618,19 +859,66 @@
618859 Result := GetWindowLongPtr(FToolTipWindowHandle,GWL_STYLE) and TTS_BALLOON = TTS_BALLOON;
619860 end;
620861
621-function TKRKToolTip.IsVisible: Boolean;
862+function TCustomKRKToolTip.IsVisible: Boolean;
622863 begin
623864 Result := SendMessage(FToolTipWindowHandle,TTM_GETCURRENTTOOL,0,0) > 0;
624865 end;
625866
626-procedure TKRKToolTip.AddToolInfo(const Ahwnd: HWND;
627- const AuId: UINT_PTR;
628- AuFlags: Cardinal;
629- Arect: TRect;
630- AhInst: HINST;
631- AlpszText: LPTSTR;
632- AlParam: LPARAM);
867+procedure TCustomKRKToolTip.Loaded;
633868 var
869+ ToolTipStyles: Cardinal;
870+begin
871+ if not (csDesigning in ComponentState) then
872+ begin
873+ // Após a classe ser instanciada, o sistema de carregamento de propriedades
874+ // começa a carregar tudo que foi definido no OI em tempo de projeto, e o
875+ // método Loaded é chamado após todas as propriedades da classe atual terem
876+ // sido atualizadas com esses valores carregados
877+ ToolTipStyles := 0;
878+
879+ if ttsAlwaysTip in FToolTipStyles then
880+ ToolTipStyles := ToolTipStyles or TTS_ALWAYSTIP;
881+
882+ if ttsBalloon in FToolTipStyles then
883+ ToolTipStyles := ToolTipStyles or TTS_BALLOON;
884+
885+ if ttsClose in FToolTipStyles then
886+ ToolTipStyles := ToolTipStyles or TTS_CLOSE;
887+
888+ if ttsNoAnimate in FToolTipStyles then
889+ ToolTipStyles := ToolTipStyles or TTS_NOANIMATE;
890+
891+ if ttsNoFade in FToolTipStyles then
892+ ToolTipStyles := ToolTipStyles or TTS_NOFADE;
893+
894+ if ttsNoPrefix in FToolTipStyles then
895+ ToolTipStyles := ToolTipStyles or TTS_NOPREFIX;
896+
897+ if ttsUseVisualStyle in FToolTipStyles then
898+ ToolTipStyles := ToolTipStyles or TTS_USEVISUALSTYLE;
899+
900+ // Cria a janela do ToolTip com os parâmetros especificados e coloca seu
901+ // Handle em FToolTipWindowHandle
902+ FToolTipWindowHandle := CreateToolTipWindow(ToolTipStyles);
903+ // Sobrepõe o procedimento de janela original
904+ ReplaceOriginalWndProc;
905+ // Definindo as opções padão
906+ SetDefaultToolTipWindowProperties;
907+ end;
908+ // Como estamos em uma classe filha de um TComponent, o inherited apenas
909+ // remove csLoading de ComponentState, portanto, tudo que há aqui antes de
910+ // inherited, acontece durante csLoading!
911+ inherited;
912+end;
913+
914+procedure TCustomKRKToolTip.AddToolInfo(const Ahwnd: HWND;
915+ const AuId: UINT_PTR;
916+ AuFlags: Cardinal;
917+ Arect: TRect;
918+ AhInst: HINST;
919+ AlpszText: LPTSTR;
920+ AlParam: LPARAM);
921+var
634922 ToolInfo: TToolInfo;
635923 begin
636924 if FToolTipWindowHandle <> 0 then
@@ -673,7 +961,7 @@
673961 // LPSTR_TEXTCALLBACK (-1 ou $FFFFFFFF), significa que o texto do ToolTip
674962 // será obitdo por meio de TTN_GETDISPINFO
675963 if (Cardinal(AlpszText) <> High(Cardinal)) and (HiWord(Cardinal(AlpszText)) > 0) then
676- SetText(Ahwnd,AuId,PChar(Copy(AlpszText,1,TOOLTIPTEXTMAXLENGTH)));
964+ SetTipText(Ahwnd,AuId,PChar(Copy(AlpszText,1,TOOLTIPTEXTMAXLENGTH)));
677965 // Caso a condição acima não seja satisfeita, significa que AlpszText
678966 // contém um identificador de string de recurso ou LPSTR_TEXTCALLBACK e
679967 // neste caso não precisamos fazer mais nada, pois a mensagem TTM_ADDTOOL
@@ -685,11 +973,11 @@
685973 // que isso aconteceu. Caso o programador informe uma string vazia aí
686974 // realmente não tem jeito, pois o ToolTip não vai aparecer
687975 else
688- SetText(Ahwnd,AuId,'Nenhum texto foi definido, por isso você está vendo isso');
976+ SetTipText(Ahwnd,AuId,'Nenhum texto foi definido, por isso você está vendo isso');
689977 end;
690978 end;
691979
692-procedure TKRKToolTip.DelToolInfo(const Ahwnd: HWND; const AuId: UINT_PTR);
980+procedure TCustomKRKToolTip.DelToolInfo(const Ahwnd: HWND; const AuId: UINT_PTR);
693981 var
694982 ToolInfo: TToolInfo;
695983 begin
@@ -705,14 +993,22 @@
705993 end;
706994 end;
707995
708-procedure TKRKToolTip.SetToolInfo(const AToolInfo: TToolInfo);
996+procedure TCustomKRKToolTip.SetToolInfo(const AToolInfo: TToolInfo);
709997 begin
710998 if FToolTipWindowHandle <> 0 then
711999 SendMessage(FToolTipWindowHandle,TTM_SETTOOLINFO,0,LPARAM(@AToolInfo));
7121000 end;
7131001
714-function TKRKToolTip.GetToolInfo(const Ahwnd: HWND; const AuId: UINT_PTR; out AToolInfo: TToolInfo; out AMustDeallocateText: Boolean): Boolean;
1002+procedure TCustomKRKToolTip.SetTipStyles(const AValue: TTipStyles);
7151003 begin
1004+ if not CanModifyProperty then
1005+ raise Exception.Create('Não é possível alterar a propriedade "ToolTipStyles" em tempo de execução');
1006+
1007+ FToolTipStyles := AValue;
1008+end;
1009+
1010+function TCustomKRKToolTip.GetToolInfo(const Ahwnd: HWND; const AuId: UINT_PTR; out AToolInfo: TToolInfo; out AMustDeallocateText: Boolean): Boolean;
1011+begin
7161012 ZeroMemory(@AToolInfo,SizeOf(TToolInfo));
7171013 AMustDeallocateText := False;
7181014 Result := False;
@@ -742,7 +1038,7 @@
7421038 end;
7431039 end;
7441040
745-procedure TKRKToolTip.UpdateToolInfo(const Ahwnd: HWND; const AuId: UINT_PTR; const AuFlags: UINT; const Arect: TRect; const AhInst: HINST; const AlpszText: LPTSTR; const AlParam: LPARAM);
1041+procedure TCustomKRKToolTip.UpdateToolInfo(const Ahwnd: HWND; const AuId: UINT_PTR; const AuFlags: UINT; const Arect: TRect; const AhInst: HINST; const AlpszText: LPTSTR; const AlParam: LPARAM);
7461042 var
7471043 ToolInfo: TToolInfo;
7481044 MustDeallocateText: Boolean;
@@ -783,7 +1079,7 @@
7831079 // Definindo o texto do ToolTip aqui para permitir que um texto de
7841080 // qualquer tamanho seja informado (TTM_UPDATETIPTEXT)
7851081 if Assigned(AlpszText) then
786- SetText(Ahwnd,AuId,AlpszText);
1082+ SetTipText(Ahwnd,AuId,AlpszText);
7871083 finally
7881084 if MustDeallocateText then
7891085 FreeMem(ToolInfo.lpszText);
@@ -791,7 +1087,7 @@
7911087 end;
7921088 end;
7931089
794-class function TKRKToolTip.IconResourceId2IconHandle(AIconResourceId: LPTSTR): HICON;
1090+class function TCustomKRKToolTip.IconResourceId2IconHandle(AIconResourceId: LPTSTR): HICON;
7951091 begin
7961092 Result := 0;
7971093
@@ -799,7 +1095,7 @@
7991095 Result := LoadIcon(HInstance,AIconResourceId);
8001096 end;
8011097
802-procedure TKRKToolTip.SetActive(const AValue: Boolean);
1098+procedure TCustomKRKToolTip.SetTipActive(const AValue: Boolean);
8031099 begin
8041100 if FToolTipWindowHandle <> 0 then
8051101 begin
@@ -809,42 +1105,99 @@
8091105 end;
8101106 end;
8111107
812-procedure TKRKToolTip.SetDefaultToolTipWindowProperties;
1108+procedure TCustomKRKToolTip.SetDefaultIcon(const AValue: String);
1109+var
1110+ Icon: Cardinal;
8131111 begin
814- SetMaxTipWidth(FDefaultWidth);
1112+ if not CanModifyProperty then
1113+ raise Exception.Create('Não é possível alterar a propriedade "DefaultIcon" em tempo de execução');
8151114
816- if IsBalloon then
817- SetIconAndTitle(FDefaultIcon,FDefaultTitle);
1115+ FDefaultIconStr := Trim(AValue);
1116+
1117+ // Se foi informado o nome de um ícone padrão ...
1118+ if FDefaultIconStr = 'TTI_NONE' then
1119+ FDefaultIcon := TTI_NONE
1120+ else if FDefaultIconStr = 'TTI_INFO' then
1121+ FDefaultIcon := TTI_INFO
1122+ else if FDefaultIconStr = 'TTI_WARNING' then
1123+ FDefaultIcon := TTI_WARNING
1124+ else if FDefaultIconStr = 'TTI_ERROR' then
1125+ FDefaultIcon := TTI_ERROR
1126+ else if FDefaultIconStr = 'TTI_INFO_LARGE' then
1127+ FDefaultIcon := TTI_INFO_LARGE
1128+ else if FDefaultIconStr = 'TTI_WARNING_LARGE' then
1129+ FDefaultIcon := TTI_WARNING_LARGE
1130+ else if FDefaultIconStr = 'TTI_ERROR_LARGE' then
1131+ FDefaultIcon := TTI_ERROR_LARGE
1132+ // Se foi informado um HICON diretamente ...
1133+ else if TryStrToUInt(FDefaultIconStr,Icon) then
1134+ FDefaultIcon := Icon
1135+ // Se foi informado o nome de um recurso ...
1136+ else
1137+ FDefaultIcon := IconResourceId2IconHandle(PChar(FDefaultIconStr));
8181138 end;
8191139
820-procedure TKRKToolTip.SetIconAndTitle(const AIconHandle: HICON; const ATitle: LPTSTR);
1140+procedure TCustomKRKToolTip.SetDefaultTitle(const AValue: String);
8211141 begin
1142+ if not CanModifyProperty then
1143+ raise Exception.Create('Não é possível alterar a propriedade "DefaultTitle" em tempo de execução');
1144+
1145+ if Trim(AValue) = '' then
1146+ FDefaultTitle := 'Sem título'
1147+ else
1148+ FDefaultTitle := AValue;
1149+end;
1150+
1151+procedure TCustomKRKToolTip.SetDefaultToolTipWindowProperties;
1152+begin
8221153 if FToolTipWindowHandle <> 0 then
823- if (AIconHandle > 0) or Assigned(ATitle) then
824- SendMessage(FToolTipWindowHandle,TTM_SETTITLE,AIconHandle,LPARAM(ATitle));
1154+ begin
1155+ SetTipMaxWidth(FDefaultMaxWidth);
1156+ SetTipIconAndTitle(FDefaultIcon,PChar(FDefaultTitle));
1157+ end;
8251158 end;
8261159
827-procedure TKRKToolTip.SetMaxTipWidth(AMaxTipWidth: SmallInt = -1);
1160+procedure TCustomKRKToolTip.SetDefaultMaxWidth(const AValue: SmallInt);
8281161 begin
1162+ if not CanModifyProperty then
1163+ raise Exception.Create('Não é possível alterar a propriedade "DefaultWidth" em tempo de execução');
1164+
1165+ if AValue <= 0 then
1166+ FDefaultMaxWidth := -1
1167+ else if AValue < TOOLTIPMINIMUMMAXWIDTH then
1168+ FDefaultMaxWidth := TOOLTIPMINIMUMMAXWIDTH
1169+ else
1170+ FDefaultMaxWidth := AValue;
1171+end;
1172+
1173+procedure TCustomKRKToolTip.SetTipIconAndTitle(const AIcon: HICON; const ATitle: LPTSTR);
1174+begin
1175+ if (FToolTipWindowHandle <> 0) and IsBalloon then
1176+ if (AIcon > 0) or Assigned(ATitle) then
1177+ SendMessage(FToolTipWindowHandle,TTM_SETTITLE,AIcon,LPARAM(ATitle));
1178+end;
1179+
1180+procedure TCustomKRKToolTip.SetTipMaxWidth(ATipMaxWidth: SmallInt = -1);
1181+begin
8291182 if FToolTipWindowHandle <> 0 then
8301183 begin
831- if AMaxTipWidth <= 0 then
832- AMaxTipWidth := -1
833- else if AMaxTipWidth < 175 then
834- AMaxTipWidth := 175;
1184+ if ATipMaxWidth <= 0 then
1185+ ATipMaxWidth := -1
1186+ else if ATipMaxWidth < TOOLTIPMINIMUMMAXWIDTH then
1187+ ATipMaxWidth := TOOLTIPMINIMUMMAXWIDTH;
8351188
836- if (AMaxTipWidth = -1) or (AMaxTipWidth >= 175) then
837- SendMessage(FToolTipWindowHandle,TTM_SETMAXTIPWIDTH,0,AMaxTipWidth);
1189+ if (ATipMaxWidth = -1) or (ATipMaxWidth >= TOOLTIPMINIMUMMAXWIDTH) then
1190+ SendMessage(FToolTipWindowHandle,TTM_SETMAXTIPWIDTH,0,ATipMaxWidth);
8381191 end;
8391192 end;
8401193
841-procedure TKRKToolTip.SetPosition(const AX, AY: Word);
1194+procedure TCustomKRKToolTip.SetTipPosition(const AX, AY: Word);
8421195 begin
8431196 if FToolTipWindowHandle <> 0 then
8441197 SendMessage(FToolTipWindowHandle,TTM_TRACKPOSITION,0,MAKELONG(AX,AY));
8451198 end;
8461199
847-procedure TKRKToolTip.SetText(const Ahwnd: HWND; const AuId: UINT_PTR; const AlpszText: PChar);
1200+procedure TCustomKRKToolTip.SetTipText(const Ahwnd: HWND; const AuId: UINT_PTR; const AlpszText: PChar);
8481201 var
8491202 ToolInfo: TToolInfo;
8501203 begin
@@ -864,7 +1217,7 @@
8641217 // https://docs.microsoft.com/en-us/windows/win32/controls/tooltip-controls
8651218 // https://docs.microsoft.com/en-us/windows/win32/controls/using-tooltip-contro
8661219
867-procedure TKRKToolTip.Show(const Ahwnd: HWND; const AuId: UINT_PTR; const AActivateOnShow: Boolean = True);
1220+procedure TCustomKRKToolTip.Show(const Ahwnd: HWND; const AuId: UINT_PTR; const AActivateOnShow: Boolean = True);
8681221 var
8691222 ToolInfo: TToolInfo;
8701223 begin
@@ -899,7 +1252,7 @@
8991252 end;
9001253 end;
9011254
902-procedure TKRKToolTip.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);
1255+procedure TCustomKRKToolTip.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);
9031256 var
9041257 Icon: HICON;
9051258 begin
@@ -922,7 +1275,7 @@
9221275 else if Assigned(AIconResourceId) then
9231276 Icon := IconResourceId2IconHandle(AIconResourceId);
9241277
925- SetIconAndTitle(Icon,ATitle);
1278+ SetTipIconAndTitle(Icon,ATitle);
9261279
9271280 // Definindo a largura máxima do ToolTip. Se o texto não couber no tamanho
9281281 // especificado (em pixels) ele será quebrado. Caso AMaxTipWidth seja menor
@@ -931,9 +1284,9 @@
9311284 // seja < 100 o seu valor deve ser 100 para garantir uma melhor
9321285 // legibilidade do texto. O tamanho mínimo aceitável portanto é 100, mas as
9331286 // condições abaixo permitem o uso de -1 para indicar qualquer largura
934- SetMaxTipWidth(AMaxTipWidth);
1287+ SetTipMaxWidth(AMaxTipWidth);
9351288 // Definindo a posição de exibição da janela de ToolTip
936- SetPosition(AX,AY);
1289+ SetTipPosition(AX,AY);
9371290 // Efetivamente exibe a janela de ToolTip
9381291 Show(Ahwnd,AuId,AActivateOnShow);
9391292 end
@@ -941,4 +1294,291 @@
9411294 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');
9421295 end;
9431296
1297+{ TToolTipItem }
1298+
1299+constructor TToolTip.Create(ACollection: TCollection);
1300+begin
1301+ inherited;
1302+ FTool := nil;
1303+ FToolIsAssigned := False;
1304+ FParent := nil;
1305+ FFlags := [];
1306+end;
1307+
1308+destructor TToolTip.Destroy;
1309+begin
1310+
1311+ inherited;
1312+end;
1313+
1314+function TToolTip.GetDisplayName: String;
1315+begin
1316+ Result := 'No tool selected';
1317+
1318+ if Assigned(FTool) then
1319+ begin
1320+ // Quando a ferramenta é um TCustomForm eu convencionei que é porque estamos
1321+ // tentando criar um Tracking ToolTip. Criar um Tracking ToolTip informando
1322+ // em Tool um TControl ou um TWinControl não é errado em essência, mas não
1323+ // faz sentido, pois um Tracking ToolTip pode ser colocado em qualquer lugar
1324+ // e não apenas em cima de um controle específico
1325+ if ttfTrack in FFlags then
1326+ begin
1327+ Result := 'Type=Tracking, Tool=';
1328+
1329+ if FTool is TCustomForm then
1330+ Result := Result + FTool.Name + ', Parent=' + FTool.Name
1331+ else
1332+ Result := Result + FTool.Owner.Name + '.' + FTool.Name + ', Parent=' + FParent.Owner.Name + '.' + FParent.Name;
1333+
1334+ Result := Result + ', Id=' + IntToStr(FId);
1335+ end
1336+ else
1337+ begin
1338+ Result := 'Type=Automatic, Tool=';
1339+
1340+ if FTool is TCustomForm then
1341+ Result := Result + FTool.Name + ', Parent=' + FTool.Name
1342+ else
1343+ Result := Result + FTool.Owner.Name + '.' + FTool.Name + ', Parent=' + FParent.Owner.Name + '.' + FParent.Name;
1344+
1345+ if FTool is TWinControl then
1346+ Result := Result + ', Id=Tool.Handle'
1347+ else
1348+ Result := Result + ', Id=Parent.Handle + Tool.ComponentIndex';
1349+ end;
1350+
1351+
1352+
1353+
1354+// if Assigned(FTool.Owner) then
1355+// Result := FTool.Owner.Name + '.' + FTool.Name
1356+// else
1357+// Result := FTool.Name;
1358+//
1359+// Result := Result + ' (Id=' + IntToStr(GetId) + ')';
1360+ end;
1361+end;
1362+
1363+function TToolTip.GetParentHandle: HWND;
1364+begin
1365+ Result := 0;
1366+
1367+ if Assigned(FParent) then
1368+ Result := FParent.Handle
1369+end;
1370+
1371+function TToolTip.GetParentName: String;
1372+begin
1373+ Result := 'No parent available';
1374+
1375+ if Assigned(FParent) then
1376+ if FParent.Owner is TApplication then
1377+ Result := 'Application.' + FParent.Name
1378+ else if FParent.Owner.Name <> '' then
1379+ Result := FParent.Owner.Name + '.' + FParent.Name
1380+ else
1381+ Result := FParent.Owner.ClassName + '.' + FParent.Name;
1382+end;
1383+
1384+function TToolTip.GetToolInfoUFlags: UINT;
1385+begin
1386+ Result := 0;
1387+
1388+ if ttfAbsolute in FFlags then
1389+ Result :=Result or TTF_ABSOLUTE;
1390+
1391+ if ttfCenterTip in FFlags then
1392+ Result := Result or TTF_CENTERTIP;
1393+
1394+ if ttfIDIsHwnd in FFlags then
1395+ Result := Result or TTF_IDISHWND;
1396+
1397+ if ttfParseLinks in FFlags then
1398+ Result := Result or TTF_PARSELINKS;
1399+
1400+ if ttfRtlReading in FFlags then
1401+ Result := Result or TTF_RTLREADING;
1402+
1403+ if ttfSubclass in FFlags then
1404+ Result := Result or TTF_SUBCLASS;
1405+
1406+ if ttfTrack in FFlags then
1407+ Result := Result or TTF_TRACK;
1408+
1409+ if ttfTransparent in FFlags then
1410+ Result := Result or TTF_TRANSPARENT;
1411+end;
1412+
1413+function TToolTip.GetToolInfoHwnd: HWND;
1414+begin
1415+ Result := GetParentHandle;
1416+end;
1417+
1418+function TToolTip.GetToolInfoUId: UIntPtr;
1419+begin
1420+ Result := GetId;
1421+end;
1422+
1423+function TToolTip.GetToolInfoLParam: LPARAM;
1424+begin
1425+ Result := FTag;
1426+end;
1427+
1428+function TToolTip.GetToolInfoLpszText: LPTSTR;
1429+var
1430+ StringResourceId: Cardinal;
1431+begin
1432+ // Se for a constante especial LPSTR_TEXTCALLBACK ...
1433+ if FText = 'LPSTR_TEXTCALLBACK' then
1434+ Result := LPSTR_TEXTCALLBACK
1435+ // Se foi informado um ID de string de recurso diretamente ...
1436+ else if TryStrToUInt(FText,StringResourceId) then
1437+ Result := LPTSTR(StringResourceId)
1438+ // Se foi informado um texto regular ...
1439+ else
1440+ Result := LPTSTR(FText);
1441+end;
1442+
1443+function TToolTip.GetToolInfoRect: TRect;
1444+begin
1445+ ZeroMemory(@Result,SizeOf(TRect));
1446+
1447+ if Assigned(FTool) then
1448+ Result := Rect(FTool.Left,FTool.Top,FTool.Left + FTool.Width,FTool.Top + FTool.Height);
1449+end;
1450+
1451+function TToolTip.IsTrackingToolTip: Boolean;
1452+begin
1453+ Result := ttfTrack in FFlags;
1454+end;
1455+
1456+function TToolTip.CanModifyProperty: Boolean;
1457+begin
1458+ Result := TCustomKRKToolTip(Collection.Owner).CanModifyProperty;
1459+end;
1460+
1461+function TToolTip.GetId: Cardinal;
1462+begin
1463+ Result := FId;
1464+
1465+ if not IsTrackingToolTip then
1466+ if Assigned(FTool) then
1467+ if FTool is TWinControl then
1468+ Result := TWinControl(FTool).Handle
1469+ else
1470+ Result := FParent.Handle + Cardinal(FTool.ComponentIndex);
1471+end;
1472+
1473+procedure TToolTip.SetFlags(const AValue: TTTFlags);
1474+begin
1475+ if not CanModifyProperty then
1476+ raise Exception.Create('Não é possível alterar a propriedade "Flags" em tempo de execução');
1477+
1478+ FFlags := AValue;
1479+end;
1480+
1481+procedure TToolTip.SetId(const AValue: Cardinal);
1482+begin
1483+ if ttfTrack in FFlags then
1484+ FId := AValue;
1485+end;
1486+
1487+procedure TToolTip.SetTool(const AValue: TControl);
1488+begin
1489+ // Esta propriedade só é carregada quando o TControl está disponível, ou seja,
1490+ // quando a referência a ele passa a ser conhecida. Caso o TControl esteja em
1491+ // um TForm e o componente pai (TCustomKRKToolTip) esteja em um TDataModule
1492+ // que é criado antes do TForm, isso acontecerá após o final do método Loaded
1493+ // do componente principal, por isso não é possível (e nem últil) verificar
1494+ // aqui o ComponentState para decidir se estamos carregando a propriedade ou
1495+ // não, em outras palavras, a propriedade atual sempre será carregada em tempo
1496+ // de execução com nenhum flag configurado em ComponentState, sendo assim, não
1497+ // podemos usar aqui o método "CanModifyProperty", em seu lugar usaremos a
1498+ // versão especializada "CanModifyTool", que meramente verifica um flag
1499+ // interno que indica que a propriedade já foi configurada uma vez ou se
1500+ // estamos em tempo de desenvolvimento
1501+ if not CanModifyTool then
1502+ raise Exception.Create('Não é possível alterar a propriedade "Tool" em tempo de execução');
1503+
1504+ FTool := AValue;
1505+ FToolIsAssigned := True;
1506+ FParent := nil;
1507+
1508+ if Assigned(FTool) then
1509+ begin
1510+ // Forms criados automaticamente não possuem pai a não ser que estes forms
1511+ // tenham sido criados pelo designer do Delphi, em tempo de desenvolvimento,
1512+ // neste caso a janela do designer é o pai destes forms, por este motivo
1513+ // precisamos verificar não apenas se há um pai, mas se este pai é realmente
1514+ // um pai válido
1515+
1516+ // Se FTool for um TCustomForm, verificamos se estamos em runtime
1517+ if FTool is TCustomForm then
1518+ begin
1519+ // Caso estejamos em runtime, verificamos se o TCustomForm tem um pai
1520+ if not (csDesigning in TCustomKRKToolTip(Collection.Owner).ComponentState) then
1521+ // Se tem um pai, ele será o pai válido
1522+ if Assigned(FTool.Parent) then
1523+ FParent := FTool.Parent
1524+ // Se não tem um pai, então o pai é ele mesmo. Isso permite a criação de
1525+ // ToolTips do tipo Tracking, que não tem um controle (ferramenta)
1526+ // associado e consequentemente não têm um pai específico. Isso é
1527+ // convenção minha, para este componente
1528+ else
1529+ FParent := FTool as TCustomForm;
1530+ end
1531+ // Se FTool for um TControl ou mesmo um TWinControl, mas não um TCustomForm,
1532+ // verificamos se ele tem um pai. Caso tenha um pai, ele será o pai válido.
1533+ // Muito provavelmente sempre haverá um pai nesta situação, pois se não é um
1534+ // TCustomForm, só pode ser um controle solto em um TCustomForm (TControl ou
1535+ // TWinControl), logo, sempre haverá um pai, contudo, precaver-se é melhor
1536+ else if Assigned(FTool.Parent) then
1537+ FParent := FTool.Parent;
1538+ end;
1539+end;
1540+
1541+function TToolTip.CanModifyTool: Boolean;
1542+begin
1543+ // É necessário usar CanModifyProperty porque no caso de estamos em tempo de
1544+ // desenvolvimento, esta função tem que retornar true independentemente do
1545+ // valor em FToolIsAssigned
1546+ Result := CanModifyProperty or (not FToolIsAssigned);
1547+end;
1548+
1549+{ TToolTips }
1550+
1551+function TToolTips.GetEnumerator: TToolTipsEnumerator;
1552+begin
1553+ Result := TToolTipsEnumerator.Create(Self);
1554+end;
1555+
1556+function TToolTips.GetItem(AIndex: Integer): TToolTip;
1557+begin
1558+ Result := TToolTip(inherited Items[AIndex]);
1559+end;
1560+
1561+{ TToolTipsEnumerator }
1562+
1563+constructor TToolTipsEnumerator.Create(AToolTips: TToolTips);
1564+begin
1565+ inherited Create;
1566+
1567+ FIndex := -1;
1568+ FCollection := AToolTips;
1569+end;
1570+
1571+function TToolTipsEnumerator.GetCurrent: TToolTip;
1572+begin
1573+ Result := FCollection.Items[FIndex];
1574+end;
1575+
1576+function TToolTipsEnumerator.MoveNext: Boolean;
1577+begin
1578+ Result := FIndex < Pred(FCollection.Count);
1579+
1580+ if Result then
1581+ Inc(FIndex);
1582+end;
1583+
9441584 end.
--- trunk/utl/TESTADOR/src/UDAMOPrincipal.pas (revision 575)
+++ trunk/utl/TESTADOR/src/UDAMOPrincipal.pas (revision 576)
@@ -32,6 +32,7 @@
3232 MNUMultipartFormData: TMenuItem;
3333 OPDICarregarArquivoAAssinar: TOpenDialog;
3434 OPDICarregarArquivoPFX: TOpenDialog;
35+ KRTT: TKRKToolTip;
3536 procedure MNUIJSONvazio1Click(Sender: TObject);
3637 procedure MNUISICASE1Click(Sender: TObject);
3738 procedure MNUItextxml1Click(Sender: TObject);
@@ -41,14 +42,11 @@
4142 procedure ContentTypemultipartformdataboundaryWININET1Click(Sender: TObject);
4243 procedure CookieClick(Sender: TObject);
4344 procedure MNUMultipartFormDataClick(Sender: TObject);
44- procedure DataModuleCreate(Sender: TObject);
45- procedure DataModuleDestroy(Sender: TObject);
45+ procedure KRTTRegisterToolTip(const AToolTip: TToolTip);
4646 private
4747 { Private declarations }
48- FKRTT: TKRKToolTip;
4948 public
5049 { Public declarations }
51- procedure AddToolTipConfigurations;
5250 procedure ShowTrackingToolTip1;
5351 procedure ShowTrackingToolTip2;
5452 procedure ShowTrackingToolTip3;
@@ -67,209 +65,6 @@
6765
6866 {$R *.dfm}
6967
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- // O Rect é relativo a janela cujo handle é indicado aqui,
246- // portanto não é possível usar aqui o handle do form
247- // principal, pois estamos dentro de um TTabSheet e isso
248- // implicaria em conversões de coordendas potencialmente
249- // complicadas. Além disso, o encaminhamento da mensagem
250- // WM_MOUSEMOVE só vai ocorrer quando este evento for
251- // disparado e a única forma de este evento ocorrer é
252- // quando o cursor do mouse está passando por cima da
253- // janela cujo handle é indicado aqui. Como a imagem está
254- // dentro de um TTabSheet, a mensagem WM_MOUSEMOVE ocorre
255- // nele, que é o pai da imagem
256- FKRTT.AddToolInfo(FormPrincipal.IMAGDelphi.Parent.Handle
257- // Somando o valor do handle do pai do controle com o
258- // ComponentIndex do controle, o membro uId passa a ser
259- // único dentro da aplicação. Isso permite identificar o
260- // controle ao qual uma configuração de exibição de
261- // ToolTip está assiciada
262- ,FormPrincipal.IMAGDelphi.Parent.Handle + Cardinal(FormPrincipal.IMAGDelphi.ComponentIndex)
263- ,TTF_SUBCLASS or TTF_CENTERTIP
264- ,Rect(FormPrincipal.IMAGDelphi.Left
265- ,FormPrincipal.IMAGDelphi.Top
266- ,FormPrincipal.IMAGDelphi.Left + FormPrincipal.IMAGDelphi.Width
267- ,FormPrincipal.IMAGDelphi.Top + FormPrincipal.IMAGDelphi.Height)
268- ,0
269- ,PChar(GetLongHint(FormPrincipal.IMAGDelphi.Hint))
270- ,0);
271-end;
272-
27368 procedure TDAMOPrincipal.ContentTypeapplicationxwwwformurlencodedcharsetutf81Click(Sender: TObject);
27469 begin
27570 FormPrincipal.MEMOOpenRequestHeaders.Lines.Add('Content-Type: application/x-www-form-urlencoded; charset=utf-8');
@@ -285,28 +80,6 @@
28580 FormPrincipal.MEMOOpenRequestHeaders.Lines.Add('Cookie: portal[ses]=3008b76fd1ff586487c1ec330bce3a9c');
28681 end;
28782
288-procedure TDAMOPrincipal.DataModuleCreate(Sender: TObject);
289-begin
290- // Cria a janela de ToolTip, que é a janela que é exibida quando o ToolTip
291- // aparece. Aqui criamos uma jenale de ToolTip que exibe ToolTips em forma de
292- // balão mesmo quando a janela que for "dona" do controle associado ao ToolTip
293- // esteja inativa
294- // Estilos da janela de ToolTip afetam a
295- // forma como esta janela é exibida.
296- // Consulte o MSDN para saber o que estes
297- // estilos representam
298- FKRTT := TKRKToolTip.Create(TTS_NOPREFIX or TTS_ALWAYSTIP or TTS_BALLOON or TTS_CLOSE
299- // Tamanho padrão das janelas de ToolTip.
300- // ToolTips automáticos terão esta largura
301- // sempre!
302- ,500);
303-end;
304-
305-procedure TDAMOPrincipal.DataModuleDestroy(Sender: TObject);
306-begin
307- FKRTT.Free;
308-end;
309-
31083 procedure TDAMOPrincipal.HandleTTNMessages(var AMessage: TWMNotify);
31184 var
31285 Link: PNMLink;
@@ -338,7 +111,7 @@
338111 begin
339112 Application.MessageBox(PChar('"A vida te derruba hoje preparando você para'+
340113 ' 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);
341- FKRTT.Hide;
114+ KRTT.Hide;
342115 end;
343116
344117 if Link.item.szID = 'tt1' then
@@ -393,11 +166,11 @@
393166 // tracking (método Show, versão que tem mais parâmetros)
394167 TTN_SHOW: begin
395168 if AMessage.NMHdr.idFrom = FormPrincipal.BUTNHint4.Handle then
396- FKRTT.SetIconAndTitle(TTI_INFO,'ToolTip automático 1')
169+ KRTT.SetTipIconAndTitle(TTI_INFO,'ToolTip automático 1')
397170 else if AMessage.NMHdr.idFrom = FormPrincipal.BUTNHint5.Handle then
398- FKRTT.SetIconAndTitle(TTI_WARNING,'ToolTip automático 2')
171+ KRTT.SetTipIconAndTitle(TTI_WARNING,'ToolTip automático 2')
399172 else if AMessage.NMHdr.idFrom = (FormPrincipal.IMAGDelphi.Parent.Handle + Cardinal(FormPrincipal.IMAGDelphi.ComponentIndex)) then
400- FKRTT.SetIconAndTitle(FKRTT.IconResourceId2IconHandle('IMGDELPHI'),'ToolTip automático 2');
173+ KRTT.SetTipIconAndTitle(KRTT.IconResourceId2IconHandle('IMGDELPHI'),PChar(GetShortHint(FormPrincipal.IMAGDelphi.Hint)));
401174
402175 // Eu tentei de várias formas alterar a largura do ToolTip automático de
403176 // forma dinâmica, tanto aqui quanto dentro de NM_CUSTOMDRAW, mas não
@@ -410,10 +183,16 @@
410183 end;
411184 end;
412185
186+procedure TDAMOPrincipal.KRTTRegisterToolTip(const AToolTip: TToolTip);
187+begin
188+ if AToolTip.Tool = FormPrincipal.IMAGDelphi then
189+ AToolTip.Text := GetLongHint(FormPrincipal.IMAGDelphi.Hint);
190+end;
191+
413192 procedure TDAMOPrincipal.ShowTrackingToolTip1;
414193 begin
415- if not FKRTT.IsVisible then
416- FKRTT.Show(FormPrincipal.Handle
194+ if not KRTT.IsVisible then
195+ KRTT.Show(FormPrincipal.Handle
417196 ,1
418197 ,0
419198 ,Rect(0,0,0,0)
@@ -428,13 +207,13 @@
428207 ,100
429208 ,False)
430209 else
431- FKRTT.Hide;
210+ KRTT.Hide;
432211 end;
433212
434213 procedure TDAMOPrincipal.ShowTrackingToolTip2;
435214 begin
436- if not FKRTT.IsVisible then
437- FKRTT.Show(FormPrincipal.Handle
215+ if not KRTT.IsVisible then
216+ KRTT.Show(FormPrincipal.Handle
438217 ,2
439218 ,0
440219 ,Rect(0,0,0,0)
@@ -449,13 +228,13 @@
449228 ,200
450229 ,False)
451230 else
452- FKRTT.Hide;
231+ KRTT.Hide;
453232 end;
454233
455234 procedure TDAMOPrincipal.ShowTrackingToolTip3;
456235 begin
457- if not FKRTT.IsVisible then
458- FKRTT.Show(FormPrincipal.Handle
236+ if not KRTT.IsVisible then
237+ KRTT.Show(FormPrincipal.Handle
459238 ,3
460239 ,0
461240 ,Rect(0,0,0,0)
@@ -470,7 +249,7 @@
470249 ,300
471250 ,False)
472251 else
473- FKRTT.Hide;
252+ KRTT.Hide;
474253 end;
475254
476255 procedure TDAMOPrincipal.MNUIapplicationjson1Click(Sender: TObject);
--- trunk/utl/TESTADOR/src/UPrincipal.pas (revision 575)
+++ trunk/utl/TESTADOR/src/UPrincipal.pas (revision 576)
@@ -111,6 +111,7 @@
111111 BUTNHint4: TButton;
112112 BUTNHint5: TButton;
113113 IMAGDelphi: TImage;
114+ STTX: TStaticText;
114115 procedure BUTNGetStringCheckSumClick(Sender: TObject);
115116 procedure MNUIPackagesCreationToolClick(Sender: TObject);
116117 procedure MNUITranslationManagerClick(Sender: TObject);
@@ -138,6 +139,7 @@
138139 procedure BUTNHint2Click(Sender: TObject);
139140 procedure BUTNHint1Click(Sender: TObject);
140141 procedure BUTNHint3Click(Sender: TObject);
142+ procedure FormCreate(Sender: TObject);
141143 private
142144 { Private declarations }
143145 MM: TMainMenu;
@@ -799,6 +801,11 @@
799801 MEMOSendRequestHeaders.Enabled := CHBXUseSendRequestHeaders.Checked;
800802 end;
801803
804+procedure TFormPrincipal.FormCreate(Sender: TObject);
805+begin
806+ DAMOPrincipal.KRTT.RegisterToolTips;
807+end;
808+
802809 procedure TFormPrincipal.FormDestroy(Sender: TObject);
803810 begin
804811 UnloadComboBoxes;
@@ -818,13 +825,12 @@
818825 FRAMAssinaturaEmXML.UnloadAll;
819826 end;
820827
821-
822828 procedure TFormPrincipal.FormShow(Sender: TObject);
823829 begin
824830 LoadComboBoxes;
825831 // Como neste ponto já temos FormPrincipal criado, podemos adicionar as várias
826832 // configurações de ToolTips que podem usar o handle deste form
827- DAMOPrincipal.AddToolTipConfigurations;
833+// DAMOPrincipal.AddToolTipConfigurations;
828834 end;
829835
830836 procedure TFormPrincipal.HandleNotifyMessages(var AMessage: TWMNotify);
Show on old repository browser