Q5/ws_objects/Ew_dw2xls.pbl.src/n_cst_dw2excel.sru

$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