OSDN -- オープンソース・ソフトウェアの開発とダウンロード
日本語の翻訳状況 translation status for ja
  • R/O
  • SSH
  • HTTPS

onstepper: コミット


コミットメタ情報

リビジョン6 (tree)
日時2022-03-16 07:45:16
作者derekwildstar

ログメッセージ

Utilização do novo componente TKRKToolTip

変更サマリ

差分

--- trunk/prj/OnStepper.dproj (revision 5)
+++ trunk/prj/OnStepper.dproj (revision 6)
@@ -146,6 +146,10 @@
146146 <ResourceType>ICON</ResourceType>
147147 <ResourceId>IMAGTRACKING</ResourceId>
148148 </RcItem>
149+ <RcItem Include="..\res\icons8-gestor-de-networking-32.ico">
150+ <ResourceType>ICON</ResourceType>
151+ <ResourceId>IMAGTIPODECONEXAO</ResourceId>
152+ </RcItem>
149153 <BuildConfiguration Include="Release">
150154 <Key>Cfg_2</Key>
151155 <CfgParent>Base</CfgParent>
@@ -168,6 +172,12 @@
168172 </Source>
169173 </Delphi.Personality>
170174 <Deployment Version="3">
175+ <DeployFile LocalName="..\res\icons8-gestor-de-networking-32.ico" Configuration="Debug" Class="ProjectFile">
176+ <Platform Name="Win32">
177+ <RemoteDir>.\</RemoteDir>
178+ <Overwrite>true</Overwrite>
179+ </Platform>
180+ </DeployFile>
171181 <DeployFile LocalName="..\bin\OnStepper.exe" Configuration="Debug" Class="ProjectOutput">
172182 <Platform Name="Win32">
173183 <RemoteName>OnStepper.exe</RemoteName>
--- trunk/src/UClassesAjudantes.pas (revision 5)
+++ trunk/src/UClassesAjudantes.pas (revision 6)
@@ -3,7 +3,7 @@
33 interface
44
55 uses
6- Vcl.ActnList;
6+ Vcl.ActnList, Vcl.Controls, System.Types;
77
88 type
99 TActionHelper = class Helper for TAction
@@ -12,8 +12,17 @@
1212 procedure Enable;
1313 end;
1414
15+ TControlHelper = class Helper for TControl
16+ public
17+ function Rect: TRect;
18+ function UniqueId: Cardinal;
19+ end;
20+
1521 implementation
1622
23+uses
24+ System.Classes;
25+
1726 { TActionHelper }
1827
1928 procedure TActionHelper.Disable;
@@ -26,4 +35,16 @@
2635 Enabled := True;
2736 end;
2837
38+{ TControlHelper }
39+
40+function TControlHelper.Rect: TRect;
41+begin
42+ Result := System.Classes.Rect(Left,Top,Left + Width,Top + Height);
43+end;
44+
45+function TControlHelper.UniqueId: Cardinal;
46+begin
47+ Result := Parent.Handle + Cardinal(ComponentIndex);
48+end;
49+
2950 end.
--- trunk/src/UDamoPrincipal.pas (revision 5)
+++ trunk/src/UDamoPrincipal.pas (revision 6)
@@ -14,7 +14,8 @@
1414 TDamoPrincipal = class(TDataModule)
1515 PNILPrincpal: TPngImageList;
1616 PNILBalloonHint: TPngImageList;
17- KRBHPrincipal: TKRKBalloonHint;
17+ KRTT: TKRKToolTip;
18+ procedure KRTTRegisterToolTip(const AToolTip: TToolTip);
1819 private
1920 { Private declarations }
2021 FOnStepInfo: TOnStepInfo;
@@ -22,12 +23,8 @@
2223 FVisibleFrame: TFramBasico;
2324
2425 function FrameByClassName(AClassName: String): TFramBasico;
26+
2527 procedure HandleOnInfo(AIdentification: String; AStatus: TOnStepStatus);
26-
27- procedure ShowBalloonHint(AControl: TControl);
28- procedure HideBalloonHint;
29- procedure HandleMouseEnter(ASender: TObject);
30- procedure HandleMouseLeave(ASender: TObject);
3128 public
3229 { Public declarations }
3330 constructor Create(AOwner: TComponent); override;
@@ -36,17 +33,6 @@
3633 procedure ShowFrame(AFrameClass: TFramBasicoClass; AAction: TAction);
3734 procedure StartPooling;
3835 procedure PausePooling;
39- procedure ConfigureBalloonHint(AControl: TControl);
40-
41-// procedure s1;
42- procedure s11;
43- procedure h1;
44- procedure h11;
45- procedure s2;
46- procedure s22;
47- procedure h2;
48- procedure h22;
49- procedure MSG;
5036 end;
5137
5238 implementation
@@ -54,7 +40,8 @@
5440 {%CLASSGROUP 'Vcl.Controls.TControl'}
5541
5642 uses
57- UKRFMPrincipal, Winapi.Windows, Vcl.Graphics, Vcl.ExtCtrls, Dialogs, Winapi.CommCtrl;
43+ UKRFMPrincipal, Vcl.Graphics, Vcl.ExtCtrls, Dialogs,
44+ Winapi.CommCtrl, Windows, Messages;
5845
5946 {$R *.dfm}
6047
@@ -67,74 +54,8 @@
6754 FOnStepInfo.OnInfo := HandleOnInfo;
6855 end;
6956
70-procedure TDamoPrincipal.s11;
71-//var
72-// T: TToolInfo;
73-begin
74-// T.cbSize := SizeOf(TToolInfo);
75-// T.hwnd := 0;
76-// T.uId := 1;
77-// SendMessage(FKRBH.ToolTipWindowHandle,TTM_TRACKACTIVATE,WPARAM(True),LPARAM(@T));
78-end;
79-
80-procedure TDamoPrincipal.s2;
81-//var
82-// P2: TKRKTrackingToolTipParams;
83-begin
84-// P2 := Default(TKRKTrackingToolTipParams);
85-// P2.IconHandle := 2;
86-// P2.Title := 'Título 2';
87-// P2.Text := 'Este é um texto menor, porém que precisa de um ToolTip maior que 100 pixels, portanto ele será quebrado';
88-// P2.X := 500;
89-// P2.Y := 500;
90-// FKRBH.Show(0,2,P2);
91-end;
92-
93-procedure TDamoPrincipal.s22;
94-//var
95-// T: TToolInfo;
96-begin
97-// T.cbSize := SizeOf(TToolInfo);
98-// T.hwnd := 0;
99-// T.uId := 2;
100-// SendMessage(FKRBH.ToolTipWindowHandle,TTM_TRACKACTIVATE,WPARAM(True),LPARAM(@T));
101-end;
102-
103-procedure TDamoPrincipal.h1;
104-begin
105-// FKRBH.Hide;
106-end;
107-
108-
109-procedure TDamoPrincipal.h11;
110-//var
111-// T: TToolInfo;
112-begin
113-// T.cbSize := SizeOf(TToolInfo);
114-// T.hwnd := 0;
115-// T.uId := 1;
116-// SendMessage(FKRBH.ToolTipWindowHandle,TTM_TRACKACTIVATE,WPARAM(False),LPARAM(@T));
117-end;
118-
119-procedure TDamoPrincipal.h2;
120-begin
121-// FKRBH.Hide;
122-end;
123-
124-procedure TDamoPrincipal.h22;
125-//var
126-// T: TToolInfo;
127-begin
128-// T.cbSize := SizeOf(TToolInfo);
129-// T.hwnd := 0;
130-// T.uId := 2;
131-// SendMessage(FKRBH.ToolTipWindowHandle,TTM_TRACKACTIVATE,WPARAM(False),LPARAM(@T));
132-end;
133-
13457 destructor TDamoPrincipal.Destroy;
13558 begin
136-// FKRBH.Free;
137-
13859 FOnStepInfo.Free;
13960 FFrameList.Free;
14061 inherited;
@@ -152,39 +73,6 @@
15273 end;
15374 end;
15475
155-procedure TDamoPrincipal.HandleMouseEnter(ASender: TObject);
156-//var
157-// Icon: HICON;
158-begin
159-// Icon := LoadIcon(HInstance,PWideChar(UpperCase(AControl.Name)));
160-//
161-// if Icon > 0 then
162-// begin
163-// AControl.Hint := AControl.Hint + '|' + IntToStr(Icon);
164-// DestroyIcon(Icon);
165-// end;
166-
167-
168-
169-// eu estou tentando fazer com que TipIconId funcione, mas descobri que ao usar AUtoGetTexts (published)
170-// caso eu mude ele aqui embaixo, FToolInfo é todo vazio e por isso o hint não é mostrado
171-// se eu coloco Autogettexts no OI como false desde o começo ele pega o texto padrão.
172-
173-// KRBHPrincipal.AutoGetTexts := fALSE;
174- //KRBHPrincipal.TipIcon := tiInfo;
175-// KRBHPrincipal.TipIconId := 'MAINICON';
176-
177-// em setautogettexts só resetar se houve mudança de propriedade. Nao fazer isso
178-// faz com que toda vez o valor dos textos sejam sobrescritos
179-
180- ShowBalloonHint(TControl(ASender));
181-end;
182-
183-procedure TDamoPrincipal.HandleMouseLeave(ASender: TObject);
184-begin
185- HideBalloonHint;
186-end;
187-
18876 procedure TDamoPrincipal.HandleOnInfo(AIdentification: String; AStatus: TOnStepStatus);
18977 var
19078 KRFM: TKRFMPrincipal;
@@ -212,69 +100,17 @@
212100 end;
213101 end;
214102
215-procedure TDamoPrincipal.HideBalloonHint;
103+procedure TDamoPrincipal.KRTTRegisterToolTip(const AToolTip: TToolTip);
216104 begin
217- KRBHPrincipal.Hide;
105+ AToolTip.Text := GetLongHint(AToolTip.Tool.Hint);
106+ AToolTip.Tool.ShowHint := False;
218107 end;
219108
220-procedure TDamoPrincipal.MSG;
221-begin
222-// ShowMessage(Inttostr(SendMessage(FKRBH.ToolTipWindowHandle,TTM_GETTOOLCOUNT,0,0)));
223-
224-//var T: TToolInfo := Default(TToolInfo);
225-//T.cbSize := SizeOf(TToolInfo);
226-//
227-//SendMessage(FKRBH.ToolTipWindowHandle,TTM_ENUMTOOLS,0,LPARAM(@T));
228-//SendMessage(FKRBH.ToolTipWindowHandle,TTM_ENUMTOOLS,1,LPARAM(@T));
229-//
230-//T := Default(TToolInfo);
231-//T.cbSize := SizeOf(TToolInfo);
232-//
233-//if SendMessage(FKRBH.ToolTipWindowHandle,TTM_GETCURRENTTOOL,0,LPARAM(@T)) > 0 then
234-// ShowMessage('tem');
235-
236-end;
237-
238-type
239- TControlHack = class(TControl);
240-
241-procedure TDamoPrincipal.ConfigureBalloonHint(AControl: TControl);
242-var
243- Icon: HICON;
244-begin
245- Icon := LoadIcon(HInstance,PWideChar(UpperCase(AControl.Name)));
246-
247- if Icon > 0 then
248- begin
249- AControl.Hint := AControl.Hint + '|' + IntToStr(Icon);
250- DestroyIcon(Icon);
251- end;
252-
253- TControlHack(AControl).OnMouseEnter := HandleMouseEnter;
254- TControlHack(AControl).OnMouseLeave := HandleMouseLeave;
255-end;
256-
257109 procedure TDamoPrincipal.PausePooling;
258110 begin
259111 FOnStepInfo.Pause;
260112 end;
261113
262-procedure TDamoPrincipal.ShowBalloonHint(AControl: TControl);
263-begin
264- // Remove o controle que já existe (se houver um) e atribui o novo controle.
265- // Isso é necessário porque o TKRKBalloonHint é concebido para servir a apenas
266- // um controle de cada vez e ser configurado completamente via Object
267- // Inspector. Esse é o mesmo motivo pelo qual eu também desativo e ativo a
268- // propriedade AutoGetTexts e altero a posição TipAlignmente para algo
269- // diferente de taCenter
270- KRBHPrincipal.AssociatedControl := nil;
271- KRBHPrincipal.AssociatedControl := AControl;
272- KRBHPrincipal.AutoGetTexts := False;
273- KRBHPrincipal.AutoGetTexts := True;
274- KRBHPrincipal.TipAlignment := taTopLeft;
275- KRBHPrincipal.Show(taCenter);
276-end;
277-
278114 procedure TDamoPrincipal.ShowFrame(AFrameClass: TFramBasicoClass; AAction: TAction);
279115 var
280116 Frame: TFramBasico;
--- trunk/src/UKRFMPrincipal.pas (revision 5)
+++ trunk/src/UKRFMPrincipal.pas (revision 6)
@@ -25,27 +25,16 @@
2525 LABEOnStepIdentification: TLabel;
2626 LABEOnStepStatus: TLabel;
2727 IMAGAtHome: TImage;
28- PANEStatus: TPanel;
28+ PANEStatus: TKRKPanel;
2929 IMAGParked: TImage;
3030 IMAGTracking: TImage;
3131 IMAGGoTo: TImage;
32- BUTNToggleToolTip: TButton;
33- BUTN: TButton;
34- BUTN3: TButton;
35- BUTN4: TButton;
36- BUTN5: TButton;
3732 procedure ACTNLocaisDeObservacaoExecute(Sender: TObject);
38- procedure FormShow(Sender: TObject);
3933 procedure FormCreate(Sender: TObject);
40- procedure BUTNToggleToolTipClick(Sender: TObject);
41- procedure BUTNClick(Sender: TObject);
42- procedure BUTN3Click(Sender: TObject);
43- procedure BUTN4Click(Sender: TObject);
44- procedure BUTN5Click(Sender: TObject);
34+ function KRKFormTTNShow(ANMHdr: tagNMHDR): Boolean;
4535 private
4636 { Private declarations }
4737 FDamoPrincipal: TDamoPrincipal;
48- procedure HandleNotifyMessages(var AMessage: TWMNotify); message WM_NOTIFY;
4938 public
5039 { Public declarations }
5140 constructor Create(AOwner: TComponent); override;
@@ -59,7 +48,7 @@
5948 {$R *.dfm}
6049
6150 uses
62- UFramLocaisDeObservacao, CommCtrl, KRK.Rtl.Win.CommCtrl;
51+ UFramLocaisDeObservacao, UClassesAjudantes, KRK.Rtl.Win.CommCtrl;
6352
6453 { TFormPrincipal }
6554
@@ -68,70 +57,6 @@
6857 FDamoPrincipal.ShowFrame(TFramLocaisDeObservacao,TAction(Sender));
6958 end;
7059
71-//var
72-// v1, v11, v2, v22: Boolean;
73-
74-procedure TKRFMPrincipal.BUTN3Click(Sender: TObject);
75-begin
76-// if v11 then
77-// begin
78-// FDamoPrincipal.h11;
79-// v11 := False;
80-// end
81-// else
82-// begin
83-// FDamoPrincipal.s11;
84-// v11 := True;
85-// end;
86-end;
87-
88-procedure TKRFMPrincipal.BUTN4Click(Sender: TObject);
89-begin
90-// if v22 then
91-// begin
92-// FDamoPrincipal.h22;
93-// v22 := False;
94-// end
95-// else
96-// begin
97-// FDamoPrincipal.s22;
98-// v22 := True;
99-// end;
100-end;
101-
102-procedure TKRFMPrincipal.BUTN5Click(Sender: TObject);
103-begin
104- FDamoPrincipal.MSG;
105-end;
106-
107-procedure TKRFMPrincipal.BUTNClick(Sender: TObject);
108-begin
109-// if v2 then
110-// begin
111-// FDamoPrincipal.h2;
112-// v2 := False;
113-// end
114-// else
115-// begin
116-// FDamoPrincipal.s2;
117-// v2 := True;
118-// end;
119-end;
120-
121-procedure TKRFMPrincipal.BUTNToggleToolTipClick(Sender: TObject);
122-begin
123-// if v1 then
124-// begin
125-// FDamoPrincipal.h1;
126-// v1 := False;
127-// end
128-// else
129-// begin
130-// FDamoPrincipal.s1;
131-// v1 := True;
132-// end;
133-end;
134-
13560 constructor TKRFMPrincipal.Create(AOwner: TComponent);
13661 begin
13762 // Anteriormente eu criva FDamoPrincipal antes de inherited, porque eu
@@ -141,7 +66,7 @@
14166 // executado APÓS a finalização total do construtor, portanto, não importa
14267 // neste caso onde se cria FDamoPrincipal, pois no evento OnCreate ele estará
14368 // disponível com certeza! Com isso em mente eu acredito que dificilmente
144- // alguma implementação deva de fato criar coisas antes do Inherited. Aqui
69+ // alguma implementação deva de fato criar coisas antes do inherited. Aqui
14570 // mesmo, fazer isso estava causando a limpeza do membro FToolInfo.lpszText
14671 // (em TKRKBalloonHint) e eu não sei porque isso aconteceu, pois não faz muito
14772 // sentido. Como a mudança de criação de FDamoPrincipal para depois de
@@ -153,29 +78,20 @@
15378
15479 procedure TKRFMPrincipal.FormCreate(Sender: TObject);
15580 begin
156- FDamoPrincipal.ConfigureBalloonHint(IMAGAtHome);
157- FDamoPrincipal.ConfigureBalloonHint(IMAGGoTo);
158- FDamoPrincipal.ConfigureBalloonHint(IMAGParked);
159- FDamoPrincipal.ConfigureBalloonHint(IMAGTracking);
81+ FDamoPrincipal.KRTT.RegisterToolTips;
16082 end;
16183
162-procedure TKRFMPrincipal.FormShow(Sender: TObject);
84+function TKRFMPrincipal.KRKFormTTNShow(ANMHdr: tagNMHDR): Boolean;
16385 begin
164-// FDamoPrincipal.StartPooling;
165-// comitar o krakatoa depois de incluir nele a opção de uso do wordwrap
166-// nao esquecer de comentar que caso algo errado aconteça, que basta reverter os fontes para uma versão anterior
167-end;
86+ Result := False;
16887
169-procedure TKRFMPrincipal.HandleNotifyMessages(var AMessage: TWMNotify);
170-var
171- Link: TNMLink;
172-begin
173- if Assigned(AMessage.NMHdr) and (AMessage.NMHdr.code = TTN_LINKCLICK) then
174- begin
175- Link := PNMLink(AMessage.NMHdr)^;
176-
177- Application.MessageBox(PChar('O link clicado tem href="' + Link.item.szUrl + '" e id="' + Link.item.szID + '" e seu índice é "' + Link.item.iLink.ToString + '"'),'Sou foda!',MB_ICONINFORMATION);
178- end;
88+ for var ToolTip: TToolTip in FDamoPrincipal.KRTT.ToolTips do
89+ if ToolTip.Id = ANMHdr.idFrom then
90+ begin
91+ FDamoPrincipal.KRTT.SetTipIconAndTitle(FDamoPrincipal.KRTT.IconResourceId2IconHandle(PChar(ToolTip.Tool.Name))
92+ ,PChar(GetShortHint(ToolTip.Tool.Hint)));
93+ Break;
94+ end;
17995 end;
18096
18197 initialization
旧リポジトリブラウザで表示