一个供查询用的datawindow

      主要供以grid方式展示查询数据使用， 包括以下几个功能：

1、点击列头排序（可选）；

2、 时候，自动用微帮助展示（可选）；

3、数据库错误时中文提示；

      包括以下对象（按顺序导入即可）：

1、gf_dberrormsg

global type gf_dberrormsg from function_objectend type

forward prototypesglobal 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

forwardglobal type n_cst_dwsrv_gridsort from nonvisualobjectend typeend forward

global type n_cst_dwsrv_gridsort from nonvisualobjectevent type long ue_lbuttondown ( unsignedlong flags,  integer xpos,  integer ypos )event type long ue_lbuttonup ( unsignedlong flags,  integer xpos,  integer ypos )end typeglobal n_cst_dwsrv_gridsort n_cst_dwsrv_gridsort

type prototypesFunction ULong SetCapture(ULong hWnd) Library "USER32.DLL"Function Boolean ReleaseCapture() Library "USER32.DLL"

end prototypes

type variablesPrivate: 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 prototypespublic 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_columnint 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_objectEnd 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 ifend 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_sortLong lng_posy,lng_left,lng_top,lng_right,lng_bottom

lng_posy = yposstr_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 IfEnd Ifidw_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 -1End If

idw_Requestor = adw_RequestorReturn 1end function

on n_cst_dwsrv_gridsort.createcall super::createTriggerEvent( this, "constructor" )end on

on n_cst_dwsrv_gridsort.destroyTriggerEvent( this, "destructor" )call super::destroyend on

event constructor;//单击列标题对列进行排序end event

3、nvo_tooltips

forwardglobal type nvo_tooltips from nonvisualobjectend typetype point from structure within nvo_tooltipsend typetype msg from structure within nvo_tooltipsend typetype rect from structure within nvo_tooltipsend typetype toolinfo from structure within nvo_tooltipsend typeend forward

type point from structure long  x long  yend type

type msg from structure long  hwnd long  message long  wparam long  lparam long  time point  ptend type

type rect from structure long  left long  top long  right long  bottomend type

type toolinfo from structure long  cbsize long  uflags long  hwnd long  uid rect  rect long  hinstance string  lpsztextend type

global type nvo_tooltips from nonvisualobject autoinstantiateend 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 = 2147483648CONSTANT long WM_USER = 1024CONSTANT long WS_EX_TOPMOST = 8CONSTANT long WM_SETFONT = 48

// ToolTip MessagesConstant long TTM_ADDTOOL   = WM_USER + 4Constant long TTM_DELTOOL = WM_USER + 5Constant long TTM_NEWTOOLRECT = WM_USER + 6Constant long TTM_RELAYEVENT   = WM_USER + 7Constant long TTM_POPUP =WM_USER + 34 Constant long TTM_UPDATE= WM_USER + 29Constant long TTM_UPDATETIPTEXT = WM_USER + 12Constant long TTM_TRACKACTIVATE = WM_USER + 17Constant long TTM_TRACKPOSITION = WM_USER + 18Constant long TTM_SETMAXTIPWIDTH = 1048Constant long TTM_GETMAXTIPWIDTH = WM_USER + 25Constant long TTM_SETTIPBKCOLOR = WM_USER + 19Constant long TTM_SETTIPTEXTCOLOR = WM_USER + 20Constant long TTM_SETTITLEA = WM_USER + 32// Tooltip flagsConstant integer TTF_CENTERTIP   = 2Constant integer TTF_RTLREADING = 4Constant integer TTF_SUBCLASS  = 16Constant integer TTF_TRACK  = 32Constant integer TTF_ABSOLUTE  = 128Constant integer TTF_TRANSPARENT = 256Constant integer TTF_DI_SETITEM  = 32768Constant integer TTS_BALLOON = 64

// Title ConstantsConstant integer TTI_NONE = 0Constant integer TTI_INFO = 1Constant integer TTI_WARNING = 2Constant integer TTI_ERROR = 3//公共变量和常量Public:long hWndTT=0 // Tooltip control window handlelong ToolID = 1 // Tooltip internal ID

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



end variables

forward prototypespublic 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 = 40ToolInfo.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  = LeftTOOLINFO.Rect.Top   = TopTOOLINFO.Rect.Right  = RightTOOLINFO.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 IfEnd If

TOOLINFO TOOLINFO

TOOLINFO.cbSize = 40TOOLINFO.uFlags = FlagsTOOLINFO.hWnd = Handle(Object)TOOLINFO.hInstance = 0TOOLINFO.uID = ToolIDToolID++TOOLINFO.lpszText = tiptext//LStrCpy(ToolInfo.lpszText,Left(tiptext,80))

TOOLINFO.Rect.Left  = 0TOOLINFO.Rect.Top   = 0TOOLINFO.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 MSGMSG.hWnd = Handle(ControlObject)MSG.Message  = 513 // WM_LBUTTONDOWNMSG.WParam = Message.WordParmMSG.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 = uIDToolInfo.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! ) )

Returnend 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 TOOLINFOInteger li_Width, li_Height

TOOLINFO.cbSize   = 40TOOLINFO.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_MOUSEMOVEMSG.Message  = 512MSG.WParam   = Message.WordParmMSG.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_MOUSEMOVEMSG.Message  = 512MSG.WParam   = WordParmMSG.LParam   = LongParm

RelayMsg(hWndTT,TTM_RELAYEVENT,0,MSG)

end subroutine

on nvo_tooltips.createcall super::createTriggerEvent( this, "constructor" )end on

on nvo_tooltips.destroyTriggerEvent( this, "destructor" )call super::destroyend 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

