$PBExportHeader$w_sentdataout.srw $PBExportComments$数据发送窗口 forward global type w_sentdataout from w_publ_base end type type cb_backup from uo_imflatbutton within w_sentdataout end type type st_1 from statictext within w_sentdataout end type type sle_filename from singlelineedit within w_sentdataout end type type cb_ch from commandbutton within w_sentdataout end type type gb_1 from groupbox within w_sentdataout end type type ddlb_dataformat from dropdownlistbox within w_sentdataout end type type rb_xls from radiobutton within w_sentdataout end type type rb_xlsx from radiobutton within w_sentdataout end type type ddlb_1 from dropdownlistbox within w_sentdataout end type type st_2 from statictext within w_sentdataout end type end forward global type w_sentdataout from w_publ_base integer width = 2487 integer height = 628 string title = "数据发送" boolean minbox = false windowtype windowtype = response! cb_backup cb_backup st_1 st_1 sle_filename sle_filename cb_ch cb_ch gb_1 gb_1 ddlb_dataformat ddlb_dataformat rb_xls rb_xls rb_xlsx rb_xlsx ddlb_1 ddlb_1 st_2 st_2 end type global w_sentdataout w_sentdataout type variables DATAWINDOW OBJ_DW INT ddlb_dataformat_INDEX=1 end variables forward prototypes public function string of_globalreplace (string as_source, string as_old, string as_new) public function integer of_xlsx (string arg_str) end prototypes public function string of_globalreplace (string as_source, string as_old, string as_new);long ll_oldlen, ll_newlen, ll_pos as_source=trim(as_source) as_old=trim(as_old) ll_pos = Pos(as_source,as_old) IF ll_pos > 0 Then ll_oldlen = Len(as_old) ll_newlen = Len(as_new) DO WHILE ll_pos > 0 as_source = Replace(as_source,ll_pos,ll_oldlen,as_new) ll_pos = Pos(as_source,as_old,ll_pos + ll_newlen) LOOP END IF RETURN as_source end function public function integer of_xlsx (string arg_str); OLEObject ExcelServer ExcelServer = Create OLEObject string new_str IF ExcelServer.ConnectToNewObject( "excel.application" ) < 0 THEN MessageBox('', "连接excel失败,检查你的系统是否安装了office,必须安装EXCLE才可以使用该导入功能!") RETURN 0 END IF TRY ExcelServer.Workbooks.Open(arg_str) ExcelServer.activeworkbook.worksheets(1).Activate ExcelServer.activeworkbook.Save new_str= replace(arg_str,pos(arg_str,'.'),1,' .') new_str= of_globalreplace(new_str,'xls','xlsx') new_str= of_globalreplace(new_str,'XLS','xlsx') ExcelServer.activeworkbook.SaveAs(new_str,51) ExcelServer.displayalerts = False ExcelServer.quit() ExcelServer.DisconnectObject() Destroy ExcelServer FileDelete(arg_str) RETURN 1 Catch(runtimeerror er) MessageBox('错误','导出execl失败~r~n'+er.getmessage()) FileDelete(arg_str) Destroy ExcelServer // ll_rtn_dsr = 0 RETURN 0 END TRY end function on w_sentdataout.create int iCurrent call super::create this.cb_backup=create cb_backup this.st_1=create st_1 this.sle_filename=create sle_filename this.cb_ch=create cb_ch this.gb_1=create gb_1 this.ddlb_dataformat=create ddlb_dataformat this.rb_xls=create rb_xls this.rb_xlsx=create rb_xlsx this.ddlb_1=create ddlb_1 this.st_2=create st_2 iCurrent=UpperBound(this.Control) this.Control[iCurrent+1]=this.cb_backup this.Control[iCurrent+2]=this.st_1 this.Control[iCurrent+3]=this.sle_filename this.Control[iCurrent+4]=this.cb_ch this.Control[iCurrent+5]=this.gb_1 this.Control[iCurrent+6]=this.ddlb_dataformat this.Control[iCurrent+7]=this.rb_xls this.Control[iCurrent+8]=this.rb_xlsx this.Control[iCurrent+9]=this.ddlb_1 this.Control[iCurrent+10]=this.st_2 end on on w_sentdataout.destroy call super::destroy destroy(this.cb_backup) destroy(this.st_1) destroy(this.sle_filename) destroy(this.cb_ch) destroy(this.gb_1) destroy(this.ddlb_dataformat) destroy(this.rb_xls) destroy(this.rb_xlsx) destroy(this.ddlb_1) destroy(this.st_2) end on event open;call super::open;OBJ_DW=Message.PowerObjectParm IF OBJ_DW.DATAOBJECT='' THEN CLOSE(THIS) ddlb_1.selectitem(2) end event type cb_func from w_publ_base`cb_func within w_sentdataout boolean visible = false integer x = 64 integer y = 388 boolean enabled = false end type type cb_exit from w_publ_base`cb_exit within w_sentdataout integer x = 1138 integer y = 388 integer width = 320 end type type cb_backup from uo_imflatbutton within w_sentdataout integer x = 453 integer y = 388 integer width = 320 integer height = 96 integer taborder = 60 string text = "发送" end type event clicked;call super::clicked;Integer SAVE_RSLT = 0 IF ddlb_dataformat_INDEX <> 4 AND Len(Trim(sle_filename.Text)) <= 5 THEN MessageBox('错误','请检查文件名!') RETURN END IF IF FileExists(sle_filename.Text) THEN IF MessageBox("系统提示","文件"+sle_filename.Text+"已经存在,是否覆盖该文件?",Question!,YesNo!,2) = 2 THEN RETURN END IF FileDelete(sle_filename.Text) END IF string ls_Sparse ls_Sparse = trim(obj_dw.Describe('datawindow.Sparse')) obj_dw.setredraw(false) If ddlb_1.Text = '不合并' Then obj_dw.Object.DataWindow.Sparse = '' obj_dw.Modify("DataWindow.HTMLTable.Border='0'") End If CHOOSE CASE ddlb_dataformat_INDEX CASE 1 //EXCEL n_cst_dw2Excel lnv_Excel SAVE_RSLT = lnv_Excel.OF_dw2Excel(obj_dw,sle_filename.Text,'Sheet1') IF rb_xlsx.Checked = True THEN of_xlsx(sle_filename.Text) CASE 2 //EXCEL SAVE_RSLT = obj_dw.SaveAsAscii(sle_filename.Text) IF rb_xlsx.Checked = True THEN of_xlsx(sle_filename.Text) CASE 3 //HTML SAVE_RSLT = obj_dw.SaveAs(sle_filename.Text,HTMLTable!,FALSE) CASE 4 //TEXT SAVE_RSLT = obj_dw.SaveAs(sle_filename.Text,Text!,FALSE) CASE 5 //CLB SAVE_RSLT = obj_dw.SaveAs(sle_filename.Text,Clipboard!,FALSE) CASE ELSE END CHOOSE If ddlb_1.Text = '不合并' Then obj_dw.Object.DataWindow.Sparse = ls_Sparse obj_dw.Modify("DataWindow.HTMLTable.Border='1'") end if obj_dw.setredraw(true) IF SAVE_RSLT = 1 THEN MessageBox("成功信息","数据发送操作成功!") ELSE MessageBox("失败信息","数据发送操作失败!请检查目标文件名称是否拼写正确!") END IF //Clipboard! Save to the clipboard //CSV! ?Comma-separated values //dBASE2! ?dBASE-II format //dBASE3! ?dBASE-III format //DIF! ?Data Interchange Format //Excel! ?Microsoft Excel format //Excel5! ?Microsoft Excel 5 format //HTMLTable! ?Text with HTML formatting that approximates the DataWindow layout //PSReport! ?Powersoft Report (PSR) format //SQLInsert! ?SQL syntax //SYLK! ?Microsoft Multiplan format //Text! ?(Default) Tab-separated columns with a return at the end of each row //WKS! ?Lotus 1-2-3 format //WK1! ?Lotus 1-2-3 format //WMF! ?Windows Metafile format end event type st_1 from statictext within w_sentdataout integer x = 73 integer y = 32 integer width = 480 integer height = 48 integer textsize = -9 integer weight = 400 fontcharset fontcharset = gb2312charset! fontpitch fontpitch = variable! string facename = "宋体" long textcolor = 33554432 long backcolor = 134217739 string text = "目标发送数据格式:" boolean focusrectangle = false end type type sle_filename from singlelineedit within w_sentdataout integer x = 96 integer y = 216 integer width = 1559 integer height = 92 integer taborder = 50 integer textsize = -9 integer weight = 400 fontcharset fontcharset = gb2312charset! fontpitch fontpitch = variable! string facename = "宋体" long textcolor = 33554432 borderstyle borderstyle = stylelowered! end type type cb_ch from commandbutton within w_sentdataout integer x = 1659 integer y = 216 integer width = 114 integer height = 92 integer taborder = 60 integer textsize = -9 integer weight = 400 fontcharset fontcharset = gb2312charset! fontpitch fontpitch = variable! string facename = "宋体" string text = "..." end type event clicked;string DATAFORMAT='' integer i string pathname,filename CHOOSE CASE ddlb_dataformat_INDEX CASE 1,2 //EXCEL DATAFORMAT='XLS' CASE 3 //HTML DATAFORMAT='HTML' CASE 4 //TEXT DATAFORMAT='TXT' CASE ELSE END CHOOSE i=getfilesavename("给予目标文件名",pathname,filename,DATAFORMAT,ddlb_dataformat.text+',*.'+DATAFORMAT) IF i=1 AND TRIM(pathname)<>'' AND TRIM(FILENAME)<>"" THEN sle_filename.text=pathname END IF end event type gb_1 from groupbox within w_sentdataout integer x = 32 integer y = 136 integer width = 1810 integer height = 216 integer taborder = 30 integer textsize = -9 integer weight = 400 fontcharset fontcharset = gb2312charset! fontpitch fontpitch = variable! string facename = "宋体" long textcolor = 33554432 long backcolor = 134217739 string text = "发送的目标文件路径及名称" end type type ddlb_dataformat from dropdownlistbox within w_sentdataout integer x = 544 integer y = 20 integer width = 654 integer height = 740 integer taborder = 20 boolean bringtotop = true integer textsize = -9 integer weight = 400 fontcharset fontcharset = gb2312charset! fontpitch fontpitch = variable! string facename = "宋体" long textcolor = 33554432 boolean sorted = false boolean vscrollbar = true string item[] = {"Excel 完整(*.xls)","Excel 快速(*.xls)","HTML (*.htmL)","Text (*.txt)","剪切板"} borderstyle borderstyle = stylelowered! end type event constructor;if THIS.TotalItems ( )>=1 then THIS.SelectItem(1) end event event selectionchanged;ddlb_dataformat_INDEX = Index IF Index = 4 THEN sle_filename.Enabled = False cb_ch.Enabled = False ELSE sle_filename.Enabled = True cb_ch.Enabled = True END IF sle_filename.Text = '' IF Pos(This.Text,'xls') <= 0 THEN rb_xls.Visible = False rb_xlsx.Visible = False ELSE rb_xls.Visible = True rb_xlsx.Visible = True END IF end event type rb_xls from radiobutton within w_sentdataout integer x = 1289 integer y = 36 integer width = 256 integer height = 60 boolean bringtotop = true integer textsize = -9 integer weight = 400 fontcharset fontcharset = gb2312charset! fontpitch fontpitch = variable! string facename = "宋体" long textcolor = 33554432 long backcolor = 67108864 string text = "xls" boolean checked = true end type event constructor;Long ls_show_save //ls_show_save = Long(ProfileString (sys_inifilename,publ_userid+'_'+String('xlsq'), "xls",'0')) ls_show_save=long(f_ProfileString (sys_empid,publ_userid+'_'+String('xlsq'), "xls",'0')) IF ls_show_save = 0 THEN rb_xls.Checked = True rb_xlsx.Checked = False ELSE rb_xls.Checked = false rb_xlsx.Checked = True END IF end event event destructor; long ll_xls if rb_xls.checked=true then ll_xls=0 else ll_xls=1 end if //f_SetProfileString(SYS_INIFILENAME, publ_userid+'_'+String('xlsq'), "xls", String(ll_xls)) f_SetProfileString (sys_empid,publ_userid+'_'+String('xlsq'), "xls",String(ll_xls)) end event type rb_xlsx from radiobutton within w_sentdataout integer x = 1577 integer y = 36 integer width = 256 integer height = 60 boolean bringtotop = true integer textsize = -9 integer weight = 400 fontcharset fontcharset = gb2312charset! fontpitch fontpitch = variable! string facename = "宋体" long textcolor = 33554432 long backcolor = 67108864 string text = "xlsx" end type type ddlb_1 from dropdownlistbox within w_sentdataout integer x = 1920 integer y = 108 integer width = 507 integer height = 300 integer taborder = 30 boolean bringtotop = true integer textsize = -9 integer weight = 400 fontcharset fontcharset = gb2312charset! fontpitch fontpitch = variable! string facename = "宋体" long textcolor = 33554432 boolean sorted = false string item[] = {"不合并","按原格式"} borderstyle borderstyle = stylelowered! end type type st_2 from statictext within w_sentdataout integer x = 1920 integer y = 32 integer width = 507 integer height = 48 boolean bringtotop = true integer textsize = -9 integer weight = 400 fontcharset fontcharset = gb2312charset! fontpitch fontpitch = variable! string facename = "宋体" long textcolor = 33554432 long backcolor = 67108864 string text = "相同数据列显示方式" boolean focusrectangle = false end type