$PBExportHeader$w_emp_pic2.srw forward global type w_emp_pic2 from window end type type cb_6 from uo_imflatbutton within w_emp_pic2 end type type st_2 from statictext within w_emp_pic2 end type type st_1 from statictext within w_emp_pic2 end type type cb_5 from uo_imflatbutton within w_emp_pic2 end type type p_2 from picture within w_emp_pic2 end type type p_1 from picture within w_emp_pic2 end type type cb_4 from uo_imflatbutton within w_emp_pic2 end type type cb_3 from uo_imflatbutton within w_emp_pic2 end type type cb_2 from uo_imflatbutton within w_emp_pic2 end type type cb_1 from uo_imflatbutton within w_emp_pic2 end type type gb_1 from groupbox within w_emp_pic2 end type end forward global type w_emp_pic2 from window integer x = 2999 integer y = 1408 integer width = 987 integer height = 996 boolean titlebar = true string title = "员工图片管理" boolean controlmenu = true windowtype windowtype = response! long backcolor = 134217739 string icon = "AppIcon!" event ue_destop ( ) cb_6 cb_6 st_2 st_2 st_1 st_1 cb_5 cb_5 p_2 p_2 p_1 p_1 cb_4 cb_4 cb_3 cb_3 cb_2 cb_2 cb_1 cb_1 gb_1 gb_1 end type global w_emp_pic2 w_emp_pic2 type variables long cur_empid Blob lb_pic boolean import = false boolean success = false end variables forward prototypes public function long wf_picretrieve (long arg_empid) public function long wf_picsave (transaction pictrans, long arg_empid, ref string arg_msg) public subroutine wf_resize () end prototypes event ue_destop();//附件下载并打开 Integer i Blob ls_filedata String Pathname,ls_filename String errmsg,arg_msg IF ISNULL(lb_pic) THEN MessageBox('系统提示','图片不存在') RETURN END IF //取附件信息 i = GetFileSaveName("另存为",Pathname,ls_filename,"*",".jpg,*.jpg") If i = 1 And Trim(Pathname) <> '' Then If f_saveblobtofile(lb_pic,Pathname,errmsg) = 0 Then MessageBox('系统提示',errmsg) Return Else MessageBox('系统提示','保存成功!'+'~r~n'+'保存路径:'+Pathname) End If End If end event public function long wf_picretrieve (long arg_empid);//Blob lb_pic_tmp Long ll_cnt Blob lb p_1.visible = false p_1.Width = 603 p_1.Height = 704 SetNull(lb) SELECT count(*) INTO :ll_cnt FROM u_rs_emppic Where empid = :arg_empid USING sqlca; IF sqlca.SQLCode <> 0 THEN SetNull(lb) p_1.SetPicture(lb) // p_1.PictureName = 'nullpic.bmp' p_1.visible = true RETURN 1 END IF IF ll_cnt = 0 THEN SetNull(lb) p_1.SetPicture(lb) // p_1.PictureName = 'nullpic.bmp' p_1.visible = true RETURN 1 END IF p_1.SetPicture(lb) SELECTBLOB picture INTO :lb_pic FROM u_rs_emppic Where empid = :arg_empid USING sqlca; IF sqlca.SQLCode <> 0 THEN SetNull(lb) // p_1.PictureName = 'nullpic.bmp' p_1.SetPicture(lb) p_1.visible = true END IF IF Len(String(lb_pic)) > 0 THEN p_1.SetPicture(lb_pic) p_2.SetPicture(lb_pic) p_1.X = 18 p_1.Y = 56 p_1.Width = 603 p_1.Height = 704 IF p_2.Width < 603 AND p_2.Height < 704 THEN p_1.Width = p_2.Width p_1.Height = p_2.Height wf_resize() p_1.visible = true RETURN 1 END IF If (p_2.Width / p_2.Height) > (603/704) THEN p_1.Width = 603 p_1.Height = 603 / (p_2.Width / p_2.Height ) ELSE p_1.Width = 704 * (p_2.Width / p_2.Height ) p_1.Height = 704 p_1.X = 603 - p_1.Width END IF wf_resize() p_1.visible = true ELSE SetNull(lb) p_1.SetPicture(lb) // p_1.PictureName = 'nullpic.bmp' p_1.visible = true END IF RETURN 1 end function public function long wf_picsave (transaction pictrans, long arg_empid, ref string arg_msg);//wf_picsave() blob lb,bl_mtrlpic,bl_jgpic,bl_packpic int li_piccount,rslt = 1 //lb = ole_1.objectdata if not isnull(lb) and len(lb)>1 and len(lb)<>1536 then //showmsg('没有获取员工相片信息') select count(*) into :li_piccount from u_rs_emppic where empid = :arg_empid; if sqlca.sqlcode = -1 then rslt = 0 arg_msg = '查询员工图片失败!原因:'+sqlca.sqlerrtext goto ext end if if li_piccount = 0 then insert into u_rs_emppic (empid) values(:arg_empid) using pictrans; if sqlca.sqlcode = -1 then rslt = 0 arg_msg = '保存员工图片失败!原因:'+sqlca.sqlerrtext goto ext end if commit using pictrans; end if updateblob u_rs_emppic set picture = :lb where empid = :arg_empid using pictrans; if pictrans.sqlcode = -1 then rslt = 0 arg_msg = '员工图片失败!原因:'+pictrans.sqlerrtext goto ext end if commit using pictrans; end if ext: if rslt = 0 then rollback using pictrans; end if return (rslt) end function public subroutine wf_resize ();long li_SW,li_SH long li_x = 1,li_y = 1 li_SW = 603 li_SH = 704 li_x = (li_SW - p_1.Width)/2 + gb_1.x + 28 li_y = (li_SH - p_1.Height)/2 + gb_1.y + 60 p_1.Move(li_x,li_y) end subroutine on w_emp_pic2.create this.cb_6=create cb_6 this.st_2=create st_2 this.st_1=create st_1 this.cb_5=create cb_5 this.p_2=create p_2 this.p_1=create p_1 this.cb_4=create cb_4 this.cb_3=create cb_3 this.cb_2=create cb_2 this.cb_1=create cb_1 this.gb_1=create gb_1 this.Control[]={this.cb_6,& this.st_2,& this.st_1,& this.cb_5,& this.p_2,& this.p_1,& this.cb_4,& this.cb_3,& this.cb_2,& this.cb_1,& this.gb_1} end on on w_emp_pic2.destroy destroy(this.cb_6) destroy(this.st_2) destroy(this.st_1) destroy(this.cb_5) destroy(this.p_2) destroy(this.p_1) destroy(this.cb_4) destroy(this.cb_3) destroy(this.cb_2) destroy(this.cb_1) destroy(this.gb_1) end on event open;cur_empid=Message.DoubleParm cb_1.triggerevent(clicked!) end event type cb_6 from uo_imflatbutton within w_emp_pic2 integer x = 663 integer y = 464 integer width = 256 integer height = 96 integer taborder = 40 string text = "另存图片" end type event clicked;call super::clicked;parent.triggerevent('ue_destop') end event type st_2 from statictext within w_emp_pic2 integer x = 160 integer y = 852 integer width = 453 integer height = 48 integer textsize = -9 integer weight = 400 fontcharset fontcharset = gb2312charset! fontpitch fontpitch = variable! string facename = "宋体" long textcolor = 16711680 long backcolor = 134217739 string text = "可以获得最佳效果" boolean focusrectangle = false end type type st_1 from statictext within w_emp_pic2 integer x = 27 integer y = 796 integer width = 1303 integer height = 56 integer textsize = -9 integer weight = 400 fontcharset fontcharset = gb2312charset! fontpitch fontpitch = variable! string facename = "宋体" long textcolor = 16711680 long backcolor = 134217739 string text = "提示:照片大小控制在130*170之内," boolean focusrectangle = false end type type cb_5 from uo_imflatbutton within w_emp_pic2 integer x = 663 integer y = 560 integer width = 256 integer height = 96 integer taborder = 40 string text = "删除图片" end type event clicked;call super::clicked;IF MessageBox("询问", '是否删除该员工的图片资料?', question!, OKCancel!, 2) = 2 THEN RETURN DELETE FROM u_rs_emppic Where empid = :cur_empid; IF sqlca.SQLCode <> 0 THEN ROLLBACK; MessageBox('Error','删除员工图片失败!') RETURN END IF p_1.PictureName = 'graphics\nophoto.jpg' p_2.PictureName = 'graphics\nophoto.jpg' p_1.X = 46 p_1.Y = 60 p_1.Width = 603 p_1.Height = 704 IF p_2.Width < 603 AND p_2.Height < 704 THEN p_1.Width = p_2.Width p_1.Height = p_2.Height wf_resize() END IF COMMIT; MessageBox('系统提示','删除员工图片成功!') end event type p_2 from picture within w_emp_pic2 boolean visible = false integer x = 480 integer y = 428 integer width = 375 integer height = 192 boolean originalsize = true boolean focusrectangle = false end type type p_1 from picture within w_emp_pic2 integer x = 46 integer y = 60 integer width = 603 integer height = 704 boolean originalsize = true boolean focusrectangle = false end type type cb_4 from uo_imflatbutton within w_emp_pic2 integer x = 663 integer y = 652 integer width = 256 integer height = 96 integer taborder = 30 string text = "退出" string normalpicname = "exit.bmp" end type event clicked;call super::clicked;close(parent) end event type cb_3 from uo_imflatbutton within w_emp_pic2 integer x = 663 integer y = 340 integer width = 256 integer height = 96 integer taborder = 30 string text = "保存图片" end type event clicked;call super::clicked;IF NOT import THEN MessageBox('系统提示','请选择图片!') success = FALSE RETURN END IF Long ll_cnt SELECT count(*) INTO :ll_cnt FROM u_rs_emppic Where empid = :cur_empid; IF sqlca.SQLCode <> 0 THEN MessageBox('Error','查询员工照片资料失败') RETURN END IF IF ll_cnt = 0 THEN INSERT INTO u_rs_emppic (empid) Values (:cur_empid) ; IF sqlca.SQLCode <> 0 THEN ROLLBACK; MessageBox('Error','插入员工图片资料失败>>'+ sqlca.SQLErrText ) success = FALSE RETURN END IF END IF UPDATEBLOB u_rs_emppic Set picture = :lb_pic Where empid = :cur_empid; IF sqlca.SQLCode = 0 THEN MessageBox('成功',"更新图片成功" ) COMMIT USING sqlca; success = TRUE Close(PARENT) RETURN ELSE MessageBox('失败',"更新图片失败" + sqlca.SQLErrText ) ROLLBACK USING sqlca; RETURN END IF end event type cb_2 from uo_imflatbutton within w_emp_pic2 integer x = 663 integer y = 248 integer width = 256 integer height = 96 integer taborder = 30 string text = "获取图片" end type event clicked;call super::clicked;String Pathname,Filename Integer i i = GetFileOpenName("请选择图片", Pathname, Filename, "PIC", "JPG(*.JPG),*.JPG,位图文件(*.bmp),*.bmp") If i = 1 And Trim(Pathname) <> '' And Trim(Filename) <> "" Then If Pathname = '' Or Not FileExists(Pathname) Then MessageBox('系统提示','请选择图片!') success = False import = False Return End If ///////////////////////////////////////////// // SetNull(lb_pic) Long ll_fileLength,li_FileNum,loops,new_pos,bytes_read Blob b,temp ll_fileLength = FileLength(Pathname) li_FileNum = FileOpen(Pathname, StreamMode!, Read!, LockRead!) If ll_fileLength > 32765 Then If Mod(ll_fileLength, 32765) = 0 Then loops = ll_fileLength/32765 Else loops = (ll_fileLength/32765) + 1 End If Else loops = 1 End If // Read the file new_pos = 1 For i = 1 To loops bytes_read = FileRead(li_FileNum, b) temp = temp + b Next FileClose(li_FileNum) lb_pic = temp p_1.PictureName = Filename p_1.SetPicture(lb_pic) p_2.PictureName = Filename p_2.SetPicture(lb_pic) Filename = Lower(Filename) import = True Else success = False End If p_1.X = 46 p_1.Y = 60 p_1.Width = 603 p_1.Height = 704 If p_2.Width < 603 And p_2.Height < 704 Then p_1.Width = p_2.Width p_1.Height = p_2.Height wf_resize() Return End If If (p_2.Width / p_2.Height) > (603/704) Then p_1.Width = 603 p_1.Height = 603 / (p_2.Width / p_2.Height ) Else p_1.Width = 704 * (p_2.Width / p_2.Height ) p_1.Height = 704 p_1.X = 603 - p_1.Width End If wf_resize() end event type cb_1 from uo_imflatbutton within w_emp_pic2 integer x = 663 integer y = 56 integer width = 256 integer height = 96 integer taborder = 20 string text = "刷新" end type event clicked;call super::clicked; wf_picretrieve(cur_empid) end event type gb_1 from groupbox within w_emp_pic2 integer x = 18 integer width = 937 integer height = 784 integer taborder = 10 integer textsize = -12 integer weight = 400 fontcharset fontcharset = ansi! fontpitch fontpitch = variable! fontfamily fontfamily = swiss! string facename = "Arial" long textcolor = 33554432 long backcolor = 134217739 end type