[此贴子已经被作者于2023-3-23 14:27编辑过]

程序代码：

Show_Tips('提示标签测试','这个是一个用API在VFP下直接建立的提示标签！','3000')  
********************************
*!*        原程序来至行者
*!*        修改:自由的风
*!*        原程序地址:http://hi.baidu.com/myvfp/blog/item/21434a00eb66c403738b651d.html
********************************
Function Show_Tips
        Lparameters toTitle,TipStr,cTime  &&提示标题,提示内容,显示时间
        Declare Integer CreateWindowEx In user32 Integer,String,String,Integer,Integer,Integer,;
                INTEGER,Integer,Integer,Integer,Integer,Integer
        Declare Integer SendMessage In user32 Integer,Integer,Integer,String @
        Declare Integer SendMessage In user32 As SendMessageLong Integer,Integer,Integer,Integer
        Declare Integer GetWindowLong In user32 Integer,Integer
        Declare Integer DestroyWindow In user32 Integer HWnd
        Declare Integer StrDup In shlwapi String @
        Declare Sleep In kernel32 Integer dwMilliseconds
        Declare SHORT GetCursorPos In user32 String @
        WM_USER = 0x400
        TTS_NOPREFIX = 0x2
        TTF_TRANSPARENT = 0x100
        TTM_ADDTOOLA = (WM_USER + 4)
        TTM_ACTIVATE = WM_USER + 1
        TTM_SETTITLE = (WM_USER + 32)
        TTS_BALLOON = 0x40
        TTS_ALWAYSTIP = 0x1
        TTF_SUBCLASS = 0x10
        TTF_IDISHWND = 0x1
        TTS_CLOSE=0x80
        TTM_TRACKPOSITION = WM_USER + 18
        TTM_TRACKACTIVATE=WM_USER + 17
        TTM_SETTITLEA=(WM_USER+32)
        TTF_TRACK =0x20
        Orientation=0&&调整箭头方向，0朝上，1朝下
        TOOLTIPS_CLASSA = "tooltips_class32"
        hParentHWnd=0
        hInstance=GetWindowLong(hParentHWnd,-6)
        TipStrhMem= StrDup(@TipStr)
        mSize=BinToC(44,'4rs')
        If Orientation=0
                mFlags=BinToC(Bitor(TTF_IDISHWND,TTF_TRANSPARENT,TTF_TRACK),'4rs')
        Else
                mFlags=BinToC(TTF_IDISHWND+TTF_TRANSPARENT+TTF_SUBCLASS,'4rs')
        Endif
        mhwnd=BinToC(hParentHWnd,'4rs')
        mId=BinToC(hParentHWnd,'4rs')
        mRect=Replicate(0h00000000,4)
        mInstance=BinToC(hInstance,'4rs')
        mStr=BinToC(TipStrhMem,'4rs')
        mlParam=BinToC(0,'4rs')
        TIPINFO=mSize+mFlags+mhwnd+mId+mRect+mInstance+mStr+mlParam
        lnStyle=TTF_IDISHWND+TTF_TRANSPARENT+TTF_TRACK+TTS_BALLOON+TTS_CLOSE
        lTTHwnd=CreateWindowEx(0,TOOLTIPS_CLASSA,Null,lnStyle,0,0,0,0,0,0,0,0)
        SendMessage(lTTHwnd,TTM_ADDTOOLA,0,@TIPINFO)
        SendMessage(lTTHwnd,TTM_SETTITLEA,1,@toTitle)
        If Orientation=0
                POINTAPI=Replicate(Chr(0),8)
                GetCursorPos(@POINTAPI)
                x=CToBin(Substr(POINTAPI,1,4),'4rs')
                Y=CToBin(Substr(POINTAPI,5,4),'4rs')
                SendMessageLong(lTTHwnd,TTM_TRACKPOSITION,0,Bitlshift(Y-15,16)+X-5)
                SendMessage(lTTHwnd, TTM_TRACKACTIVATE,1,@TIPINFO)
        Endif
        If Val(Alltrim(cTime))>0
                Sleep(Val(cTime))
                If lTTHwnd>0
                        DestroyWindow(lTTHwnd)
                Endif
        Endif
Endfunc

[此贴子已经被作者于2023-3-23 19:28编辑过]