1 {
2 ***************************************************************************
3 * *
4 * This source is free software; you can redistribute it and/or modify *
5 * it under the terms of the GNU General Public License as published by *
6 * the Free Software Foundation; either version 2 of the License, or *
7 * (at your option) any later version. *
8 * *
9 * This code is distributed in the hope that it will be useful, but *
10 * WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
12 * General Public License for more details. *
13 * *
14 * A copy of the GNU General Public License is available on the World *
15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
16 * obtain it by writing to the Free Software Foundation, *
17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 * *
19 ***************************************************************************
20
21 Author: Mattias Gaertner
22
23 Abstract:
24 The base class for hint windows for the source editor for the online help.
25 For example for the fpdoc and comment help.
26 }
27 unit SrcEditHintFrm;
28
29 {$mode objfpc}{$H+}
30
31 interface
32
33 uses
34 Classes, Math, SysUtils, LCLProc, LCLType, LCLIntf, Forms, Controls, Graphics,
35 ExtCtrls,
36 SynEdit, SynEditKeyCmds,
37 SrcEditorIntf;
38
39 type
40
41 { TCodeHintProvider }
42
43 TCodeHintProvider = class(TComponent)
44 private
45 FControl: TWinControl;
46 protected
47 procedure SetControl(const AValue: TWinControl); virtual;
48 public
49 procedure GetPreferredSize(var {%H-}PreferredWidth, {%H-}PreferredHeight: integer); virtual;
50 procedure UpdateHint; virtual;
51 property Control: TWinControl read FControl write SetControl;
52 end;
53
54 { TSrcEditHintWindow }
55
56 TSrcEditHintWindow = class(THintWindow)
57 IdleTimer1: TIdleTimer;
58 procedure ApplicationIdle(Sender: TObject; var {%H-}Done: Boolean);
59 procedure FormCreate(Sender: TObject);
60 procedure FormDestroy(Sender: TObject);
61 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
62 procedure FormUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
63 procedure IdleTimer1Timer(Sender: TObject);
64 private
65 FAnchorForm: TCustomForm;
66 FHelpEnabled: boolean;
67 FPreferredHeight: integer;
68 FPreferredWidth: integer;
69 FProvider: TCodeHintProvider;
70 FSrcEditCaret: TPoint;
71 procedure SetAnchorForm(const AValue: TCustomForm);
72 procedure OnAnchorFormChangeBounds(Sender: TObject);
73 procedure SetHelpEnabled(const AValue: boolean);
74 procedure SetProvider(const AValue: TCodeHintProvider);
75 procedure UpdatePosition;
76 public
77 constructor Create(TheOwner: TComponent); override;
78 destructor Destroy; override;
79 procedure Paint; override;
80 procedure UpdateHints(Immediately: boolean = false);// update content
NeedVisiblenull81 function NeedVisible: boolean;
82 property AnchorForm: TCustomForm read FAnchorForm write SetAnchorForm;
83 property HelpEnabled: boolean read FHelpEnabled write SetHelpEnabled;
84 property SrcEditCaret: TPoint read FSrcEditCaret write FSrcEditCaret;// 0,0 means use current position, should be ScreenXY, not TextXY
85 property PreferredWidth: integer read FPreferredWidth write FPreferredWidth;
86 property PreferredHeight: integer read FPreferredHeight write FPreferredHeight;
87 property Provider: TCodeHintProvider read FProvider write SetProvider; // Provider.Control=Self
88 end;
89
90 var
91 SrcEditHintWindow: TSrcEditHintWindow = nil;
92
93 implementation
94
95 type
96 TWinControlAccess = class(TWinControl);
97
98 { TSrcEditHintWindow }
99
100 procedure TSrcEditHintWindow.ApplicationIdle(Sender: TObject; var Done: Boolean);
101 begin
102 //DebugLn(['TCodeHintFrm.ApplicationIdle NeedVisible=',NeedVisible]);
103 if Visible and (not NeedVisible) then
104 Hide;
105 end;
106
107 procedure TSrcEditHintWindow.FormCreate(Sender: TObject);
108 begin
109 Application.AddOnIdleHandler(@ApplicationIdle);
110 end;
111
112 procedure TSrcEditHintWindow.FormDestroy(Sender: TObject);
113 begin
114
115 end;
116
117 procedure TSrcEditHintWindow.FormKeyDown(Sender: TObject; var Key: Word;
118 Shift: TShiftState);
119 var
120 SrcEdit: TSourceEditorInterface;
121 begin
122 if (Key=VK_ESCAPE) and (Shift=[]) then
123 Hide
124 else if SourceEditorManagerIntf<>nil then begin
125 SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
126 if SrcEdit=nil then
127 Hide
128 else begin
129 // redirect keys
130 TWinControlAccess(SrcEdit.EditorControl).KeyDown(Key,Shift);
131 SetActiveWindow(SourceEditorManagerIntf.ActiveSourceWindow.Handle);
132 end;
133 end;
134 end;
135
136 procedure TSrcEditHintWindow.FormUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
137 var
138 SrcEdit: TSourceEditorInterface;
139 ASynEdit: TCustomSynEdit;
140 begin
141 SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
142 if SrcEdit=nil then begin
143 Hide;
144 end else begin
145 ASynEdit:=(SrcEdit.EditorControl as TCustomSynEdit);
146 ASynEdit.CommandProcessor(ecChar,UTF8Key,nil);
147 end;
148 end;
149
150 procedure TSrcEditHintWindow.IdleTimer1Timer(Sender: TObject);
151 begin
152 UpdateHints(true);
153 end;
154
155 procedure TSrcEditHintWindow.SetAnchorForm(const AValue: TCustomForm);
156 begin
157 if FAnchorForm=AValue then exit;
158 if FAnchorForm<>nil then
159 FAnchorForm.RemoveAllHandlersOfObject(Self);
160 FAnchorForm:=AValue;
161 if FAnchorForm<>nil then
162 FAnchorForm.AddHandlerOnChangeBounds(@OnAnchorFormChangeBounds);
163 UpdateHints;
164 end;
165
166 procedure TSrcEditHintWindow.OnAnchorFormChangeBounds(Sender: TObject);
167 begin
168 //DebugLn(['TCodeHintFrm.OnAnchorFormChangeBounds ',dbgs(BoundsRect),' Sender=',dbgsName(Sender),' SenderVisible=',TControl(Sender).Visible,' SenderBounds=',dbgs(TControl(Sender).BoundsRect)]);
169 if Visible then
170 UpdatePosition;
171 end;
172
173 procedure TSrcEditHintWindow.SetHelpEnabled(const AValue: boolean);
174 begin
175 if FHelpEnabled=AValue then exit;
176 FHelpEnabled:=AValue;
177 if not HelpEnabled then
178 Visible:=false;
179 UpdateHints;
180 end;
181
182 procedure TSrcEditHintWindow.SetProvider(const AValue: TCodeHintProvider);
183 begin
184 if FProvider=AValue then exit;
185 if FProvider<>nil then begin
186 FProvider.Control:=nil;
187 end;
188 FProvider:=AValue;
189 if FProvider<>nil then begin
190 FProvider.Control:=Self;
191 FProvider.GetPreferredSize(FPreferredWidth,FPreferredHeight);
192 end;
193 end;
194
195 procedure TSrcEditHintWindow.UpdatePosition;
196 var
197 NewBounds: TRect;
198 DesktopBounds: TRect;
199
200 procedure TryPosition(TryBounds: TRect; TheAnchors: TAnchors);
201 begin
202 TryBounds.Right:=Max(TryBounds.Left,TryBounds.Right);
203 TryBounds.Bottom:=Max(TryBounds.Top,TryBounds.Bottom);
204 if TryBounds.Right>DesktopBounds.Right then begin
205 if not (akLeft in TheAnchors) then begin
206 // move to the left
207 dec(TryBounds.Left,TryBounds.Right-DesktopBounds.Right);
208 TryBounds.Left:=Max(TryBounds.Left,DesktopBounds.Left);
209 end;
210 TryBounds.Right:=DesktopBounds.Right;
211 end;
212 if TryBounds.Left<DesktopBounds.Left then begin
213 if not (akRight in TheAnchors) then begin
214 // move to the right
215 inc(TryBounds.Right,DesktopBounds.Left-TryBounds.Left);
216 TryBounds.Left:=Min(TryBounds.Right,DesktopBounds.Right);
217 end;
218 TryBounds.Left:=DesktopBounds.Left;
219 end;
220 if TryBounds.Bottom>DesktopBounds.Bottom then begin
221 if not (akTop in TheAnchors) then begin
222 // move to the top
223 dec(TryBounds.Top,TryBounds.Bottom-DesktopBounds.Bottom);
224 TryBounds.Top:=Max(TryBounds.Top,DesktopBounds.Top);
225 end;
226 TryBounds.Bottom:=DesktopBounds.Bottom;
227 end;
228 if TryBounds.Top<DesktopBounds.Top then begin
229 if not (akBottom in TheAnchors) then begin
230 // move to the bottom
231 inc(TryBounds.Bottom,DesktopBounds.Top-TryBounds.Top);
232 TryBounds.Bottom:=Min(TryBounds.Bottom,DesktopBounds.Bottom);
233 end;
234 TryBounds.Top:=DesktopBounds.Top;
235 end;
236 // check if TryBounds are better than NewBounds
237 if (TryBounds.Right-TryBounds.Left)*(TryBounds.Bottom-TryBounds.Top)
238 > (NewBounds.Right-NewBounds.Left)*(NewBounds.Bottom-NewBounds.Top)
239 then
240 NewBounds:=TryBounds;
241 end;
242
243 var
244 CurCaret: TPoint;
245 SrcEdit: TSourceEditorInterface;
246 AnchorBounds: TRect;
247 begin
248 if (not NeedVisible) or Visible then exit;
249 DesktopBounds:=Rect(30,30,Screen.DesktopWidth-30,Screen.DesktopHeight-50);
250 NewBounds:=Bounds(DesktopBounds.Left,DesktopBounds.Top,30,30);
251
252 if AnchorForm<>nil then begin
253 // place near the AnchorForm
254 AnchorBounds:=AnchorForm.BoundsRect;
255 // try right of AnchorForm
256 TryPosition(Bounds(AnchorBounds.Right+6,AnchorBounds.Top,
257 PreferredWidth,PreferredHeight),[akLeft,akTop]);
258 // try left of AnchorForm
259 TryPosition(Bounds(AnchorBounds.Left-6-PreferredWidth,AnchorBounds.Top,
260 PreferredWidth,PreferredHeight),[akRight,akTop]);
261 // try below
262 TryPosition(Bounds(AnchorBounds.Left,AnchorBounds.Bottom+6,
263 PreferredWidth,PreferredHeight),[akTop]);
264 end else begin
265 // place near the source editor caret
266 CurCaret:=SrcEditCaret;
267 SrcEdit:=SourceEditorManagerIntf.ActiveEditor;
268 if CurCaret.Y<1 then
269 CurCaret:=SrcEdit.CursorScreenXY;
270 CurCaret:=SrcEdit.EditorControl.ClientToScreen(SrcEdit.ScreenToPixelPosition(CurCaret));
271
272 // try below
273 TryPosition(Bounds(CurCaret.X-(PreferredWidth div 2),CurCaret.Y+6,
274 PreferredWidth,PreferredHeight),[akTop]);
275 // try above
276 TryPosition(Bounds(CurCaret.X-(PreferredWidth div 2),
277 CurCaret.Y-6-PreferredHeight,
278 PreferredWidth,PreferredHeight),[akBottom]);
279 end;
280
281 //DebugLn(['TCodeHintFrm.UpdatePosition NewBounds=',dbgs(NewBounds),' BoundsRect=',dbgs(BoundsRect)]);
282 BoundsRect:=NewBounds;
283 Visible:=true;
284 end;
285
286 procedure TSrcEditHintWindow.Paint;
287 begin
288
289 end;
290
291 constructor TSrcEditHintWindow.Create(TheOwner: TComponent);
292 begin
293 inherited Create(TheOwner);
294 OnDestroy:=@FormDestroy;
295 OnKeyDown:=@FormKeyDown;
296 OnUTF8KeyPress:=@FormUTF8KeyPress;
297 FPreferredWidth:=400;
298 FPreferredHeight:=200;
299
300 IdleTimer1:=TIdleTimer.Create(Self);
301 IdleTimer1.Interval:=400;
302 IdleTimer1.OnTimer:=@IdleTimer1Timer;
303
304 FormCreate(Self);
305 end;
306
307 destructor TSrcEditHintWindow.Destroy;
308 begin
309 Application.RemoveAllHandlersOfObject(Self);
310 if SrcEditHintWindow=Self then
311 SrcEditHintWindow:=nil;
312 inherited Destroy;
313 end;
314
315 procedure TSrcEditHintWindow.UpdateHints(Immediately: boolean);
316 begin
317 if Visible and not NeedVisible then begin
318 // hide immediately
319 Hide;
320 exit;
321 end;
322 if not Immediately then begin
323 IdleTimer1.AutoEnabled:=true;
324 exit;
325 end;
326 //DebugLn(['TCodeHintFrm.UpdateHints Visible=',Visible]);
327 IdleTimer1.AutoEnabled:=false;
328 IdleTimer1.Enabled:=false;
329 UpdatePosition;
330 if Provider<>nil then Provider.UpdateHint;
331 end;
332
TSrcEditHintWindow.NeedVisiblenull333 function TSrcEditHintWindow.NeedVisible: boolean;
334 begin
335 if not HelpEnabled then exit(false);
336 if (AnchorForm<>nil) then begin
337 Result:=AnchorForm.IsVisible;
338 end else begin
339 Result:=(SourceEditorManagerIntf<>nil)
340 and (SourceEditorManagerIntf.ActiveEditor<>nil);
341 end;
342 end;
343
344 { TCodeHintProvider }
345
346 procedure TCodeHintProvider.SetControl(const AValue: TWinControl);
347 begin
348 if FControl=AValue then exit;
349 FControl:=AValue;
350 end;
351
352 procedure TCodeHintProvider.GetPreferredSize(var PreferredWidth,
353 PreferredHeight: integer);
354 begin
355
356 end;
357
358 procedure TCodeHintProvider.UpdateHint;
359 begin
360
361 end;
362
363 end.
364
365