forward
global type nvo_tooltips from nonvisualobject
end type
type point from structure within nvo_tooltips
end type
type msg from structure within nvo_tooltips
end type
type rect from structure within nvo_tooltips
end type
type toolinfo from structure within nvo_tooltips
end type
end forward
type point from structure
long x
long y
end type
type msg from structure
long hwnd
long message
long wparam
long lparam
long time
point pt
end type
type rect from structure
long left
long top
long right
long bottom
end type
type toolinfo from structure
long cbsize
long uflags
long hwnd
long uid
rect rect
long hinstance
string lpsztext
end type
global type nvo_tooltips from nonvisualobject autoinstantiate
end type
type prototypes
// ToolTips函数
SubRoutine InitCommonControls() library "comctl32.dll"
Function long CreateWindowExA(ulong dwExStyle, string ClassName, &
long WindowName, ulong dwStyle, ulong X, ulong Y, ulong nWidth, &
ulong nHeight, ulong hWndParent, ulong hMenu, ulong hInstance, &
ulong lpParam) library "user32.dll"
Function integer DestroyWindow(long hWnd) library "user32.dll"
Function integer ToolTipMsg(long hWnd, long uMsg, long wParam, &
REF TOOLINFO ToolInfo) library "user32.dll" Alias For "SendMessageA"
Function integer RelayMsg(long hWnd, long uMsg, long wParam, &
REF MSG Msg) library "user32.dll" Alias For "SendMessageA"
Function uLong SendMessageString( uLong hwnd, uLong Msg, uLong wParam, Ref String lpzString ) Library "user32.dll" Alias For "SendMessageA"
FUNCTION ulong ShowWindow(ulong hwnd,ulong nCmdShow) LIBRARY "user32.dll"
//内存管理函数
//Function long LocalAlloc(long Flags, long Bytes) library "kernel32.dll"
//Function long LocalFree(long MemHandle) library "kernel32.dll"
//Function long lstrcpy(long Destination, string Source) library "kernel32.dll"
FUNCTION ulong IsWindowVisible(ulong hwnd) LIBRARY "user32.dll"
end prototypes
type variables
//私有常量
Private:
//杂项常量
CONSTANT string TOOLTIPS_CLASS = 'tooltips_class32'
CONSTANT ulong CW_USEDEFAULT = 2147483648
CONSTANT long WM_USER = 1024
CONSTANT long WS_EX_TOPMOST = 8
CONSTANT long WM_SETFONT = 48
// ToolTip Messages
Constant long TTM_ADDTOOL = WM_USER + 4
Constant long TTM_DELTOOL = WM_USER + 5
Constant long TTM_NEWTOOLRECT = WM_USER + 6
Constant long TTM_RELAYEVENT = WM_USER + 7
Constant long TTM_POPUP =WM_USER + 34
Constant long TTM_UPDATE= WM_USER + 29
Constant long TTM_UPDATETIPTEXT = WM_USER + 12
Constant long TTM_TRACKACTIVATE = WM_USER + 17
Constant long TTM_TRACKPOSITION = WM_USER + 18
Constant long TTM_SETMAXTIPWIDTH = 1048
Constant long TTM_GETMAXTIPWIDTH = WM_USER + 25
Constant long TTM_SETTIPBKCOLOR = WM_USER + 19
Constant long TTM_SETTIPTEXTCOLOR = WM_USER + 20
Constant long TTM_SETTITLEA = WM_USER + 32
// Tooltip flags
Constant integer TTF_CENTERTIP = 2
Constant integer TTF_RTLREADING = 4
Constant integer TTF_SUBCLASS = 16
Constant integer TTF_TRACK = 32
Constant integer TTF_ABSOLUTE = 128
Constant integer TTF_TRANSPARENT = 256
Constant integer TTF_DI_SETITEM = 32768
Constant integer TTS_BALLOON = 64
// Title Constants
Constant integer TTI_NONE = 0
Constant integer TTI_INFO = 1
Constant integer TTI_WARNING = 2
Constant integer TTI_ERROR = 3
//公共变量和常量
Public:
long hWndTT=0 // Tooltip control window handle
long ToolID = 1 // Tooltip internal ID
CONSTANT integer STYLE_NORMAL = 0
CONSTANT integer STYLE_BALLOONTIP = 1
integer TIPSTYLE
end variables
forward prototypes
public subroutine setfont (long hfont)
public subroutine settipposition (integer x, integer y)
public subroutine settrack (dragobject object, integer uid, boolean status)
public subroutine updatetiprect (dragobject object, long uid, long left, long top, long right, long bottom)
public function integer addtool (dragobject object, string tiptext, integer flags)
public subroutine hidetip (dragobject controlobject)
public subroutine settiptext (dragobject object, long uid, string tiptext)
public subroutine setmaxwidth (long al_maxwidth)
public function integer removetool (dragobject ado_object, integer ai_toolid)
public subroutine settiptitle (integer ai_icon, string as_title)
public subroutine settipbkcolor (long aul_color)
public subroutine relaymsg (dragobject object)
public function boolean tipvisible ()
public subroutine relaymsg (dragobject object, long wordparm, integer longparm)
end prototypes
public subroutine setfont (long hfont);//此函数用于设置ToolTips窗口的字体,代码如下:
Send(hWndTT,WM_SETFONT,hFont,1)
end subroutine
public subroutine settipposition (integer x, integer y);//此函数用于设置ToolTips的位置,代码如下:
Send(hWndTT,TTM_TRACKPOSITION,0,Long(X,Y))
end subroutine
public subroutine settrack (dragobject object, integer uid, boolean status);//此函数用于激活或取消ToolTips窗口设置新文本,代码如下:
//参数Status为True时激活,为False时取消
TOOLINFO ToolInfo
ToolInfo.cbSize = 40
ToolInfo.hWnd = Handle(Object)
ToolInfo.uID = uID
If Status Then
ToolTipMsg(hWndTT,TTM_TRACKACTIVATE,1,ToolInfo)
Else
ToolTipMsg(hWndTT,TTM_TRACKACTIVATE,0,ToolInfo)
End If
end subroutine
public subroutine updatetiprect (dragobject object, long uid, long left, long top, long right, long bottom);//此函数用于更新ToolTips的矩形框,代码如下:
TOOLINFO TOOLINFO
TOOLINFO.hWnd = Handle(Object)
TOOLINFO.uID = uID
TOOLINFO.Rect.Left = Left
TOOLINFO.Rect.Top = Top
TOOLINFO.Rect.Right = Right
TOOLINFO.Rect.Bottom = Bottom
ToolTipMsg(hWndTT,TTM_NEWTOOLRECT,0,TOOLINFO)
end subroutine
public function integer addtool (dragobject object, string tiptext, integer flags);//此函数用于注册要显示ToolTips的控制,代码如下:
If hWndTT <= 0 Then
If TIPSTYLE = STYLE_BALLOONTIP Then
hWndTT = CreateWindowExA(WS_EX_TOPMOST,TOOLTIPS_CLASS,0, TTF_CENTERTIP+ TTS_BALLOON, &
CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, &
0, 0, Handle(GetApplication()),0)
Else
hWndTT = CreateWindowExA(WS_EX_TOPMOST, TOOLTIPS_CLASS,0,TTF_CENTERTIP, &
CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, &
0, 0, Handle(GetApplication()),0)
End If
End If
TOOLINFO TOOLINFO
TOOLINFO.cbSize = 40
TOOLINFO.uFlags = Flags
TOOLINFO.hWnd = Handle(Object)
TOOLINFO.hInstance = 0
TOOLINFO.uID = ToolID
ToolID++
TOOLINFO.lpszText = tiptext
//LStrCpy(ToolInfo.lpszText,Left(tiptext,80))
TOOLINFO.Rect.Left = 0
TOOLINFO.Rect.Top = 0
TOOLINFO.Rect.Right = UnitsToPixels(Object.Width,XUnitsToPixels!)
TOOLINFO.Rect.Bottom = UnitsToPixels(Object.Height,YUnitsToPixels!)
If ToolTipMsg(hWndTT,TTM_ADDTOOL, 0, TOOLINFO) = 0 Then
// MessageBox("错误","不能注册控件!",StopSign!,Ok!)
// LocalFree(ToolInfo.lpszText) //释放分配的内存
Return(-1)
End If
//LocalFree(ToolInfo.lpszText) //释放分配的内存
Return(ToolID - 1)
end function
public subroutine hidetip (dragobject controlobject);MSG MSG
MSG.hWnd = Handle(ControlObject)
MSG.Message = 513 // WM_LBUTTONDOWN
MSG.WParam = Message.WordParm
MSG.Lparam = Message.LongParm
RelayMsg(hWndTT,TTM_RELAYEVENT,0,MSG)
end subroutine
public subroutine settiptext (dragobject object, long uid, string tiptext);//此函数用于为ToolTips窗口设置新文本,代码如下:
TOOLINFO ToolInfo
ToolInfo.hWnd = Handle(Object)
ToolInfo.uID = uID
ToolInfo.lpszText = TipText
ToolTipMsg(hWndTT,TTM_UPDATETIPTEXT,0,ToolInfo)
end subroutine
public subroutine setmaxwidth (long al_maxwidth);/*****************************************************************************
Function: of_setmaxwidth
Description: Sets the maximum tooltip width. If the text is longer it will
splitted over more than one line.
Returns: (none)
Arguments: Long al_MaxWidth
Use: Call to set the maximum width.
-------------------------------------------------------------------------------
Auteur: Aart Onkenhout
Revision History
--------------------
Date Version
15-05-2000 1.0 Initial version
******************************************************************************/
Send( hWndTT, TTM_SETMAXTIPWIDTH, 0, UnitsToPixels( al_MaxWidth, xUnitsToPixels! ) )
Return
end subroutine
public function integer removetool (dragobject ado_object, integer ai_toolid);/*****************************************************************************
Function: of_removetool
Description: Unregisters a control within the tooltip control
Returns: (none)
Arguments: DragObject ado_Object Object to unregister within the tooltip control
Integer ai_ToolId Tool Id (returned by of_AddTool)
Use:
-------------------------------------------------------------------------------
Auteur: Aart Onkenhout
Revision History
--------------------
Date Version
29-06-2001 1.0 Initial version
******************************************************************************/
TOOLINFO TOOLINFO
Integer li_Width, li_Height
TOOLINFO.cbSize = 40
TOOLINFO.uFlags = 16 //Flags
TOOLINFO.hWnd = Handle( ado_Object )
TOOLINFO.hInstance = 0 // Not used
TOOLINFO.uID = ai_ToolID
ToolTipMsg( hWndTT, TTM_DELTOOL, 0, TOOLINFO )
Return 1
end function
public subroutine settiptitle (integer ai_icon, string as_title);/*****************************************************************************
Function: of_settiptitle
Description: Sets the title of the tooltip
Returns: (none)
Arguments: Integer ai_Icon
Values: TTI_NONE = 0
TTI_INFO = 1
TTI_WARNING = 2
TTI_ERROR = 3
String as_Title
Use: Call with the desired title and icon.
-------------------------------------------------------------------------------
Auteur: Aart Onkenhout
Revision History
--------------------
Date Version
10-05-2001 1.0 Initial version
******************************************************************************/
SendMessageString( hWndTT, TTM_SETTITLEA, ai_Icon, as_Title )
end subroutine
public subroutine settipbkcolor (long aul_color);/*****************************************************************************
Function: of_settipbkcolor
Description: Sets the backgroundcolor of the tooltip-window
Returns: (none)
Arguments: uLong aul_Color
Use: Call with the desired color
-------------------------------------------------------------------------------
Auteur: Aart Onkenhout
Revision History
--------------------
Date Version
10-05-2001 1.0 Initial version
******************************************************************************/
Send( hWndTT, TTM_SETTIPBKCOLOR,aul_color, 0 )
end subroutine
public subroutine relaymsg (dragobject object);//此函数用于向显示ToolTips窗口发送控制消息,代码如下:
MSG MSG
MSG.hWnd = Handle(Object) // WM_MOUSEMOVE
MSG.Message = 512
MSG.WParam = Message.WordParm
MSG.LParam = Message.LongParm
RelayMsg(hWndTT,TTM_RELAYEVENT,0,MSG)
end subroutine
public function boolean tipvisible ();If IsWindowVisible(HwndTT) > 0 Then Return True
Return False
end function
public subroutine relaymsg (dragobject object, long wordparm, integer longparm);//此函数用于向显示ToolTips窗口发送控制消息,代码如下:
MSG MSG
MSG.hWnd = Handle(Object) // WM_MOUSEMOVE
MSG.Message = 512
MSG.WParam = WordParm
MSG.LParam = LongParm
RelayMsg(hWndTT,TTM_RELAYEVENT,0,MSG)
end subroutine
on nvo_tooltips.create
call super::create
TriggerEvent( this, "constructor" )
end on
on nvo_tooltips.destroy
TriggerEvent( this, "destructor" )
call super::destroy
end on
event constructor;//结构point用于传送坐标
//结构msg用于传送消息
//结构rect用于传送矩形框的位置
//结构toolinfo用于传送与tooltips相关的消息
//用法/
//定义实例变量:
//nca_ToolTips invo_ToolTip
//window open事件:
//注册要显示ToolTips的控制
//invo_tooltip.AddTool(sle_userid,"请输入登录用户名",0)
//invo_tooltip.AddTool(sle_password,"请输入登录口令",0)
//需要提示的控件,在自定义ue_mousemove事件(pbm_mousemove):
//invo_tooltip.RelayMsg(This)
//
InitCommonControls()
end event
event destructor;if hWndTT>0 then DestroyWindow(hWndTT)
end event