Q5/ws_objects/Ew_publ903.pbl.src/uo_tooltip.sru

$PBExportHeader$uo_tooltip.sru
$PBExportComments$显示按钮提示用
forward
global type uo_tooltip from nonvisualobject
end type
type tag_rect from structure within uo_tooltip
end type
type toolinfo from structure within uo_tooltip
end type
type msg from structure within uo_tooltip
end type
type point from structure within uo_tooltip
end type
end forward

type tag_rect from structure
	long		left
	long		top
	long		right
	long		bottom
end type

type toolinfo from structure
	unsignedlong		cbsize
	unsignedlong		uflags
	unsignedlong		hwnd
	unsignedlong		uid
	tag_rect		rect
	unsignedlong		hinstance
	long		lpsztext
end type

type msg from structure
	unsignedlong		hwnd
	unsignedlong		message
	unsignedlong		wparam
	unsignedlong		lparam
	long		time
	point		pt
end type

type point from structure
	long		x
	long		y
end type

global type uo_tooltip from nonvisualobject autoinstantiate
end type

type prototypes
//确保动态链接库（DLL）被加载
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:
// Constants
CONSTANT string TOOLTIPS_CLASS = 'tooltips_class32'
CONSTANT ulong CW_USEDEFAULT = 2147483648
CONSTANT long WM_USER = 1024
CONSTANT long WS_EX_TOPMOST = 8
// ToolTip Messages
CONSTANT long TTM_ADDTOOL = WM_USER + 4
CONSTANT long TTM_RELAYEVENT = WM_USER + 7

Public:

CONSTANT integer STYLE_NORMAL = 0
CONSTANT integer STYLE_BALLOONTIP = 1
integer TIPSTYLE = STYLE_NORMAL

long hWndTT		
// Tooltip control window handle
long ToolID = 1	// Tooltip internal ID
// Tooltip flags
constant long TOOLINFO_SIZE = 40

CONSTANT integer TTF_CENTERTIP = 2
CONSTANT integer TTF_RTLREADING = 4
//CONSTANT integer TTF_DI_SETITEM = 32768
//CONSTANT long TTM_NEWTOOLRECT	= WM_USER + 6
CONSTANT integer TTS_BALLOON = 64

end variables

forward prototypes
public subroutine showtip (dragobject ControlObject)
public function integer controlregister (dragobject controlobject, string tip, integer flag)
end prototypes

public subroutine showtip (dragobject ControlObject);MSG Msg
Msg.hWnd = Handle(ControlObject)
Msg.Message	= 512	// WM_MOUSEMOVE
Msg.WParam = Message.WordParm
Msg.Lparam = Message.LongParm

RelayMsg(hWndTT,TTM_RELAYEVENT,0,Msg)
end subroutine

public function integer controlregister (dragobject controlobject, string tip, integer flag);if hWndTT<=0 then
	if  TIPSTYLE = STYLE_BALLOONTIP then 
		hWndTT = CreateWindowExA(WS_EX_TOPMOST,TOOLTIPS_CLASS,0, TTF_CENTERTIP + TTS_BALLOON + 2, &
         	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 = Flag 
ToolInfo.hWnd = Handle(ControlObject)
ToolInfo.hInstance = 0
ToolInfo.uID = ToolID
ToolID++
ToolInfo.lpszText = LocalAlloc(0,80)

POST LocalFree(ToolInfo.lpszText)

lStrCpy(ToolInfo.lpszText,Left(tip,80))

tag_rect lrect

lrect.Left = 0
lrect.top = 0
lrect.right = UnitsToPixels(ControlObject.Width,XUnitsToPixels!)
lrect.bottom = UnitsToPixels(ControlObject.Height,YUnitsToPixels!)

ToolInfo.Rect = lrect

If ToolTipMsg(hWndTT,TTM_ADDTOOL, 1, ToolInfo) = 0 Then
//	MessageBox("出错","不能注册对象！",StopSign!,Ok!)
	Return(-1)
End If
Return(ToolID - 1)
end function

event constructor;InitCommonControls()



end event

event destructor;DestroyWindow(hWndTT)
end event

on uo_tooltip.create
call super::create
TriggerEvent( this, "constructor" )
end on

on uo_tooltip.destroy
TriggerEvent( this, "destructor" )
call super::destroy
end on