Creating your own Tooltips

Here is a way to create your own Tooltips, it's a bit complicated but the result is not so bad. It can be useful for versions prior to Paradox 9. These Tooltips can be multiline and can be out of the form or Paradox if it isn't full screen.


The uses part

Uses "gdi32.dll"
    SetBkColor(hdc cLong,nColor cLong)cLong [stdcall]
    SetTextColor(hdc cLong,crColor cLong)cLong [stdcall "SetTextColor"]
    RoundRect(hdc clong,nLeftRect clong,nTopRect clong,nRightRect clong,nBottomRect clong,nWidth clong,nHeight clong)clong [stdcall]
    CreateSolidBrush(crColor cLong)cLong [stdcall]
    DeleteObject(hObject cLong)cLong [stdcall "DeleteObject"]
    SelectObject(hdc clong,hbrush clong)clong [stdcall]
    CreateFont(H cLong,W cLong,E cLong,O cLong,W cLong,I cLong,u cLong,S cLong,C cLong,OP cLong,CP cLong,Q cLong,PAF cLong, F cptr)cLong [stdcall "CreateFontA"]
    Polygon(hdc clong,lpPoints clong,nCounts clong)clong [stdcall]
enduses
uses "user32.dll"
    GetWindowRect(hwnd clong,lprect clong)clong [stdcall]
    GetWindowDC(hwnd cLong)cLong [stdcall "GetWindowDC"]
    DrawText(hdc cLong,lpStr cptr,nCount cLong,lpRect clong,wFormat cLong)cLong [stdcall "DrawTextA"]
    DrawEdge(hdc clong,lprect clong,edge clong,flags clong)clong [stdcall]
    FillRect(hdc clong,lprect clong,hbrush clong)clong [stdcall]
    SystemParametersInfo(uAction CLONG,uParam CLONG,lpvParam clong,fuWinIni CLONG)CLONG [stdcall "SystemParametersInfoA"]
    ReleaseDC(hwnd clong,hdc clong)clong [stdcall]
    GetDesktopWindow()clong [stdcall]
endUses
uses "kernel32.dll"
    GlobalAlloc(wFlags cLong,dwBytes cLong)cLong [stdcall]
    RtlMoveMemory(hpvDest clong, hpvSource cptr, cbCopy cLong)clong [stdcall]
    RtlMoveMemory2(hpvDest cptr, hpvSource clong, cbCopy cLong)clong [stdcall "RtlMoveMemory"]
    GlobalFree(hMem cLong)cLong [stdcall]
enduses


The var part

Var
    hwnd,hdc longint
    f form
    h_font,hb,res longint
    mem_str,adr,mem_rect,mem_rect2,mem_rect_wkspace longint
    l,t,r,b longint
    l2,t2,r2,b2 longint
    str string
    app application
    pos_mouse,p1,p2 point
    mouse_x,mouse_y anytype
    ws,hs longint
    h_multiline longint
    ls,ts,rs,bs longint
    wf smallint
    fcreate smallint
    hrgn longint
    mem_poly longint
endVar


Tooltips with rounded corners

method tooltip()

wf = 0
mem_rect_wkspace = GlobalAlloc(fromhex("0x40"),16)
mem_poly = GlobalAlloc(fromhex("0x40"),12)
res = SystemParametersInfo(48,0,mem_rect_wkspace,0)

adr = mem_rect_wkspace
res = RtlMoveMemory2(ls,adr,4)
adr = adr + 4
res = RtlMoveMemory2(ts,adr,4)
adr = adr + 4
res = RtlMoveMemory2(rs,adr,4)
adr = adr + 4
res = RtlMoveMemory2(bs,adr,4)

GlobalFree(mem_rect_wkspace)

;/ Mouse position
pos_mouse = getmousescreenposition()
mouse_x = x(twipstopixels(pos_mouse))
mouse_y = y(twipstopixels(pos_mouse))
hwnd = GetDesktopWindow()
mem_str = GlobalAlloc(fromhex("0x40"),8)
hdc = GetWindowDC(hwnd)

;/ Change the font
str = "Home Made Tooltip !"+"\n"+"Mouse Position : "+string(mouse_x)+"/"+string(mouse_y)
h_font = CreateFont(14,0,0,0,300,0,0,0,1,7,0,0,0,"Verdana")
res = SelectObject(hdc,h_font)

