Author: Kniebusch Horst
How can I create my own hint windows, even with bitmaps and so on?
Answer:
You just have to add the following code to your project (it's just an example). You
don't need to change something else in your project. Maybe the code will run in
earlier versions of Borland Delphi too, but didn't test it.
1 type
2 TGraphicHintWindow = class(THintWindow)
3 constructor Create(AOwner: TComponent); override;
4 private
5 FActivating: Boolean;
6 public
7 procedure ActivateHint(Rect: TRect; const AHint: string); override;
8 protected
9 procedure Paint; override;
10 published
11 property Caption;
12 end;
13
14 {...}
15
16 constructor TGraphicHintWindow.Create(AOwner: TComponent);
17 begin
18 inherited Create(AOwner);
19
20 //Here you can set custom Font properties:
21
22 with Canvas.Font do
23 begin
24 Name := 'Arial';
25 Style := style + [fsBold];
26 Color := clBlack;
27 end;
28 end;
29
30 procedure TGraphicHintWindow.Paint;
31 var
32 R: TRect;
33 bmp: TBitmap;
34 l: TStrings;
35 begin
36 R := ClientRect;
37 Inc(R.Left, 2);
38 Inc(R.Top, 2);
39
40 {*******************************************************
41 The following Code is an example how to create a custom
42 Hint Object. :
43 *******************************************************}
44
45 bmp := TBitmap.create;
46 bmp.LoadfromFile('D:\hint.bmp');
47
48 with Canvas do
49 begin
50 Brush.style := bsSolid;
51 Brush.color := clsilver;
52 Pen.color := clgray;
53 Rectangle(0, 0, 18, R.Bottom + 1);
54 Draw(2,(R.Bottom div 2) - (bmp.height div 2), bmp);
55 end;
56
57 bmp.free;
58
59 Color := clWhite; //Beliebige HintFarbe
60 //custom Hint Color
61
62 Canvas.Brush.style := bsClear;
63 //Canvas.TextOut(20,(R.Bottom div 2)-(canvas.Textheight(caption) div 2),caption);
64 Inc(R.Left, 20);
65 l := TStringlist.create;
66 l.SetText(PChar(Caption));
67 R.top := (R.Bottom div 2) - ((canvas.Textheight(caption) * l.count) div 2);
68
69 DrawText(Canvas.Handle, PChar(Caption), -1, R, 0);
70
71 l.free;
72 {********************************************************}
73 end;
74
75 procedure TGraphicHintWindow.ActivateHint(Rect: TRect; const AHint: string);
76 begin
77 FActivating := True;
78 try
79 Caption := AHint;
80 Inc(Rect.Bottom, 14); //Set the "Height" Property of the Hint
81
82 Rect.Right := Rect.right + 20; //Set the "Width" Property of the Hint
83 UpdateBoundsRect(Rect);
84 if Rect.Top + Height > Screen.DesktopHeight then
85 Rect.Top := Screen.DesktopHeight - Height;
86 if Rect.Left + Width > Screen.DesktopWidth then
87 Rect.Left := Screen.DesktopWidth - Width;
88 if Rect.Left < Screen.DesktopLeft then
89 Rect.Left := Screen.DesktopLeft;
90 if Rect.Bottom < Screen.DesktopTop then
91 Rect.Bottom := Screen.DesktopTop;
92 SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height,
93 SWP_SHOWWINDOW or SWP_NOACTIVATE);
94 Invalidate;
95 finally
96 FActivating := False;
97 end;
98 end;
99
100 procedure TForm1.FormCreate(Sender: TObject);
101 begin
102 HintWindowClass := TGraphicHintWindow;
103 Application.ShowHint := False;
104 Application.ShowHint := True;
105 end;
|
