$PBExportHeader$n_dw2xls_layout.sru forward global type n_dw2xls_layout from nonvisualobject end type type ustr_picture from structure within n_dw2xls_layout end type type ustr_graph from structure within n_dw2xls_layout end type end forward type ustr_picture from structure long row integer col string filename Long offsetx Long offsety Long width Long height end type type ustr_graph from structure long row long col n_dw2xls_requestor requestor datastore ds string name Long offsetx Long offsety Long width Long height end type global type n_dw2xls_layout from nonvisualobject end type global n_dw2xls_layout n_dw2xls_layout type prototypes Function ulong GetDC(ulong hwnd) library "user32.dll" Function ulong ReleaseDC(ulong hwnd,ulong hdc) library "user32.dll" function int GetDeviceCaps(ulong hdc, int nIndex) library "gdi32" end prototypes type variables DataStore ids_Objects Datastore ids_Columns Datastore ids_PageBreak Int ii_SheetIndex Int ii_Freeze_Rows Long il_Progress_Data Long il_Progress_Pictures Boolean ib_HasPictures Int ii_ColSpace =30 Int ii_RowSpace=20 Int ii_ObjSpace =100 Int ii_LineSpace Long il_First_X1 =30000 long il_Last_X2 = 0 INT ii_LOGPIXELSX INT ii_LOGPIXELSY Private: Boolean ib_Nested=False Long il_RowCount //加入全部需要二次登记列位置的对象 n_dw2xls_Object inv_Objects[] ustr_Picture istr_Pictures[] ustr_Graph istr_Graphs[] //图表 constant long LOGPIXELSX =90 /* Logical pixels/inch in X */ constant long LOGPIXELSY =90 /* Logical pixels/inch in Y */ end variables forward prototypes public function integer of_columncount () public function integer of_getcolspace () public subroutine of_sortobject_x () public subroutine of_addobject (n_dw2xls_object anv_object) public subroutine of_registcolumninfo () public function integer of_writepictures (ref oleobject ole_excel, ref oleobject ole_sheet, ref n_dw2xls_progress anv_progress) public function boolean of_checkwritepictures () public function Boolean of_haspictures () public subroutine of_sethaspictures (readonly boolean ab_flag) public subroutine of_getcolumninfo () public subroutine of_addhpagebreak (long al_row) public subroutine of_increaseprogress_picture (readonly long ai_increasevalue) public subroutine of_increaseprogress_data (readonly long al_increasevalue) public subroutine of_get_progresstotal (ref long al_progress_data, ref long al_progress_pictures) public subroutine of_updatecolumninfo () public subroutine of_write_pagebreak (ref n_dw2xls_winapi anv_winapi, readonly unsignedlong al_hsheet) public subroutine of_write_columninfo (ref n_dw2xls_winapi anv_winapi, readonly unsignedlong al_hsheet) public function boolean of_isnested () public subroutine of_setnested (boolean ab_flag) public function Long of_rowcount () public subroutine of_setrowcount (readonly long al_count) public function Long of_get_next_x1 (long ai_x1) public function Long of_getcolumn_x1 (readonly integer ai_col) public function Long of_getcolumn_x2 (readonly long ai_col) public subroutine of_addgraph (readonly long ai_row, readonly long ai_col, n_dw2xls_requestor anv_requestor, readonly string as_name, readonly long ai_offsetx, readonly long ai_offsety, readonly long ai_width, readonly long ai_height) public function Long of_getcolumn_width (readonly integer ai_col) public function integer of_getendcolumn (long ai_x) public function integer of_getstartcolumn (long ai_x) public subroutine of_registcolumn (readonly long ai_x1) public subroutine of_updatecolumn_textwidth (readonly integer ai_col, readonly long ai_textwidth) public function Long of_get_pre_x1 (long ai_x1) public subroutine of_registobject (readonly long ai_x1, readonly boolean ab_x1) public subroutine of_addpicture (readonly long ai_row, readonly integer ai_col, readonly string as_filename, readonly long ai_offsetx, readonly long ai_offsety, readonly long ai_width, readonly long ai_height) end prototypes public function integer of_columncount ();Return ids_Columns.RowCount() end function public function integer of_getcolspace ();Return ii_ColSpace end function public subroutine of_sortobject_x ();Int li,lj,li_cnt Boolean lb_Stop n_dw2xls_Object lnv_Temp //先按X值按序,再按Y值排序 li_cnt = UpperBound(inv_Objects) lb_Stop=False Do While Not lb_Stop lb_Stop=TRUE For li=1 TO li_cnt -1 lj =li+1 IF inv_Objects[lj ].x1lnv_Object.inv_Band Then Continue END IF //在对象与边线之间,前面是否有其它的对象,如果有,则登记该列的位置 // IF inv_Objects[lj].Y1< lnv_Object.OF_GetTextRect_Y2() AND inv_Objects[lj].OF_GetTextRect_Y2() >lnv_Object.y1 Then // IF This.OF_Get_Pre_x1(inv_Objects[lj].OF_GetTextRect_X2() )>=li_Pre_x1 Then IF inv_Objects[lj].Y1< lnv_Object.OF_GetTextRect_Y2() AND inv_Objects[lj].OF_GetTextRect_Y2() >lnv_Object.y1 Then IF This.OF_Get_Pre_x1(inv_Objects[lj].X2 -ii_ColSpace )>=li_Pre_x1 OR lnv_Object.BorderStyle<>'0' Then This.OF_RegistObject(lnv_Object.X1 ,TRUE ) lb_Flag=TRUE Exit ELSEIF inv_Objects[lj].x1<= li_Pre_x1 Then Exit END IF END IF Next //如果没有找到,为了输出的位置不会偏离太远,则登记该对象的起始位置 IF lb_Flag=False AND (lnv_Object.X1 - li_Pre_x1)>400 AND lnv_Object.Alignment<>'1' Then This.OF_RegistObject(lnv_Object.X1, TRUE ) END IF END IF Next For li=1 To UpperBound(inv_Objects) IF inv_Objects[li].ObjType="report" Then Continue END IF lnv_Object = inv_Objects[li] IF IsValid( lnv_Object.inv_LeftLine)=False AND IsValid( lnv_Object.inv_RightLine)=False AND & IsValid( lnv_Object.inv_TopLine)=False AND IsValid( lnv_Object.inv_BottomLine)=False AND & ( lnv_Object.BorderStyle='2' OR lnv_Object.BorderStyle='4' ) Then li_Next_X1 =This.OF_Get_Next_x1(lnv_Object.X2) IF ABS(li_Next_X1 - lnv_Object.X1)>50 Then This.OF_RegistObject(lnv_Object.X2, FALSE ) END IF END IF Next end subroutine public function integer of_writepictures (ref oleobject ole_excel, ref oleobject ole_sheet, ref n_dw2xls_progress anv_progress);Long li, li_Count, li_Row, li_Col ,li_GraphCount ,li_Result Long li_Width, li_Height n_dw2xls_datawindow ldw li_Count = UpperBound(istr_Pictures) li_GraphCount = UpperBound(istr_Graphs ) IF li_Count <= 0 And li_GraphCount <= 0 THEN RETURN 1 END IF IF IsValid(ole_excel) = False Or IsValid(ole_sheet) = False Or IsValid(anv_progress) = False THEN RETURN -1 END IF TRY FOR li = 1 To li_Count li_Row = istr_Pictures[li].Row li_Col = istr_Pictures[li].Col ole_sheet.Cells(li_Row ,li_Col ).Select() IF Right(istr_Pictures[li].Filename,1) = '\' Or FileExists(istr_Pictures[li].Filename) = False THEN CONTINUE //荣修改20170214 ole_sheet.Pictures.Insert( istr_Pictures[li].Filename ).Select() ole_excel.Application.Selection.ShapeRange.LockAspectRatio = False ole_excel.Application.Selection.ShapeRange.Left = ole_sheet.Cells(li_Row, li_Col).Left + istr_Pictures[li].OffsetX ole_excel.Application.Selection.ShapeRange.Top = ole_sheet.Cells(li_Row,li_Col).Top + istr_Pictures[li].OffsetY ole_excel.Application.Selection.ShapeRange.Width = istr_Pictures[li].Width ole_excel.Application.Selection.ShapeRange.Height = istr_Pictures[li].Height anv_progress.OF_Progress(3) NEXT FOR li = 1 To li_GraphCount li_Result = 0 IF IsValid(istr_Graphs[li].ds) THEN IF istr_Graphs[li].ds.Describe("DataWindow.Processing") = "3" THEN IF istr_Graphs[li].Requestor.OF_GetControlWidth() > 0 THEN li_Width = istr_Graphs[li].Requestor.OF_GetControlWidth() ELSE li_Width = istr_Graphs[li].Width END IF IF istr_Graphs[li].Requestor.OF_GetControlHeight() > 0 THEN li_Height = istr_Graphs[li].Requestor.OF_GetControlHeight() ELSE li_Height = istr_Graphs[li].Height END IF IF li_Width <= 0 Or li_Height <= 0 THEN CONTINUE END IF anv_progress.iw_progress.OpenUserObject(ldw,anv_progress.iw_progress.Width -40,0 ) ldw.Resize(li_Width,li_Height) ldw.Create(istr_Graphs[li].ds.Describe("DataWindow.Syntax")) ldw.ImportString(istr_Graphs[li].ds.Describe("DataWindow.Data")) ldw.SetRedraw(True) li_Result = ldw.Clipboard( istr_Graphs[li].Name) anv_progress.iw_progress.CloseUserObject(ldw) Destroy istr_Graphs[li].ds ELSE li_Result = istr_Graphs[li].ds.Clipboard( istr_Graphs[li].Name) Destroy istr_Graphs[li].ds END IF ELSE li_Result = istr_Graphs[li].Requestor.OF_Clipboard( istr_Graphs[li].Name) END IF IF li_Result <> 1 THEN CONTINUE END IF li_Row = istr_Graphs[li].Row li_Col = istr_Graphs[li].Col ole_sheet.Cells(li_Row ,li_Col ).Select() ole_excel.Application.ActiveSheet.Paste() ole_excel.Application.Selection.ShapeRange.LockAspectRatio = False ole_excel.Application.Selection.ShapeRange.Left = ole_sheet.Cells(li_Row, li_Col).Left + istr_Graphs[li].OffsetX ole_excel.Application.Selection.ShapeRange.Top = ole_sheet.Cells(li_Row,li_Col).Top + istr_Graphs[li].OffsetY ole_excel.Application.Selection.ShapeRange.Width = istr_Graphs[li].Width ole_excel.Application.Selection.ShapeRange.Height = istr_Graphs[li].Height anv_progress.OF_Progress(3) NEXT ole_sheet.Cells(ii_Freeze_Rows+1,1).Select() ole_sheet.Cells(1,1).Select() li_Result = 1 //编译为DLL时,不能处理 OLERuntimeError 的异常 Catch(OLERuntimeError oleError) li_Result = -1 Catch(RuntimeError er) li_Result = -1 END TRY RETURN li_Result end function public function boolean of_checkwritepictures ();Return ( UpperBound(istr_Pictures) +UpperBound(istr_Graphs)) >0 end function public function Boolean of_haspictures ();Return ib_HasPictures end function public subroutine of_sethaspictures (readonly boolean ab_flag);ib_HasPictures =ab_flag end subroutine public subroutine of_getcolumninfo ();Long li,li_Row Long li_x1, li_x2 Long li_Pre_x1, li_Pre_x2, li_Next_x1, li_Next_x2 String ls_Border ids_Columns.Sort() For li=1 TO ids_Columns.RowCount() -1 ids_Columns.SetItem(li,"x2",ids_Columns.GetItemNumber(li+1,"x1") ) Next //删除最后一行 ids_Columns.DeleteRow(ids_Columns.RowCount()) ids_Columns.Sort() end subroutine public subroutine of_addhpagebreak (long al_row);Long li_Row IF al_Row<=0 Then Return li_Row= ids_PageBreak.Find("RowNum="+String(al_Row),1,ids_PageBreak.RowCount()) IF li_Row<=0 Then li_Row = ids_PageBreak.InsertRow(0) ids_PageBreak.SetItem(li_Row,"RowNum",al_Row) END IF end subroutine public subroutine of_increaseprogress_picture (readonly long ai_increasevalue);il_Progress_Pictures+=ai_IncreaseValue end subroutine public subroutine of_increaseprogress_data (readonly long al_increasevalue);il_Progress_Data+=al_increaseValue end subroutine public subroutine of_get_progresstotal (ref long al_progress_data, ref long al_progress_pictures);al_Progress_Data +=il_Progress_Data al_Progress_Pictures+=il_Progress_Pictures end subroutine public subroutine of_updatecolumninfo ();Long li ,li_TextWidth ,li_X2 For li=1 To ids_Columns.RowCount() li_TextWidth= ids_Columns.GetItemNumber(li,"MaxTextWidth") IF li_TextWidth>0 Then li_X2 = ids_Columns.GetItemNumber(li,"X1")+li_TextWidth IF (li_X2 - ids_Columns.GetItemNumber(li,"X2"))<=ii_ColSpace Then ids_Columns.SetItem(li,"X2",li_X2 ) IF li = "+String(ai_x1 - ii_ColSpace), 1, ids_Columns.RowCount()) IF li_Row >0 Then li_Next_x1= ids_Columns.GetItemNumber(li_Row,"x1") IF li_Next_x10 AND ai_Col<=ids_Columns.RowCount() Then Return ids_Columns.GetItemNumber(ai_Col, "x1") END IF RETURN 0 end function public function Long of_getcolumn_x2 (readonly long ai_col);IF ai_Col>0 AND ai_Col<=ids_Columns.RowCount() Then Return ids_Columns.GetItemNumber(ai_Col, "x2") END IF RETURN 0 end function public subroutine of_addgraph (readonly long ai_row, readonly long ai_col, n_dw2xls_requestor anv_requestor, readonly string as_name, readonly long ai_offsetx, readonly long ai_offsety, readonly long ai_width, readonly long ai_height);Long li_Index Datastore lds li_Index = UpperBound(istr_graphs) +1 istr_graphs[li_Index].Requestor =anv_Requestor istr_graphs[li_Index].Row =ai_Row istr_graphs[li_Index].Col =ai_Col istr_graphs[li_Index].Name =as_name istr_graphs[li_Index].offsetX =UnitsToPixels(ai_offsetX,XUnitsToPixels!)/ii_LOGPIXELSX*72 //把PB的Units转为 Excel的单位 istr_graphs[li_Index].OffsetY =UnitsToPixels(ai_OffsetY,YUnitsToPixels!)/ii_LOGPIXELSY*72 IF anv_Requestor.OF_GetProcessing()='3' Then IF anv_Requestor.OF_GetControlWidth()>0 Then istr_graphs[li_Index].Width =UnitsToPixels(anv_Requestor.OF_GetControlWidth(),XUnitsToPixels!)/ii_LOGPIXELSX*72 ELSE istr_graphs[li_Index].Width =UnitsToPixels(ai_width,XUnitsToPixels!)/ii_LOGPIXELSX*72 END IF IF anv_Requestor.OF_GetControlHeight()>0 Then istr_graphs[li_Index].Height =UnitsToPixels(anv_Requestor.OF_GetControlHeight(),YUnitsToPixels!)/ii_LOGPIXELSY*72 ELSE istr_graphs[li_Index].Height =UnitsToPixels(ai_Height,YUnitsToPixels!)/ii_LOGPIXELSY*72 END IF ELSE istr_graphs[li_Index].Width =UnitsToPixels(ai_width,XUnitsToPixels!)/ii_LOGPIXELSX*72 istr_graphs[li_Index].Height =UnitsToPixels(ai_Height,YUnitsToPixels!)/ii_LOGPIXELSY*72 END IF IF anv_Requestor.OF_IsChild() OR anv_Requestor.OF_IsDataWindowChild() THen //先缓存数据,因为Nest Report的数据窗口,在输出一行后,会删除该行数据 lds = Create Datastore lds.Create(anv_Requestor.OF_Describe("DataWindow.Syntax")) lds.ImportString(anv_Requestor.OF_Describe("DataWindow.Data")) istr_graphs[li_Index].ds = lds END IF end subroutine public function Long of_getcolumn_width (readonly integer ai_col);IF ai_Col>0 AND ai_Col<=ids_Columns.RowCount() Then Return ids_Columns.GetItemNumber(ai_Col, "x2") - ids_Columns.GetItemNumber(ai_Col, "x1") END IF Return 0 end function public function integer of_getendcolumn (long ai_x);Int li_Find li_Find = ids_Columns.Find("x2= "+String(ai_x), 1, ids_Columns.RowCount() ) IF li_Find<=0 Then li_Find = ids_Columns.Find("x2<= "+String(ai_x+ii_ColSpace)+" AND x2>= "+String(ai_x - ii_ColSpace),1,ids_Columns.RowCount()) IF li_Find<=0 Then li_Find = ids_Columns.Find("x1> "+String(ai_x -ii_ColSpace), 1 ,ids_Columns.RowCount() ) IF li_Find<=0 Then li_Find=ids_Columns.Find("X2<"+String(ai_x +ii_ColSpace),ids_Columns.RowCount() ,1) IF li_Find<=0 Then li_Find= ids_Columns.RowCount() ELSE li_Find = li_Find +1 END IF ELSE li_Find = li_Find -1 END IF // ELSEIF li_Find ids_Columns.RowCount() Then li_Find = ids_Columns.RowCount() END IF Return li_Find end function public function integer of_getstartcolumn (long ai_x);Int li_Find li_Find = ids_Columns.Find("x1= "+String(ai_x), 1, ids_Columns.RowCount() ) IF li_Find<=0 Then li_Find = ids_Columns.Find("x1<= "+String(ai_x+ii_ColSpace)+" AND x1>= "+String(ai_x - ii_ColSpace),1,ids_Columns.RowCount()) IF li_Find<=0 Then li_Find = ids_Columns.Find("x1> "+String(ai_x + ii_ColSpace), 1, ids_Columns.RowCount() ) IF li_Find<=0 Then li_Find=ids_Columns.Find("X2<"+String(ai_x +ii_ColSpace),ids_Columns.RowCount() ,1) IF li_Find<=0 Then li_Find= ids_Columns.RowCount() ELSE li_Find = li_Find +1 END IF ELSE li_Find = li_Find -1 IF li_Find>0 AND li_Find ai_X Then li_Find = li_Find +1 END IF END IF END IF END IF END IF IF li_Find<=0 Then li_Find =1 ELSEIF li_Find> ids_Columns.RowCount() Then li_Find = ids_Columns.RowCount() END IF Return li_Find end function public subroutine of_registcolumn (readonly long ai_x1);//如是是注册细节区的对象,则按精准定义 Long li_Row li_Row = ids_Columns.Find("x1="+String(ai_x1),1,ids_Columns.RowCount()) IF li_Row<=0 Then li_Row = ids_Columns.InsertRow(0) ids_Columns.SetItem(li_Row,"x1",ai_x1) END IF ids_Columns.Sort() end subroutine public subroutine of_updatecolumn_textwidth (readonly integer ai_col, readonly long ai_textwidth);IF ai_Col>0 AND ai_Col<=ids_Columns.RowCount() Then IF ids_Columns.GetItemNumber(ai_Col, "MaxTextWidth")0 Then li_Pre_x1= ids_Columns.GetItemNumber(li_Row,"x1") END IF li_Row = ids_Objects.Find("x1<= "+String(ai_x1 -ii_ColSpace),ids_Objects.RowCount(), 1) IF li_Row >0 Then IF ids_Objects.GetItemNumber(li_Row,"x1")>li_Pre_x1 Then li_Pre_x1= ids_Objects.GetItemNumber(li_Row,"x1") END IF END IF Return li_Pre_x1 end function public subroutine of_registobject (readonly long ai_x1, readonly boolean ab_x1);//注册非细节区的对象,则不按精准对象定位 Long li_Row li_Row = ids_Columns.Find("x1<="+String(ai_x1+ii_ColSpace)+" AND X1>= "+String(ai_x1 - ii_ColSpace) ,1,ids_Columns.RowCount()) IF li_Row<=0 Then li_Row = ids_Columns.InsertRow(0) ids_Columns.SetItem(li_Row,"x1",ai_x1) ELSE IF ab_x1 Then IF ids_Columns.GetItemNumber(li_Row,"X1")>ai_X1 Then ids_Columns.SetItem(li_Row,"X1",ai_X1) END IF END IF END IF ids_Columns.Sort() end subroutine public subroutine of_addpicture (readonly long ai_row, readonly integer ai_col, readonly string as_filename, readonly long ai_offsetx, readonly long ai_offsety, readonly long ai_width, readonly long ai_height);Long li_Index String new_FileName li_Index = UpperBound(istr_Pictures) +1 istr_Pictures[li_Index].Row = ai_Row istr_Pictures[li_Index].Col = ai_Col istr_Pictures[li_Index].Filename = as_FileName istr_Pictures[li_Index].offsetX = UnitsToPixels(ai_offsetX,XUnitsToPixels!)/ii_LOGPIXELSX*72 //把PB的Units转为 Excel的单位 istr_Pictures[li_Index].OffsetY = UnitsToPixels(ai_OffsetY,YUnitsToPixels!)/ii_LOGPIXELSY*72 istr_Pictures[li_Index].Width = UnitsToPixels(ai_width,XUnitsToPixels!)/ii_LOGPIXELSX*72 istr_Pictures[li_Index].Height = UnitsToPixels(ai_Height,YUnitsToPixels!)/ii_LOGPIXELSY*72 end subroutine on n_dw2xls_layout.create call super::create TriggerEvent( this, "constructor" ) end on on n_dw2xls_layout.destroy TriggerEvent( this, "destructor" ) call super::destroy end on event constructor;String ls_Syntax Long hdc n_dw2xls_WinApi lnv_Api ls_Syntax =" release 6; "+ & " datawindow(units=0 processing=1 ) " + & " header(height=0 ) " + & " detail(height=0 ) "+ & " summary(height=0 ) "+ & " table( "+& " column=(type=long updatewhereclause=no name=x1 dbname='x1' initial='0' ) " +& " column=(type=long updatewhereclause=no name=x2 dbname='x2' initial='0' ) " +& " column=(type=long updatewhereclause=no name=textwidth dbname='textwidth' initial='0' ) " +& " column=(type=long updatewhereclause=no name=textheight dbname='textheight' initial='0' ) " +& " column=(type=char(1) updatewhereclause=no name=Alignment dbname='Alignment' initial='0' )"+& " column=(type=char(1) updatewhereclause=no name=Border dbname='Border' initial='0' )"+& " sort='x1 A, X2 A ' ) " ids_Objects = Create DataStore ids_Objects.Create( ls_Syntax) ls_Syntax =" release 6; "+ & " datawindow(units=0 processing=1 ) " + & " header(height=0 ) " + & " detail(height=0 ) "+ & " summary(height=0 ) "+ & " table( "+& " column=(type=long updatewhereclause=no name=x1 dbname='x1' initial='0' ) " +& " column=(type=long updatewhereclause=no name=x2 dbname='x2' initial='0' ) " +& " column=(type=long updatewhereclause=no name=MaxTextWidth dbname='MaxTextWidth' initial='0' ) " +& " sort='x1 A, x2 A ' ) " ids_Columns = Create DataStore ids_Columns.Create( ls_Syntax) ls_Syntax =" release 6; "+ & " datawindow(units=0 processing=1 ) " + & " header(height=0 ) " + & " detail(height=0 ) "+ & " summary(height=0 ) "+ & " table( "+& " column=(type=long updatewhereclause=no name=RowNum dbname='RowNum' initial='0' ) " +& " sort='RowNum A ' ) " ids_PageBreak = Create DataStore ids_PageBreak.Create( ls_Syntax) hdc =GetDC(0) ii_LOGPIXELSX =GetDeviceCaps(hdc, LOGPIXELSX) ii_LOGPIXELSY=GetDeviceCaps(hdc , LOGPIXELSY) ReleaseDC(0,hdc) end event event destructor;Int li Destroy ids_Objects Destroy ids_Columns For li =1 TO UpperBound(istr_Graphs) IF IsValid(istr_Graphs[li].ds) Then Destroy istr_Graphs[li].ds END IF Next end event