unit UnitFrmDummyUnicodeTooltip;

{
    Purpose:
        Gather up all the logic needed to display Unicode in a Tooltip
        I have to parasite The TTooltip to a form so it can specify
        the NotifyFOrmat

}
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, GraphUtil,

  UnitTWideChar, UnitClipQueue, Vcl.StdCtrls, UnitMisc;




type TTooltipWindow = class(THintWindow)
    private
        ShowingHint : boolean;
        MaxWidth : Integer;
        MaxHeight : integer;
        UseLocalMax : boolean;
        RestrictSize : boolean;
        MaxSuprassed : boolean;

        hwndTip : THandle;
        LastPoint : TPoint;
        fOnClick : TNotifyEvent;

        fMouseDown : boolean;
        fMouseHover : boolean;

        procedure WMNCHitTest(VAR Msg: TWMNcHitTest);  message WM_NCHITTEST;
        procedure InitFont;
    protected
        HittestActive : boolean;
        procedure paint; reintroduce; override;
        procedure AlterSizePosition(var r : TRect; Pos : TPoint);virtual;
        //procedure WMNCHitTest(VAR Msg: TWMNcHitTest);  message WM_NCHITTEST;
    public
        constructor Create; reintroduce;
        destructor Destroy; override;

        procedure SetMaxWidth(max : cardinal);
        procedure SetMaxHeight(max : cardinal);
        procedure ShowTooltip(s : string; Pos : TPoint; UseHelpString : boolean = true;header : string = ''); overload;virtual;
        procedure ShowTooltip(ci : TClipItem; Pos : TPoint; header : string = '';usehelpstring : boolean = true); overload;virtual;
        procedure ShowTooltip(inwc : TWideChar; Pos : TPoint; UseHelpString : boolean = true; header : string = ''); overload;virtual;
        procedure ShowTooltip(pic : TPicture; Pos : TPoint; header : string = ''); overload;virtual;
        procedure CloseTooltip(fade : boolean = false);

        function IsShowing : boolean;
        function IsHit(Pos : TPoint) : boolean;
        procedure EnforceSizeRestriction(value : boolean);
        function SizeWasRestricted : boolean;

    property OnClick : TNotifyEvent read fOnClick write fOnClick;

end;



type TTooltipDragWindow = class(TTooltipWindow)
    // these can't be public because they're overloaded
    private

        lastClip : TClipItem;
        procedure HandleUserInput;
        procedure WMNCHitTest(VAR Msg: TWMNcHitTest);  message WM_NCHITTEST; 
        procedure WMResize(var ms : TWMSizing); message WM_SIZING;
    protected
        {$hints off}
        procedure ShowTooltip(s : string; Pos : TPoint; UseHelpString : boolean = true;header : string = '');overload;override;
        procedure ShowTooltip(ci : TClipItem; Pos : TPoint; header : string = '';usehelpstring : boolean = true);overload;override;
        procedure ShowTooltip(inwc : TWideChar; Pos : TPoint; UseHelpString : boolean = true; header : string = '');overload;override;
        procedure ShowTooltip(pic : TPicture; Pos : TPoint; header : string = '');overload;override;

        {$HINTS on}
        procedure AlterSizePosition(var r : TRect; Pos : TPoint);override;


    public
        constructor Create; reintroduce;

end;


type
  TFrmDummyUnicodeTooltip = class(TForm)
    Image1: TImage;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }

    LastHint : string;
    LastClipItem : TClipItem;
    TooltipWindows : TTooltipWindow;
    wc : TWideChar;


    {For Unicode Popup}
    procedure WMNotifyFormat(var msg : TWMNotifyFormat); message WM_NOTIFYFORMAT;
    procedure WMNotify(var msg : TWMNotify); message WM_NOTIFY;


  public
    procedure SetLastClip(ci : TClipItem); overload;
    procedure SetLastClip(s : string); overload;
    procedure SetLastClip(wcc : TWideChar); overload;

    { Public declarations }
  end;

var
  FrmDummyUnicodeTooltip: TFrmDummyUnicodeTooltip;


implementation

{$R *.dfm}