;/ We create the rectangle to display text
mem_rect = GlobalAlloc(fromhex("0x40"),16)
l2 = mouse_x+10
t2 = mouse_y+15
r2 = mouse_x+10
b2 = mouse_y+10
adr = mem_rect
res = RtlMoveMemory(adr,l2,4)
adr = adr + 4
res = RtlMoveMemory(adr,t2,4)
adr = adr + 4
res = RtlMoveMemory(adr,r2,4)
adr = adr + 4
res = RtlMoveMemory(adr,b2,4)
;/ We write the text once but it is not displayed because of parameter ("0x400") which is used to calculed the dimension of the rectangle to display all the text.
h_multiline = DrawText(hdc,str,longint(str.size()),mem_rect,fromhex("0x1")+fromhex("0x400"))

;/ Coordinates for rectangle with rounded corners and we verify it won't go outside the screen, if so, we change the position.
adr = mem_rect
res = RtlMoveMemory2(l2,adr,4)
l2 = l2 - 4
adr = adr + 4
res = RtlMoveMemory2(t2,adr,4)
t2 = t2 - 4
adr = adr + 4
res = RtlMoveMemory2(r2,adr,4)
r2 = r2 + 4
adr = adr + 4
res = RtlMoveMemory2(b2,adr,4)
b2 = b2 + 4
if r2 > rs then
    r = r2 - rs
    l2 = l2 - r - 4
    l = l2 + 4 
    r2 = rs
    r = r2 - 4
    t = t2 + 4
    b = b2 - 4 
    wf = 1
endif 
if b2 > bs then
    t = b2 - bs
    t2 = t2 - t
    b2 = bs 
    t = t2 + 4
    r = r2 - 4
    b = b2 - 4
    l = l2 + 4 
    wf = 1
endif
if wf = 1 then
    adr = mem_rect
    res= RtlMoveMemory(adr,l,4)
    adr = adr + 4
    res= RtlMoveMemory(adr,t,4)
    adr = adr + 4
    res= RtlMoveMemory(adr,r,4)
    adr = adr + 4
    res = RtlMoveMemory(adr,b,4)
endif
;/ We create background color for the rectangle
hb = CreateSolidBrush(rgb(fromhex("0xff"),fromhex("0xfa"),fromhex("0xcd")))
res = SetBkColor(hdc,rgb(fromhex("0xff"),fromhex("0xfa"),fromhex("cd")))
res = SelectObject(hdc,hb)
;/ We draw the rectangle
res = RoundRect(hdc,l2,t2,r2,b2,20,20)

;/ We also can create a polygon to create a "balloon tooltip" (optional)
adr = mem_poly
res = RtlMoveMemory(adr,l2+10,4)
adr = adr + 4
res = RtlMoveMemory(adr,t2+5,4)
adr = adr + 4
res = RtlMoveMemory(adr,l2-5,4)
adr = adr + 4
res = RtlMoveMemory(adr,t2-15,4)
adr = adr + 4
res = RtlMoveMemory(adr,l2+20,4)
adr = adr + 4
res = RtlMoveMemory(adr,t2+5,4)
res = Polygon(hdc,mem_poly,3)

;/ And finally we display the text
res = SetBkColor(hdc,rgb(fromhex("0xff"),fromhex("0xfa"),fromhex("cd")))
res = SetTextColor(hdc,Black)
res = FillRect(hdc,mem_rect,hb)
res = DrawText(hdc,str,longint(str.size()),mem_rect,fromhex("0x0"))

GlobalFree(mem_rect)
GlobalFree(mem_str)
GlobalFree(mem_poly)
ReleaseDC(app.windowhandle(),hdc)
DeleteObject(h_font)
DeleteObject(hb)

endMethod


Tooltips with 3D frame

method tooltip()

wf = 0
mem_rect_wkspace = GlobalAlloc(fromhex("0x40"),16)
res = SystemParametersInfo(48,0,mem_rect_wkspace,0)

adr = mem_rect_wkspace
res = RtlMoveMemory2(ls,adr,4)
adr = adr + 4
res = RtlMoveMemory2(ts,adr,4)
adr = adr + 4
res = RtlMoveMemory2(rs,adr,4)
adr = adr + 4
res = RtlMoveMemory2(bs,adr,4)

GlobalFree(mem_rect_wkspace)

;/ Mouse position
pos_mouse = getmousescreenposition()
mouse_x = x(twipstopixels(pos_mouse))
mouse_y = y(twipstopixels(pos_mouse))
hwnd = GetDesktopWindow()
mem_str = GlobalAlloc(fromhex("0x40"),8)
hdc = GetWindowDC(hwnd)

