unit UnitFrmTooltipNew;

interface

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

type
  TFrmTooltipNew = class(TForm)
    lblHeader: TLabel;
    imgBody: TImage;
    lblBody: TLabel;
    TimClose: TTimer;
    lblFooter: TLabel;
    reBody: TRichEdit;
    procedure FormPaint(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure TimCloseTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure reBodyClick(Sender: TObject);
    procedure lblBodyClick(Sender: TObject);
    procedure lblFooterClick(Sender: TObject);
    procedure lblHeaderClick(Sender: TObject);
  private
    { Private declarations }
    firstpaint : boolean;
    fCloseOnLostFocus : boolean;
    fShowing : boolean;
    fPoint : TPoint;
    fSmallFont : boolean;
    fMaxWidth, fMaxHeight : integer;
    fDodgeMouse : boolean;
    fDodgeX : boolean;
    fTimeStamp : boolean;
    fTimeSTring : string;
    fsize : cardinal;
    fMinWidth : integer;
    fSingleLineOnce : boolean;
    clicked : boolean;
    //fOnClickEvent : TNotifyEvent;
    procedure CreateParams(var Params: TCreateParams);  override;

    procedure WMActivate(Var msg:tMessage); message WM_ACTIVATE;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    procedure ShowSelf;
    procedure SetPosition(pos : TPoint);
    procedure InitFonts;
    procedure FixSize;
    procedure FixAlign;
    procedure HideAllBodies;
    procedure SetHeaderFooter(header, footer : string);
  public
    { Public declarations }
    //constructor Create(AControl: TComponent); override;   \
    procedure Hide;
    procedure SetHeader(header : string);
    procedure SetFooter(footer: string);
    procedure HideHeader;
    procedure ShowTooltip(s : string; Pos : TPoint; header : string = '';footer : string=  ''); overload;
    procedure ShowTooltip(pic : TPicture; Pos : TPoint; bytes: Cardinal; header : string = '';footer : string=  ''); overload;
    procedure ShowTooltip(ci : TClipITem; Pos : TPoint; header : string = '';footer:string=  '';usetimestamp:Boolean = false); overload;
    procedure ShowTooltipRichtext(s : string; Pos : TPoint; header : string =''; footer : string = '');
    procedure DodgePoint(pt : TPoint);

    property CloseOnLostFocus : boolean read fCloseOnLostFocus write fCloseOnLostFocus;
    property SmallFontOnce : boolean read fSmallFont write fSmallFont;
    property SingleLineOnce : boolean read fSingleLineOnce write fSingleLineOnce;
    //property OnClick : TNotifyEvent read fOnClickEvent write  fOnClickEvent;

    property MyShowing : boolean read fShowing write fShowing;
    property MaxWidth : integer read fMaxWidth write fMaxWidth;
    property MaxHeight : integer read fMaxHeight write fMaxHeight;

    property DodgeMouse : Boolean read fDodgeMouse write fDodgeMouse;
    property DoggeMouseX : Boolean read fDodgeX write fDodgeX;
    property MinWidth : integer read fMinWidth write fMinWidth;
  end;
var
  FrmTooltipNew: TFrmTooltipNew;

implementation

{$R *.dfm}


uses UnitMisc, UnitFrmConfig, GraphUtil, Math, UnitKeyboardQuery, UnitToken,
  UnitFrmSizeRichtext, UnitHTMLConvert;

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


   	Params.Style := WS_POPUP ;
    Params.ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST or WS_EX_NOACTIVATE;


    //params.ExStyle := {WS_EX_NOACTIVATE or} WS_EX_TOOLWINDOW or WS_EX_TOPMOST or WS_EX_COMPOSITED ;

    {WS_EX_TRANSPARENT screws up in WinXP - causing a blank redraw}
end;
procedure TFrmTooltipNew.WMActivate(Var msg:tMessage);
begin
	if not fCloseOnLostFocus then EXIT;

	if Msg.WParam = WA_INACTIVE then begin
    	if self.FirstPaint then begin
        	self.hide;
        end;
    end;
end;
procedure TFrmTooltipNew.WMNCHitTest(var Message: TWMNCHitTest);
begin
	inherited;

    if (message.result = HTCLIENT) and (KeyboardQuery.IsClicked(leftButton)) and not clicked then begin
        clicked := true;
    	CallEventSafe(Self.OnClick, self);
    end;
end;
procedure TFrmTooltipNew.FormCreate(Sender: TObject);
begin
	Application.ProcessMessages;
    fDodgeMouse := true;
    fMinWidth := 160;
    fDodgeX := true;
end;
procedure TFrmTooltipNew.FormHide(Sender: TObject);
begin
    Self.Visible := false;
    self.fShowing := false;
    ShowWindow(self.Handle, sw_hide);
end;
procedure TFrmTooltipNew.Hide;
begin
	self.FormHide(self);
end;


procedure TFrmTooltipNew.SetHeaderFooter(header, footer : string);
begin
    lblHeader.Visible := false;
    lblFooter.Visible := false;
    if FrmConfig.cbShowHeaderFooter.Checked then begin
        if header <> '' then SetHeader(header);
        SetFooter(footer);
    end;
end;
type mypanel = class(TPanel)
    function GetCanvas : TCanvas;
public
    property mycanvas : TCanvas read GetCanvas;
end;

function mypanel.GetCanvas : TCanvas;
begin
    Result := self.Canvas;
end;

procedure TFrmTooltipNew.FormPaint(Sender: TObject);
var
        Vertex : array[0..1] of TTriVertex;
        grect : TGradientRect;
        procedure SetColor(var v : TTriVertex; c : TColor; x,y : integer);
        var clr : TColor;
        begin
            v.x :=x;
            v.y :=y;
            clr := ColorToRGB(c);
            v.Red := GetRValue(clr) shl 8;
            v.Green := GetGValue(clr) shl 8;
            v.Blue := GetBValue(clr) shl 8;
        end;
var hue, sat, lum : word;
    c : TColor;
    r, r2 : TRect;
begin
    if lblFooter.Visible then begin
        r2:= lblFooter.boundsrect;
        Dec(r2.top,4);
        inc(r2.bottom,1);
        r2.Left := self.ClientRect.Left;
        r2.Right := self.ClientRect.Right;
        canvas.Brush.Color := clBtnFace;
        canvas.Pen.Color := clBlack;

        Canvas.Rectangle(r2);
    end;
    r := Self.ClientRect;

    if lblFooter.Visible then begin
        Dec(r.Bottom,lblFooter.Height+1);
    end;
	canvas.Brush.Color := clWhite;
    canvas.Pen.Color := clBlack;
    Canvas.Rectangle( r );

    r.top := lblheader.ClientRect.top;
    r.bottom := lblheader.ClientRect.bottom + 2;
    r.Left := 0;
    r.right := self.width;

    if lblHeader.Visible then begin
        c := ColorToRGB(clMenu);
        ColorRGBToHLS(c,hue,lum,sat);
        c := ColorHLSToRGB(hue,max(lum+15,0),sat);
        SetColor(vertex[0], c, r.Left, r.top);

        c := ColorToRGB(clMenu);
        ColorRGBToHLS(c,hue,lum,sat);
        c := ColorHLSToRGB(hue,max(lum,0),sat);
        SetColor(vertex[1], c , r.Right,
        r.top + trunc((r.bottom-r.top)/2));

        grect.UpperLeft := 0;
        grect.LowerRight := 1;

        GradientFill(
            Canvas.Handle,
            @Vertex,
            2,
            @grect,
            1,
            GRADIENT_FILL_RECT_V
        );

        c := ColorToRGB(clMenu);
        ColorRGBToHLS(c,hue,lum,sat);
        c := ColorHLSToRGB(hue,max(lum-20,0),sat);
        SetColor(vertex[0], c, r.Left,
        r.top + trunc((r.bottom-r.top)/2));

        c := ColorToRGB(clMenu);
        ColorRGBToHLS(c,hue,lum,sat);
        c := ColorHLSToRGB(hue,max(lum,0),sat);
        SetColor(vertex[1], c , r.Right, r.bottom);

        grect.UpperLeft := 0;
        grect.LowerRight := 1;

        GradientFill(
            Canvas.Handle,
            @Vertex,
            2,
            @grect,
            1,
            GRADIENT_FILL_RECT_V
        );


        Canvas.Brush.Color := clBtnText;
        Canvas.Brush.Style := bsClear;
        Canvas.Rectangle( r );
    end;

    if fTimeStamp then begin
        r := self.BoundsRect;
        r.Top := r.Bottom - self.Canvas.TextHeight(fTimeSTring);
        r.Left := 0;

        self.Canvas.Font.Size := 7;
        self.Canvas.Rectangle(r);
        Self.Canvas.TextOut(r.left, r.top, fTimeString);
    end;
    self.firstpaint := true;
end;

procedure TFrmTooltipNew.InitFonts;
const SMALLEST_FONT = 7;
begin
    lblHeader.Font := frmconfig.GetFont;
    lblheader.Font.size  := SMALLEST_FONT;


    lblbody.Font := frmconfig.GetFont;
    if fSmallFont then begin
        lblBody.font.size := SMALLEST_FONT;
        fSmallFont := false;
    end else begin
        lblBody.font.size := max(SMALLEST_FONT, lblBody.font.size - 1);
    end;
    self.firstpaint := false;

    rebody.font.Name := lblBody.Font.name;
    rebody.Font.Size := lblBody.Font.Size;
    reBody.SelStart := 0;
    reBody.SelLength := length(reBody.Text);
    reBody.SelAttributes.size := lblBody.font.size;

    self.Font := lblBody.Font;
end;
procedure TFrmTooltipNew.lblBodyClick(Sender: TObject);
begin
//    CallEventSafe(Self.OnClick, self);
end;
procedure TFrmTooltipNew.lblFooterClick(Sender: TObject);
begin
    CallEventSafe(Self.OnClick, self);
end;
procedure TFrmTooltipNew.lblHeaderClick(Sender: TObject);
begin
//    CallEventSafe(Self.OnClick, self);
end;
procedure TFrmTooltipNew.reBodyClick(Sender: TObject);
begin
    CallEventSafe(Self.OnClick, self);
end;

procedure TFrmTooltipNew.HideAllBodies;
begin
    imgBody.Visible := false;
    reBody.Visible := false;
    lblBody.Visible := false;
end;
CONST DODGE_Y = 10;
procedure TFrmTooltipNew.FixSize;
var wd : integer;
	r : TRect;
begin
    wd := 0;
    if lblHeader.Visible then inc(wd, lblheader.Height);
    if lblBody.Visible then inc(wd, lblBody.Height+3);
    if imgBody.Visible then Inc(wd, imgBody.Height+3);
    if reBody.Visible then inc(wd, reBody.Height+3);
    if lblFooter.Visible then Inc(wd, lblfooter.Height + 2);
    self.AutoSize := false;
    self.Height := wd;

    if (not SingleLineOnce) then begin
        if (self.fMaxHeight <> 0) and (self.Height > self.fMaxHeight) then begin
            wd := Self.Height - Self.fMaxHeight;
            if lblBody.Visible then lblBody.Height := lblBody.Height - wd;
            if imgBody.Visible then imgBody.Height := imgBody.Height - wd;
            if reBody.Visible then reBody.Height := reBody.Height - wd;

            self.Height := self.Height - wd;
        end;
        if self.fMaxWidth <> 0 then
            self.Width := min(self.Width, self.fMaxWidth);
    end;

    if lblHeader.Visible then begin
        self.Height := max(30, self.Height);
    end else begin
		self.Height := max(10, self.Height);
    end;
    if lblHeader.Visible and imgBody.Visible then begin
        self.Width := Max(130, self.width);
    end else if not (SingleLineOnce) then begin
        self.Width := Max(fMinWidth, self.width);
    end;



{    if lblFooter.Visible then
        self.Height := Self.Height + lblFooter.Height;
 }
    r.Top := self.Top;
    r.Left := self.Left;
    r.Bottom := self.Top + self.Height;
    r.right := self.Left + self.width;


    if r.Right > screen.DesktopRect.right then begin
       wd := screen.DesktopRect.right - r.right;
       inc(r.left, wd);
       inc(r.Right, wd);
    end;

    if (r.Bottom > screen.DesktopRect.Bottom) {and fDodgeMouse} then begin
        wd := r.bottom - r.top;
        r.Top := screen.DesktopRect.Bottom - r.Height;
        r.Bottom := r.Top + wd;

        if fDodgeMouse then
            if PtInRect(r,fPoint) or PtInRect(r,point(fPoint.X, fPoint.Y+DODGE_Y)) then begin
                if assigned(OnClick) then begin
                    {fudge up above the mouse}
                    wd := r.bottom - r.top;
                    r.top := mouse.cursorpos.Y - (wd+18);
                    r.bottom := r.top + wd;
                end else begin
                    {fudge to the right if it falls off the bottom and the point is in the window}
                    if (mouse.CursorPos.x > r.left) and (mouse.CursorPos.x < r.right) and
                        (r.right+(mouse.CursorPos.x-r.left) < screen.DesktopRect.right) then begin
                            inc(r.Right, (mouse.CursorPos.x-r.left)+40);
                            inc(r.left,  (mouse.CursorPos.x-r.left)+40);
                    end else begin
                        {fudge up above the mouse - last resort}
                        wd := r.bottom - r.top;
                        r.bottom := mouse.cursorpos.Y - 25;
                        r.Top := r.bottom - wd;
                    end;
                end;
            end;
    end else if PtInRect(r, mouse.CursorPos) then begin
        if fDodgeMouse and fDodgeX then
        if (mouse.CursorPos.x > r.left) and (mouse.CursorPos.x < r.right) then begin
             	if r.right+(mouse.CursorPos.x-r.left) < screen.DesktopRect.right then begin
                    inc(r.Right, (mouse.CursorPos.x-r.left)+40);
					inc(r.left,  (mouse.CursorPos.x-r.left)+40);
                end;
            end;
    end;

    self.Top := r.Top;
    self.Left := r.Left;
end;
procedure TFrmTooltipNew.FixAlign;
begin
    lblBody.top := 0;
    imgBody.Top := 0;
    reBody.Top := 0;
    lblHeader.Top := 0;
end;
procedure TFrmTooltipNew.SetPosition(pos : TPoint);
begin
    self.top := pos.Y;
    self.left := pos.X;
end;
procedure TFrmTooltipNew.ShowSelf;
var left, top : integer;
begin
    clicked := false;

	self.FixSize;
    self.FixAlign;
    fSingleLineOnce := false;
    left := self.Left;
    top := self.top;
    SetWindowPos(self.Handle,HWND_TOPMOST,self.left,self.top,self.width,self.Height,SWP_SHOWWINDOW or SWP_NOACTIVATE);
    Self.Visible := true;
    self.fShowing := true;

    if self.Left <> left then
        self.Left := left;

    if self.Top <> top then
        self.top := top;
end;

procedure TFrmTooltipNew.SetHeader(header : string);
begin
	if header <> '' then begin
        lblHeader.Visible := true;
    end;
    lblHeader.Caption := header;
end;
procedure TFrmTooltipNew.SetFooter(footer: string);
begin
    lblFooter.Visible := (footer <> '');
    lblfooter.Caption := footer;
end;
procedure TFrmTooltipNew.HideHeader;
begin
	lblHeader.Visible := false;
end;

procedure TFrmTooltipNew.ShowTooltip(s : string; Pos : TPoint; header : string = '';footer : string=  '');
var
	r : TRect;
    i : integer;
    str, line : string;

    MaxWidth : integer;
const NO_BREAK_SPACE = Char($00A0);
    procedure ReplaceWhiteSpaceAndTrim;
    begin
        if s = '' then begin
            lblBody.Canvas.Font.Style := lblBody.Canvas.Font.Style + [fsItalic];
            s := '[empty]';
        end;

        s := LeftStr(s, 2000); // max character length
        s := TrimRight(s);
        s := StringReplace(s,#9,'    ',[rfReplaceAll]);
         s := StringReplace(s,' ',NO_BREAK_SPACE,[rfReplaceAll] );
    end;
    function AppendIt(line : string) : string;
    begin
    	line := ReplaceStr(line,' ',NO_BREAK_SPACE); //nobreakspace

    	if lblBody.Canvas.TextWidth(line + NO_BREAK_SPACE) < (MaxWidth) then begin
            while lblBody.Canvas.TextWidth(line + NO_BREAK_SPACE) < (MaxWidth) do begin
                line := line + NO_BREAK_SPACE;
            end;
            line := line + ' ';
        end;

    	if str = '' then begin
            str := line;
        end else begin
        	str := str + #13#10 + line;

        end;
    end;
begin
	MaxWidth := self.fMaxWidth - 20;
	fPoint := pos;
	InitFonts;

    SetHeaderFooter(header, footer);
    SetPosition(pos);
    ReplaceWhiteSpaceAndTrim;
    self.HideAllBodies;

    lblBody.Visible := true;
    lblBody.Align := alNone;

	self.AutoSize := false;
    self.Width := 150;

    lblBody.Height := 15;
    lblBOdy.width := 150;
    if (SingleLineOnce) then begin
        lblBody.Width := 10;
    end;
    lblBody.WordWrap := false;
    lblBody.AutoSize := true;
    lblBody.Caption := s;

    if (not fSingleLineOnce) and (self.fMaxWidth<>0) and (lblBody.Width > (MaxWidth)) then begin
        s := StringReplace(s,NO_BREAK_SPACE,' ', [rfReplaceAll] );
    	lblBody.Width := self.fMaxWidth-4;
        r.Width := self.fMaxWidth-4;
        line := '';
        str := '';
        for i := 1 to length(s) do begin
        	if (s[i] = #13) then begin
            end else if (s[i] = #10) then begin
            	AppendIt(line);
                line := '';
            end else begin
            	line := line + s[i];
            end;

            lblBody.Caption := line;
            if lblBody.Width >= MaxWidth then begin
            	line := leftstr(line, length(line)-1);
                AppendIt(line);
                line := s[i];
            end;
            if i = length(s) then begin
            	AppendIt(line);
            end;
        end;

        lblBody.Width := self.fMaxWidth-4;
        lblBody.WordWrap := true;
        lblBody.Width := self.fMaxWidth-4;
        lblBody.Caption := str;
        lblBody.autosize := false;
    end else begin
        lblBody.autosize := true;
        lblBody.autosize := false;

        lblBody.caption := lblBody.caption;
    end;

    if (lblBody.Width < 220) and (self.fMaxWidth > 220) and lblHeader.Visible then begin
        lblBody.width := 220;
    end;

    lblBody.AutoSize := false;
    lblBody.Height := lblBody.Height + 4;

    self.Width := lblBody.Width + 6;
    self.Autosize := true;
    self.AutoSize := false;

//    self.Width := max(100, self.Width);
    if lblHeader.Visible then begin
    	self.width := max(self.width, lblHeader.canvas.textwidth(lblheader.caption)+15);
    end;

    self.Height := lblbody.Height + 9;
    if lblHeader.Visible then begin
    	self.Height := self.Height + lblheader.Height;
    end;
    if lblFooter.Visible then begin
    	self.Height := self.Height + lblFooter.Height;
    end;

    lblBody.Align := altop;

    self.ShowSelf;
end;
procedure TFrmTooltipNew.ShowTooltip(pic : TPicture; Pos : TPoint; bytes: Cardinal; header : string = '';footer : string=  '');
var
    iw,ih,iratio : double;
begin
	fPoint := pos;
	InitFonts;
	SetHeaderFooter(header, footer);
	SetPosition(pos);
    Self.HideAllBodies;
	imgBody.Visible := true;
    self.AutoSize := false;
    imgBody.Align := alnone;

    if (pic.Width = 0) or (pic.Height = 0) then begin
        EXIT;
    end else begin
        iw :=  FrmConfig.UDToolWidth.Position / pic.width;
        ih :=  FrmConfig.UDToolHeight.Position / pic.Height;
        if lblheader.Visible then begin
        	ih :=  (FrmConfig.UDToolHeight.Position - lblheader.height) / pic.Height;
        end;
    end;
    iratio := min(iw, ih);
    if iratio > 1 then iratio := 1.0;

    lblheader.caption := Format('Pic (%d x %d)',[pic.Width, pic.height]) + ' ' +
        IntToStr(Max(1,bytes div 1024)) + 'KB';


    imgBody.Width := trunc(pic.Width * iratio);
    imgBody.Height := trunc(pic.Height * iratio);

    self.Width := max(imgbody.Width, lblheader.canvas.textwidth(lblheader.caption));
    self.Width := max(100, imgBody.Width);

    with imgBody.Picture.Bitmap do begin
        width := imgBody.Width;
        height := imgBody.Height;
        SetStretchBltMode(Canvas.Handle, STRETCH_HALFTONE);
        StretchBlt(
            Canvas.Handle,
            0,0,imgBody.Width,imgBody.Height,
            pic.Bitmap.Canvas.Handle,
            0,0,pic.Width,pic.Height,
            SRCCOPY
        );
    end;
    self.AutoSize := false;

    imgBody.Align := altop;
    self.Height := 10;
    self.AutoSize := true;
    self.AutoSize := false;
    self.Height := self.Height + 2;

    self.ShowSelf;
end;
procedure TFrmTooltipNew.ShowTooltipRichtext(s : string; Pos : TPoint; header : string =''; footer : string = '');
var r : TRect;

begin
    SetHeaderFooter(header, footer);
    self.SetPosition(pos);

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

    // WORKAROUNDS
    // - the first text is always plaintext
    // - the first call to richtext doesn't trigger the resize data
    reBody.PlainText := false;
    reBody.Text := s;
    InitFonts;
    reBody.Text := s;
    InitFonts;

    if not frmSizeRichtext.SetRichtext( rebody.font, s ) then
        frmSizeRichtext.SetRichtext( rebody.font, s );
    r := frmSizeRichtext.SizeRect;


    rebody.Align := alNone;
    rebody.width := r.Width;
    reBody.Height := Max(r.Height, 10);
    reBody.Height := reBody.Height + 2;

    self.Width := reBody.Width + 6;
    self.Width := max(150, self.Width);

    self.Height := rebody.height;
    if lblHeader.Visible then begin
    	self.Height := self.Height + lblheader.Height;
    end;
    if lblFooter.Visible then begin
    	self.Height := self.Height + lblFooter.Height;
    end;
//    self.Height := self.Height + 5;

    rebody.Align := altop;
    self.ShowSelf;
end;
procedure TFrmTooltipNew.ShowTooltip(ci : TClipITem; Pos : TPoint; header : string = '';footer : string=  '';usetimestamp:Boolean=false);
var pic : TPicture;
    df : string;
    s : string;
begin
    fTimeStamp := usetimestamp;
    fsize := ci.GetDataSize;
    if fTimeStamp then begin
        footer := '';
        // short date with no year
        df := 'mmm dd';
        fTimeSTring := FormatDateTime(df, ci.CData.GetCreationDate);
        footer := ftimestring;
        fTimeSTring := FormatDateTime(LongTimeFormat, ci.CData.GetCreationDate);
        footer := footer + ' ' + ftimestring;

        if ci.GetFormatType in [FT_UNICODE,FT_HTML, FT_RICHTEXT, FT_FILE] then begin
            if ci.GetFormatType in [FT_UNICODE] then begin
                footer := footer + '  ' + '('+IntToStr(fsize div 2)+' chars)';
            end else begin
                footer := footer + '  ' + '('+IntToStr(fsize)+' bytes)';
            end;
            header := trim(UnitToken.CutWord(header,'('));
        end else begin
            //footer := footer + '  ' + '('+IntToStr(fsize div 2)+' chars)';
        end;
    end;


	case ci.GetFormatType of
    FT_UNICODE: begin
        self.showtooltip(ci.GetAsPlaintext, Pos, header,footer);
    end;
    FT_PICTURE: begin
    	pic := TPicture.Create;
    	ci.GetDIB(pic);
    	self.ShowTooltip(pic, pos, ci.GetDataSize, header, footer);
        pic.Free;
    end;

    else begin
        if (ci.HasRichShadow) and FrmConfig.cbTooltipRichText.Checked then begin
            ci.GetRichTextShadow(s);
            self.ShowTooltipRichtext(s, pos, header, footer);
        end else if FrmConfig.cbTooltipRichText.Checked and (ci.GetFormatType = FT_RICHTEXT) then begin
            ci.GetRichText(s);
            self.ShowTooltipRichtext(s, Pos, header, footer);
        end else begin
            s := ci.GetAsPlaintext;
            if (s<>'') then begin
                self.ShowTooltip(s, pos, header,footer);
            end else begin
                ci.GetUTF8Text(s);
                self.ShowTooltip(s, pos, header, footer);
            end;
        end;
    end;
    end;
end;

procedure TFrmTooltipNew.DodgePoint(pt : TPoint);
var
    m : TMonitor;
begin
    m := screen.MonitorFromPoint(pt);
    self.Top := pt.Y - 10 - self.Height;
    if (m <> nil) then begin
        if self.Top < m.Top then begin
            self.Top := m.Top;
        end;

        if Self.Top+self.height > m.BoundsRect.Bottom then begin
            self.Top := Mouse.CursorPos.Y - (self.Height + 18);
        end;
    end;
end;

procedure TFrmTooltipNew.TimCloseTimer(Sender: TObject);
begin
	timClose.Enabled := false;
	self.free;
end;

end.
