Mega Code Archive
A Hotspot function with CLX
<![CDATA[
Title: A Hotspot function with CLX
Question: 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.
Answer:
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:
procedure TThreadSortForm.initHotspot;
var myhotspot3: THotspot;
begin
myhotspot3:= THotspot.Create(owner);
with myhotspot3 do begin
parent:= self;
left:= 46;
top:=288;
width:= 50;
height:= 50;
hint:=('this is building STARTRAIN');
masked:= true;
OnMouseEnter:= Hotspot1MouseEnter;
end;
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.
unit hotspot;
// march of 2005 CLX version
// cause of masked property no special cursor is available
// works best with onmouseEnter ;)
interface
uses QControls, Classes, QGraphics, SysUtils,
QStdCtrls, QTypes, QForms;
type
THotspot = class(TCustomControl)
private
FFirstPaint: Boolean;
FCursor: TCursor;
protected
procedure Paint; override;
published
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure changeCursor(howlong_msec: integer);
property OnClick;
property OnMouseDown;
property OnMouseUp;
property OnMouseMove;
property OnMouseEnter;
property OnMouseLeave;
property Masked;
end;
procedure Register;
implementation
procedure THotspot.Paint;
begin
inherited Paint;
if (csDesigning in ComponentState) then
if FFirstPaint then begin
FFirstPaint:= False;
Width:= Width + 1;
masked:= false;
end else
//just the formframe of design time
with Canvas do begin
Pen.Style:= psDot;
Pen.Width:= 1;
Pen.Color:= clBlack;
Pen.Mode:= pmNotXor;
Brush.Style:= bsClear;
//brush.Style:= bsSolid;
Rectangle(0,0,Width,Height);
Rectangle(1,1,Width-1,Height-1);
end;
end;
//old style in windows
{procedure THotspot.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := Params.ExStyle or ws_ex_Transparent;
end;}
constructor THotspot.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width:= 100;
Height:= 100;
FFirstPaint:= True;
Cursor:= crHandPoint;
FCursor:= crDefault;
//transparentmode
//controlstyle:= controlstyle -[csOpaque];
showhint:= true;
masked:= true;
end;
procedure THotspot.changeCursor(howlong_msec: integer);
var save_cursor: TCursor;
begin
save_cursor:= screen.Cursor;
try
screen.Cursor:= crHandPoint;
//howlong in milliseconds
sleep(howlong_msec);
finally
screen.Cursor:= save_cursor;
end;
end;
destructor THotspot.Destroy;
begin
inherited Destroy;
end;
procedure Register;
begin
RegisterComponents('PascalScript', [THotspot]);
end;
end.
//STARTRAIN
// start train
// start rain
// star train
]]>