PeterDelphin
asked on
Show a thumbnail hint when hovering mouse-ponter over menu-item?
It is possible. Just to know - I'm working on example but short on time right now...
Ok. here it is.
1. you need to use TAction-s assigned to each MenuItem you use for hints.
This way your Hint will assigned if some Clipboard format is ready and force to start showing Hint - this is big.
Make own inherited THintWindow:
... TMenuItemPreviewHint implementation - with two timers - one - time to show and one - time to hide (after showing)
I implement two common Clipboard formats: text and bitmap. When text is detected - it calls common Hint window, but on bitmap - shows custom made: TMenuItemPreviewHint class.
1. you need to use TAction-s assigned to each MenuItem you use for hints.
uses ... ClipBrd, ActnList;
...
procedure TForm1.Action1Execute(Sender: TObject);
begin
//do something with Clipboard bitmap
end;
procedure TForm1.Action1Update(Sender: TObject);
begin
TAction(Sender).Enabled := Clipboard.HasFormat(CF_BITMAP);
if TAction(Sender).Enabled then TAction(Sender).Hint := 'CF_BITMAP'
else TAction(Sender).Hint := '';
end;
procedure TForm1.Action2Execute(Sender: TObject);
begin
//do something with Clipboard text
end;
procedure TForm1.Action2Update(Sender: TObject);
begin
TAction(Sender).Enabled := Clipboard.HasFormat(CF_TEXT);
if TAction(Sender).Enabled then TAction(Sender).Hint := 'CF_TEXT'
else TAction(Sender).Hint := '';
end;
This way your Hint will assigned if some Clipboard format is ready and force to start showing Hint - this is big.
Make own inherited THintWindow:
...
type
//TMyAppHook = class(TApplication);
TMenuItemPreviewHint = class(THintWindow)
private
showTimer : TTimer;
hideTimer : TTimer;
HintBmp: TPicture;
procedure DoHide(Sender : TObject);
procedure DoShow(Sender : TObject);
protected
procedure Paint; override;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure DoActivateHint(HintPos: TPoint; HintText: String);
end;
type
TForm1 = class(TForm)
Button1: TButton;
PopupMenu1: TPopupMenu;
Panel1: TPanel;
PasteImage1: TMenuItem;
PasteText1: TMenuItem;
Label1: TLabel;
Edit1: TEdit;
ActionList1: TActionList;
Action1: TAction;
Action2: TAction;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Action1Execute(Sender: TObject);
procedure Action1Update(Sender: TObject);
procedure Action2Execute(Sender: TObject);
procedure Action2Update(Sender: TObject);
private
MyPicHint: TMenuItemPreviewHint;
procedure DisplayHint(Sender: TObject);
{ Private declarations }
public
{ Public declarations }
end;
...
//http://smiguel.free.fr/exempledetaille/juin01/exemplejuin01.htm
//http://capecodgunny.blogspot.hr/2014/12/how-to-display-menu-item-hints-in.html
//https://www.thoughtco.com/how-to-display-menu-item-hints-1058397
//https://svn.code.sf.net/p/monex/code/trunk/Komponente/KalkulatorEdit/MultiLineHint.pas
//form *****************
procedure TForm1.DisplayHint(Sender: TObject);
var
P: TPoint;
sHint: String;
begin
if Application.Hint = '' then
begin
Application.CancelHint;
MyPicHint.Hide;
end
else
begin
sHint := Application.Hint;
GetCursorPos(P);
//show build in
if (sHint = 'CF_BITMAP') or (sHint = 'CF_TEXT') then
begin
//comes from menuitem
MyPicHint.DoActivateHint(P, sHint); //show custom hint
end
else
begin
//all other
Application.ActivateHint(P); //show build in hint
end;
end;
end;
//do some initialization here ....
procedure TForm1.FormCreate(Sender: TObject);
begin
MyPicHint := TMenuItemPreviewHint.Create(nil);
Application.OnHint := DisplayHint;
Application.HideHint;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Application.HideHint;
Application.OnHint := nil;
MyPicHint.Free;
end;
... TMenuItemPreviewHint implementation - with two timers - one - time to show and one - time to hide (after showing)
{ TMenuItemPreviewHint }
constructor TMenuItemPreviewHint.Create(AOwner: TComponent);
begin
inherited;
showTimer := TTimer.Create(self) ;
showTimer.Interval := Application.HintPause;
hideTimer := TTimer.Create(self) ;
hideTimer.Interval := Application.HintHidePause;
HintBmp := TPicture.Create;
end;
destructor TMenuItemPreviewHint.Destroy;
begin
hideTimer.OnTimer := nil;
showTimer.OnTimer := nil;
HintBmp.Free;
self.ReleaseHandle;
hideTimer.Free;
showTimer.Free;
inherited;
end;
procedure TMenuItemPreviewHint.DoActivateHint(HintPos: TPoint; HintText: String);
begin
//force remove of the "old" hint window
DoHide(self) ;
Self.Hint := HintText;
Self.Color := Application.HintColor;
showTimer.OnTimer := DoShow;
hideTimer.OnTimer := DoHide;
end;
procedure TMenuItemPreviewHint.DoHide(Sender: TObject);
begin
self.ReleaseHandle;
hideTimer.OnTimer := nil;
end;
procedure TMenuItemPreviewHint.Paint;
var
R: TRect;
begin
//draw internal image if exists
if HintBmp.Width>0 then
begin
R := ClientRect;
Canvas.Draw(R.Left+1, R.Top+1, HintBmp.Graphic);
end
else
inherited; //draw common text
end;
procedure TMenuItemPreviewHint.DoShow(Sender: TObject);
var
p: TPoint;
r : TRect;
iHintControl: integer;
s, sHint: String;
bmp: TPicture;
begin
sHint := Self.Hint;
iHintControl := 0;
//show build in
if (sHint = 'CF_BITMAP') then iHintControl := 1
else if (sHint = 'CF_TEXT') then iHintControl := 2; //... and so on ...
GetCursorPos(p);
//free old info
HintBmp.Assign(nil);
case iHintControl of
1: //bitmap
begin
//MyPicHint.DoActivateHint(PasteImage1);
bmp := TPicture.Create;
try
try
bmp.Assign(Clipboard);
if bmp.Width>0 then
begin
r := Rect(1, 1, bmp.Width+2, bmp.Height+2);
HintBmp.Assign(bmp);
OffsetRect(r, p.X + 100, p.Y);
ActivateHint(r, '');
end;
except
// Can't convert
end;
finally
bmp.Free;
end;
end;
2: //text
begin
try
sHint := Clipboard.AsText;
s := GetLongHint(sHint);
r := Rect(0, 0, 0, 0);
//calc size
r := CalcHintRect(200, s, nil);
OffsetRect(r, p.X + 100, p.Y);
ActivateHint(r, s);
except
end;
end;
end;
showTimer.OnTimer := nil;
end;
I implement two common Clipboard formats: text and bitmap. When text is detected - it calls common Hint window, but on bitmap - shows custom made: TMenuItemPreviewHint class.
This question needs an answer!
Become an EE member today
7 DAY FREE TRIALMembers can start a 7-Day Free trial then enjoy unlimited access to the platform.
View membership options
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.