;/ We change the font
str = "Home Made Tooltip !"+"\n"+"Mouse Position : "+string(mouse_x)+"/"+string(mouse_y)
h_font = CreateFont(14,0,0,0,300,0,0,0,1,7,0,0,0,"Verdana")
res = SelectObject(hdc,h_font)

;/ We create the rectangle to display text
mem_rect = GlobalAlloc(fromhex("0x40"),16)
l2 = mouse_x+10
t2 = mouse_y+15
r2 = mouse_x+10
b2 = mouse_y+10
adr = mem_rect
res = RtlMoveMemory(adr,l2,4)
adr = adr + 4
res = RtlMoveMemory(adr,t2,4)
adr = adr + 4
res = RtlMoveMemory(adr,r2,4)
adr = adr + 4
res = RtlMoveMemory(adr,b2,4)
;/ We write the text once but it is not displayed because of parameter ("0x400") which is used to calculed the dimension of the rectangle to display all the text.
h_multiline = DrawText(hdc,str,longint(str.size()),mem_rect,fromhex("0x1")+fromhex("0x400"))

;/ Coordinates for rectangle and we verify it won't go outside the screen, if so, we change the position.
adr = mem_rect
res = RtlMoveMemory2(l2,adr,4)
l2 = l2 - 2
adr = adr + 4
res = RtlMoveMemory2(t2,adr,4)
t2 = t2 - 2
adr = adr + 4
res = RtlMoveMemory2(r2,adr,4)
r2 = r2 + 2
adr = adr + 4
res = RtlMoveMemory2(b2,adr,4)
b2 = b2 + 2
if r2 > rs then
    r = r2 - rs
    l2 = l2 - r - 2
    l = l2 + 4 
    r2 = rs
    r = r2 - 4
    t = t2 + 4
    b = b2 - 4 
    wf = 1
endif 
if b2 > bs then
    t = b2 - bs
    t2 = t2 - t
    b2 = bs 
    t = t2 + 4
    r = r2 - 4
    b = b2 - 4
    l = l2 + 4 
    wf = 1
endif
if wf = 1 then
    adr = mem_rect
    res= RtlMoveMemory(adr,l,4)
    adr = adr + 4
    res= RtlMoveMemory(adr,t,4)
    adr = adr + 4
    res= RtlMoveMemory(adr,r,4)
    adr = adr + 4
    res = RtlMoveMemory(adr,b,4)
endif
;/ We create background color for the rectangle
hb = CreateSolidBrush(rgb(fromhex("0xff"),fromhex("0xfa"),fromhex("0xcd")))
res = SetBkColor(hdc,rgb(fromhex("0xff"),fromhex("0xfa"),fromhex("cd")))
res = SelectObject(hdc,hb)

;/ We display text
res = SetBkColor(hdc,rgb(fromhex("0xff"),fromhex("0xfa"),fromhex("cd")))
res = SetTextColor(hdc,Black)
res = FillRect(hdc,mem_rect,hb)
res = DrawText(hdc,str,longint(str.size()),mem_rect,fromhex("0x0"))

;/ Fill the structure back and display the 3D frame around the text
adr = mem_rect
res = RtlMoveMemory(adr,l2,4)
adr = adr + 4
res = RtlMoveMemory(adr,t2,4)
adr = adr + 4
res = RtlMoveMemory(adr,r2,4)
adr = adr + 4
res = RtlMoveMemory(adr,b2,4)
res = DrawEdge(hdc,mem_rect,fromhex("0x8")+fromhex("0x1"),fromhex("0x1")+fromhex("0x2")+fromhex("0x4")+fromhex("0x8")+fromhex("0x1000"))

GlobalFree(mem_rect)
GlobalFree(mem_str)
ReleaseDC(app.windowhandle(),hdc)
DeleteObject(h_font)
DeleteObject(hb)

endMethod


To activate the tooltip

method mouseEnter(var eventInfo MouseEvent)

var
   ob uiobject
endvar

if eventInfo.isPreFilter() then
   eventinfo.gettarget(ob)
   if ob.class = "Button" then
      tooltip()
   endif
else
endIf

endMethod


To erase the tooltip

uses "user32.dll"
   InvalidateRect(hwnd clong,lprect clong,hErase clong)clong [stdcall]
enduses

method mouseExit(var eventInfo MouseEvent)

var
   res longint
   app application
endvar

if eventInfo.isPreFilter() then
   res = InvalidateRect(0,0,0)
else
endIf

endMethod