uses CommCtrl, Math, StrUtils, UnitFrmConfig, UnitKeyboardQuery, System.UITypes,
  UnitFrmDebug;
//const HELP_STRING = 'shift+click to preview  |  right-click for item menu';

const HELP_STRING =   '    right-click for Clip Menu   ';

{ TTooltipWindow }

procedure TTooltipWindow.paint;
begin

end;

procedure TTooltipWindow.CloseTooltip(fade : boolean = false);
var ti : TOOLINFOW;
begin
    Windows.SetLastError(ERROR_SUCCESS);

    if fade then begin
    end;

    self.ReleaseHandle;
    self.ShowingHint := false;

    if (hwndTip <> 0) then begin
        fillchar(ti, sizeof(ti), #0);
        ti.cbSize := sizeof(TOOLINFO);
        ti.uFlags   := TTF_SUBCLASS;
        ti.hInst := hInstance; // ??

        // only hwndTip, .uId, cbSize are used, all else is ignored
        SendMessage(hwndTip, TTM_TRACKACTIVATE, Integer(false), Integer(@ti));

        Windows.DestroyWindow(hwndTip);
    end;


    hwndTip := 0;
end;

constructor TTooltipWindow.Create;
begin
    inherited Create(FrmDummyUnicodeTooltip);

    // Stated to correct problems in older Delphi versions
    // Like adding controls and hopefully accepting clicks



    //self.MaxWidth := 300;
    self.Width := 220;
    //MaxHeight := 200;
    self.Font.Name := 'Arial';
    self.Color := Graphics.clInfoBk;

    if assigned(frmconfig) then begin
        self.MaxWidth := FrmConfig.UDToolWidth.Position;
        self.MaxHeight := FrmConfig.UDToolHeight.Position;
    end;


end;

destructor TTooltipWindow.Destroy;
begin
  inherited;
end;

procedure TTooltipWindow.EnforceSizeRestriction(value: boolean);
begin
    self.RestrictSize := value;
end;

procedure TTooltipWindow.SetMaxHeight(max: cardinal);
begin
    Maxheight := max;
end;

procedure TTooltipWindow.SetMaxWidth(max: cardinal);
begin
    MaxWidth := max;
end;


procedure TTooltipWindow.AlterSizePosition(var r: TRect; Pos : TPoint);
var wd : integer;
    w,h : integer;
begin
	self.fMouseDown := false;
    self.fMouseHover := false;

    self.MaxSuprassed := false;
    if not UseLocalMax then begin
        w := FrmConfig.UDToolWidth.position;
        h := FrmConfig.UDToolHeight.position;
    end else begin
        w := self.MaxWidth;
        h := self.MaxHeight;
    end;

    if  w <> 0 then begin
        if (r.right - r.left) > w then
            self.MaxSuprassed := true;
    end;
    if (r.Bottom - r.Top) > h then begin
        self.MaxSuprassed := true;
    end;

    {if self.RestrictSize = false then begin
        h := round(h * 1.1);
        w := round(w * 1.2);
    end;
    }
    if  w <> 0 then begin
        if (r.right - r.left) > w then
            r.right := r.left + w;
    end;
    if (r.Bottom - r.Top) > h then begin
        r.bottom := r.top + h;
    end;

    inc(r.Top, Pos.y );
    inc(r.Bottom, Pos.Y );
    inc(r.Left, Pos.X );
    inc(r.right, Pos.X );


    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) then begin
        wd := screen.DesktopRect.bottom - r.bottom;
        inc(r.top, wd);
        inc(r.Bottom, wd);
        if PtInRect(r,pos) or PtInRect(r,point(pos.X,pos.Y+16)) 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) 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;


        end;
    end else if PtInRect(r,pos) then begin
        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;


end;


procedure TTooltipWindow.ShowTooltip(s : string; Pos : TPoint;UseHelpString : boolean = true; header : string = '');
var wc : TWideChar;
begin
    wc := TWideChar.Create;
    wc.AppendUnicode(s);

    self.ShowTooltip(wc,pos,usehelpstring,header);

    wc.clear;
    myfree(wc);
end;

