unit UnitFrameTooltip;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
  UnitClipQueue;

type
  TFrameTooltip = class(TForm)
    lblHeader: TLabel;
    lblBody: TLabel;
    imgBody: TImage;
  private
    { Private declarations }
    procedure CreateParams(var Params: TCreateParams);
    procedure ShowSelf;
    procedure SetPosition(pos : TPoint);
  public
    { Public declarations }
    //constructor Create(AControl: TComponent); override;
    procedure SetHeader(header : string);
    procedure ShowTooltip(s : string; Pos : TPoint; header : string = ''); overload;
    procedure ShowTooltip(pic : TPicture; Pos : TPoint; header : string = ''); overload;
    procedure ShowTooltip(ci : TClipITem; Pos : TPoint; header : string = ''); overload;
  end;

implementation



uses UnitMisc;


procedure TFrameTooltip.CreateParams(var Params: TCreateParams);
begin
    inherited CreateParams(params);

   	Params.Style := WS_POPUP;
    Params.ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
    {WS_EX_TRANSPARENT screws up in WinXP - causing a blank redraw}
end;


procedure TFrameTooltip.SetPosition(pos : TPoint);
begin
    self.top := pos.Y;
    self.left := pos.X;
end;
procedure TFrameTooltip.ShowSelf;
begin
	self.Visible := true;
	SetWindowPos(self.Handle,HWND_TOPMOST,self.left,self.top,self.width,self.Height,SWP_SHOWWINDOW);
    ForceForeground(self.handle);
end;



procedure TFrameTooltip.SetHeader(header : string);
begin
    lblHeader.Caption := header;
end;

procedure TFrameTooltip.ShowTooltip(s : string; Pos : TPoint; header : string = '');
begin
	if header <> '' then SetHeader(header);
    SetPosition(pos);

	imgBody.Visible := false;
    lblBody.Visible := true;

    lblBody.Caption := s;

    self.ShowSelf;
end;
procedure TFrameTooltip.ShowTooltip(pic : TPicture; Pos : TPoint; header : string = '');
begin
	if header <> '' then SetHeader(header);
	SetPosition(pos);

	imgBody.Visible := true;
    lblBody.Visible := false;

    imgBody.Picture := pic;

    self.ShowSelf;
end;

procedure TFrameTooltip.ShowTooltip(ci : TClipITem; Pos : TPoint; header : string = '');
var pic : TPicture;
    s : string;
begin
	case ci.GetFormatType of
    FT_UNICODE: begin
        ci.GetUnicodeText(s);
        self.showtooltip(s, Pos, header);
    end;
    FT_PICTURE: begin
    	pic := TPicture.Create;
    	ci.GetDIB(pic);
    	self.ShowTooltip(pic, pos, header);
        pic.Free;
    end;
    else begin
        self.ShowTooltip(ci.GetAsText, pos, header);
    end;
    end;
end;

end.
