主要供以grid方式展示查询数据使用， 包括以下几个功能：
1、点击列头排序（可选）；
2、 时候，自动用微帮助展示（可选）；
3、数据库错误时中文提示；
包括以下对象（按顺序导入即可）：
1、gf_dberrormsg
global type gf_dberrormsg from function_object
end type
forward prototypes
global function integer gf_dberrormsg (long sqldbcode, string sqlerrtext, long row, string as_ty)
end prototypes
global function integer gf_dberrormsg (long sqldbcode, string sqlerrtext, long row, string as_ty);//有关数据窗口的错误：
Choose Case SQLDBCode
Case 1400
If as_ty = "freeform" Then
MessageBox("提示信息" , "请查找空项，并填入内容，才能保存!")
Else
MessageBox("提示信息","请查找第"+String(row)+"行空列,并填入内容,才能保存!")
End If
Case 1
If as_ty = "freeform" Then
MessageBox("提示信息" , "此项记录已经存在，不能重复!")
Else
MessageBox("提示信息","请查重复行第"+String(row)+"行,修改某列或删除重复行,才能保存!")
End If
Case 3114
MessageBox("提示信息","没有连接数据库,建议重新运行应用程序!")
Case -193
If as_ty = "freeform" Then
MessageBox("提示信息" , "此项记录已经存在，不能重复!")
Else
MessageBox("提示信息","请查重复行第"+String(row)+"行,修改某列或删除重复行,才能保存!")
End If
Case -195 // Required value is NULL.
If as_ty = "freeform" Then
MessageBox("提示信息" , "请查找空项，并填入内容，才能保存!")
Else
MessageBox("提示信息","请查找第"+String(row)+"行空列,并填入内容,才能保存!")
End If
Case -3
MessageBox("注意信息","原数据已被其它用户修改,请重新检索后再保存!")
Case 2601
MessageBox("注意信息","主键记录重复,不能保存!")
Case 233
MessageBox("注意信息","主键记录为空,不能保存!")
Case 1105 //Sybase??
MessageBox("注意信息","数据库日志满,请通知系统管理员清日志!")
Case 2627
MessageBox("注意信息","您新增的记录已存在，插入失败! 也许是网络冲突，请您稍后再做此项操作。")
Case -932
MessageBox("注意信息","请检查网络是否正常工作!")
Case 10004
MessageBox("注意信息","请检查数据库是否正常工作!")
Case 999
MessageBox("注意信息","请检查服务器是否正常工作!")
Case Else
MessageBox("数据库提示信息:","出错行：" + String(row) + ", 出错信息：" + SQLErrText+"SQLDBCode:"+string(SQLDBCode))
End Choose
Return 1
end function
2、n_cst_dwsrv_gridsort
forward
global type n_cst_dwsrv_gridsort from nonvisualobject
end type
end forward
global type n_cst_dwsrv_gridsort from nonvisualobject
event type long ue_lbuttondown ( unsignedlong flags, integer xpos, integer ypos )
event type long ue_lbuttonup ( unsignedlong flags, integer xpos, integer ypos )
end type
global n_cst_dwsrv_gridsort n_cst_dwsrv_gridsort
type prototypes
Function ULong SetCapture(ULong hWnd) Library "USER32.DLL"
Function Boolean ReleaseCapture() Library "USER32.DLL"
end prototypes
type variables
Private:
DataWindow idw_requestor
string i_str_oldcolumn //上次点击排序的列名
string i_str_newcolumn //本次点击排序的列名
string i_str_arrowname //排序用的小三角符号名
string i_str_sort='A' //上次排序是升序(A)还是降序(B)
string i_str_flag='0' //是否已执行正确的鼠标按下事件(0-否,1-是)
end variables
forward prototypes
public function integer of_setrequestor (datawindow adw_requestor)
end prototypes
event type long ue_lbuttondown(unsignedlong flags, integer xpos, integer ypos);String str_band,str_object,str_title,str_column
int li_x
str_band = idw_requestor.GetBandAtPointer() //得到当前鼠标所指对象所在的带区
str_band = Left(str_band,(Pos(str_band,'~t') - 1))
If str_band <> 'header' Then Return 0 //单击非头区，退出
str_object = idw_requestor.GetObjectAtPointer() //得到当前鼠标所指对象名
str_object = Left(str_object,(Pos(str_object,'~t') - 1))
If str_object = '' Or IsNull(str_object) Then Return 0 //未得到，退出
If Right(str_object,4) = '_lag' Then //点击的是小三角符号对象，说明上次点击过该列
str_title = Left(str_object,(Len(str_object) - 4))
Else //头一次点击该列
str_title = str_object
End If
//得到列对象名(默认为列名_t为列标题)
str_column = Left(str_title,(Len(str_title) - 2))
//判断该名称是否为列名字
If idw_requestor.Describe(str_column+".band") = '!' Then Return 0//非是列名，即列标题不是按正常规律起名的。
//列的交接处，可能出现调整列宽度状态
li_x=integer(idw_requestor.Describe(str_object+".X"))
if String(idw_requestor.Object.DataWindow.HorizontalScrollSplit)='0' then
if xpos+integer(idw_requestor.Object.DataWindow.HorizontalScrollPosition)- li_x<=6 then
return 0
end if
end if
i_str_newcolumn = str_column //得到当前单击的列
idw_requestor.Modify(str_title+".border='5'") //设置下凹动画效果
i_str_flag = '1' //已启动单击事件
//设置鼠标捕获
SetCapture(Handle(idw_requestor)) //将鼠标的动作转移给指定的DW窗口
Return 0
end event
event type long ue_lbuttonup(unsignedlong flags, integer xpos, integer ypos);String str_title,str_object,str_tmp,str_column,str_sort
Long lng_posy,lng_left,lng_top,lng_right,lng_bottom
lng_posy = ypos
str_object = idw_requestor.GetObjectAtPointer()
ReleaseCapture() //必须先释放鼠标否则该鼠标动作将一直被数据窗口捕获
str_title = i_str_newcolumn+'_t'
If i_str_flag = '1' Then
lng_left = Long(idw_requestor.Describe(str_title+".x"))
lng_top = Long(idw_requestor.Describe(str_title+".y"))
lng_right = lng_left+Long(idw_requestor.Describe(str_title+".width"))
lng_bottom = lng_top+Long(idw_requestor.Describe(str_title+".height"))
str_object = Left(str_object,(Pos(str_object,'~t') - 1))
If Not (str_object = '' Or IsNull(str_object)) Then //得到单击对象
If Right(str_object,4) = '_lag' Then //点击的是箭头对象，说明上次已点击过此列
str_tmp = Left(str_object,(Len(str_object) - 4))
Else //头一次点击该列
str_tmp = str_object
End If
If str_tmp = str_title Then //说明是在点击列上释放鼠标的
//判断是否上次点击该列，并排序
If i_str_oldcolumn = i_str_newcolumn Then //上次点击的也是此列
If i_str_sort = 'A' Then
str_sort = 'D'
str_tmp = '6'
Else
str_sort = 'A'
str_tmp = '5'
End If
Else //上次点击的不是此列
str_sort = 'A'
str_tmp = '5'
End If
//不管有没有全删除箭头对象
idw_requestor.Modify("destroy "+i_str_arrowname)
i_str_arrowname = str_title+'_lag' //生成新的箭头对象名=标题名_lag
str_tmp = 'create text(band=header alignment="0" text="'+str_tmp+'" border="0" color="16711680" x="'+String(lng_left)+'" y="'+String(lng_top)+'" height="'+String(lng_bottom - lng_top)+'" width="10" name='+i_str_arrowname+' visible="1" font.face="Webdings" font.height="-12" font.weight="400" font.family="1" font.pitch="2" font.charset="2" background.mode="1" background.color="553648127" )'
idw_requestor.Modify(str_tmp)
str_tmp = i_str_newcolumn+' '+str_sort
idw_requestor.SetSort(str_tmp)
idw_requestor.Sort()
i_str_oldcolumn = i_str_newcolumn
i_str_newcolumn = ''
i_str_sort = str_sort
End If
End If
End If
idw_requestor.Modify(str_title+".border='6'")
i_str_flag = '0'
Return 0
end event
public function integer of_setrequestor (datawindow adw_requestor);If IsNull(adw_requestor) or Not IsValid(adw_requestor) Then
Return -1
End If
idw_Requestor = adw_Requestor
Return 1
end function
on n_cst_dwsrv_gridsort.create
call super::create
TriggerEvent( this, "constructor" )
end on
on n_cst_dwsrv_gridsort.destroy
TriggerEvent( this, "destructor" )
call super::destroy
end on
event constructor;//单击列标题对列进行排序
end event
3、nvo_tooltips
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
4、n_cst_dwsrv_autohint
forward
global type n_cst_dwsrv_autohint from nonvisualobject
end type
type logfont from structure within n_cst_dwsrv_autohint
end type
type textsize from structure within n_cst_dwsrv_autohint
end type
end forward
type logfont from structure
long lfHeight
long lfWidth
long lfEscapement
long lfOrientation
long lfWeight
character lfItalic
character lfUnderline
character lfStrikeOut
character lfCharSet
character lfOutPrecision
character lfClipPrecision
character lfQuality
character lfPitchAndFamily
string lfFaceName
end type
type textsize from structure
long l_cx
long l_cy
end type
global type n_cst_dwsrv_autohint from nonvisualobject
event type long ue_mousemove ( unsignedlong flags, integer xpos, integer ypos )
event type long resize ( unsignedlong sizetype, integer newwidth, integer newheight )
end type
global n_cst_dwsrv_autohint n_cst_dwsrv_autohint
type prototypes
FUNCTION ulong GetDC(ulong hwnd) LIBRARY "user32.dll"
FUNCTION ulong ReleaseDC(ulong hwnd,ulong hdc) LIBRARY "user32.dll"
FUNCTION ulong SelectObject(ulong hdc,ulong hObject) LIBRARY "gdi32.dll"
FUNCTION ulong DeleteObject(ulong hObject) LIBRARY "gdi32.dll"
FUNCTION ulong CreateFontIndirect(ref LOGFONT lpLogFont) LIBRARY "gdi32.dll" ALIAS FOR "CreateFontIndirectA"
FUNCTION ulong GetTextExtentExPoint(ulong hdc,ref string lpszStr,ulong cchString,ulong nMaxExtent,ref ulong lpnFit,ref ulong alpDx,ref textSIZE lpSize) LIBRARY "gdi32.dll" ALIAS FOR "GetTextExtentExPointA"
FUNCTION ulong GetTextExtentPoint32(ulong hdc,ref string lpsz,ulong cbString,ref textSIZE lpSize) LIBRARY "gdi32.dll" ALIAS FOR "GetTextExtentPoint32A"
Function long MulDiv (long nNumber, long nNumerator, long nDenominator) Library "KERNEL32.DLL"
FUNCTION ulong GetDeviceCaps(ulong hdc,ulong nIndex) LIBRARY "gdi32.dll"
end prototypes
type variables
Private:
DataWindow idw_requestor
nvo_tooltips ToolTip
String is_prior_dwo
end variables
forward prototypes
public function long of_gettextwidth (string as_colname, string as_text)
public subroutine of_replacestring (ref string as_src, string as_oldstr, string as_newstr)
public function integer of_setrequestor (datawindow adw_requestor)
end prototypes
event type long ue_mousemove(unsignedlong flags, integer xpos, integer ypos);String ls_dwo,ls_col,ls_text
Long ll_row
Int li_pos
ls_dwo = idw_requestor.GetObjectAtPointer()
If is_prior_dwo = ls_dwo Then
Return 0
Else
is_prior_dwo = ls_dwo
End If
If Tooltip.tipvisible() or flags <> 0 Then
Tooltip.hidetip(idw_requestor)
end if
li_pos = Pos(ls_dwo, "~t")
If li_pos <= 0 Then Return 0
ls_col = Left (ls_dwo, li_pos - 1 )
ll_row = Long(Mid(ls_dwo,li_pos + 1 ))
If idw_requestor.Describe(ls_col+".Type") <> "column" Then Return 0 //不是列对象
Long ll_width,ll_needWidth,ll_x
String ls_editSty
ll_width = Long(idw_requestor.Describe(ls_col+".Width"))
ll_x = Long(idw_requestor.Describe(ls_col+".x"))
ls_editSty = idw_requestor.Describe(ls_col+".Edit.Style")
If ls_editSty = "editmask" Then //有掩码
Int li_colNum
String ls_mask
li_colNum = Integer(idw_requestor.Describe(ls_col+".ID"))
ls_mask = idw_requestor.Describe(ls_col+".EditMask.Mask")
If Left(idw_requestor.Describe(ls_col+".Coltype"),4) = "char" Then //字符型掩码
//字符可以转化为数字（直接用string(s,"##")得不到）
of_replaceString(ls_mask,"#","@")
ls_text = String(idw_requestor.Object.Data[ll_row,li_colNum],ls_mask)
Else //其它类型掩码
//// messagebox("",ls_mask)
ls_text = String(idw_requestor.Object.Data[ll_row,li_colNum],ls_mask)
End If
Else
//当前行列值（便于dddw,ddlb得到显示值）
ls_text = idw_requestor.Describe("Evaluate('LookUpDisplay("+ls_col+")',"+String(ll_row)+")")
End If
//需要宽度
ll_needWidth = of_getTextWidth(ls_col,ls_text)
If ls_editSty = "checkbox" Or ls_editSty = "radiobuttons" Then
//这两种类型需要加个额外值
ll_needWidth+= 86
End If
//列的宽度不够 或者 位于显示的最右列，只能显示一部分
If ll_width < ll_needWidth Or &
ll_x+ll_width >= idw_requestor.Width +Long(idw_requestor.Object.DataWindow.HorizontalScrollPosition) Then
//修改Tip
Tooltip.SetTipText( idw_requestor, Tooltip.ToolID - 1,ls_text)
Tooltip.relaymsg(idw_requestor)
Return 0
End If
Return 0
end event
event type long resize(unsignedlong sizetype, integer newwidth, integer newheight);If sizetype <> 1 Then
Tooltip.updatetiprect(idw_requestor,Tooltip.ToolID - 1 ,0,0,&
UnitsToPixels(idw_requestor.Width, XUnitsToPixels!),UnitsToPixels(idw_requestor.Height, YUnitsToPixels!) )
End If
Return 0
end event
public function long of_gettextwidth (string as_colname, string as_text);//根据列名和文本，得到文本的显示宽度
//得到字体相关信息
Int li_charset
li_charset = Integer(idw_requestor.Describe(as_colName+".Font.CharSet"))
Int li_Escapement
li_Escapement = Integer(idw_requestor.Describe(as_colName+".Font.Escapement"))
String ls_Face
ls_Face = idw_requestor.Describe(as_colName+".Font.Face")
Int li_Family
li_Family = Integer(idw_requestor.Describe(as_colName+".Font.Family"))
Int li_height
li_height = Integer(idw_requestor.Describe(as_colName+".Font.Height"))
Int li_Italic
li_Italic = Integer(idw_requestor.Describe(as_colName+".Font.Italic"))
Int li_Pitch
li_Pitch = Integer(idw_requestor.Describe(as_colName+".Font.Pitch"))
Int li_Strikethrough
li_Strikethrough = Integer(idw_requestor.Describe(as_colName+".Font.Strikethrough"))
Int li_Underline
li_Underline = Integer(idw_requestor.Describe(as_colName+".Font.Underline"))
Int li_Weight
li_Weight = Integer(idw_requestor.Describe(as_colName+".Font.Weight"))
Int li_Width
li_Width = Integer(idw_requestor.Describe(as_colName+".Font.Width"))
Long ll_newFont,ll_oldFont,ll_hdc
LOGFONT lst_Font
lst_Font.lfWeight = li_Weight
lst_Font.lfWidth = li_Width
If li_Italic = 1 Then
lst_Font.lfItalic = Char(255)
Else
lst_Font.lfItalic = Char(0)
End If
If li_Underline = 1 Then
lst_Font.lfUnderline = Char(1)
Else
lst_Font.lfUnderline = Char(0)
End If
If li_Strikethrough = 1 Then
lst_Font.lfStrikeOut = Char(1)
Else
lst_Font.lfStrikeOut = Char(0)
End If
//DEFAULT_CHARSET
lst_Font.lfCharSet = Char(li_charset)
lst_Font.lfOutPrecision = Char(0)
lst_Font.lfClipPrecision = Char(0)
lst_Font.lfQuality = Char(0)
lst_Font.lfPitchAndFamily = Char(0)
lst_Font.lfFaceName = ls_Face
ll_hdc = getdc(Handle(idw_requestor))
//以点为大小单位的字体转变成设备所需要的恰当的逻辑大小
//LOGPIXELSY=90
//muldiv : abs(li_Height)*getdevicecaps(ll_hdc,90)/72
lst_Font.lfHeight = - muldiv(Abs(li_height),getdevicecaps(ll_hdc,90),72)
//用指定的属性创建逻辑字体
ll_newFont = CreateFontIndirect(lst_Font)
//选入
ll_oldFont = SelectObject(ll_hdc,ll_newFont)
TextSize lstr_Size
//判断字串的大小
GetTextExtentpoint32(ll_hdc, as_text, Len(as_text), lstr_Size )
//恢复
SelectObject(ll_hdc,ll_oldFont)
//释放资源
DeleteObject(ll_newFont)
ReleaseDC(Handle(idw_requestor),ll_hdc)
//返回宽度（unit单位）
Return PixelsToUnits(lstr_Size.l_cx,XPixelsToUnits!)
end function
public subroutine of_replacestring (ref string as_src, string as_oldstr, string as_newstr);Int start_pos = 0
// Find the first occurrence of old_str.
start_pos = Pos(as_src, as_oldstr)
// Only enter the loop if you find old_str.
Do While start_pos > 0
// Replace old_str with new_str.
as_src = Replace(as_src, start_pos, &
Len(as_oldstr), as_newstr)
// Find the next occurrence of old_str.
start_pos = Pos(as_src, as_oldstr, &
start_pos+Len(as_newstr))
Loop
end subroutine
public function integer of_setrequestor (datawindow adw_requestor);If IsNull(adw_requestor) Or Not IsValid(adw_requestor) Then
Return -1
End If
idw_Requestor = adw_requestor
toolTip.addtool(adw_requestor,"",0)
Return 1
end function
on n_cst_dwsrv_autohint.create
call super::create
TriggerEvent( this, "constructor" )
end on
on n_cst_dwsrv_autohint.destroy
TriggerEvent( this, "destructor" )
call super::destroy
end on
5、uo_dw_query
forward
global type uo_dw_query from datawindow
end type
end forward
global type uo_dw_query from datawindow
integer width = 1797
integer height = 712
integer taborder = 1
boolean hscrollbar = true
boolean vscrollbar = true
boolean livescroll = true
borderstyle borderstyle = stylelowered!
event mousemove pbm_mousemove
event ue_mouseup pbm_lbuttonup
event ue_lbuttondown pbm_lbuttondown
event ue_mousemove pbm_mousemove
end type
global uo_dw_query uo_dw_query
type prototypes
Function ulong SetCapture(ulong hWnd) Library "USER32.DLL"
Function BOOLEAN ReleaseCapture() Library "USER32.DLL"
FUNCTION ulong GetCapture() LIBRARY "user32.dll"
end prototypes
type variables
Public:
Boolean SortAfterClickOnHeader = True
Boolean AutoHint = False
Private:
n_cst_dwsrv_gridSort inv_gridSort
n_cst_dwsrv_autoHint inv_antohint
end variables
event ue_mouseup;If SortAfterClickOnHeader And IsValid(inv_gridSort) Then
inv_gridSort.Event ue_lbuttonup(flags,xpos,ypos)
End If
end event
event ue_lbuttondown;If SortAfterClickOnHeader And IsValid(inv_gridSort) Then
inv_gridSort.Event ue_lbuttondown(flags,xpos,ypos)
End If
end event
event ue_mousemove;If AutoHint And IsValid(inv_antohint) Then
inv_antohint.Event ue_MouseMove(flags,xpos,ypos)
End If
end event
on uo_dw_query.create
end on
on uo_dw_query.destroy
end on
event constructor;SetTransObject(sqlca)
If SortAfterClickOnHeader Then
inv_gridSort = Create n_cst_dwsrv_gridSort
inv_gridSort.of_SetRequestor(This)
End If
If AutoHint Then
inv_antohint = Create n_cst_dwsrv_autoHint
inv_antohint.of_SetRequestor(This)
End If
end event
event rowfocuschanged;//
end event
event clicked;if row<>0 then
this.setRow(row)
end if
end event
event dberror;if SQLDBCode = -1 then
int li_rtn
//重新连接成功，则返回
li_rtn = SetTranSobject(sqlca)
if li_rtn = 1 then return 1
end if
//display different message according the datawindow is freeform or not
If This.Object.datawindow.processing = "0" Then
gf_dberrormsg(SQLDBCode,SQLErrText,row , "freeform")
Else
gf_dberrormsg(SQLDBCode , SQLErrText , row , "")
End If
sqlca.SQLCode = -1
Return 1
end event
event destructor;If IsValid(inv_gridSort) Then
Destroy inv_gridSort
End If
If IsValid(inv_antohint) Then
Destroy inv_antohint
End If
end event
event itemerror;string ls_column , ls_message
if trim(data) = "" then
return 3
end if
ls_column = dwo.name
ls_message = this.describe(ls_column + ".validationmsg")
if trim(ls_message) <> "?" then
messagebox("提示信息" , ls_message)
return 3
else
messagebox("提示信息" , "该项数据不合法!")
return 3
end if
/*
各返回值意义：
0－拒绝此数值，显示错误消息
1－拒绝此数值，但不显示错误消息
2－接受此数值。
3－拒绝此数值，但允许改变焦点，用原值来代替新值
*/
end event
本文地址：http://com.8s8s.com/it/it19303.htm