procedure TTooltipWindow.ShowTooltip(pic: TPicture; Pos: TPoint; header : string = '');
var
    r : TRect;
    wd, ht, headerht, headerwd : integer;
    iratio, iw, ih : double;
begin
    if self.ShowingHint then EXIT;
    self.ShowingHint := true;

    self.InitFont;
    self.Canvas.Font.Size := 8;

    self.lastpoint := pos;
    self.canvas.Refresh;
{    if not self.UseLocalMax  then begin
        wd := min(FrmConfig.UDToolWidth.Position, pic.Width);
        ht := min(FrmConfig.UDToolHeight.Position, pic.Height);
    end else begin
        wd := self.MaxWidth;
        ht := self.MaxHeight;
    end;
}

    // choose the smallest ratio (represening the largest shrink in dimension)
    //iw := 0.0; ih := 0.0;

    if (pic.Width=0) or (pic.Height =0) then begin
        exit;
    end else begin
        if not self.UseLocalMax  then begin
            iw :=  FrmConfig.UDToolWidth.Position / pic.width;
            ih :=  FrmConfig.UDToolHeight.Position / pic.Height;
        end else begin
            iw :=  self.MaxWidth / pic.width;
            ih :=  self.MaxHeight / pic.Height;
        end;
    end;
    iratio := min(iw, ih);


    if iratio > 1 then iratio := 1.0;

    wd := trunc(pic.Width * iratio);
    ht := trunc(pic.Height * iratio);
    wd := max(100, wd);
    ht := max(20, ht);


    r.Left := 0;
    r.right := min(wd,pic.width) + 2;
    r.Top := 0;
    r.bottom := (ht + 2);
    self.caption := '';
    self.AlterSizePosition(r, pos);
    headerht := 0;
    headerwd := 0;
    if header <> '' then begin
    	headerht := canvas.TextHeight('AZ');
        headerwd := canvas.TextWidth(header);
        inc(ht, headerht);
    end;


    SetWindowPos(Handle, HWND_TOPMOST, R.Left, R.Top, max(wd,headerwd)+4, ht,
      SWP_NOACTIVATE);

    ShowWindow(Handle, SW_SHOWNOACTIVATE);
    r := self.ClientRect;
    inc(r.Left, 1);
    inc(r.Top, 1);
    dec(r.Right, 1);
    dec(r.Bottom, 1);

    inc(r.Top, headerht);
    r.Right := r.Left + min(wd,pic.Width);

    self.Canvas.FillRect(self.Canvas.ClipRect);
    self.canvas.StretchDraw(r, pic.Bitmap);
    self.Canvas.Brush.Color :=     self.Color;;


    if header <> '' then begin

        SetBkMode(canvas.Handle, TRANSPARENT);
        self.Canvas.TextOut(0,0, header);
    end;

    application.ProcessMessages;
end;




function TTooltipWindow.SizeWasRestricted: boolean;
begin
    result := self.MaxSuprassed;
end;

procedure TTooltipWindow.WMNCHitTest(var Msg: TWMNcHitTest);
begin
    msg.result := HTNOWHERE;
    if self.IsHit( point(msg.XPos, msg.YPos)) then begin
        msg.Result := HTCLIENT;
        {only trigger a click if the mouse enters the window unpressed and is pressed}
        if (KeyboardQuery.IsClicked(leftbutton)) then begin
        	if not fMouseDown and fMouseHover then begin
            	fMouseDown := true;
            end;
        end else if fMouseDown then begin
        	fMouseDown := false;
			if assigned(OnClick) then OnClick(self);
        end else begin
            fMouseHover := true;
        end;
    end;
end;

procedure TTooltipWindow.ShowTooltip(inwc: TWideChar; Pos: TPoint;UseHelpString : boolean = true; header : string = '');
var r : TRect;
    rhead, rbody : TRect;
    wc : TWideChar;
    fs : TFontStyles;
    fsz : integer;
    topper : string;
    textformat : cardinal;

