XProfan

 $I Listview_Funktionen.inc
var lvdll&=usedll("Listview.dll")
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' (W) 2003 Frank Abbing
'
Declare sx&,sy&,bereich#,be#,erg&,erg2&,x&,y&,text$,handl&
Dim be#,8
Dim bereich#,1024
DEF GetCursorPos(1) !"USER32","GetCursorPos"
DEF WindowFromPoint(2) !"USER32","WindowFromPoint"
DEF ChildWindowFromPoint(3) !"USER32","ChildWindowFromPoint"
Def GetSysColor(1) !"USER32","GetSysColor"
Def ScreenToClient(2) !"USER32","ScreenToClient"
Def GetClassName(3) !"USER32","GetClassNameA"
Def GetWindowText(3) !"USER32","GetWindowTextA"
DEF NewWindowPos(7) !"USER32","SetWindowPos"
DEF AllocConsole(0) !"KERNEL32","AllocConsole"

Proc DText

    Parameters xx&,yy&,ttext$
    Drawtext xx&,yy&,ttext$

EndProc

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
'Tooltip erstellen
'Lauffähig ab Profan-Version 5.0
'------------ Für Tooltip -----------------------
Def InitCommonControls(0) !"COMCTL32","InitCommonControls"

Proc AddToolTip

    Parameters __Handle&,__Text$
    Declare ToolinfoButton#
    Dim ToolinfoButton#,40
    Declare Text1#
    Dim Text1#,255
    String Text1#,0=__Text$
    LONG ToolinfoButton#,0=40'Strukturgroesse
    LONG ToolinfoButton#,4=$11'Flags
    LONG ToolinfoButton#,8=__Handle&
    LONG ToolinfoButton#,12=__Handle&
    LONG ToolinfoButton#,36=Text1#'Text
    @SendMessage(TipControl&,$0404,0,ToolInfoButton#)
    Dispose Text1#
    Dispose ToolinfoButton#

EndProc

InitCommonControls()
declare tipcontrol&
Declare Tiptext$
TipControl&=@Control("tooltips_class32","",$D0000000,0,0,0,0,%Hwnd,0,%HInstance)'Tooltip fuer Rest
SendMessage(TipControl&,1048,0,200)
declare exit&,e%
SetTrueColor 1
cls GetSysColor(15)
var listview&=CreateListView(%hwnd,%hinstance,-1,9356944,-1,$20)
InsertColumn listview&,"1.Spalte",120,0
InsertColumn listview&,"2.Spalte",120,0

Whileloop 50

    AddString(listview&,"mit|HERZ  "+str$(&loop))

wend

'Liste Tooltips
vaR LB%=CreateListBox(%hwnd,0,0,0,0,0)

Whileloop GetCount(listview&)

    AddString(LB%,"Tooltip "+str$(&loop))

wend

' Zeilenhöhe im Listview festlegen oder ermitteln und in einer Variablen speichern
' für die spätere Berechnung: Curserposition ist in Zeile
var freelist&=SetLineHeight(listview&,20)
ShowListView(listview&,10,160,400,200)
Declare ZeileO&,ZeileU&,x%,y%
Usermessages 16
SubClass listview&, 1

while 1

    waitinput
    case %umessage=16 :BREAK

wend

SubClass listview&, 0
DeleteObject TipControl&
DestroyWindow(%hwnd)
DestroyImageList(freelist&)
dispose be#
dispose bereich#
freedll lvdll&
end

SubClassProc

    Clear bereich#
    GetVisibleLines(listview&,bereich#)
    ZeileO&=Long(bereich#,0)'Obere sichtbare Zeile
    ZeileU&=Long(bereich#,4)'Untere sichtbare Zeile
    GetCursorPos(be#)
    x&=Long(be#,0)
    y&=Long(be#,4)
    erg&=@WindowFromPoint(x&,y&)

    If erg&<>0

        ScreenToClient(erg&,be#)
        x&=Long(be#,0)'Maus Position X
        y&=Long(be#,4)'Maus Position Y
        erg2&=@ChildWindowFromPoint(erg&,x&,y&)'Handle unter Mauszeiger

    EndIf

    Tiptext$=""

    If erg&=Listview&

        x%= int((y&/21)-1+ZeileO&)'Zeile= Mausposition/ Zeilenhöhe+1(=Raster)
        Tiptext$=GetString$(LB%,x%)'Tooltiptext aus der Listbox

    EndIf

    AddTooltip Listview&,TipText$

EndProc