How can we build a transparent control, like a hotspot? It is transparent, has its
own hint property and you can even click on it.
To do what you want, just create a descendant of TCustomControl and publish a few
protected properties and events. Especially the masked property is CLX specific.
To create a transparent control, all you need to do is descend from TCustomControl,
publish the Masked property (or hard-code it to True at runtime),
and override the Paint() virtual method. Paint() allows you to essentially create a
design time frame representing the area you want transparent with an overlayed
bitmap or image. Set an image and select a hotspot to trigger another event..
Example: Display a train layout and when you select a part display information
about that train. Or you'll have to find some easter eggs in a bunny bitmap ;)
You can call the component at run- or at designtime:
1
2 procedure TThreadSortForm.initHotspot;
3 var myhotspot3: THotspot;
4 begin
5 myhotspot3:= THotspot.Create(owner);
6 with myhotspot3 do begin
7 parent:= self;
8 left:= 46;
9 top:=288;
10 width:= 50;
11 height:= 50;
12 hint:=('this is building STARTRAIN');
13 masked:= true;
14 OnMouseEnter:= Hotspot1MouseEnter;
15 end;
16 end;
The method changeCursor in the event OnMouseEnter() changes the cursor after the
constructor, cause the masked property would hide the new cursor at mouse move
time! So FCursor is for further use.
17
18 unit hotspot;
19 // march of 2005 CLX version
20 // cause of masked property no special cursor is available
21 // works best with onmouseEnter ;)
22
23 interface
24
25 uses QControls, Classes, QGraphics, SysUtils,
26 QStdCtrls, QTypes, QForms;
27
28
29 type
30 THotspot = class(TCustomControl)
31 private
32 FFirstPaint: Boolean;
33 FCursor: TCursor;
34 protected
35 procedure Paint; override;
36 published
37 constructor Create(AOwner: TComponent); override;
38 destructor Destroy; override;
39 procedure changeCursor(howlong_msec: integer);
40 property OnClick;
41 property OnMouseDown;
42 property OnMouseUp;
43 property OnMouseMove;
44 property OnMouseEnter;
45 property OnMouseLeave;
46 property Masked;
47 end;
48
49 procedure register;
50
51 implementation
52
53 procedure THotspot.Paint;
54 begin
55 inherited Paint;
56 if (csDesigning in ComponentState) then
57 if FFirstPaint then begin
58 FFirstPaint:= False;
59 Width:= Width + 1;
60 masked:= false;
61 end else
62 //just the formframe of design time
63 with Canvas do begin
64 Pen.Style:= psDot;
65 Pen.Width:= 1;
66 Pen.Color:= clBlack;
67 Pen.Mode:= pmNotXor;
68 Brush.Style:= bsClear;
69 //brush.Style:= bsSolid;
70 Rectangle(0,0,Width,Height);
71 Rectangle(1,1,Width-1,Height-1);
72 end;
73 end;
74
75 //old style in windows
76 {procedure THotspot.CreateParams(var Params: TCreateParams);
77 begin
78 inherited CreateParams(Params);
79 Params.ExStyle := Params.ExStyle or ws_ex_Transparent;
80 end;}
81
82 constructor THotspot.Create(AOwner: TComponent);
83 begin
84 inherited Create(AOwner);
85 Width:= 100;
86 Height:= 100;
87 FFirstPaint:= True;
88 Cursor:= crHandPoint;
89 FCursor:= crDefault;
90 //transparentmode
91 //controlstyle:= controlstyle -[csOpaque];
92 showhint:= true;
93 masked:= true;
94 end;
95
96
97 procedure THotspot.changeCursor(howlong_msec: integer);
98 var save_cursor: TCursor;
99 begin
100 save_cursor:= screen.Cursor;
101 try
102 screen.Cursor:= crHandPoint;
103 //howlong in milliseconds
104 sleep(howlong_msec);
105 finally
106 screen.Cursor:= save_cursor;
107 end;
108 end;
109
110 destructor THotspot.Destroy;
111 begin
112 inherited Destroy;
113 end;
114
115
116 procedure register;
117 begin
118 RegisterComponents('PascalScript', [THotspot]);
119 end;
120
121 end.
122
123 //STARTRAIN
124 // start train
125 // start rain
126 // star train
|