const TTS_BALLOON = $40;

    function MeasureText(p : pointer; size : cardinal; wordbreak : boolean = true) : TRect; overload;
    var tf : cardinal;
        name : string;



        wd, ht : integer;
    begin

        name := self.canvas.Font.Name;

        //GetObject(self.Font.Handle, sizeof(lf), @lf);
        //f := CreateFontIndirect(lf);
        //oldf := Windows.SelectObject(self.Canvas.Handle, f);

        wd := frmconfig.UDToolWidth.position;
        ht := frmconfig.UDToolHeight.Position;
        if self.UseLocalMax  then begin
            wd := self.MaxWidth;
            ht := self.MaxHeight;
        end;
        result := Rect(0, 0, wd , ht);
        tf := DT_CALCRECT or textformat;
        if not wordbreak then tf := tf or DT_CENTER or DT_BOTTOM or DT_SINGLELINE ;

        DrawTextW(
            self.Canvas.Handle, p, -1,
            result,
            tf
        );

        inc(result.Right, 7);  // don't understand, but the "close" measurement
        // is off by a little bit
        // but is off even worse when a font is not selected

        //h := SelectObject(self.Canvas.Handle, oldf);
        //DeleteObject(h);
    end;

    function MeasureText(widetext : TWideChar; text : string = ''; wordbreak : boolean = true) : TRect; overload;
    var dofree : boolean;
    begin
        dofree := false;
        if widetext = nil then begin
            widetext := TWideChar.Create;
            widetext.AppendUnicode(text+#0);
            dofree := true;
        end;

        result := MeasureText(widetext.memory, widetext.size, wordbreak);

        //self.AlterSizePosition(result, Pos);
        //inc(result.left,4); dec(result.right,4);
        //inc(result.top,4); dec(result.bottom,4);

        //inc(result.left,4);inc(result.right,2);
        if dofree then begin
            widetext.clear;
            MyFree(widetext);
        end;
    end;





const HEADER_SPACER = 8;


    procedure DoHeader;
    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;


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

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

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

        Windows.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, rhead.Left, rhead.top + trunc((rhead.bottom-rhead.top)/2));

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

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

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


    end;

    procedure MeasureBodyText;







    begin

        rbody := MeasureText(wc);
{
        wc2 := TWideChar.Create;
        ms := wc.GetMemoryStream;
        if (ms.Size > 1000) then begin
            ms.SetSize(1000);
            b[0] := 0;
            ms.Write(b[0], sizeof(b[0]));
        end;

        maxw := frmconfig.UDToolWidth.Position;
        if self.UseLocalMax then begin
            maxw := self.MaxWidth;
        end;
        if (self.RestrictSize = false) then begin
            //maxw := trunc(maxw * 1.2);
        end;
        if (rbody.right-rbody.left) > maxw  then begin
            ms2 := TMemoryStream.Create;
            ms.Seek(0,soFromBeginning);

            repeat
                i := ms.Read(b,Sizeof(b[0]));
                last := b[0];

                if i <> 0 then begin
                    wc2.GetMemoryStream.Write(b[0],i);
                    ms2.Write(b[0],i);
                    b[0] := 0;
                    wc2.GetMemoryStream.Write(b[0],i); // null terminate

                    // measure then remove the last character
                    line := MeasureText(wc2.memory, wc2.GetMemoryStream.size);
                    wc2.GetMemoryStream.SetSize(wc2.GetMemoryStream.Size - sizeof(b[0]));

                    // write and react when the line is too big
                    if ((line.right-line.left) > maxw) then begin

                        // remove the last character
                        wc2.GetMemoryStream.SetSize(wc2.GetMemoryStream.Size - sizeof(b[0]));
                        ms2.SetSize(ms2.Size - sizeof(b[0]));

                        // add a newline
                        b[0] := ord(#13);
                        b[1] := ord(#10);
                        wc2.GetMemoryStream.Write(b[0], sizeof(b[0]) * 2);
                        ms2.Write(b[0],sizeof(b[0]) * 2);

                        // re-add the last character on the new line
                        wc2.Clear;
                        b[0] := last;
                        ms2.Write(b[0],sizeof(b[0]));
                        wc2.GetMemoryStream.Write(b[0],sizeof(b[0]));

                        inc(linecount);
                    end;
                end else begin
                     b[0] := 0;
                    wc2.GetMemoryStream.Write(b[0],i); // null terminate
                end;

            until (i = 0);

            wc.Clear;
            wc.GetMemoryStream.Write(ms2.Memory^, ms2.size);
            rbody := MeasureText(wc);
            ms2.Clear;
            myfree(ms2);
        end;
        wc2.Clear;
        myfree(wc2);
}
    end;
begin
    if self.ShowingHint then EXIT;
    self.ShowingHint := true;

    self.InitFont;

    Windows.SetLastError(ERROR_SUCCESS);

    textformat := DT_VCENTER or DT_MODIFYSTRING or DT_LEFT or  DT_EXPANDTABS or
    DT_NOPREFIX or DT_INTERNAL {use system font} or DT_EDITCONTROL or DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly;

    wc := TWideChar.Create;
    topper := '';
    if (UseHelpString) then begin
        topper := HELP_STRING + '  ('+ IntToStr(inwc.StrLength)  +' chars)';
    end;
    if header <> '' then begin
        UseHelpString := true;
        if topper <> '' then begin
            topper := topper + #13#10+ '[Hotkey: ' + header +']';
        end else begin
            topper := header;
        end;
    end;


    //wc.append(#13#10);
    wc.Append(inwc);
    wc.Append(#0);
    {if wc.StrLength > 200 then begin
        wc.LeftStr(200);
    end;
    }
    FrmDebug.AppendLog('ShowTooltip(wc,pos)');
    self.LastPoint := pos;

    fs := self.Canvas.Font.style;
    //self.Canvas.Font.Style := self.Canvas.Font.Style + [fsBold];
    fsz := self.Canvas.Font.Size;

    fs := self.canvas.font.style;
    self.canvas.font.style := [];





    MeasureBodyText;

    inc(rbody.bottom, 4);

    r := rbody;
    if UseHelpString then begin
    	self.Canvas.Font.Size := 8;
        rhead := MeasureText(nil, topper);
        self.Canvas.Font.Size := fsz;
        inc(rhead.bottom, 1);

        r.top := rhead.Top;
        r.Bottom := rhead.bottom + (rbody.bottom-rbody.top) + 6 + HEADER_SPACER;
        r.Left := min(r.left, rhead.left);
        r.Right := max(r.Right, rhead.right) + 8 ;

        rbody.left := r.left;
        rbody.Right := r.right;

        rhead.Right := r.right;
        rhead.Left := r.Left;

        rbody.top :=  rhead.bottom + HEADER_SPACER;
        inc(rbody.bottom, rhead.bottom + HEADER_SPACER + 11);
    end;
    AlterSizePosition(r, pos);
    inc(r.Bottom,10);

    FrmDummyUnicodeTooltip.SetLastClip(wc);

    //FillRect(self.Canvas.Handle, rhead, self.Canvas.Brush.Handle);
    //FillRect(self.Canvas.Handle, r, self.Canvas.Brush.Handle);

    SetWindowPos(Handle, HWND_TOPMOST, R.Left, R.Top, r.Right-r.left, r.bottom-r.top,
      SWP_NOACTIVATE);
    ShowWindow(Handle, SW_SHOWNOACTIVATE);
    r := self.ClientRect;




    // body
    Canvas.Brush.Color := clWindow;  // or whatever color is appropriate
    canvas.fillRect(r);

    // header
    //Canvas.Brush.color := clInactiveCaption;
    //Canvas.FillRect(rhead);

    if UseHelpString then begin
        DoHeader;

        // dark line
        Canvas.Brush.Color := clBtnText;
        Canvas.Brush.Style := bsClear;

        Canvas.Rectangle( rhead );
    end;





    //Canvas.Brush.Style := bsClear;
    // NOTE: without a concatonated string, this routine crashes
    //

    //canvas.Font.Color := clInactiveCaptionText;
    canvas.Font.Color := clMenuText;
    inc(rhead.Top,1);

    {j := rhead.Right-rhead.left;
    i := (rbody.Right-rbody.left) - j;
    if (i>0) then begin
    	rhead.left := 0 + (i div 2);
        rhead.Right := rhead.left + j;
    end;
    }
    self.Canvas.Font.Size := 8;
    DrawText(self.Canvas.Handle, PChar(topper+ ' '), length(topper+ ' '), rhead, (textformat or DT_VCENTER {or DT_CENTER}));
    self.Canvas.Font.Size := fsz;

    canvas.Font.Color := clWindowText;
    Canvas.Brush.Style := bsClear;



    inc(rbody.left, 1); inc(rbody.right,3);
    rbody.Right := rbody.Right - 15;
    inc(rbody.bottom,10);
    //rbody.Bottom := rbody.Top + 10;
    {DrawTextW(
        self.Canvas.Handle, wc.memory, -1,
        rbody,  textformat or DT_CALCRECT);
    dec(rbody.top, 6);}
    DrawTextW(
        self.Canvas.Handle, wc.memory, -1,
        rbody,  textformat);
    self.Canvas.Font.style := fs;


    {
    //
    // Set the size & text callback options
    //

    fillchar(ti, sizeof(ti), #0);
    ti.cbSize := sizeof(TOOLINFO);
    ti.uFlags := TTF_SUBCLASS or TTF_ABSOLUTE or TTF_TRACK;
    // Send messages to us and use the ti.rect for placement
    ti.hwnd := FrmDummyUnicodeTooltip.handle;
    ti.uId := 0;

    ti.lpszText := LPSTR_TEXTCALLBACKw;
    ti.hInst := hInstance;

    ti.rect.Top  := r.top;
    ti.rect.Bottom  := r.Bottom;
    ti.rect.Right  := r.Right;
    ti.rect.Left   := r.Left;
    //self.Left := r.Left;

    //
    // Create, set max width, activate, and set position
    //
    hwndTip := CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, nil,
                  TTS_ALWAYSTIP or TTS_NOPREFIX or WS_POPUP,
                  0,0,0,0, FrmDummyUnicodeTooltip.handle, 0, hInstance, nil);


    SetWindowPos(hwndTip, HWND_TOPMOST, r.Left,r.top, r.Right-r.left,r.Bottom-r.top,
         SWP_NOACTIVATE);

    SendMessage(hwndTip, TTM_SETMAXTIPWIDTH, 0, Self.MaxWidth);
    // ignored is text has no spaces - so dumb

    SendMessage(hwndTip, TTM_ADDTOOL, 0, Integer(@ti));
    if pos.X + (r.Right - r.left) > screen.DesktopWidth then begin
        pos.x := screen.DesktopWidth-(r.Right - r.left) ;
    end;
    SendMessage(hwndTip, TTM_TRACKPOSITION, 0, MakeLong(pos.x, pos.y));
    SendMessage(hwndTip, TTM_TRACKACTIVATE, Integer(true),
        Integer(@ti));
    }

    wc.Clear;
    MyFree(wc);
end;

procedure TTooltipWindow.ShowTooltip(ci: TClipItem; Pos : TPoint;header : string = ''; usehelpstring : boolean = true);
var wcc : TWideChar;
    pic : TPicture;

begin
    Windows.SetLastError(ERROR_SUCCESS);
    self.LastPoint := pos;



    if ci.GetFormat = CF_DIB then begin
        FrmDummyUnicodeTooltip.SetLastClip(ci);
        pic := TPicture.Create;
        ci.GetDIB(pic);
        self.ShowTooltip(pic, pos, header);
        myfree(pic);
        pic.free;
        EXIT;
    end;

    //
    // Only Unicode items are show directly in this method
    //


    if (ci.getformat = 0) then begin
        self.ShowTooltip('[empty]',pos,usehelpstring,header);
        EXIT;
    end;

    //
    // Set size based on size of text
    //
    wcc := TWideChar.Create;
    wcc.AppendUnicode(ci.GetAsPlaintext);

    self.ShowTooltip(wcc, pos, usehelpstring, header);

    wcc.Clear;
    MyFree(wcc);

    application.ProcessMessages;
end;



{
//
// Removed - inconsistant!
// A plain text item would receive this message, a unicode text item
// would not
// REPLACED with IsHit
procedure TTooltipWindow.WMNCHitTest(var Msg: TWMNcHitTest);
}
procedure TTooltipWindow.InitFont;
var f : TFont;
begin
	f := FrmConfig.GetFont;
	canvas.Font := f;
    self.Font := f;
end;

function TTooltipWindow.IsHit(Pos: TPoint): boolean;
var r : TRect;
begin
    Windows.SetLastError(ERROR_SUCCESS);
    //if (hwndTip <> 0) then begin
        windows.GetWindowRect(self.Handle, r);
    //end else begin
    //    r := Self.GetClientRect;
    //end;

    //inc(r.left, LastPoint.x);
    //inc(r.Right, LastPoint.X);
    //inc(r.Top, lastpoint.Y);
    //inc(r.Bottom, Lastpoint.y);
    result := Windows.PtInRect(r, Pos);

    {
    // DOES NOT WORK!!!!!! Damn MS documentation
    // unable to find any case where it fires a true result
    fillchar(hi,sizeof(hi),#0);

    hi.pt.x := Pos.x;
    hi.pt.y := Pos.Y;
    hi.hwnd := self.hwndTip;
    hi.ti.cbSize := sizeof(hi.ti);


    result := (Windows.SendMessage(self.hwndTip, TTM_HITTEST, 0,Integer(@hi)) <> 0);
    }
end;


function TTooltipWindow.IsShowing: boolean;
begin
    result := self.ShowingHint;
end;



{ TFrmDummyUnicodeTooltip }

//
// I'm created, then multiple calls to Show/Close Tooltip
//
procedure TFrmDummyUnicodeTooltip.FormCreate(Sender: TObject);
begin
    FrmDebug.AppendLog('FrmDummyUnicodeTooltip - creating');

    TooltipWindows := TTooltipWindow.Create;
    wc := TWideChar.Create;
end;


//
// Callbacks used when UNICODE is sent via the ShowTooltip method
// Say "I've got Unicode" for the format
// Say, "Here's the string you asked for" for the content
//
procedure TFrmDummyUnicodeTooltip.WMNotifyFormat(var msg: TWMNotifyFormat);
begin
    if (self.wc.size <> 0) then begin
        msg.Result := NFR_UNICODE;
    end else begin
        msg.Result := NFR_ANSI;
    end;
end;

procedure TFrmDummyUnicodeTooltip.WMNotify(var msg: TWMNotify);
//const TTN_FIRST = $-520;
const TTN_GETDISPINFO = (TTN_FIRST - 0);
const TTN_GETDISPINFOW = (TTN_FIRST - 10);

var pdiw : ^tagNMTTDISPINFOW;
    pdia : ^tagNMTTDISPINFO;
begin
    // Tell the popup what text to show
    //
    // NOTE: This string must exist while the tooltip is being shown
    // Bad, bad, bad things happen when the string disappears
    //

    if msg.NMHdr^.code  = TTN_GETDISPINFOW then begin
        pdiw := Pointer(TMessage(msg).lparam);
        wc.LeftStr(600);
        pdiw.lpszText := wc.Memory;

        msg.Result := 0;
    end else if msg.NMHdr^.code  = TTN_GETDISPINFO then begin
        pdia := Pointer(TMessage(msg).lparam);
        pdia.hinst := 0;
        pdia.lpszText := PChar(self.LastHint);
        msg.result := 0;
    end;

end;




procedure TFrmDummyUnicodeTooltip.SetLastClip(ci: TClipItem);
begin
    self.LastClipItem := ci;
    self.LastHint := '';
    self.wc.Clear;
end;

procedure TFrmDummyUnicodeTooltip.SetLastClip(s: string);
begin
    self.LastHint := s;
    self.LastClipItem := nil;
    self.wc.Clear;
end;

procedure TFrmDummyUnicodeTooltip.FormShow(Sender: TObject);
begin
 	SetWindowPos(self.handle, HWND_TOPMOST, 0, 0, 0,0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
end;

procedure TFrmDummyUnicodeTooltip.SetLastClip(wcc: TWideChar);
begin
    self.wc.clear;
    self.wc.Append(wcc);
    self.LastHint := '';
    self.LastClipItem := nil;
end;




{ TTooltipDragWinow }

procedure TTooltipDragWindow.ShowTooltip(ci: TClipItem; Pos: TPoint;
  header: string; usehelpstring: boolean);
begin
    self.lastClip := ci;
    inherited;
    self.HandleUserInput;
end;

procedure TTooltipDragWindow.ShowTooltip(s: string; Pos: TPoint;
  UseHelpString: boolean; header: string);
begin
    s := '  ' + s;
    inherited;
    self.HandleUserInput;

end;





procedure TTooltipDragWindow.AlterSizePosition(var r: TRect; Pos: TPoint);
begin
    inherited;
    r.Bottom := r.top + self.MaxHeight;
    r.right := r.left + self.MaxWidth;
end;

constructor TTooltipDragWindow.Create;
begin
    inherited;
    self.UseLocalMax := true;
    self.MaxWidth := 300;
    self.MaxHeight := 80;
    //self.DoubleBuffered := true;
end;

procedure TTooltipDragWindow.HandleUserInput;
var r : TRect;
begin


    r.top := self.ClientRect.top+1;
    r.Bottom := self.clientrect.Bottom-1;
    r.Left := self.ClientRect.Left+1;
    r.Right := self.ClientRect.left;

    self.Canvas.Brush.Color := clBlack;
    //self.Canvas.Rectangle(r);

    Windows.DrawEdge(self.Canvas.Handle,r,EDGE_ETCHED,BF_LEFT);

    r.Left := r.left + 2;
    r.Right := r.left;

    Windows.DrawEdge(self.Canvas.Handle,r,EDGE_ETCHED,BF_LEFT);

end;



procedure TTooltipDragWindow.ShowTooltip(pic: TPicture; Pos: TPoint;
  header: string);
begin
    inherited ShowTooltip(
        '   [Picture: ' + IntToSTr(pic.Width) + 'x' + IntToStr(pic.Height)+']',
        pos,
        false,
        header
    );

    self.HandleUserInput;
end;



procedure TTooltipDragWindow.WMNCHitTest(var Msg: TWMNcHitTest);
var

    r : TRect;
begin
    inherited;

    // clicking anywhere and dragging should result in a move of the tooltip
    // rightclick should close the damn thing

    msg.result := HTCAPTION;
    //if self.IsHit(point(msg.XPos, msg.YPos)) then begin

        if KeyboardQuery.IsClicked(rightbutton) then begin

            while KeyboardQuery.IsClicked(rightbutton) do begin

                mysleep(50);
                //msg.result := HTCLOSE;
            end;

            msg.Result := HTERROR; 
            self.CloseTooltip();
            EXIT;
        end;

        if self.IsHit( point(msg.XPos, msg.YPos)) then begin
            Windows.GetWindowRect(self.Handle, r);
            if (r.Right - msg.xpos) < 5 then begin
                msg.Result := HTRIGHT;
            end else if ((r.Bottom - msg.YPos) < 3) then begin
                msg.Result := HTBOTTOM;
            end;

        end;

    //end else begin
    //end;
end;

procedure TTooltipDragWindow.WMResize(var ms: TWMSizing);
var r : TRect;
begin
    self.ShowingHint := false;
    Windows.GetWindowRect(self.Handle,r);
    self.LastPoint := point(r.Left,r.top);

    self.MaxWidth := ms.lprect.Right - ms.lpRect.Left;
    self.MaxHeight := ms.lprect.Bottom - ms.lprect.top;
    self.ShowTooltip(lastClip, lastPoint,'',false);
end;

procedure TTooltipDragWindow.ShowTooltip(inwc: TWideChar; Pos: TPoint;
  UseHelpString: boolean; header: string);
var  wc : TWideChar;
begin

    wc := TWideChar.Create;
    wc.append('   ');
    wc.Append(inwc);

    wc.Replace(WideChar(#13),WideChar(' '));
    wc.Replace(WideChar(#10),WideChar(' '));
    wc.Replace(WideChar(#9),WideChar(' '));

    inherited ShowTooltip(wc,pos,usehelpstring,header); 
    self.HandleUserInput;
end;

end.
