一、f_cncharnum函数 f_cncharnum.srf$PBExportHeader$f_cncharnum.srf$PBExportComments$得到字符串中汉字或者双字节的个数global type f_cncharnum from function_objectend typeforward prototypesglobal function integer f_cncharnum (string aString)end prototypesglobal function integer f_cncharnum (string aString);//函数名: f_cncharnum//用途: 返回一个字符串中汉字的个数//输入: aString - string, 给定的字符串//返回值: li_num - Integer, 给定的字符串中汉字的个数//注意: 1. 此方法基于汉字的国标汉字库区位编码的有效性，不符合此编码的系统此函数无效！// 2. 若汉字串含有非汉字字符,如图形符号或ASCII码,则这些非汉字字符将保持不变.//例如: li_ret = f_cncharnum("摆渡人ferryman") li_ret = 3string ls_ch //临时单元string ls_SecondSecTable //存放所有国标二级汉字读音integer li_num = 0 //返回值integer i,jFor i = 1 to Len(aString)ls_ch = Mid(aString,i,1)If Asc(ls_ch) >= 128 then //是汉字li_num++i = i+1End ifNextReturn li_numend function
二、PBToExcel函数f_outputtoexcel_new.srf
$PBExportHeader$f_outputtoexcel_new.srfglobal type f_outputtoexcel_new from function_objectend typeforward prototypesglobal function integer f_outputtoexcel_new (datawindow adw)end prototypesglobal function integer f_outputtoexcel_new (datawindow adw);//函数名:f_outputtoexcel_new//输入: adw - datawindow,指定的数据窗口//返回值: Integerconstant integer ppLayoutBlank = 12OLEObject ole_objectole_object = CREATE OLEObjectinteger li_retli_ret = ole_object.ConnectToObject("","Excel.Application")IF li_ret <> 0 THEN//如果Excel还没有打开，则新建。li_ret = ole_object.ConnectToNewObject("Excel.Application")if li_ret <> 0 thenMessageBox('OLE错误','OLE无法连接!错误号：' + string(li_ret))return 0end ifole_object.Visible = TrueEND IFpointer oldpointeroldpointer = SetPointer(HourGlass!)ole_object.Workbooks.Addlong ll_colnum,ll_rownumstring ls_valuestring ls_objects,ls_obj,ls_objs[],ls_objtag[]long ll_pos,ll_len,ll_num = 0ls_objects = trim(adw.Describe('datawindow.Objects'))do while (pos(ls_objects,"~t") > 0)ll_pos = pos(ls_objects,"~t")ll_len = ll_pos - 1ls_obj = left(ls_objects,ll_len)if (adw.Describe(ls_obj + '.type') = 'column' or &adw.Describe(ls_obj + '.type') = 'compute') and &(adw.Describe(ls_obj + '.band') = 'detail') and (ls_obj <> "asd") thenll_num += 1ls_objs[ll_num] = ls_objls_objtag[ll_num] = adw.Describe(ls_obj + '.tag')end ifls_objects = right(ls_objects,len(ls_objects) - ll_pos)loop//得到数据窗口数据的列数与行数（行数应该是数据行数 + 1）ll_colnum = ll_numll_rownum = adw.rowcount() + 1string ls_colnameinteger i,j,kfor i = 1 to ll_colnum//得到标题头的名字ls_value = ls_objtag[i]ole_object.cells(1,i).value = ls_valuenextstring column_namefor i = 2 to ll_rownumfor j = 1 to ll_colnumcolumn_name = ls_objs[j]if adw.Describe(column_name + '.type') = 'column' thenls_value = adw.Describe("Evaluate('LookupDisplay("+column_name+")',"+string(i - 1)+")")end ifif adw.Describe(column_name + '.type') = 'compute' thenls_value = adw.Describe("Evaluate('" + adw.Describe(column_name + '.expression') + "',"+string(i - 1)+")")end ifole_object.cells(i,j).value = ls_valuenextnextSetPointer(oldpointer)ole_object.disconnectobject()DESTROY ole_objectreturn 1end function三、PBToWord函数f_outputtoword_new.srf
$PBExportHeader$f_outputtoword_new.srfglobal type f_outputtoword_new from function_objectend typeforward prototypesglobal function integer f_outputtoword_new (datawindow adw)end prototypesglobal function integer f_outputtoword_new (datawindow adw);//函数名:f_outputtoword_new//输入: adw - datawindow,指定的数据窗口//返回值: Integerconstant integer ppLayoutBlank = 12OLEObject ole_objectole_object = CREATE OLEObjectinteger li_retli_ret = ole_object.ConnectToObject("","word.application")IF li_ret <> 0 THEN//如果Word还没有打开，则新建。li_ret = ole_object.ConnectToNewObject("word.application")if li_ret <> 0 thenMessageBox('OLE错误','OLE无法连接!错误号：' + string(li_ret))return 0end ifole_object.Visible = TrueEND IFlong ll_colnum,ll_rownumconstant long wdWord9TableBehavior = 1constant long wdAutoFitFixed = 0constant long wdCell = 12string ls_valuepointer oldpointeroldpointer = SetPointer(HourGlass!)string ls_objects,ls_obj,ls_objs[],ls_objtag[]long ll_pos,ll_len,ll_num = 0ls_objects = trim(adw.Describe('datawindow.Objects'))do while (pos(ls_objects,"~t") > 0)ll_pos = pos(ls_objects,"~t")ll_len = ll_pos - 1ls_obj = left(ls_objects,ll_len)if (adw.Describe(ls_obj + '.type') = 'column' or &adw.Describe(ls_obj + '.type') = 'compute') and &(adw.Describe(ls_obj + '.band') = 'detail') and (ls_obj <> "asd") thenll_num += 1ls_objs[ll_num] = ls_objls_objtag[ll_num] = adw.Describe(ls_obj + '.tag')end ifls_objects = right(ls_objects,len(ls_objects) - ll_pos)loop//得到数据窗口数据的列数与行数（行数应该是数据行数 + 1）ll_colnum = ll_numll_rownum = adw.rowcount() + 1ole_object.Documents.Add()ole_object.ActiveDocument.Tables.Add(ole_object.Selection.Range, ll_rownum, ll_colnum)string ls_colnameinteger i,j,kfor i = 1 to ll_colnum//得到标题头的名字ls_value = ls_objtag[i]ole_object.Selection.TypeText(ls_value)for k = 1 to f_cncharnum(ls_value)ole_object.Selection.TypeBackspace()nextole_object.Selection.MoveRight(wdCell)nextadw.setredraw(false)ole_object.Selection.MoveLeft(wdCell)string column_namefor i = 2 to ll_rownumfor j = 1 to ll_colnumcolumn_name = ls_objs[j]if adw.Describe(column_name + '.type') = 'column' thenls_value = adw.Describe("Evaluate('LookupDisplay("+column_name+")',"+string(i - 1)+")")end ifif adw.Describe(column_name + '.type') = 'compute' thenls_value = adw.Describe("Evaluate('" + adw.Describe(column_name + '.expression') + "',"+string(i - 1)+")")end ifole_object.Selection.MoveRight(wdCell)ole_object.Selection.TypeText(ls_value)for k = 1 to f_cncharnum(ls_value)ole_object.Selection.TypeBackspace()nextnextnextadw.setredraw(true)constant long wdFormatDocument = 0SetPointer(oldpointer)//保存新建的文档if messagebox("保存","文档已经成功完成，是否保存？",Question!,YesNo!) = 1 thenstring docname, namedinteger valuevalue = GetFileSaveName("选择文件",docname, named, "DOC","Doc Files (*.DOC), *.DOC")IF value = 1 THENole_object.ActiveDocument.SaveAs(docname, 0,False,"",True,"",False,False,False, False,False)end ifend if//断开OLE连接Ole_Object.DisConnectObject()Destroy Ole_Objectreturn 1end function
