• R/O
  • SSH
  • HTTPS

akdf: Commit


Commit MetaInfo

Revision573 (tree)
Time2022-03-05 03:58:45
Authorderekwildstar

Log Message

Ajustes para adequação ao Delphi XE8
Classe TKRKToolTip básica concluída

Change Summary

Incremental Difference

--- trunk/rtp/src/Internet/KRK.Internet.Edge.pas (revision 572)
+++ trunk/rtp/src/Internet/KRK.Internet.Edge.pas (revision 573)
@@ -11,7 +11,7 @@
1111 unit KRK.Internet.Edge;
1212 {$IF CompilerVersion >= 25}{$LEGACYIFEND ON}{$IFEND} { Delphi XE4 }
1313 interface
14-{$IF (RTLVersion >= 20) and (RTLVersion <= 33)} { Delphi 2009 ~ Delphi Rio }
14+{$IF (RTLVersion >= 30) and (RTLVersion <= 33)} { Delphi Seattle ~ Delphi Rio }
1515 {$WEAKPACKAGEUNIT ON}
1616 uses
1717 System.Classes, System.Win.ComObj, System.Generics.Collections, System.SyncObjs,
@@ -702,7 +702,7 @@
702702 function CompareBrowserVersions(Version1, Version2: LPCWSTR; var AResult: Integer): HRESULT; stdcall;
703703 {$IFEND}
704704 implementation
705-{$IF (RTLVersion >= 20) and (RTLVersion <= 33)} { Delphi 2009 ~ Delphi Rio }
705+{$IF (RTLVersion >= 30) and (RTLVersion <= 33)} { Delphi Seattle ~ Delphi Rio }
706706 uses
707707 System.SysUtils, Winapi.ShLwApi, Winapi.ActiveX, Vcl.Forms, KRK.Internet.EdgeConst;
708708
--- trunk/rtp/src/Rtl/Common/zlib/KRK.Rtl.Common.ZLib.ZLibGZ.pas (revision 572)
+++ trunk/rtp/src/Rtl/Common/zlib/KRK.Rtl.Common.ZLib.ZLibGZ.pas (revision 573)
@@ -886,7 +886,7 @@
886886 size : Integer;
887887 c : AnsiChar;
888888 begin
889-{$IF RTLVersion <= 27} // Delphi XE6
889+{$IF RTLVersion <= 29} { Delphi XE8 }
890890 result := 0;
891891 {$IFEND}
892892
--- trunk/rtp/src/Rtl/Win/KRK.Rtl.Win.CommCtrl.pas (revision 572)
+++ trunk/rtp/src/Rtl/Win/KRK.Rtl.Win.CommCtrl.pas (revision 573)
@@ -3,8 +3,8 @@
33 interface
44
55 uses
6- Windows, Messages, CommCtrl, Graphics, Controls;
7- //https://www.devmedia.com.br/tooltips-em-aplicacoes-delphi-dica/16252
6+ Windows, Messages, CommCtrl, Graphics, Controls, Classes;
7+
88 type
99 //: Use esta classe para criar dicas (ToolTips) em runtime.
1010 //: Para criar e exibir um ToolTip, primeiramente se cria a janela deste
@@ -70,7 +70,7 @@
7070 //: diretamente da ferramenta cujo handle é agora conhecido por meio de uId
7171 //: @SeeAlso(DelToolInfo)
7272 //: @SeeAlso(AddToolInfo)
73- TKRKTrackingToolTip = class
73+ TKRKToolTip = class
7474 private
7575 FToolTipWindowHandle: HWND;
7676 FDefaultWidth: SmallInt;
@@ -77,26 +77,42 @@
7777 FDefaultTitle: LPTSTR;
7878 FDefaultIcon: HICON;
7979 FActive: Boolean;
80- //: Cria a janela do ToolTip, a qual receberá mensagens de ToolTip (TTM)
81- function CreateToolTipWindow(AOwnerHandle: HWND; AToolTipStyles: Cardinal): HWND;
80+ FOnHide: TNotifyEvent;
81+
82+ //: Retorna True caso a janela de ToolTip seja um balão (TTS_BALLOON)
83+ function IsBalloon: Boolean;
84+ //: Retorna True caso a janela de ToolTip seja um balão com um botão fechar
85+ //: associado (TTS_CLOSE)
86+ function HasCloseButton: Boolean;
87+ //: Cria a janela do ToolTip
88+ function CreateToolTipWindow(AToolTipStyles: Cardinal): HWND;
89+ //: Sobrepõe o procedimento de janela original de forma que possamos
90+ //: manipular mensagens enviadas a janela de ToolTip
91+ procedure ReplaceOriginalWndProc;
92+ //: Recupera o procedimento de janela original do ToolTip
93+ procedure RestoreOriginalWndProc;
8294 //: Destrói a janela do ToolTip
8395 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
96+ //: Altera uma estrutura TOOLINFO registrada anteriormente com AddToolInfo.
97+ //: Use este método para atribuir vários membros de TToolInfo de uma só vez.
98+ //: A mensagem TTM_SETTOOLINFO utiliza os membros hwnd e uId para
99+ //: identificar qual estrutura interna TOOLINFO deve ser modificado, isso
100+ //: significa que não é possível alterar estes membros após eles terem sido
101+ //: definidos. É responsabilidade do chamador configurar o membro cbSize de
102+ //: AToolInfo. Os únicos membros válidos para alteração são uFlags, rect,
103+ //: hinst, lpszText e lParam.
93104 //: @SeeAlso(DelToolInfo)
94105 //: @SeeAlso(AddToolInfo)
95106 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
107+ //: Atualiza de forma inteligente as informações existentes na estrutura
108+ //: TOOLINFO identificada por Ahwnd e AuId. A inteligência deste método vem
109+ //: da verificação dos valores dos parâmetros, de forma que apenas
110+ //: parâmetros "válidos" sejam atribuídos. Este método obtém a estrutura
111+ //: ToolInfo registrada e identificada por Ahwnd e AuId, modifica apenas os
112+ //: membros cujos parâmetros correspondentes sejam "válidos" e por fim
113+ //: aplica as estrutura TOOLINFO com os membros alterados
114+ //: @SeeAlso(GetToolInfo)
115+ //: @SeeAlso(SetToolInfo)
100116 procedure UpdateToolInfo(const Ahwnd: HWND;
101117 const AuId: UINT_PTR;
102118 const AuFlags: UINT;
@@ -105,23 +121,35 @@
105121 const AlpszText: LPTSTR;
106122 const AlParam: LPARAM);
107123 //: 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;
124+ //: membros Ahwnd e AuId. Use este método para obter as configurações de um
125+ //: ToolTip de forma que seja possível alterar algumas destas configurações
126+ //: e aplicá-las posteriormente usando @Link(SetToolInfo).
127+ //: @SeeAlso(SetToolInfo)
128+ //: @SeeAlso(UpdateToolInfo)
129+ function GetToolInfo(const Ahwnd: HWND; const AuId: UINT_PTR; out AToolInfo: TToolInfo; out AMustDeallocateText: Boolean): Boolean;
130+ //: Modifica o texto de um ToolTip cuja configurção registrada é
131+ //: identificada por Ahwnd e AuId
115132 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);
133+ //: Altera a largura máxima da janela de ToolTip. Um texto que não couber
134+ //: nesta largua será quebrado em várias linhas de forma a manter a largura
135+ //: máxima configurada
136+ //: Atenção! Esta configuração afeta todas as configurações de exibição,
137+ //: pois trata-se de uma configuração da janela de ToolTip em si.
138+ procedure SetMaxTipWidth(AMaxTipWidth: SmallInt = -1);
139+ //: Altera a posição da janela de ToolTip. Estas são coordenadas relativas a
140+ //: tela do computador e não a janelas
141+ //: Atenção! Esta configuração afeta todas as configurações de exibição,
142+ //: pois trata-se de uma configuração da janela de ToolTip em si.
119143 procedure SetPosition(const AX, AY: Word);
120- procedure ResetToDefaultToolTipWindowProperties;
144+ //: Ativa ou desativa a jenela de ToolTip. Uma janela desativada não pode
145+ //: ser exibida
146+ //: Atenção! Esta configuração afeta todas as configurações de exibição,
147+ //: pois trata-se de uma configuração da janela de ToolTip em si.
121148 procedure SetActive(const AValue: Boolean);
122149 public
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);
150+ constructor Create(AToolTipStyles: Cardinal = TTS_NOPREFIX or TTS_ALWAYSTIP or TTS_BALLOON; ADefaultWidth: SmallInt = -1; ADefaultTitle: String = 'Nenhum título definido'; ADefaultIcon: HICON = TTI_INFO);
124151 destructor Destroy; override;
152+
125153 //: Adiciona uma configuração de exibição para a janela de ToolTip atual
126154 //: identificada pelos parâmetros informados de forma única. Os membros
127155 //: Ahwnd e AuId são, respectivamente, os membro hwnd e uId de TToolInfo e
@@ -141,19 +169,18 @@
141169 AlParam: LPARAM);
142170 //: Remove a configuração de exibição identificada pelos perâmetros
143171 //: 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
172+ //: e uId de TToolInfo são usados como identificadores da configuração de
173+ //: exibição no momento de sua remoção
146174 //: @SeeAlso(UpdateToolInfo)
147175 //: @SeeAlso(AddToolInfo)
148176 procedure DelToolInfo(const Ahwnd: HWND; const AuId: UINT_PTR);
149-
177+ //: Oculta a janela de ToolTip sendo exibida no momento
150178 procedure Hide;
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
179+ //: Retorna True caso a janela de ToolTip esteja visível
156180 function IsVisible: Boolean;
181+ //: Exibe a janela de ToolTip usando as informções de uma estrutura TOOLINFO
182+ //: previamente registrada e identificada por Ahwnd e AuId ao mesmo tempo em
183+ //: que, opcionalmente, reconfigura esta estrutura TOOLINFO
157184 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;
158185 //: Exibe o ToolTip com as suas configurações originais. As configurações
159186 //: originais de um ToolTip encontram-se na estrutura TOOLINFO identificada
@@ -168,16 +195,26 @@
168195 //: Obtém o handle para um ícone adicionado aos recursos da aplicação e
169196 //: identificado por AResourceId
170197 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 }
198+ //: Atribui o ícone e o título da janela de ToolTip
173199 procedure SetIconAndTitle(const AIconHandle: HICON; const ATitle: LPTSTR);
174200
175- property ToolTipWindowHandle: HWND read FToolTipWindowHandle;
176201 //: Quando False, nenhum dos ToolTips registrados por esta classe aparecerá.
177202 //: Quando da criação desta classe, esta propriedade é sempre true, o que
178203 //: significa que todos os ToolTips registrados poderão aparecer, seja
179204 //: automaticamente ou por demanda
180205 property Active: Boolean read FActive write SetActive;
206+ //: O evento OnHide ocorre quando a jenela do ToolTip está prestes a ser
207+ //: ocultada. Se agora você agora estiver se perguntando como saber quando
208+ //: um ToolTip está prestes a ser exibido, consulte a respeito de TTN_SHOW,
209+ //: uma mensagem de notificação enviada a janela identificada no membro hwnd
210+ //: de TOOLINFO. Existe também a notificação TTN_POP que informa quando o
211+ //: ToolTip está prestes a ser ocultado. O problema destas notificações é
212+ //: que elas dependem de uma janela para as receber. O procedimento de
213+ //: janela da janela de ToolTip apenas fornece um meio de detectar a
214+ //: ocultação de um ToolTip, para um controle maior você precisa capturar
215+ //: estas notificações em uma janela cujo handle tenha sido informado no
216+ //: membro hwnd de uma das estruturas TOOLINFO registradas
217+ property OnHide: TNotifyEvent read FOnHide write FOnHide;
181218 end;
182219
183220 const
@@ -197,25 +234,26 @@
197234 TTS_CLOSE = $80;
198235
199236 // Flags de Tool Tip (TTF)
200- // TTF_TRANSPARENT se setado, encaminha para o controle pai todas as mensagens
201- // que receber, e estas são manipuladas pelo WndProc do controle pai
202- // normalmente. TTF_SUBCLASS se setado, encaminha para o balão, algumas
203- // mensagens que são recebidas pelo controle pai, são estas WM_LBUTTONDOWN,
204- // WM_LBUTTONUP, WM_MBUTTONDOWN, WM_MBUTTONUP, WM_MOUSEMOVE, WM_RBUTTONDOWN e
205- // WM_RBUTTONUP. Este flag tem de ser setado caso queira fazer o balão
206- // aparecer quando o cursor estiver sobre o controle associado.
237+ // TTF_TRANSPARENT se setado, encaminha para o controle pai (membro hwnd de
238+ // TOOLINFO) todas as mensagens de mouse que a janela de ToolTip receber.
239+ // TTF_SUBCLASS se setado, encaminha para o balão, algumas mensagens que são
240+ // recebidas pelo controle pai (membro hwnd de TOOLINFO), são estas
241+ // WM_LBUTTONDOWN, WM_LBUTTONUP, WM_MBUTTONDOWN, WM_MBUTTONUP, WM_MOUSEMOVE,
242+ // WM_RBUTTONDOWN e WM_RBUTTONUP. Este flag tem de ser setado caso se queira
243+ // fazer o balão aparecer quando o cursor estiver sobre o controle associado,
244+ // o que eu chamo de ToolTip automático.
207245 TTF_PARSELINKS = $1000;
208246 {$IFEND}
209- // Notificações de Tool Tip (TTN). Provavelmente são códigos usados para
210- // diferenciar vários tipos de mensagens que são enviadas como notificação.
211- // Concluí isso observando o código de TKRKTrackingToolTip.CustomizedWindowProc em
212- // KRK.Vcl.Controls
247+ // Notificações de Tool Tip (TTN).
248+ // São códigos usados para diferenciar vários tipos de mensagens que são
249+ // enviadas como notificação (WM_NOTIFY) para a janela do controle pai (membro
250+ // hwnd de TOOLINFO)
213251 TTN_LINKCLICK = TTN_FIRST - 3;
214252
215253 implementation
216254
217255 uses
218- Classes, UITypes, SysUtils;
256+ UITypes, SysUtils, Forms;
219257
220258 const
221259 // Tamanho máximo do texto do ToolTip, em caracteres. O texto do ToolTip pode
@@ -233,12 +271,15 @@
233271
234272 { TKRKTrackingToolTip }
235273
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);
274+constructor TKRKToolTip.Create(AToolTipStyles: Cardinal = TTS_NOPREFIX or TTS_ALWAYSTIP or TTS_BALLOON; ADefaultWidth: SmallInt = -1; ADefaultTitle: String = 'Nenhum título definido'; ADefaultIcon: HICON = TTI_INFO);
237275 begin
238276 // Cria a janela do ToolTip com os parâmetros especificados e coloca seu
239277 // Handle em FToolTipWindowHandle
240- FToolTipWindowHandle := CreateToolTipWindow(AOwnerHandle, AToolTipStyles);
278+ FToolTipWindowHandle := CreateToolTipWindow(AToolTipStyles);
241279
280+ // Sobrepõe o procedimento de janela original
281+ ReplaceOriginalWndProc;
282+
242283 FActive := True;
243284
244285 FDefaultWidth := ADefaultWidth;
@@ -245,143 +286,177 @@
245286 FDefaultTitle := PChar(ADefaultTitle);
246287 FDefaultIcon := ADefaultIcon;
247288
248- ResetToDefaultToolTipWindowProperties;
289+ // Definindo as opções padão
290+ SetMaxTipWidth(FDefaultWidth);
291+ SetIconAndTitle(FDefaultIcon,FDefaultTitle);
249292 end;
250293
294+// Original ToolTip WndProc
251295 var
252- // OTTWNDPROC = Original ToolTip WndProc
253296 OTTWNDPROC: Pointer = nil;
254297
255-// NTTWNDPROC = New ToolTip WndProc
298+// ToolTip WndProc
256299 function NTTWNDPROC(AWindowHandle: HWND; AMessage: UINT; AWParam: WPARAM; ALParam: LPARAM): LRESULT; stdcall;
257-//var
258-// KRBH: TKRKTrackingToolTip;
259-// ShiftState: TShiftState;
260-// Button: TMouseButton;
300+var
301+ KRTT: TKRKToolTip;
261302 begin
262-// Button := mbLeft;
303+ // Obtendo a instância do ToolTip atual, a fim de obter acesso facilitado as
304+ // suas propriedades e eventos
305+ KRTT := TKRKToolTip(GetWindowLong(AWindowHandle,GWL_USERDATA));
263306
264- // Obtendo a instância do balão atual, a fim de obter acesso facilitado a suas
265- // propriedades e eventos
266-// KRBH := TKRKTrackingToolTip(GetWindowLong(AWindowHandle,GWL_USERDATA));
307+ // Sempre que uma janela de ToolTip é ocultada, uma mensagem WM_SHOWWINDOW é
308+ // envida para a janela do ToolTip (com AWParam = 0). Quando o botão fechar de
309+ // um ToolTip do tipo balão é clicado, a janela de ToolTip recebe esta
310+ // mensagem também, contudo nenhum ToolTip será exibido posteriormente, a não
311+ // ser que se execute a mensagem de ocultação do ToolTip. Os métodos Show
312+ // usados para Tracking ToolTips já executam Hide antes de exibir o ToolTip, o
313+ // problema é com os ToolTips automáticos, sobre os quais não temos contrlole
314+ // de quando eles são exibidos, por isso a saída é, toda vez que se oculta um
315+ // ToolTip do tipo balão cuja janela tenha o estilo TTS_CLOSE definido,
316+ // executar de forma forçada a ocultação do ToolTip.
317+ if AMessage = WM_SHOWWINDOW then
318+ begin
319+ // HasCloseButton só retorna True se há um botão de fechar sendo exibido no
320+ // ToolTip e isso só é verdade se o ToolTip for um balão, portanto,
321+ // HasCloseButton só retorna true se os estilos TTS_BALLOON e TTS_CLOSE
322+ // estiverem definidos!
323+ if KRTT.HasCloseButton then
324+ begin
325+ KRTT.RestoreOriginalWndProc;
326+ KRTT.Hide;
327+ KRTT.ReplaceOriginalWndProc;
328+ end;
267329
268-// if KRBH.FShowWhenRequested then
269-// case AMessage of
270-// WM_KEYUP: case AWParam of
271-// 13: if kbhoHideWithEnter in KRBH.Options then
272-// KRBH.Hide;
273-// 27: if kbhoHideWithEsc in KRBH.Options then
274-// KRBH.Hide;
275-// end;
276-// WM_MOUSEMOVE: if Assigned(KRBH.FOnMouseMove) then
277-// begin
278-// ShiftState := [];
279-//
280-// if (MK_CONTROL and AWParam) = MK_CONTROL then
281-// ShiftState := ShiftState + [ssCtrl];
282-//
283-// if (MK_SHIFT and AWParam) = MK_SHIFT then
284-// ShiftState := ShiftState + [ssShift];
285-//
286-// if GetKeyState(VK_MENU) < 0 then
287-// ShiftState := ShiftState + [ssAlt];
288-//
289-// if (MK_LBUTTON and AWParam) = MK_LBUTTON then
290-// ShiftState := ShiftState + [ssLeft];
291-//
292-// if (MK_MBUTTON and AWParam) = MK_MBUTTON then
293-// ShiftState := ShiftState + [ssMiddle];
294-//
295-// if (MK_RBUTTON and AWParam) = MK_RBUTTON then
296-// ShiftState := ShiftState + [ssRight];
297-//
298-// KRBH.FOnMouseMove(KRBH,ShiftState,LOWORD(ALParam),HIWORD(ALParam));
299-// end;
300-//
301-// WM_LBUTTONDOWN, WM_MBUTTONDOWN, WM_RBUTTONDOWN: if Assigned(KRBH.FOnMouseDown) then
302-// begin
303-// ShiftState := [];
304-//
305-// if (MK_CONTROL and AWParam) = MK_CONTROL then
306-// ShiftState := ShiftState + [ssCtrl];
307-//
308-// if (MK_SHIFT and AWParam) = MK_SHIFT then
309-// ShiftState := ShiftState + [ssShift];
310-//
311-// if GetKeyState(VK_MENU) < 0 then
312-// ShiftState := ShiftState + [ssAlt];
313-//
314-// if (MK_LBUTTON and AWParam) = MK_LBUTTON then
315-// begin
316-// ShiftState := ShiftState + [ssLeft];
317-// Button := mbLeft;
318-// end
319-// else if (MK_MBUTTON and AWParam) = MK_MBUTTON then
320-// begin
321-// ShiftState := ShiftState + [ssMiddle];
322-// Button := mbMiddle;
323-// end
324-// else if (MK_RBUTTON and AWParam) = MK_RBUTTON then
325-// begin
326-// ShiftState := ShiftState + [ssRight];
327-// Button := mbRight;
328-// end;
329-//
330-// KRBH.FOnMouseDown(KRBH,Button,ShiftState,LOWORD(ALParam),HIWORD(ALParam));
331-// end;
332-//
333-// WM_LBUTTONUP, WM_MBUTTONUP, WM_RBUTTONUP: if Assigned(KRBH.FOnMouseUp) then
334-// begin
335-// ShiftState := [];
336-//
337-// if (MK_CONTROL and AWParam) = MK_CONTROL then
338-// ShiftState := ShiftState + [ssCtrl];
339-//
340-// if (MK_SHIFT and AWParam) = MK_SHIFT then
341-// ShiftState := ShiftState + [ssShift];
342-//
343-// if GetKeyState(VK_MENU) < 0 then
344-// ShiftState := ShiftState + [ssAlt];
345-//
346-// if (MK_LBUTTON and AWParam) = MK_LBUTTON then
347-// begin
348-// ShiftState := ShiftState + [ssLeft];
349-// Button := mbLeft;
350-// end;
351-//
352-// if (MK_MBUTTON and AWParam) = MK_MBUTTON then
353-// begin
354-// ShiftState := ShiftState + [ssMiddle];
355-// Button := mbMiddle;
356-// end;
357-//
358-// if (MK_RBUTTON and AWParam) = MK_RBUTTON then
359-// begin
360-// ShiftState := ShiftState + [ssRight];
361-// Button := mbRight;
362-// end;
363-//
364-// KRBH.FOnMouseUp(KRBH,Button,ShiftState,LOWORD(ALParam),HIWORD(ALParam));
365-// end;
366-//
367-// WM_KILLFOCUS:begin
368-// if Assigned(KRBH.AssociatedControl) and (KRBH.AssociatedControl is TWinControl) and (kbhoSetFocusToAssociatedWinContronOnDeactivate in KRBH.Options) then
369-// SetFocus(TWinControl(KRBH.AssociatedControl).Handle);
370-//
371-// if Assigned(KRBH.AssociatedControl) and (KRBH.AssociatedControl is TWinControl) and (kbhoSelectAllOnFocus in KRBH.Options) then
372-// SendMessage(TWinControl(KRBH.AssociatedControl).Handle, EM_SETSEL, 0, -1);
373-//
374-// if kbhoHideOnDeactivate in KRBH.Options then
375-// KRBH.Hide;
376-// end;
377-// // o que raios acontece quando se fecha o tooltip clicando o X?
378-// end;
330+ if Assigned(KRTT.FOnHide) then
331+ KRTT.FOnHide(KRTT);
332+ end;
379333
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
334+ // Deixa o procedimento de jenala original lidar com as mensagens também
335+ Result := CallWindowProc(OTTWNDPROC,AWindowHandle,AMessage,AWParam,ALParam);
384336
337+{$REGION 'CÓDIGO QUE PODE SER ÚTIL NO FUTURO'}
338+(*
339+ Abaixo está o código do componente TKRKBalloonHint que pode no futuro ser
340+ usado aqui também
341+
342+var
343+ ShiftState: TShiftState;
344+ Button: TMouseButton;
345+begin
346+ Button := mbLeft;
347+
348+
349+ if KRBH.FShowWhenRequested then
350+ case AMessage of
351+ WM_KEYUP: case AWParam of
352+ 13: if kbhoHideWithEnter in KRBH.Options then
353+ KRBH.Hide;
354+ 27: if kbhoHideWithEsc in KRBH.Options then
355+ KRBH.Hide;
356+ end;
357+ WM_MOUSEMOVE: if Assigned(KRBH.FOnMouseMove) then
358+ begin
359+ ShiftState := [];
360+
361+ if (MK_CONTROL and AWParam) = MK_CONTROL then
362+ ShiftState := ShiftState + [ssCtrl];
363+
364+ if (MK_SHIFT and AWParam) = MK_SHIFT then
365+ ShiftState := ShiftState + [ssShift];
366+
367+ if GetKeyState(VK_MENU) < 0 then
368+ ShiftState := ShiftState + [ssAlt];
369+
370+ if (MK_LBUTTON and AWParam) = MK_LBUTTON then
371+ ShiftState := ShiftState + [ssLeft];
372+
373+ if (MK_MBUTTON and AWParam) = MK_MBUTTON then
374+ ShiftState := ShiftState + [ssMiddle];
375+
376+ if (MK_RBUTTON and AWParam) = MK_RBUTTON then
377+ ShiftState := ShiftState + [ssRight];
378+
379+ KRBH.FOnMouseMove(KRBH,ShiftState,LOWORD(ALParam),HIWORD(ALParam));
380+ end;
381+
382+ WM_LBUTTONDOWN, WM_MBUTTONDOWN, WM_RBUTTONDOWN: if Assigned(KRBH.FOnMouseDown) then
383+ begin
384+ ShiftState := [];
385+
386+ if (MK_CONTROL and AWParam) = MK_CONTROL then
387+ ShiftState := ShiftState + [ssCtrl];
388+
389+ if (MK_SHIFT and AWParam) = MK_SHIFT then
390+ ShiftState := ShiftState + [ssShift];
391+
392+ if GetKeyState(VK_MENU) < 0 then
393+ ShiftState := ShiftState + [ssAlt];
394+
395+ if (MK_LBUTTON and AWParam) = MK_LBUTTON then
396+ begin
397+ ShiftState := ShiftState + [ssLeft];
398+ Button := mbLeft;
399+ end
400+ else if (MK_MBUTTON and AWParam) = MK_MBUTTON then
401+ begin
402+ ShiftState := ShiftState + [ssMiddle];
403+ Button := mbMiddle;
404+ end
405+ else if (MK_RBUTTON and AWParam) = MK_RBUTTON then
406+ begin
407+ ShiftState := ShiftState + [ssRight];
408+ Button := mbRight;
409+ end;
410+
411+ KRBH.FOnMouseDown(KRBH,Button,ShiftState,LOWORD(ALParam),HIWORD(ALParam));
412+ end;
413+
414+ WM_LBUTTONUP, WM_MBUTTONUP, WM_RBUTTONUP: if Assigned(KRBH.FOnMouseUp) then
415+ begin
416+ ShiftState := [];
417+
418+ if (MK_CONTROL and AWParam) = MK_CONTROL then
419+ ShiftState := ShiftState + [ssCtrl];
420+
421+ if (MK_SHIFT and AWParam) = MK_SHIFT then
422+ ShiftState := ShiftState + [ssShift];
423+
424+ if GetKeyState(VK_MENU) < 0 then
425+ ShiftState := ShiftState + [ssAlt];
426+
427+ if (MK_LBUTTON and AWParam) = MK_LBUTTON then
428+ begin
429+ ShiftState := ShiftState + [ssLeft];
430+ Button := mbLeft;
431+ end;
432+
433+ if (MK_MBUTTON and AWParam) = MK_MBUTTON then
434+ begin
435+ ShiftState := ShiftState + [ssMiddle];
436+ Button := mbMiddle;
437+ end;
438+
439+ if (MK_RBUTTON and AWParam) = MK_RBUTTON then
440+ begin
441+ ShiftState := ShiftState + [ssRight];
442+ Button := mbRight;
443+ end;
444+
445+ KRBH.FOnMouseUp(KRBH,Button,ShiftState,LOWORD(ALParam),HIWORD(ALParam));
446+ end;
447+
448+ WM_KILLFOCUS:begin
449+ if Assigned(KRBH.AssociatedControl) and (KRBH.AssociatedControl is TWinControl) and (kbhoSetFocusToAssociatedWinContronOnDeactivate in KRBH.Options) then
450+ SetFocus(TWinControl(KRBH.AssociatedControl).Handle);
451+
452+ if Assigned(KRBH.AssociatedControl) and (KRBH.AssociatedControl is TWinControl) and (kbhoSelectAllOnFocus in KRBH.Options) then
453+ SendMessage(TWinControl(KRBH.AssociatedControl).Handle, EM_SETSEL, 0, -1);
454+
455+ if kbhoHideOnDeactivate in KRBH.Options then
456+ KRBH.Hide;
457+ end;
458+ end;
459+
385460 if AMessage = WM_SIZE then
386461 OutputDebugString('WM_SIZE ');
387462
@@ -391,23 +466,36 @@
391466 if AMessage = WM_DESTROY then
392467 OutputDebugString('WM_DESTROY ');
393468
469+*)
470+{$ENDREGION}
471+end;
394472
395- // Deixa o procedimento de jenala original lidar com as mensagens também
396- Result := CallWindowProc(OTTWNDPROC,AWindowHandle,AMessage,AWParam,ALParam);
473+procedure TKRKToolTip.ReplaceOriginalWndProc;
474+begin
475+ // Seta o ponteiro para GWL_WNDPROC do nosso procedimento de janela
476+ // customizado, e retorna o ponteiro para o procedimento de janela original.
477+ // Como cada instância de TKRKToolTip usa o mesmo tipo de processamento para
478+ // suas mensagens, basta apenas um ponteiro para o WndProc original que todas
479+ // as janelas de ToolTip criadas por cada instância de TKRKToolTip vão usar de
480+ // forma compartilhada. Dentro de NTTWNDPROC é possível acessar a instância da
481+ // classe atual, informada no comando SetWindowLongPtr executado dentro de
482+ // CreateToolTipWindow, e assim diferenciar qual ToolTip está tendo suas
483+ // mensagens manipuladas
484+ if FToolTipWindowHandle > 0 then
485+ OTTWNDPROC := Pointer(SetWindowLong(FToolTipWindowHandle,GWL_WNDPROC,LongInt(@NTTWNDPROC)));
397486 end;
398487
399-// [1] https://docs.microsoft.com/en-us/windows/win32/controls/create-a-tooltip-for-a-control
488+procedure TKRKToolTip.RestoreOriginalWndProc;
489+begin
490+ if FToolTipWindowHandle > 0 then
491+ begin
492+ SetWindowLong(FToolTipWindowHandle,GWL_WNDPROC,LongInt(OTTWNDPROC));
493+ OTTWNDPROC := nil;
494+ end;
495+end;
400496
401-function TKRKTrackingToolTip.CreateToolTipWindow(AOwnerHandle: HWND; AToolTipStyles: Cardinal): HWND;
497+function TKRKToolTip.CreateToolTipWindow(AToolTipStyles: Cardinal): HWND;
402498 begin
403- // AOwnerHandle é de fato o "dono" do ToolTip, não necessariamente seu pai. É
404- // que para o Windows, na função CreateWindow, hWndParent é o handle do Owner,
405- // diferente do Delphi que deixa bem claro quem é Owner e quem é Parent. A
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
411499 Result := CreateWindowEx(WS_EX_NOACTIVATE // A jenala do ToolTip não ficará ativa e portanto nunca será a janela da frente
412500 or WS_EX_TOPMOST // A janela do ToolTip ficará em cima de outras janelas não top-most e fica lá mesmo se desativada
413501 ,TOOLTIPS_CLASS
@@ -414,7 +502,7 @@
414502 ,nil
415503 ,AToolTipStyles // Estilos aplicados a janela do ToolTip
416504 ,0,0,0,0
417- ,AOwnerHandle // Handle do dono do ToolTip
505+ ,Application.Handle
418506 ,0
419507 ,HInstance // Não influencia em nada mas acho boa prática
420508 ,nil);
@@ -422,46 +510,21 @@
422510 // Associa a instância da classe atual à janela do ToolTip, o que facilita o
423511 // acesso ao objeto que a classe atual define, a partir de funções de callback
424512 SetWindowLongPtr(Result,GWL_USERDATA,Integer(Self));
425-
426- // Seta o ponteiro para GWL_WNDPROC do nosso procedimento de janela
427- // customizado, e retorna o ponteiro para o procedimento de janela original.
428- // Como cada instância de TKRKTrackingToolTip usa o mesmo tipo de processamento
429- // para suas mensagens, basta apenas um ponteiro para o WndProc original que
430- // todos os ToolTips vão usar de forma compartilhada. Dentro de
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
434-
435- OTTWNDPROC := Pointer(SetWindowLong(Result,GWL_WNDPROC,LongInt(@NTTWNDPROC)));
436513 end;
437514
438-destructor TKRKTrackingToolTip.Destroy;
515+destructor TKRKToolTip.Destroy;
439516 begin
440517 DestroyToolTipWindow;
441518 inherited;
442519 end;
443520
444-procedure TKRKTrackingToolTip.DestroyToolTipWindow;
521+procedure TKRKToolTip.DestroyToolTipWindow;
445522 begin
446523 if FToolTipWindowHandle <> 0 then
447524 DestroyWindow(FToolTipWindowHandle);
448525 end;
449526
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;
527+procedure TKRKToolTip.Hide;
465528 var
466529 ToolInfo: TToolInfo;
467530 begin
@@ -484,12 +547,22 @@
484547 end;
485548 end;
486549
487-function TKRKTrackingToolTip.IsVisible: Boolean;
550+function TKRKToolTip.HasCloseButton: Boolean;
488551 begin
552+ Result := IsBalloon and (GetWindowLongPtr(FToolTipWindowHandle,GWL_STYLE) and TTS_CLOSE = TTS_CLOSE);
553+end;
554+
555+function TKRKToolTip.IsBalloon: Boolean;
556+begin
557+ Result := GetWindowLongPtr(FToolTipWindowHandle,GWL_STYLE) and TTS_BALLOON = TTS_BALLOON;
558+end;
559+
560+function TKRKToolTip.IsVisible: Boolean;
561+begin
489562 Result := SendMessage(FToolTipWindowHandle,TTM_GETCURRENTTOOL,0,0) > 0;
490563 end;
491564
492-procedure TKRKTrackingToolTip.AddToolInfo(const Ahwnd: HWND;
565+procedure TKRKToolTip.AddToolInfo(const Ahwnd: HWND;
493566 const AuId: UINT_PTR;
494567 AuFlags: Cardinal;
495568 Arect: TRect;
@@ -512,16 +585,14 @@
512585 ToolInfo.lpszText := AlpszText;
513586 ToolInfo.lParam := AlParam;
514587
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
588+ // O membro lpszText tem dupla funcionalidade, a principal é contér o texto
589+ // do ToolTip. A outra funcionalidade é receber identificadores especiais de
590+ // forma que o texto do ToolTip seja obtido a partir de uma string de
591+ // recurso ou a partir de uma mensagem de notificação (TTN_GETDISPINFO).
592+ // Eu prefiro atualizar o texto do ToolTip por meio de TTM_UPDATETIPTEXT,
593+ // por este motivo aqui eu estou utilizando lpszText apenas para configurar
594+ // identificadores. Caso um texto tenha sido informado em AlpszText, será
595+ // usado TTM_UPDATETIPTEXT após o envio da mensagem TTM_ADDTOOL
525596
526597 SendMessage(FToolTipWindowHandle,TTM_ADDTOOL,0,LPARAM(@ToolInfo));
527598
@@ -547,8 +618,8 @@
547618 // neste caso não precisamos fazer mais nada, pois a mensagem TTM_ADDTOOL
548619 // já foi enviada com este identificador preenchido.
549620 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
621+ // Caso AlpszText seja nil, atribuimos um texto padrão de propósito de forma
622+ // que o ToolTip apareça. Não fazer isso faria com que o ToolTip não
552623 // aparecesse e isso poderia confundir o programador, que não saberia por
553624 // que isso aconteceu. Caso o programador informe uma string vazia aí
554625 // realmente não tem jeito, pois o ToolTip não vai aparecer
@@ -557,7 +628,7 @@
557628 end;
558629 end;
559630
560-procedure TKRKTrackingToolTip.DelToolInfo(const Ahwnd: HWND; const AuId: UINT_PTR);
631+procedure TKRKToolTip.DelToolInfo(const Ahwnd: HWND; const AuId: UINT_PTR);
561632 var
562633 ToolInfo: TToolInfo;
563634 begin
@@ -573,13 +644,13 @@
573644 end;
574645 end;
575646
576-procedure TKRKTrackingToolTip.SetToolInfo(const AToolInfo: TToolInfo);
647+procedure TKRKToolTip.SetToolInfo(const AToolInfo: TToolInfo);
577648 begin
578649 if FToolTipWindowHandle <> 0 then
579650 SendMessage(FToolTipWindowHandle,TTM_SETTOOLINFO,0,LPARAM(@AToolInfo));
580651 end;
581652
582-function TKRKTrackingToolTip.GetToolInfo(const AParentHandle: HWND; const AId: UINT_PTR; out AToolInfo: TToolInfo; out AMustDeallocateText: Boolean): Boolean;
653+function TKRKToolTip.GetToolInfo(const Ahwnd: HWND; const AuId: UINT_PTR; out AToolInfo: TToolInfo; out AMustDeallocateText: Boolean): Boolean;
583654 begin
584655 ZeroMemory(@AToolInfo,SizeOf(TToolInfo));
585656 AMustDeallocateText := False;
@@ -588,8 +659,8 @@
588659 if FToolTipWindowHandle <> 0 then
589660 begin
590661 AToolInfo.cbSize := SizeOf(TToolInfo);
591- AToolInfo.hwnd := AParentHandle;
592- AToolInfo.uId := AId;
662+ AToolInfo.hwnd := Ahwnd;
663+ AToolInfo.uId := AuId;
593664 Result := Boolean(SendMessage(FToolTipWindowHandle,TTM_GETTOOLINFO,0,LPARAM(@AToolInfo)));
594665 // Eu descobri que ao enviar a mensagem com AToolInfo zerado eu obtenho dois
595666 // valores possíveis em lpszText. Caso ele retorne como nil, significa que
@@ -610,7 +681,7 @@
610681 end;
611682 end;
612683
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);
684+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);
614685 var
615686 ToolInfo: TToolInfo;
616687 MustDeallocateText: Boolean;
@@ -625,7 +696,7 @@
625696 // Estes flags preexistentes podem ter sido informados quando da adição
626697 // da configuração de exibição identificada aqui por Ahwnd e AuId,
627698 // usando o método AddToolInfo. Ao alterar estes flags, eles passam a
628- // ser os flags vigentes para a combinação Ahwnd + AuId
699+ // ser os flags vigentes para a combinação Ahwnd/AuId
629700 if AuFlags <> 0 then
630701 ToolInfo.uFlags := AuFlags;
631702 // Configura o rect que define a "região-quente" do ToolTip. Esta
@@ -659,14 +730,8 @@
659730 end;
660731 end;
661732
662-procedure TKRKTrackingToolTip.ResetToDefaultToolTipWindowProperties;
733+function TKRKToolTip.IconResourceId2IconHandle(AIconResourceId: LPTSTR): HICON;
663734 begin
664- SetMaxTipWidth(FDefaultWidth);
665- SetIconAndTitle(FDefaultIcon,FDefaultTitle);
666-end;
667-
668-function TKRKTrackingToolTip.IconResourceId2IconHandle(AIconResourceId: LPTSTR): HICON;
669-begin
670735 Result := 0;
671736
672737 if Assigned(AIconResourceId) then
@@ -673,7 +738,7 @@
673738 Result := LoadIcon(HInstance,AIconResourceId);
674739 end;
675740
676-procedure TKRKTrackingToolTip.SetActive(const AValue: Boolean);
741+procedure TKRKToolTip.SetActive(const AValue: Boolean);
677742 begin
678743 if FToolTipWindowHandle <> 0 then
679744 begin
@@ -683,7 +748,7 @@
683748 end;
684749 end;
685750
686-procedure TKRKTrackingToolTip.SetIconAndTitle(const AIconHandle: HICON; const ATitle: LPTSTR);
751+procedure TKRKToolTip.SetIconAndTitle(const AIconHandle: HICON; const ATitle: LPTSTR);
687752 begin
688753 if FToolTipWindowHandle <> 0 then
689754 if (AIconHandle > 0) or Assigned(ATitle) then
@@ -690,19 +755,27 @@
690755 SendMessage(FToolTipWindowHandle,TTM_SETTITLE,AIconHandle,LPARAM(ATitle));
691756 end;
692757
693-procedure TKRKTrackingToolTip.SetMaxTipWidth(const ATipWidth: SmallInt = -1);
758+procedure TKRKToolTip.SetMaxTipWidth(AMaxTipWidth: SmallInt = -1);
694759 begin
695760 if FToolTipWindowHandle <> 0 then
696- SendMessage(FToolTipWindowHandle,TTM_SETMAXTIPWIDTH,0,ATipWidth);
761+ begin
762+ if AMaxTipWidth <= 0 then
763+ AMaxTipWidth := -1
764+ else if AMaxTipWidth < 175 then
765+ AMaxTipWidth := 175;
766+
767+ if (AMaxTipWidth = -1) or (AMaxTipWidth >= 175) then
768+ SendMessage(FToolTipWindowHandle,TTM_SETMAXTIPWIDTH,0,AMaxTipWidth);
769+ end;
697770 end;
698771
699-procedure TKRKTrackingToolTip.SetPosition(const AX, AY: Word);
772+procedure TKRKToolTip.SetPosition(const AX, AY: Word);
700773 begin
701774 if FToolTipWindowHandle <> 0 then
702775 SendMessage(FToolTipWindowHandle,TTM_TRACKPOSITION,0,MAKELONG(AX,AY));
703776 end;
704777
705-procedure TKRKTrackingToolTip.SetText(const Ahwnd: HWND; const AuId: UINT_PTR; const AlpszText: PChar);
778+procedure TKRKToolTip.SetText(const Ahwnd: HWND; const AuId: UINT_PTR; const AlpszText: PChar);
706779 var
707780 ToolInfo: TToolInfo;
708781 begin
@@ -722,7 +795,7 @@
722795 // https://docs.microsoft.com/en-us/windows/win32/controls/tooltip-controls
723796 // https://docs.microsoft.com/en-us/windows/win32/controls/using-tooltip-contro
724797
725-procedure TKRKTrackingToolTip.Show(const Ahwnd: HWND; const AuId: UINT_PTR; const AActivateOnShow: Boolean = True);
798+procedure TKRKToolTip.Show(const Ahwnd: HWND; const AuId: UINT_PTR; const AActivateOnShow: Boolean = True);
726799 var
727800 ToolInfo: TToolInfo;
728801 begin
@@ -731,11 +804,22 @@
731804 ToolInfo.cbSize := SizeOf(TToolInfo);
732805 ToolInfo.hwnd := Ahwnd;
733806 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
807+ // Exibir um ToolTip enquanto outro está sendo exibido provoca vários
808+ // problemas. Eu já havia percebido isso quando usei o ToolTip do ícone da
809+ // bandeja do sistema. Caso um ToolTip esteja sendo exibido e outro seja
810+ // definido para ser exibido sem que o anterior seja ocultado, haverá a
811+ // mudança apenas do título do ToolTip, mas o texto permanecerá o mesmo.
812+ // Isso parece ser um bug (ou uma feature) dos ToolTips mesmo. Não é erro
813+ // de implementação minha. A linha abaixo oculta um ToolTip que estiver
814+ // visível. Apenas um ToolTip pode ser visível de cada vez, mas para ser
815+ // mais preciso, apenas uma configuração de exibição pode ser exibida de
816+ // cada vez, pois há apenas uma janela de ToolTip. Alterar uma configuração
817+ // de exibição sem antes ocultar um ToolTip que esteja sendo exibido, causa
818+ // problemas. Talvez usar uma mensagem TTM_UPDATE após a reconfiguração da
819+ // janela de ToolTip seja suficiente contudo eu acho que ocultar o ToolTip
820+ // antes de mudar sua configuração e exibí-lo de novo seja uma boa prática.
821+ // O método Show atual também é executado dentro do método Show
822+ // sobrecarregado, portanto a ocultação pode ficar aqui sem problemas.
739823 Hide;
740824
741825 SendMessage(FToolTipWindowHandle,TTM_TRACKACTIVATE,WPARAM(True),LPARAM(@ToolInfo));
@@ -746,27 +830,12 @@
746830 end;
747831 end;
748832
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);
833+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);
750834 var
751835 Icon: HICON;
752836 begin
753837 if FToolTipWindowHandle <> 0 then
754838 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;
770839 // -------------------------------------------------------------------------
771840 // Primeiramente configura-se tudo que é atribuído diretamente a ToolInfo.
772841 // -------------------------------------------------------------------------
@@ -785,6 +854,7 @@
785854 Icon := IconResourceId2IconHandle(AIconResourceId);
786855
787856 SetIconAndTitle(Icon,ATitle);
857+
788858 // Definindo a largura máxima do ToolTip. Se o texto não couber no tamanho
789859 // especificado (em pixels) ele será quebrado. Caso AMaxTipWidth seja menor
790860 // que -1 ou seja zero, o seu valor deve ser -1, que indica que o ToolTip
@@ -792,14 +862,7 @@
792862 // seja < 100 o seu valor deve ser 100 para garantir uma melhor
793863 // legibilidade do texto. O tamanho mínimo aceitável portanto é 100, mas as
794864 // 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;
799-
800- if (AMaxTipWidth = -1) or (AMaxTipWidth >= 100) then
801- SetMaxTipWidth(AMaxTipWidth);
802-
865+ SetMaxTipWidth(AMaxTipWidth);
803866 // Definindo a posição de exibição da janela de ToolTip
804867 SetPosition(AX,AY);
805868 // Efetivamente exibe a janela de ToolTip
--- trunk/rtp/src/Rtl/Win/KRK.Rtl.Win.WinInet.Utilities.pas (revision 572)
+++ trunk/rtp/src/Rtl/Win/KRK.Rtl.Win.WinInet.Utilities.pas (revision 573)
@@ -1049,7 +1049,7 @@
10491049
10501050 function ReadSecureProtocolsFlags: Integer;
10511051 begin
1052- {$IF RTLVersion <= 26}
1052+ {$IF RTLVersion <= 29} { Delphi XE8 }
10531053 Result := -1;
10541054 {$IFEND}
10551055 with TRegistry.Create(KEY_READ) do
--- trunk/utl/TESTADOR/src/UDAMOPrincipal.pas (revision 572)
+++ trunk/utl/TESTADOR/src/UDAMOPrincipal.pas (revision 573)
@@ -45,7 +45,7 @@
4545 procedure DataModuleDestroy(Sender: TObject);
4646 private
4747 { Private declarations }
48- FKRTT: TKRKTrackingToolTip;
48+ FKRTT: TKRKToolTip;
4949 public
5050 { Public declarations }
5151 procedure AddToolTipConfigurations;
@@ -267,24 +267,15 @@
267267 // aparece. Aqui criamos uma jenale de ToolTip que exibe ToolTips em forma de
268268 // balão mesmo quando a janela que for "dona" do controle associado ao ToolTip
269269 // 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);
270+ // Estilos da janela de ToolTip afetam a
271+ // forma como esta janela é exibida.
272+ // Consulte o MSDN para saber o que estes
273+ // estilos representam
274+ FKRTT := TKRKToolTip.Create(TTS_NOPREFIX or TTS_ALWAYSTIP or TTS_BALLOON or TTS_CLOSE
275+ // Tamanho padrão das janelas de ToolTip.
276+ // ToolTips automáticos terão esta largura
277+ // sempre!
278+ ,500);
288279 end;
289280
290281 procedure TDAMOPrincipal.DataModuleDestroy(Sender: TObject);
--- trunk/KRAKATOA.D22.groupproj (nonexistent)
+++ trunk/KRAKATOA.D22.groupproj (revision 573)
@@ -0,0 +1,156 @@
1+<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
2+ <PropertyGroup>
3+ <ProjectGuid>{C51E2E08-0C2A-4C43-8D8E-3CE1BDB7E9B2}</ProjectGuid>
4+ </PropertyGroup>
5+ <ItemGroup>
6+ <Projects Include="rtp\prj\Delphi 22 (Delphi XE8)\KRKLib.dproj">
7+ <Dependencies/>
8+ </Projects>
9+ <Projects Include="dtp\StandardControls\prj\Delphi 22 (Delphi XE8)\KRKStandardControlsD.dproj">
10+ <Dependencies/>
11+ </Projects>
12+ <Projects Include="dtp\AdditionalControls\prj\Delphi 22 (Delphi XE8)\KRKAdditionalControlsD.dproj">
13+ <Dependencies/>
14+ </Projects>
15+ <Projects Include="dtp\ExtendedActions\prj\Delphi 22 (Delphi XE8)\KRKExtendedActionsD.dproj">
16+ <Dependencies/>
17+ </Projects>
18+ <Projects Include="dtp\DataControls\prj\Delphi 22 (Delphi XE8)\KRKDataControlsD.dproj">
19+ <Dependencies/>
20+ </Projects>
21+ <Projects Include="dtp\NetworkControls\prj\Delphi 22 (Delphi XE8)\KRKNetworkControlsD.dproj">
22+ <Dependencies/>
23+ </Projects>
24+ <Projects Include="dtp\ShellControls\prj\Delphi 22 (Delphi XE8)\KRKShellControlsD.dproj">
25+ <Dependencies/>
26+ </Projects>
27+ <Projects Include="dtp\Win32Controls\prj\Delphi 22 (Delphi XE8)\KRKWin32ControlsD.dproj">
28+ <Dependencies/>
29+ </Projects>
30+ <Projects Include="dtp\ToolsApiComponents\prj\Delphi 22 (Delphi XE8)\KRKToolsApiComponentsD.dproj">
31+ <Dependencies/>
32+ </Projects>
33+ <Projects Include="dtp\CustomModules\prj\Delphi 22 (Delphi XE8)\KRKCustomModulesD.dproj">
34+ <Dependencies>rtp\prj\Delphi 22 (Delphi XE8)\KRKLib.dproj</Dependencies>
35+ </Projects>
36+ <Projects Include="dtp\Experts\prj\Delphi 22 (Delphi XE8)\KRKExperts.dproj">
37+ <Dependencies/>
38+ </Projects>
39+ </ItemGroup>
40+ <ProjectExtensions>
41+ <Borland.Personality>Default.Personality.12</Borland.Personality>
42+ <Borland.ProjectType/>
43+ <BorlandProject>
44+ <Default.Personality/>
45+ </BorlandProject>
46+ </ProjectExtensions>
47+ <Target Name="KRKLib">
48+ <MSBuild Projects="rtp\prj\Delphi 22 (Delphi XE8)\KRKLib.dproj"/>
49+ </Target>
50+ <Target Name="KRKLib:Clean">
51+ <MSBuild Projects="rtp\prj\Delphi 22 (Delphi XE8)\KRKLib.dproj" Targets="Clean"/>
52+ </Target>
53+ <Target Name="KRKLib:Make">
54+ <MSBuild Projects="rtp\prj\Delphi 22 (Delphi XE8)\KRKLib.dproj" Targets="Make"/>
55+ </Target>
56+ <Target Name="KRKStandardControlsD">
57+ <MSBuild Projects="dtp\StandardControls\prj\Delphi 22 (Delphi XE8)\KRKStandardControlsD.dproj"/>
58+ </Target>
59+ <Target Name="KRKStandardControlsD:Clean">
60+ <MSBuild Projects="dtp\StandardControls\prj\Delphi 22 (Delphi XE8)\KRKStandardControlsD.dproj" Targets="Clean"/>
61+ </Target>
62+ <Target Name="KRKStandardControlsD:Make">
63+ <MSBuild Projects="dtp\StandardControls\prj\Delphi 22 (Delphi XE8)\KRKStandardControlsD.dproj" Targets="Make"/>
64+ </Target>
65+ <Target Name="KRKAdditionalControlsD">
66+ <MSBuild Projects="dtp\AdditionalControls\prj\Delphi 22 (Delphi XE8)\KRKAdditionalControlsD.dproj"/>
67+ </Target>
68+ <Target Name="KRKAdditionalControlsD:Clean">
69+ <MSBuild Projects="dtp\AdditionalControls\prj\Delphi 22 (Delphi XE8)\KRKAdditionalControlsD.dproj" Targets="Clean"/>
70+ </Target>
71+ <Target Name="KRKAdditionalControlsD:Make">
72+ <MSBuild Projects="dtp\AdditionalControls\prj\Delphi 22 (Delphi XE8)\KRKAdditionalControlsD.dproj" Targets="Make"/>
73+ </Target>
74+ <Target Name="KRKExtendedActionsD">
75+ <MSBuild Projects="dtp\ExtendedActions\prj\Delphi 22 (Delphi XE8)\KRKExtendedActionsD.dproj"/>
76+ </Target>
77+ <Target Name="KRKExtendedActionsD:Clean">
78+ <MSBuild Projects="dtp\ExtendedActions\prj\Delphi 22 (Delphi XE8)\KRKExtendedActionsD.dproj" Targets="Clean"/>
79+ </Target>
80+ <Target Name="KRKExtendedActionsD:Make">
81+ <MSBuild Projects="dtp\ExtendedActions\prj\Delphi 22 (Delphi XE8)\KRKExtendedActionsD.dproj" Targets="Make"/>
82+ </Target>
83+ <Target Name="KRKDataControlsD">
84+ <MSBuild Projects="dtp\DataControls\prj\Delphi 22 (Delphi XE8)\KRKDataControlsD.dproj"/>
85+ </Target>
86+ <Target Name="KRKDataControlsD:Clean">
87+ <MSBuild Projects="dtp\DataControls\prj\Delphi 22 (Delphi XE8)\KRKDataControlsD.dproj" Targets="Clean"/>
88+ </Target>
89+ <Target Name="KRKDataControlsD:Make">
90+ <MSBuild Projects="dtp\DataControls\prj\Delphi 22 (Delphi XE8)\KRKDataControlsD.dproj" Targets="Make"/>
91+ </Target>
92+ <Target Name="KRKNetworkControlsD">
93+ <MSBuild Projects="dtp\NetworkControls\prj\Delphi 22 (Delphi XE8)\KRKNetworkControlsD.dproj"/>
94+ </Target>
95+ <Target Name="KRKNetworkControlsD:Clean">
96+ <MSBuild Projects="dtp\NetworkControls\prj\Delphi 22 (Delphi XE8)\KRKNetworkControlsD.dproj" Targets="Clean"/>
97+ </Target>
98+ <Target Name="KRKNetworkControlsD:Make">
99+ <MSBuild Projects="dtp\NetworkControls\prj\Delphi 22 (Delphi XE8)\KRKNetworkControlsD.dproj" Targets="Make"/>
100+ </Target>
101+ <Target Name="KRKShellControlsD">
102+ <MSBuild Projects="dtp\ShellControls\prj\Delphi 22 (Delphi XE8)\KRKShellControlsD.dproj"/>
103+ </Target>
104+ <Target Name="KRKShellControlsD:Clean">
105+ <MSBuild Projects="dtp\ShellControls\prj\Delphi 22 (Delphi XE8)\KRKShellControlsD.dproj" Targets="Clean"/>
106+ </Target>
107+ <Target Name="KRKShellControlsD:Make">
108+ <MSBuild Projects="dtp\ShellControls\prj\Delphi 22 (Delphi XE8)\KRKShellControlsD.dproj" Targets="Make"/>
109+ </Target>
110+ <Target Name="KRKWin32ControlsD">
111+ <MSBuild Projects="dtp\Win32Controls\prj\Delphi 22 (Delphi XE8)\KRKWin32ControlsD.dproj"/>
112+ </Target>
113+ <Target Name="KRKWin32ControlsD:Clean">
114+ <MSBuild Projects="dtp\Win32Controls\prj\Delphi 22 (Delphi XE8)\KRKWin32ControlsD.dproj" Targets="Clean"/>
115+ </Target>
116+ <Target Name="KRKWin32ControlsD:Make">
117+ <MSBuild Projects="dtp\Win32Controls\prj\Delphi 22 (Delphi XE8)\KRKWin32ControlsD.dproj" Targets="Make"/>
118+ </Target>
119+ <Target Name="KRKToolsApiComponentsD">
120+ <MSBuild Projects="dtp\ToolsApiComponents\prj\Delphi 22 (Delphi XE8)\KRKToolsApiComponentsD.dproj"/>
121+ </Target>
122+ <Target Name="KRKToolsApiComponentsD:Clean">
123+ <MSBuild Projects="dtp\ToolsApiComponents\prj\Delphi 22 (Delphi XE8)\KRKToolsApiComponentsD.dproj" Targets="Clean"/>
124+ </Target>
125+ <Target Name="KRKToolsApiComponentsD:Make">
126+ <MSBuild Projects="dtp\ToolsApiComponents\prj\Delphi 22 (Delphi XE8)\KRKToolsApiComponentsD.dproj" Targets="Make"/>
127+ </Target>
128+ <Target Name="KRKCustomModulesD" DependsOnTargets="KRKLib">
129+ <MSBuild Projects="dtp\CustomModules\prj\Delphi 22 (Delphi XE8)\KRKCustomModulesD.dproj"/>
130+ </Target>
131+ <Target Name="KRKCustomModulesD:Clean" DependsOnTargets="KRKLib:Clean">
132+ <MSBuild Projects="dtp\CustomModules\prj\Delphi 22 (Delphi XE8)\KRKCustomModulesD.dproj" Targets="Clean"/>
133+ </Target>
134+ <Target Name="KRKCustomModulesD:Make" DependsOnTargets="KRKLib:Make">
135+ <MSBuild Projects="dtp\CustomModules\prj\Delphi 22 (Delphi XE8)\KRKCustomModulesD.dproj" Targets="Make"/>
136+ </Target>
137+ <Target Name="KRKExperts">
138+ <MSBuild Projects="dtp\Experts\prj\Delphi 22 (Delphi XE8)\KRKExperts.dproj"/>
139+ </Target>
140+ <Target Name="KRKExperts:Clean">
141+ <MSBuild Projects="dtp\Experts\prj\Delphi 22 (Delphi XE8)\KRKExperts.dproj" Targets="Clean"/>
142+ </Target>
143+ <Target Name="KRKExperts:Make">
144+ <MSBuild Projects="dtp\Experts\prj\Delphi 22 (Delphi XE8)\KRKExperts.dproj" Targets="Make"/>
145+ </Target>
146+ <Target Name="Build">
147+ <CallTarget Targets="KRKLib;KRKStandardControlsD;KRKAdditionalControlsD;KRKExtendedActionsD;KRKDataControlsD;KRKNetworkControlsD;KRKShellControlsD;KRKWin32ControlsD;KRKToolsApiComponentsD;KRKCustomModulesD;KRKExperts"/>
148+ </Target>
149+ <Target Name="Clean">
150+ <CallTarget Targets="KRKLib:Clean;KRKStandardControlsD:Clean;KRKAdditionalControlsD:Clean;KRKExtendedActionsD:Clean;KRKDataControlsD:Clean;KRKNetworkControlsD:Clean;KRKShellControlsD:Clean;KRKWin32ControlsD:Clean;KRKToolsApiComponentsD:Clean;KRKCustomModulesD:Clean;KRKExperts:Clean"/>
151+ </Target>
152+ <Target Name="Make">
153+ <CallTarget Targets="KRKLib:Make;KRKStandardControlsD:Make;KRKAdditionalControlsD:Make;KRKExtendedActionsD:Make;KRKDataControlsD:Make;KRKNetworkControlsD:Make;KRKShellControlsD:Make;KRKWin32ControlsD:Make;KRKToolsApiComponentsD:Make;KRKCustomModulesD:Make;KRKExperts:Make"/>
154+ </Target>
155+ <Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
156+</Project>
--- trunk/_Leia-me.txt (revision 572)
+++ trunk/_Leia-me.txt (revision 573)
@@ -1,5 +1,5 @@
11 dtp (Designtime Packages): Pacotes (bpl) que podem ser instalados na IDE ou experts (bpl/dll) que são utilizados ou instalados na mesma
2-rtp (Runtime Packages): Apenas pacotes (bpl) que não são instaláveis como aqueles contidos em dpt, porém que são utilizados por estes.
2+rtp (Runtime Packages): Apenas pacotes (bpl) que não são instaláveis como aqueles contidos em dtp, porém que são utilizados por estes.
33 doc (Documentação): Arquivos de ajuda (chm) ou documentos de componentes e blibliotecas de terceiros incluídas no KRK
44 res (Resources): Arquivos de recuros (imagens basicamente) que estão associados com o KRK
55 utl (Utilitários): Projetos criados com o KRK e que são de utilidade geral
Show on old repository browser