作者：瓜哥
准备工具 VFP SP7423 MYFLL
主角：MFYLL，瓜哥提供了一个函数，可以完美完成这个功能。
函数名：SQLCallback(nFuncType, cFuncName[,nFreq]) 缩写：sqlc SQL回调函数。采用一种插入技术，在VFP使用ODBC连接远程数据源过程中，能够调用vfp的程序。
同时支持SPT和CA，支持SQLIdleDisconnect。
目前支持两个回调函数，Fetch和RecordCount，可以用来在SPT下载数据过程产生一个进度信息。使用简便，性能要远高于异步方式。
注意 1.SQLCallback()函数必需在ODBC连接建立完后才能调用 2.不需要监控ODBC过程时，将cFuncName设为空串即可，如SQLCallback(1,"")关闭Fetch回调
返回值： 无 参数： nFuncType：要挂勾的函数类型，可为下面的值
#define SQL_CALLBACK_FETCH 1 #define SQL_CALLBACK_RECORD_COUNT 2
SQL_CALLBACK_FETCH:
此回调函数是VFP在下载数据时发生，每下载一条记录，回调一次函数，在此函数内部，可以使用Recno()来确定已下载的记录数量。
回调函数的格式为 Func()，没有参数。
SQL_CALLBACK_RECORD_COUNT：
此回调在向服务器发送SQL语句前发生，FLL内部将生成一条select count(*) from (your select cmd)向服务器索取记录总数，然后将记录总数做为参数调用你的函数。
此回调函数的格式为Func(nMaxRecord)，接收一个整型的参数，此函数只会被调用一次。
cFuncName：字符型，指定函数名，支持对像，如 MyFunc()或 thisform.UpdateProgress
不同回调类型可以指定相同的函数，但你要检查参数来区分是谁调用了你的回调函数。
[nFreq]：仅针对SQL_CALLBACK_RECORD_COUNT有效，设置回调的频率。默认值为１
最初没有这个参数，每下载一条数据产生一条回调，会降底性能。后来测试发现，此值设为100或更大的值时，如果数据量大能明显改善性能，与不使用回调函数时的速度相差无几。
*下面示例均以本机SQL的nothwind数据库为例，请行修改SQL连接串
代码语言：javascript复制*示例 1 一个简单的SPT获取下载记录数量示例
#define SQL_CALLBACK_FETCH 1
#define SQL_CALLBACK_RECORD_COUNT 2
Set Library To myfll
Clear
nHdl= SQLStringConnect("Driver=Sql Server;Server=localhost;database=northwind")
If nHdl <1
MessageBox("无法连接数据源……")
Return
EndIf
*加载一个CallBack
SQLCallback(SQL_CALLBACK_FETCH,"MyCallBack()")
SQLExec(nHdl,"select * from orders")
SQLDisconnect(nHdl)
Set Library To
Return
Procedure MyCallBack()
Wait window Transform(Recno()) nowait
EndProc
*------------------------------------------------------------------------------------
*示例 2 CA示例
#define SQL_CALLBACK_FETCH 1
#define SQL_CALLBACK_RECORD_COUNT 2
Set Library To myfll
Clear
nHdl= SQLStringConnect("Driver=Sql Server;Server=localhost;database=northwind")
If nHdl <1
MessageBox("无法连接数据源……")
Return
EndIf
*加载一个CallBack
SQLCallback(SQL_CALLBACK_FETCH,"MyCallBack()")
Local oCa as CursorAdapter
oCa=NewObject("CursorAdapter")
oCa.DataSourceType="ODBC"
oCa.DataSource=nHdl
oCa.SelectCmd="Select * from employees"
?"第一次填充……"
oCa.CursorFill()
*带索引测试CursorRefresh
?"创建索引……"
Index on FirstName to tmp
Set Order To Tag tmp
?"后台插入数据……"
SQLExec(nHdl,"insert into employees(LastName,FirstName)" ;
" values( ?Sys(2015),?Sys(2015))")
?"前台刷新数据……"
?oCa.CursorRefresh()
SQLDisconnect(nHdl)
Set Library To
Return
Procedure MyCallBack()
?Alias(),Recno() &&如果数据量多，?号速度相当慢
EndProc
*------------------------------------------------------------------------------------
*示例3 一个完整示例
oForm = NewObject("TestForm")
oForm.Show(1)
DEFINE CLASS TestForm AS form
Height = 315
Width = 422
DoCreate = .T.
AutoCenter = .T.
Caption = "Form1"
Name = "Form1"
ADD OBJECT progressbar1 AS progressbar WITH ;
Anchor = 10, ;
Top = 216, ;
Left = 12, ;
Width = 396, ;
Height = 24, ;
Name = "Progressbar1", ;
Shape.Name = "Shape", ;
Label.Name = "Label", ;
Mark.Name = "Mark"
ADD OBJECT edit1 AS editbox WITH ;
Anchor = 10, ;
Height = 61, ;
Left = 12, ;
Top = 36, ;
Width = 396, ;
Name = "Edit1"
ADD OBJECT label1 AS label WITH ;
Caption = "连接串", ;
Height = 16, ;
Left = 12, ;
Top = 12, ;
Width = 38, ;
Name = "Label1"
ADD OBJECT command1 AS commandbutton WITH ;
Top = 264, ;
Left = 192, ;
Height = 25, ;
Width = 60, ;
Anchor = 160, ;
Caption = "Command1", ;
Name = "Command1"
ADD OBJECT label2 AS label WITH ;
Caption = "SQL Select Cmd", ;
Height = 16, ;
Left = 12, ;
Top = 108, ;
Width = 156, ;
Name = "Label2"
ADD OBJECT edit2 AS editbox WITH ;
Anchor = 10, ;
Height = 61, ;
Left = 12, ;
Top = 132, ;
Width = 396, ;
Name = "Edit2"
PROCEDURE updateprogress
Lparameters nRecCount
If IsNum(nRecCount)
thisform.progressbar1.MaxValue= nRecCount
thisform.progressbar1.Value=0
Return
EndIf
thisform.progressbar1.Value =Recno()
*如果你看不到进度，需要下面这句代码
*UpdateWindow(thisform.HWnd)
ENDPROC
PROCEDURE Init
Set Library To myfll
thisform.edit1.Value ="Driver=Sql Server;Server=localhost;database=northwind"
thisform.edit2.Value ="Select * from Orders"
ENDPROC
PROCEDURE command1.Click
#define SQL_CALLBACK_FETCH 1
#define SQL_CALLBACK_RECORD_COUNT 2
SQLCallback(SQL_CALLBACK_RECORD_COUNT,"thisform.UpdateProgress")
SQLCallback(SQL_CALLBACK_FETCH,"thisform.UpdateProgress")
nHdl= SQLStringConnect(thisform.edit1.Value)
If nHdl <1
MessageBox("无法连接数据源……")
Return
EndIf
SQLExec(nHdl,thisform.edit2.Value,"temp")
SQLDisconnect(nHdl)
If Used("temp")
Browse
EndIf
ENDPROC
EndDefine
*======================================================================================================
DEFINE CLASS progressbar AS container
Width = 288
Height = 120
BackColor = RGB(235,235,235)
BorderColor = RGB(192,192,192)
maxvalue = 100
value = 0
_memberdata = [ ]
Name = "progressbar"
ADD OBJECT shape AS shape WITH ;
Top = 0, ;
Left = 0, ;
Height = 120, ;
Width = 108, ;
BorderStyle = 0, ;
BackColor = RGB(56,217,38), ;
Name = "Shape"
ADD OBJECT label AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "30%", ;
Height = 16, ;
Left = 133, ;
Top = 54, ;
Width = 20, ;
Name = "Label"
ADD OBJECT mark AS label WITH ;
BackStyle = 0, ;
Caption = "30%", ;
Height = 16, ;
Left = 133, ;
Top = 54, ;
Visible = .F., ;
Width = 0, ;
ForeColor = RGB(255,255,255), ;
Name = "Mark"
PROCEDURE value_assign
LPARAMETERS vNewVal
IF vNewVal<=0
this.Shape.Width=0
this.Label.Caption="0%"
this.Mark.Caption="0%"
RETURN
ENDIF
If m.vNewVal>this.MaxValue
m.vNewVal=this.MaxValue
EndIf
LOCAL nWidth &&记录进度的宽度
nWidth=m.vNewVal / this.MaxValue * this.Width - 2
IF nWidth>this.Width
nWidth=this.Width-2
ENDIF
***
this.Value=m.vNewVal
&&形状更新
this.Shape.Width=nWidth
&&百分数更新
IF this.value>=this.maxvalue
this.Label.Caption="100%"
ELSE
this.Label.Caption=Alltrim(STR(vNewVal/this.MaxValue * 100)) "%"
ENDIF
&&处理反色显示
IF this.shape.Width>this.label.Left
this.mark.Visible=.t.
this.mark.Caption=this.label.Caption
this.mark.Width=this.Shape.Width-this.Mark.Left
Else
this.mark.Visible=.f.
ENDIF
ENDPROC
HIDDEN PROCEDURE maxvalue_assign
LPARAMETERS vNewVal
IF m.vNewVal<1 &&不能小于１，否则会出错
m.vNewVal=1
ENDIF
THIS.maxvalue = m.vNewVal
this.Value=this.Value
ENDPROC
PROCEDURE Resize
If this.Height>=2
this.shape.Height=this.Height-2
EndIf
this.Label.Left=(this.Width-this.Label.Width )/2
this.Label.Top=(this.Height-this.Label.Height)/2 1
this.mark.Left=this.label.Left
this.mark.Top=this.label.Top
this.shape.Top=1
this.shape.Left=1
this.Value=this.Value
ENDPROC
PROCEDURE Init
this.Resize
ENDPROC
ENDDEFINE
