$PBExportHeader$n_cst_dw2excel.sru forward global type n_cst_dw2excel from nonvisualobject end type end forward global type n_cst_dw2excel from nonvisualobject autoinstantiate event ue_process_export ( ) end type type prototypes FUNCTION ulong LoadLibraryExW( string lpLibFileName ,ulong hFiles, ulong dwFlags) LIBRARY "kernel32.dll" FUNCTION ulong LoadLibraryA( string lpLibFileName) LIBRARY "kernel32.dll" ALIAS FOR "LoadLibraryA" FUNCTION ulong LoadLibraryW( string lpLibFileName) LIBRARY "kernel32.dll" ALIAS FOR "LoadLibraryW" FUNCTION ulong FreeLibrary(ulong hLibModule) LIBRARY "kernel32.dll" end prototypes type variables Private: String is_FileName Boolean ib_OpenExcelFile =False //在导出完成之后,是否提示用户打开Excel文件 Boolean ib_ShowZeroValues =TRUE // 在Excel文件中,单元的数据为0时，是否显示数据内容 Boolean ib_WriteBKColor =TRUE //是否输出背景颜色 Boolean ib_FreezeTitles=TRUE //是否冻结报表表头 Boolean ib_ShowGridLines=False //是否显示表格线 Boolean ib_ProcessSparse =TRUE //是否处理数据窗口的Spare属性 PowerObject ipos[] String is_SheetNames[] String is_Language // EN 英文 CN 中文简体 BIG5 繁体中文 String is_DefFontName //设置工作薄的缺省字体名称 ，如果没有设置,则根据当前操作系统自动设置 宋体(简体) 細明體（繁体 ) Arial(其它操作系统) uInt ii_DefFontSize //设置工作薄的缺省字体大小 ，如果没有设置,则缺省为 9 号字体 //License信息最好通过OF_SetLicense函数设置 //这样可以避免DW2XLS升级时,需要再次修改这两个变量的值 String CompanyName="佛山市顺德区龙嘉软件有限公司" //注册的单位名称 String LICENSECODE ="8BF262AEBC8D331FAFED0D659E26284E48E8E31FC12597D54134E4D9170F2F46" //在此处更新DW2XLS的授权注册码， n_dw2xls_progress inv_Progress n_dw2xls_Resource inv_Res end variables forward prototypes public function integer of_dw2excel (powerobject apo, string as_filename) public function integer of_dw2excel (readonly powerobject apos[], readonly string as_filename) public function integer of_dw2excel (readonly powerobject apo, readonly string as_filename, string as_sheetname) public function integer of_dw2excel (readonly powerobject apos[], readonly string as_sheetnames[], readonly string as_filename) public subroutine of_setshowprogress (boolean ab_show) public subroutine of_setopenexcelfile (boolean ab_open) public function Boolean of_checkexcelapplicaiton () public function boolean of_checkfilename (string as_filename) public function Boolean of_checksheetname (string as_name) public function string of_getcompanyname () public function integer of_report2excel (ref datawindow adw, readonly string as_filename) public function long of_parsetoarray (string as_source, string as_delimiter, ref string as_array[]) public subroutine of_setlicense (readonly string as_companyname, readonly string as_licensecode) public subroutine of_setlanguage (readonly string as_language, readonly string as_deffontname) public function Boolean of_openexcelfile (readonly string as_filename) public subroutine of_setshowzerovalues (readonly boolean ab_show) public subroutine of_setwritebkcolor (readonly boolean ab_flag) public subroutine of_setfreezetitles (readonly boolean ab_flag) public subroutine of_setshowgridlines (readonly boolean ab_show) public subroutine of_setprocesssparse (readonly boolean ab_flag) public subroutine of_setfontsize (readonly unsignedinteger ai_fontsize) public function string of_gettitle () end prototypes event ue_process_export();Long li, lj, li_Sheets, li_Index Long li_Progress_Data,li_Progress_Picture, li_Step ulong li_hWorkBook, li_hSheet oleobject ole_excel, ole_sheet n_dw2xls_Requestor lnv_Requestor[] n_dw2xls_WinApi lnv_Api SetPointer(HourGlass!) li_Sheets = UpperBound(ipos) TRY lnv_Api = Create n_dw2xls_WinApi lnv_Api.OF_LoadWriter() //设置授权信息 IF COMPANYNAME<>"" AND LICENSECODE<>"" Then lnv_Api.SetLicense(COMPANYNAME, LICENSECODE ) END IF lnv_Api.SetProgress( Handle(inv_Progress.iw_progress)) //设置工作的缺省字体 ，如果没有设置,则根据当前操作系统自动设置 宋体(简体) 細明體（繁体 ) Arial(其它操作系统) //必须在调用AddWorkSheet之前进行调用 IF is_DefFontName<>'' Then lnv_Api.SetDefFontName(is_DefFontName) END IF IF ii_DefFontSize>0 Then lnv_Api.SetDefFontSize(ii_DefFontSize) END IF li_hWorkBook =lnv_Api.AddWorkBook() For li =1 To li_Sheets lnv_Requestor[li] =Create n_dw2xls_Requestor lnv_Requestor[li].OF_SetWinApi(lnv_Api) IF lnv_Requestor[li].OF_SetRequestor(ipos[li],inv_Progress ) <>1 Then Continue END IF lnv_Requestor[li].OF_GetLayout().OF_Get_ProgressTotal(li_Progress_Data, li_Progress_Picture) Next inv_Progress.OF_StepIt() li_Step =2 //保留的进度百分比 IF li_Progress_Picture>0 Then ole_excel = create oleobject li_Index = ole_excel.ConnectToNewObject('Excel.Application') IF li_Index <> 0 then destroy ole_excel ELSE inv_Progress.OF_StepIt() inv_Progress.ib_WritePictures =TRUE END IF li_Step +=4 ELSE li_Step +=1 END IF inv_Progress.OF_Intial_Progress(li_Progress_Data +li_Progress_Picture *3 ,li_Step) li_Index =0 For li =1 To li_Sheets IF inv_Progress.ib_Cancel Then Exit END IF IF Not IsValid(lnv_Requestor[li].OF_GetLayout()) Then Continue END IF li_hSheet =lnv_Api.AddWorkSheet(li_hWorkBook, is_sheetnames[li] ) lnv_Api.SetShowZeroValues(li_hSheet,ib_ShowZeroValues) lnv_Api.SetShowGridLines(li_hSheet, ib_ShowGridLines) lnv_Requestor[li].OF_Output(li_hSheet, 0) li_Index++ lnv_Requestor[li].OF_GetLayout().ii_SheetIndex =li_Index Next IF inv_Progress.ib_Cancel Then inv_Progress.OF_Close_Progress() ELSE inv_Progress.OF_DisableCancel() //数据生成完毕后,禁止取消 lnv_Api.SaveWorkBook(li_hWorkBook, is_FileName) lnv_Api.DestroyWorkBook(li_hWorkBook) li_hWorkBook =0 //再次检查是否需要输出图片或图表 inv_Progress.ib_WritePictures=False For li =1 To li_Sheets IF Not IsValid(lnv_Requestor[li].OF_GetLayout()) Then Continue END IF IF lnv_Requestor[li].OF_GetLayout().OF_CheckWritePictures() Then inv_Progress.ib_WritePictures=TRUE Exit END IF Next //输出图片,当前版本采用Ole方式输出,所以速度较慢 IF inv_Progress.ib_WritePictures Then ole_excel.Application.Workbooks.Open(is_FileName) inv_Progress.OF_StepIt() For li =1 To li_Sheets IF Not IsValid(lnv_Requestor[li].OF_GetLayout()) Then Continue END IF IF lnv_Requestor[li].OF_GetLayout().OF_CheckWritePictures() Then li_Index = lnv_Requestor[li].OF_GetLayout().ii_SheetIndex ole_sheet= ole_Excel.application.activeworkbook.WorkSheets.Item[li_Index] lnv_Requestor[li].OF_GetLayout().of_WritePictures(ole_excel, ole_sheet,inv_Progress) END IF Next ole_excel.application.ActiveSheet.Cells(1,1).Select() ole_excel.application.ActiveSheet.Cells(1,1).Activate() ole_excel.application.activeworkbook.save() inv_Progress.OF_StepIt() IF ib_OpenExcelFile Then IF MessageBox(inv_Res.Tips, inv_Res.OF_Format( inv_Res.OpenFileConfirm, is_FileName),Question!,YesNo!)=2 Then ib_OpenExcelFile =False END IF END IF IF ib_OpenExcelFile Then ole_excel.application.ActiveWindow.WindowState= -4137 //最大化窗口 ole_excel.application.Visible = True ole_excel.DisConnectObject() ELSE ole_excel.application.Workbooks.close() ole_excel.application.Quit() ole_excel.DisConnectObject() Destroy ole_excel END IF ELSE IF ib_OpenExcelFile Then IF MessageBox(inv_Res.Tips, inv_Res.OF_Format( inv_Res.OpenFileConfirm, is_FileName),Question!,YesNo!)=1 Then OF_OpenExcelFile(is_FileName) END IF END IF END IF inv_Progress.ii_Result =1 END IF //编译为DLL, 不支持处理　OleRuntimeError　异常 Catch(OleRuntimeError ex1) MessageBox("DW2XLS Error",ex1.getMessage(),StopSign!) inv_Progress.ii_Result = -1 Catch(RuntimeError ex3) MessageBox("DW2XLS Error ",ex3.getMessage(),StopSign!) inv_Progress.ii_Result = -1 END TRY IF li_hWorkBook>0 Then lnv_Api.DestroyWorkBook(li_hWorkBook) li_hWorkBook =0 END IF IF IsValid(ole_excel) AND inv_Progress.ii_Result =-1 Then IF IsValid(ole_excel.application.activeworkbook ) Then ole_excel.application.activeworkbook.save() END IF ole_excel.application.Workbooks.close() ole_excel.application.Quit() ole_excel.DisConnectObject() Destroy ole_excel END IF For li=1 To li_Sheets Destroy lnv_Requestor[li] Next lnv_Api.OF_ReloadWriter() Destroy lnv_Api inv_Progress.OF_Close_Progress() SetPointer(Arrow!) end event public function integer of_dw2excel (powerobject apo, string as_filename);Return OF_dw2Excel(apo,as_FileName,"Sheet1") end function public function integer of_dw2excel (readonly powerobject apos[], readonly string as_filename);Int li String ls_Sheets[] For li=1 To UpperBound(apos) ls_Sheets[li]="Sheet"+String(li) Next Return OF_DW2Excel(apos, ls_Sheets, as_FileName) end function public function integer of_dw2excel (readonly powerobject apo, readonly string as_filename, string as_sheetname);PowerObject lpos[] String ls_SheetNames[] lpos[1] = apo ls_SheetNames[1] =as_SheetName Return OF_DW2Excel(lpos, ls_SheetNames, as_FileName) end function public function integer of_dw2excel (readonly powerobject apos[], readonly string as_sheetnames[], readonly string as_filename);Long li, lj, li_Sheets,li_Result //IF Handle(GetApplication())<>0 Then // MessageBox("提示","DW2XLS DEMO 程序只能在PB开发环境中运行!",StopSign!) // Return -1 //END IF li_Sheets = UpperBound(apos) IF li_Sheets<>UpperBound(as_sheetnames) Then Return -1 END IF For li =1 To li_Sheets IF Not IsValid(apos[li]) Then RETURN -1 IF TypeOF(apos[li])<>DataWindow! AND & TypeOF(apos[li])<>Datastore! AND & TypeOF(apos[li])<>DataWindowChild! Then Return -1 END IF Next //工作表不能有相同的名称 For li=1 To li_Sheets IF Trim(as_sheetnames[li] ) ="" Then Return -1 IF Not OF_CheckSheetName(as_sheetnames[li]) Then Return -1 //工作表名称不符号Excel 的要求 For lj=li+1 To li_Sheets IF as_sheetnames[li] = as_sheetnames[lj] Then Return -1 END IF Next Next IF Not OF_CheckFileName(as_FileName) Then Return -1 END IF ipos=apos is_SheetNames =as_SheetNames is_FileName = as_FileName SetPointer(HourGlass!) inv_Progress =Create n_dw2xls_Progress inv_Progress.OF_SetRequestor(This ,inv_Res ) inv_Progress.ib_WriteBKColor = ib_WriteBKColor inv_Progress.ib_FreezeTitles = ib_FreezeTitles inv_Progress.ib_ProcessSparse = ib_ProcessSparse inv_Progress.OF_Open_Progress() li_Result = inv_Progress.ii_Result Destroy inv_Res Destroy inv_Progress Return li_Result end function public subroutine of_setshowprogress (boolean ab_show);//ib_ShowProgress = ab_show end subroutine public subroutine of_setopenexcelfile (boolean ab_open);ib_OpenExcelFile = ab_Open end subroutine public function Boolean of_checkexcelapplicaiton ();Return False end function public function boolean of_checkfilename (string as_filename);Long li_Handle IF Trim(as_filename)="" Then REturn False If FileExists (as_filename ) Then IF MessageBox(inv_Res.Warning ,inv_Res.OF_Format( inv_Res.FileExists, as_FileName) ,Question!,YesNo!)=2 Then Return False END IF END IF //检查给定的文件路径是否可以写入 li_Handle=FileOpen(as_filename,StreamMode!,Write!,LockWrite!,Replace!) FileClose(li_Handle) IF li_Handle=-1 OR IsNull(li_Handle) THEN MessageBox(inv_Res.Warning , inv_Res.OF_Format( inv_Res.FileWriteError, as_FileName) ,StopSign!) Return False END IF Return TRUE end function public function Boolean of_checksheetname (string as_name);IF Len(as_Name) > 31 Then Return False END IF IF Match(as_Name, "[:*?/\]") then Return False END IF Return TRUE end function public function string of_getcompanyname ();Return CompanyName end function public function integer of_report2excel (ref datawindow adw, readonly string as_filename);Long li ,li_cnt ,li_Row, li_Pos,li_GroupLevels,li_Handle ,li_Index String ls_Objects[],ls_Name, ls_Processing,ls_Temp Datastore lds DataWindowChild dwc ,dwcList[] IF Not IsValid(adw) Then REturn -1 END IF //不是组合报表 IF adw.Describe("DataWindow.Processing")<>"5" THEN Return -1 END IF IF Trim(as_filename)="" Then REturn -1 //检查给定的文件路径是否可以写入 li_Handle=FileOpen(as_filename,StreamMode!,Write!,LockWrite!,Replace!) FileClose(li_Handle) IF li_Handle=-1 OR IsNull(li_Handle) THEN MessageBox(inv_Res.Warning ,inv_Res.OF_Format(inv_Res.FileWriteError, as_FileName) ,StopSign!) Return -1 END IF ls_Temp=adw.Describe("datawindow.bands") li_pos=1 Do While li_pos>0 li_pos=Pos(ls_Temp,"header.",li_pos) IF li_pos>0 Then li_GroupLevels++ li_pos++ END IF Loop ls_Temp =" release 6 ; "+ & " datawindow(units=0 processing=1 ) " + & " header(height=0 ) " + & " detail(height=0 ) "+ & " summary(height=0 ) "+ & " table( "+& " column=(type=Char(100) updatewhereclause=no name=name dbname='name' initial='' ) " +& " column=(type=long updatewhereclause=no name=BandSeq dbname='BandSeq' initial='0' ) " +& " column=(type=long updatewhereclause=no name=x dbname='X' initial='0' ) " +& " column=(type=long updatewhereclause=no name=Y dbname='Y' initial='0' ) " +& " sort='BandSeq A, Y A ,X A' ) " lds=Create Datastore lds.Create(ls_Temp) li_cnt = OF_ParseToArray(adw.Describe("DataWindow.Objects"),"~t",ls_Objects) For li=1 To li_cnt ls_Name = ls_Objects[li] IF adw.Describe(ls_Name+".Type")<>"report" Then Continue END IF ls_Temp=adw.Describe(ls_Name+".Band") IF ls_Temp="?" OR ls_Temp="!" Then Continue END IF li_Index =0 IF ls_Temp="header" Then li_Index =1 ELSEIF ls_Temp="detail" Then li_Index=li_GroupLevels +2 ELSEIF ls_Temp="summary" Then li_Index=li_GroupLevels*2 +3 ELSEIF ls_Temp="footer" Then li_Index=li_GroupLevels*2 +4 ELSE li_pos=Pos(ls_Temp,"header.",li_pos) IF li_pos>0 Then li_Index =Long(Mid(ls_Temp,li_Pos+1)) +1 ELSE li_pos=Pos(ls_Temp,"trailer.",li_pos) IF li_pos>0 Then li_Index =Long(Mid(ls_Temp,li_Pos+1))+ 1+li_GroupLevels END IF END IF END IF li_Row =lds.InsertRow(0) lds.SetItem(li_Row,"BandSeq",li_Index) lds.SetItem(li_Row,"Name",ls_Name) lds.SetItem(li_Row,"X",Long(adw.Describe(ls_Name+".X"))) lds.SetItem(li_Row,"Y",Long(adw.Describe(ls_Name+".Y"))) Next lds.Sort() For li=1 To lds.RowCount() ls_Name = lds.GetItemString(li,"Name") adw.GetChild(ls_Name,dwc) IF Not IsValid(dwc) Then Continue END IF ls_Processing = dwc.Describe("DataWindow.Processing") IF ls_Processing<>'0' AND ls_Processing<>'1' Then Continue END IF dwcList[ UpperBound(dwcList)+1] = dwc Next IF UpperBound(dwcList)<=0 Then Return -1 END IF RETURN OF_DW2Excel(dwcList, as_FileName) end function public function long of_parsetoarray (string as_source, string as_delimiter, ref string as_array[]);long ll_DelLen, ll_Pos, ll_Count, ll_Start, ll_Length string ls_holder String ls_Temp[] as_array= ls_Temp //清空原数组 //Check for NULL IF IsNull(as_source) or IsNull(as_delimiter) Then long ll_null SetNull(ll_null) Return ll_null End If //Check for at leat one entry If Trim (as_source) = '' Then Return 0 End If //Get the length of the delimeter ll_DelLen = Len(as_Delimiter) ll_Pos = Pos(Upper(as_source), Upper(as_Delimiter)) //Only one entry was found if ll_Pos = 0 then as_Array[1] = as_source return 1 end if //More than one entry was found - loop to get all of them ll_Count = 0 ll_Start = 1 Do While ll_Pos > 0 //Set current entry ll_Length = ll_Pos - ll_Start ls_holder = Mid (as_source, ll_start, ll_length) // Update array and counter ll_Count ++ as_Array[ll_Count] = ls_holder //Set the new starting position ll_Start = ll_Pos + ll_DelLen ll_Pos = Pos(Upper(as_source), Upper(as_Delimiter), ll_Start) Loop //Set last entry ls_holder = Mid (as_source, ll_start, Len (as_source)) // Update array and counter if necessary if Len (ls_holder) > 0 then ll_count++ as_Array[ll_Count] = ls_holder end if //Return the number of entries found Return ll_Count end function public subroutine of_setlicense (readonly string as_companyname, readonly string as_licensecode);CompanyName = as_CompanyName LICENSECODE = as_LicenseCode end subroutine public subroutine of_setlanguage (readonly string as_language, readonly string as_deffontname);is_Language = as_Language is_DefFontName = as_DefFontName IF IsValid(inv_Res) Then inv_Res.OF_SetLanguage(is_Language ) END IF end subroutine public function Boolean of_openexcelfile (readonly string as_filename);Long li_Result OleObject xlapp //用于连接Excel xlApp=Create OleObject li_Result= xlApp.ConnectToNewObject( "Excel.Application" ) IF li_Result < 0 Then MessageBox(inv_Res.Tips , inv_Res.RunExcelAppError ) xlApp.DisConnectObject() Destroy xlApp Return False ELSE XlApp.Workbooks.Open(as_FileName) xlApp.ActiveWindow.WindowState= -4137 //最大化窗口 xlApp.Visible = True xlApp.DisConnectObject() Return TRUE END IF Return False end function public subroutine of_setshowzerovalues (readonly boolean ab_show);ib_ShowZeroValues = ab_Show end subroutine public subroutine of_setwritebkcolor (readonly boolean ab_flag);ib_WriteBKColor =ab_flag end subroutine public subroutine of_setfreezetitles (readonly boolean ab_flag);ib_FreezeTitles =ab_Flag end subroutine public subroutine of_setshowgridlines (readonly boolean ab_show);ib_ShowGridLines =ab_Show end subroutine public subroutine of_setprocesssparse (readonly boolean ab_flag);ib_ProcessSparse = ab_Flag end subroutine public subroutine of_setfontsize (readonly unsignedinteger ai_fontsize);IF ai_FontSize>0 Then ii_DefFontSize = ai_FontSize END IF end subroutine public function string of_gettitle ();return '数据发送' end function on n_cst_dw2excel.create call super::create TriggerEvent( this, "constructor" ) end on on n_cst_dw2excel.destroy TriggerEvent( this, "destructor" ) call super::destroy end on event constructor;inv_Res = Create n_dw2xls_Resource inv_Res.OF_SetLanguage(is_Language) end event event destructor;IF IsValid(w_dw2xls_Progress) Then Return END IF IF IsValid(inv_Res) Then Destroy inv_Res END IF end event