forwardglobal type n_cst_dwsrv_autohint from nonvisualobjectend typetype logfont from structure within n_cst_dwsrv_autohintend typetype textsize from structure within n_cst_dwsrv_autohintend typeend 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  lfFaceNameend type

type textsize from structure long  l_cx long  l_cyend type

global type n_cst_dwsrv_autohint from nonvisualobjectevent type long ue_mousemove ( unsignedlong flags,  integer xpos,  integer ypos )event type long resize ( unsignedlong sizetype,  integer newwidth,  integer newheight )end typeglobal n_cst_dwsrv_autohint n_cst_dwsrv_autohint

type prototypesFUNCTION 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 clearcase/" target="_blank" >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 variablesPrivate: DataWindow idw_requestor nvo_tooltips ToolTip String is_prior_dwo

end variables

forward prototypespublic 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_textLong ll_rowInt li_posls_dwo = idw_requestor.GetObjectAtPointer()

If is_prior_dwo = ls_dwo Then Return 0Else is_prior_dwo = ls_dwoEnd 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_xString ls_editStyll_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 IfElse //当前行列值（便于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+= 86End 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 0End 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_charsetli_charset = Integer(idw_requestor.Describe(as_colName+".Font.CharSet"))Int li_Escapementli_Escapement = Integer(idw_requestor.Describe(as_colName+".Font.Escapement"))String ls_Facels_Face = idw_requestor.Describe(as_colName+".Font.Face")Int li_Familyli_Family = Integer(idw_requestor.Describe(as_colName+".Font.Family"))Int li_heightli_height = Integer(idw_requestor.Describe(as_colName+".Font.Height"))Int li_Italicli_Italic = Integer(idw_requestor.Describe(as_colName+".Font.Italic"))Int li_Pitchli_Pitch = Integer(idw_requestor.Describe(as_colName+".Font.Pitch"))Int li_Strikethroughli_Strikethrough = Integer(idw_requestor.Describe(as_colName+".Font.Strikethrough"))Int li_Underlineli_Underline = Integer(idw_requestor.Describe(as_colName+".Font.Underline"))Int li_Weightli_Weight = Integer(idw_requestor.Describe(as_colName+".Font.Weight"))Int li_Widthli_Width = Integer(idw_requestor.Describe(as_colName+".Font.Width"))

Long ll_newFont,ll_oldFont,ll_hdcLOGFONT    lst_Font

lst_Font.lfWeight = li_Weightlst_Font.lfWidth = li_WidthIf li_Italic = 1 Then lst_Font.lfItalic = Char(255)Else lst_Font.lfItalic = Char(0)End IfIf li_Underline = 1 Then lst_Font.lfUnderline = Char(1)Else lst_Font.lfUnderline = Char(0)End IfIf li_Strikethrough = 1 Then lst_Font.lfStrikeOut = Char(1)Else lst_Font.lfStrikeOut = Char(0)End If//DEFAULT_CHARSETlst_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)/72lst_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 -1End If

idw_Requestor = adw_requestor

toolTip.addtool(adw_requestor,"",0)Return 1

end function

on n_cst_dwsrv_autohint.createcall super::createTriggerEvent( this, "constructor" )end on

on n_cst_dwsrv_autohint.destroyTriggerEvent( this, "destructor" )call super::destroyend on

5、uo_dw_query

forwardglobal type uo_dw_query from datawindowend typeend forward

global type uo_dw_query from datawindowinteger width = 1797integer height = 712integer taborder = 1boolean hscrollbar = trueboolean vscrollbar = trueboolean livescroll = trueborderstyle borderstyle = stylelowered!event mousemove pbm_mousemoveevent ue_mouseup pbm_lbuttonupevent ue_lbuttondown pbm_lbuttondownevent ue_mousemove pbm_mousemoveend typeglobal uo_dw_query uo_dw_query

type prototypesFunction ulong SetCapture(ulong hWnd) Library "USER32.DLL"Function BOOLEAN ReleaseCapture() Library "USER32.DLL"FUNCTION ulong GetCapture() LIBRARY "user32.dll"

end prototypes

type variablesPublic: Boolean SortAfterClickOnHeader = True Boolean AutoHint = FalsePrivate: n_cst_dwsrv_gridSort inv_gridSort n_cst_dwsrv_autoHint inv_antohintend 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 Ifend event

on uo_dw_query.createend on

on uo_dw_query.destroyend on

event constructor;SetTransObject(sqlca)

If SortAfterClickOnHeader Then inv_gridSort = Create n_cst_dwsrv_gridSort inv_gridSort.of_SetRequestor(This)End IfIf 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 ifend event

event dberror;if SQLDBCode = -1 then int li_rtn //重新连接成功，则返回 li_rtn = SetTranSobject(sqlca) if li_rtn = 1 then return 1end if



//display different message according the datawindow is freeform or notIf This.Object.datawindow.processing = "0" Then gf_dberrormsg(SQLDBCode,SQLErrText,row , "freeform")Else gf_dberrormsg(SQLDBCode , SQLErrText , row , "")End Ifsqlca.SQLCode = -1Return 1

end event

event destructor;If IsValid(inv_gridSort) Then Destroy inv_gridSortEnd If

If IsValid(inv_antohint) Then Destroy inv_antohintEnd If

end event

event itemerror;string ls_column , ls_message

if trim(data) = "" then return 3 end ifls_column = dwo.namels_message = this.describe(ls_column + ".validationmsg")if trim(ls_message) <> "?" then messagebox("提示信息" , ls_message)   return 3else messagebox("提示信息" , "该项数据不合法!") return 3end if

/* 各返回值意义： 0－拒绝此数值，显示错误消息 1－拒绝此数值，但不显示错误消息 2－接受此数值。 3－拒绝此数值，但允许改变焦点，用原值来代替新值*/end event

原文转自：http://www.ltesting.net