Q5/ws_objects/longjoe_report_uo.pbl.src/nvo_tltips.sru

$PBExportHeader$nvo_tltips.sru
$PBExportComments$ToolBar 用户对象
forward
global type nvo_tltips from nonvisualobject
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
	long		lpsztext
end type

global type nvo_tltips 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" alias for "CreateWindowExA;Ansi"
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;Ansi"
Function integer RelayMsg(long hWnd, long uMsg, long wParam, &
     REF MSG Msg) library "user32.dll" Alias For "SendMessageA;Ansi"

//内存管理函数
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" alias for "lstrcpy;Ansi"

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

// ToolTips消息
CONSTANT long TTM_ADDTOOL = WM_USER + 4
CONSTANT long TTM_NEWTOOLRECT = WM_USER + 6
CONSTANT long TTM_RELAYEVENT = WM_USER + 7
CONSTANT long TTM_UPDATETIPTEXT	= WM_USER + 12
CONSTANT long TTM_TRACKACTIVATE = WM_USER + 17
CONSTANT long TTM_TRACKPOSITION	= WM_USER + 18

//公共变量和常量
Public:
long hWndTT	// Tooltip control window handle
long ToolID = 1	// Tooltip internal ID

//Tooltips标记
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

end variables

forward prototypes
public subroutine relaymsg (dragobject object)
public subroutine setfont (long hfont)
public subroutine settipposition (integer x, integer y)
public subroutine settiptext (dragobject object, long uid, long tiptext)
public subroutine settiptext (dragobject object, long uid, string tiptext)
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)
end prototypes

public subroutine relaymsg (dragobject object);//此函数用于向显示ToolTips窗口发送控制消息，代码如下：
MSG Msg

Msg.hWnd = Handle(Object)
Msg.Message	= 512	// WM_MOUSEMOVE
Msg.WParam 	= Message.WordParm
Msg.LParam 	= Message.LongParm
RelayMsg(hWndTT,TTM_RELAYEVENT,0,Msg)

end subroutine

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 settiptext (dragobject object, long uid, long tiptext);//此函数用于为ToolTips窗口设置新文本，代码如下：

TOOLINFO ToolInfo

ToolInfo.hWnd = Handle(Object)
ToolInfo.uID = uID
ToolInfo.lpszText = TipText

ToolTipMsg(hWndTT,TTM_UPDATETIPTEXT,0,ToolInfo)

end subroutine

public subroutine settiptext (dragobject object, long uid, string tiptext);//此函数用于为ToolTips窗口设置新文本，代码如下：

long lpszText

lpszText = LocalAlloc(0,255)
lStrCpy(lpszText,Left(TipText,255))
SetTipText(Object,uId,lpszText)

LocalFree(lpszText)

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的控制，代码如下：

TOOLINFO ToolInfo

ToolInfo.cbSize = 40
ToolInfo.uFlags = Flags 
ToolInfo.hWnd = Handle(Object)
ToolInfo.hInstance = 0 
ToolInfo.uID = ToolID
ToolID++
ToolInfo.lpszText = LocalAlloc(0,80)
POST LocalFree(ToolInfo.lpszText) //释放分配的内存
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!)
	Return(-1)
End If

Return(ToolID - 1)

end function

on nvo_tltips.create
TriggerEvent( this, "constructor" )
end on

on nvo_tltips.destroy
TriggerEvent( this, "destructor" )
end on

event constructor;//结构point用于传送坐标
//结构msg用于传送消息
//结构rect用于传送矩形框的位置
//结构toolinfo用于传送与tooltips相关的消息

//用法/////////////////////////////////////////////////////////////
//定义实例变量:
//nca_tlTips invo_tlTip

//window open事件:
//注册要显示ToolTips的控制
//invo_tltip.AddTool(sle_userid,"请输入登录用户名",0)
//invo_tltip.AddTool(sle_password,"请输入登录口令",0)
//需要提示的控件，在自定义ue_mousemove事件(pbm_mousemove):
//invo_tltip.RelayMsg(This)
//////////////////////////////////////////////////////////////////

InitCommonControls()

hWndTT = CreateWindowExA(WS_EX_TOPMOST,TOOLTIPS_CLASS,0, &
      TTF_CENTERTIP, CW_USEDEFAULT, CW_USEDEFAULT, &
      CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, Handle(GetApplication()),0)

end event

event destructor;DestroyWindow(hWndTT)
end event