$PBExportHeader$w_cusarea_def.srw forward global type w_cusarea_def from w_publ_base end type type cb_ok from uo_imflatbutton within w_cusarea_def end type type tv_1 from uo_tv_cusarea within w_cusarea_def end type type r_bar from rectangle within w_cusarea_def end type type ln_bar from line within w_cusarea_def end type type ln_bar2 from line within w_cusarea_def end type type cb_del from uo_imflatbutton within w_cusarea_def end type type cb_mod from uo_imflatbutton within w_cusarea_def end type type cb_add_next from uo_imflatbutton within w_cusarea_def end type type cb_add from uo_imflatbutton within w_cusarea_def end type type cb_refresh from uo_imflatbutton within w_cusarea_def end type type cb_help from uo_imflatbutton within w_cusarea_def end type type cb_choice from uo_imflatbutton within w_cusarea_def end type end forward global type w_cusarea_def from w_publ_base integer width = 2176 integer height = 2380 string title = "客户区域" event ue_help ( ) cb_ok cb_ok tv_1 tv_1 r_bar r_bar ln_bar ln_bar ln_bar2 ln_bar2 cb_del cb_del cb_mod cb_mod cb_add_next cb_add_next cb_add cb_add cb_refresh cb_refresh cb_help cb_help cb_choice cb_choice end type global w_cusarea_def w_cusarea_def type variables long il_hand s_cusarea s_rst end variables forward prototypes public function integer wf_cnt_dot (string arg_mtrltype) end prototypes event ue_help();Int i i = htmlhelpA(Handle(THIS), sys_help_chm, 0, THIS.Title+".html") end event public function integer wf_cnt_dot (string arg_mtrltype);long rst_cnt string ls_mtrltype long pos_dot ls_mtrltype = arg_mtrltype again: pos_dot = pos(ls_mtrltype,'>>') if pos_dot > 0 then rst_cnt++ ls_mtrltype = mid( ls_mtrltype,pos_dot + 2 ) goto again else goto ext end if ext: return rst_cnt end function on w_cusarea_def.create int iCurrent call super::create this.cb_ok=create cb_ok this.tv_1=create tv_1 this.r_bar=create r_bar this.ln_bar=create ln_bar this.ln_bar2=create ln_bar2 this.cb_del=create cb_del this.cb_mod=create cb_mod this.cb_add_next=create cb_add_next this.cb_add=create cb_add this.cb_refresh=create cb_refresh this.cb_help=create cb_help this.cb_choice=create cb_choice iCurrent=UpperBound(this.Control) this.Control[iCurrent+1]=this.cb_ok this.Control[iCurrent+2]=this.tv_1 this.Control[iCurrent+3]=this.r_bar this.Control[iCurrent+4]=this.ln_bar this.Control[iCurrent+5]=this.ln_bar2 this.Control[iCurrent+6]=this.cb_del this.Control[iCurrent+7]=this.cb_mod this.Control[iCurrent+8]=this.cb_add_next this.Control[iCurrent+9]=this.cb_add this.Control[iCurrent+10]=this.cb_refresh this.Control[iCurrent+11]=this.cb_help this.Control[iCurrent+12]=this.cb_choice end on on w_cusarea_def.destroy call super::destroy destroy(this.cb_ok) destroy(this.tv_1) destroy(this.r_bar) destroy(this.ln_bar) destroy(this.ln_bar2) destroy(this.cb_del) destroy(this.cb_mod) destroy(this.cb_add_next) destroy(this.cb_add) destroy(this.cb_refresh) destroy(this.cb_help) destroy(this.cb_choice) end on event resize;call super::resize;ln_bar.endx = this.width ln_bar2.endx = this.width r_bar.width = this.width tv_1.height = this.height - tv_1.y - 100 end event event close;call super::close;CloseWithReturn(THIS,s_rst) end event type cb_func from w_publ_base`cb_func within w_cusarea_def boolean visible = false integer x = 242 integer y = 768 end type type cb_exit from w_publ_base`cb_exit within w_cusarea_def integer x = 1138 integer width = 151 integer height = 172 integer picsize = 16 toolbaralignment pic_align = alignattop! boolean border = false end type event cb_exit::clicked;close(parent) end event type cb_ok from uo_imflatbutton within w_cusarea_def boolean visible = false integer x = 553 integer y = 764 integer width = 279 integer height = 96 integer taborder = 70 string text = "选定" end type event clicked;call super::clicked;//string ls_handtype //long ls_mtrltypeid // //select mtrltypeid,handtype into :ls_mtrltypeid,:ls_handtype from u_mtrltype //where mtrltype = :cur_mtrltype; // //if sqlca.sqlcode = -1 then // messagebox("系统提示","查询类别失败") // return //end if // //if cur_mtrltype = '+++物料类别+++' then // rst_mtrltype.mtrltypeid = -1 // rst_mtrltype.handtype = '' //else // rst_mtrltype.mtrltypeid = ls_mtrltypeid // rst_mtrltype.handtype = ls_handtype //end if // //close(parent) // // end event type tv_1 from uo_tv_cusarea within w_cusarea_def integer y = 192 integer width = 2153 integer height = 1864 integer taborder = 30 boolean bringtotop = true integer textsize = -9 fontcharset fontcharset = gb2312charset! fontfamily fontfamily = anyfont! string facename = "宋体" end type event selectionchanged;call super::selectionchanged;il_hand = newhandle end event event doubleclicked;call super::doubleclicked;IF cb_choice.Enabled THEN cb_choice.TriggerEvent(Clicked!) END IF end event type r_bar from rectangle within w_cusarea_def long linecolor = 16777215 long fillcolor = 1073741824 integer x = 1454 integer width = 73 integer height = 172 end type event constructor;this.fillcolor = 14215660 this.linecolor = 14215660 this.x = -1 this.y = -1 this.height = ln_bar2.beginy end event type ln_bar from line within w_cusarea_def long linecolor = 268435456 integer linethickness = 4 integer beginy = 176 integer endx = 2098 integer endy = 176 end type type ln_bar2 from line within w_cusarea_def long linecolor = 16777215 integer linethickness = 4 integer beginy = 180 integer endx = 2098 integer endy = 180 end type type cb_del from uo_imflatbutton within w_cusarea_def integer x = 686 integer width = 151 integer height = 172 integer taborder = 100 string text = "删除" string normalpicname = "delete.bmp" integer picsize = 16 toolbaralignment pic_align = alignattop! boolean border = false end type event clicked;call super::clicked;if not f_power_ind(19) then messagebox('提示','你没有使用权限!', Information!, OK! ) return end if if MessageBox('询问','是否要确定删除当前地区', question!, YesNo!, 2)=2 then return end if if tv_1.uo_cur_info.sonflag = 0 then messagebox('提示','不是明细地区,不能删除', Information!, OK! ) return end if long cnt select count(*) into :cnt from u_cust where Cusareaid = :tv_1.uo_cur_info.Cusareaid; if sqlca.sqlcode <> 0 then messagebox('提示','查询地区是否已用失败,不能删除', Information!, OK! ) return end if if cnt > 0 then messagebox('提示','地区已用于客户定义,不能删除', Information!, OK! ) return end if cnt = 0 select count(*) into :cnt from u_cusarea where parentid = :tv_1.uo_cur_info.parentid; if sqlca.sqlcode <> 0 then messagebox('提示','查询地区资料失败,不能删除', Information!, OK! ) return end if if cnt = 1 then update u_cusarea set sonflag = 1 where cusareaid = :tv_1.uo_cur_info.parentid; if sqlca.sqlcode <> 0 then messagebox('提示','更新上级地区资料失败,不能删除', Information!, OK! ) rollback; return end if end if delete from u_Cusarea where Cusareaid = :tv_1.uo_cur_info.Cusareaid; if sqlca.sqlcode <> 0 then messagebox('提示','删除地区失败>>'+sqlca.sqlerrtext, Information!, OK! ) rollback; return end if commit; messagebox('提示','删除地区成功', Information!, OK! ) tv_1.f_maketree() end event type cb_mod from uo_imflatbutton within w_cusarea_def integer x = 535 integer width = 151 integer height = 172 integer taborder = 90 string text = "修改" string normalpicname = "open.bmp" integer picsize = 16 toolbaralignment pic_align = alignattop! boolean border = false end type event clicked;call super::clicked;IF NOT f_power_ind(19) THEN MessageBox('提示','你没有使用权限!', Information!, OK! ) RETURN END IF IF tv_1.uo_cur_info.cusareaid = 0 THEN MessageBox('提示','请选择当前地区!', Information!, OK! ) RETURN END IF Long cnt String ls_new_Cusareaname String ls_new_handtype String ls_old_handtype String ls_update_handtype Long ll_old_parentid Long ll_new_parentid Long ll_cusareaid Long li_sonflag s_cusarea s_area,s_r_area ll_cusareaid = tv_1.uo_cur_info.cusareaid ll_old_parentid = tv_1.uo_cur_info.parentid ls_old_handtype = tv_1.uo_cur_info.areaname ls_update_handtype = tv_1.uo_cur_info.areaname + '%' s_area.cusareaid = tv_1.uo_cur_info.cusareaid s_area.cusareaname = tv_1.uo_cur_info.cusareaname s_area.sonflag = tv_1.uo_cur_info.sonflag s_area.parentid = tv_1.uo_cur_info.parentid s_area.parenthandtype = tv_1.uo_cur_info.areaname OpenWithParm(w_cusarea_add,s_area) s_r_area = Message.PowerObjectParm IF s_r_area.cusareaid = -1 THEN RETURN ls_new_Cusareaname = s_r_area.cusareaname ls_new_handtype = s_r_area.areaname ll_new_parentid = s_r_area.parentid li_sonflag = s_r_area.sonflag UPDATE u_Cusarea SET Cusareaname = :ls_new_Cusareaname, areaname = :ls_new_handtype, parentid = :ll_new_parentid, typecode = :s_r_area.typecode, typecodestr = :s_r_area.typecodestr Where (cusareaid = :ll_cusareaid ) ; IF sqlca.SQLCode <> 0 THEN ROLLBACK; MessageBox('错误','修改名称操作错误,可能是新名称已经存在或网络故障!', StopSign!, OK! ) RETURN END IF UPDATE u_Cusarea SET areaname = replace(areaname,:ls_old_handtype,:ls_new_handtype) Where areaname Like :ls_update_handtype; IF sqlca.SQLCode <> 0 THEN ROLLBACK; MessageBox('错误','修改名称操作错误,可能是新名称已经存在或网络故障!', StopSign!, OK! ) RETURN END IF UPDATE u_cust SET Cusareaname = :ls_new_Cusareaname Where cusareaid = :ll_cusareaid; IF sqlca.SQLCode <> 0 THEN ROLLBACK; MessageBox('错误','修改地区操作错误,可能是新名称已经存在或网络故障!', StopSign!, OK! ) RETURN END IF UPDATE u_cust SET areaname = replace(areaname,:ls_old_handtype,:ls_new_handtype) Where areaname Like :ls_update_handtype; IF sqlca.SQLCode <> 0 THEN ROLLBACK; MessageBox('错误','修改地区操作错误,可能是新名称已经存在或网络故障!', StopSign!, OK! ) RETURN END IF UPDATE u_Cusarea SET sonflag = 0 Where u_Cusarea.cusareaid = :ll_new_parentid; IF sqlca.SQLCode <> 0 THEN ROLLBACK; MessageBox('错误','新建地区"'+ls_new_Cusareaname+'"上级地区资料错误', StopSign!, OK! ) RETURN END IF IF ll_old_parentid <> ll_new_parentid THEN SELECT count(*) INTO :cnt FROM u_cusarea Where parentid = :ll_old_parentid; IF sqlca.SQLCode <> 0 THEN ROLLBACK; MessageBox('错误','查询上级区域是否还存在下级区域错误', StopSign!, OK! ) RETURN END IF IF cnt = 0 THEN UPDATE u_cusarea SET sonflag = 1 Where cusareaid = :ll_old_parentid; IF sqlca.SQLCode <> 0 THEN ROLLBACK; MessageBox('错误','更新上级区域资料错误', StopSign!, OK! ) RETURN END IF END IF END IF COMMIT; MessageBox('提示','区域修改成功!', Information!, OK! ) TreeViewItem l_tvi IF tv_1.GetItem(il_hand,l_tvi) > 0 THEN l_tvi.Label = ls_new_Cusareaname l_tvi.Data = ll_cusareaid tv_1.SetItem(il_hand, l_tvi) tv_1.SetFocus() tv_1.SelectItem ( il_hand ) END IF end event type cb_add_next from uo_imflatbutton within w_cusarea_def integer x = 343 integer width = 192 integer height = 172 integer taborder = 90 string text = "增下级" string normalpicname = "mx2.bmp" integer picsize = 16 toolbaralignment pic_align = alignattop! boolean border = false end type event clicked;call super::clicked;IF NOT f_power_ind(19) THEN MessageBox('提示','你没有使用权限!', Information!, OK! ) RETURN END IF String ls_Cusareaname String ls_areaname Long ll_parentid Long ll_cusareaid Int li_sonflag String arg_msg s_cusarea s_area,s_r_area s_area.cusareaid = 0 s_area.cusareaname = '' s_area.sonflag = 1 IF tv_1.uo_cur_info.cusareaid = 0 THEN s_area.parentid = 0 s_area.parenthandtype = '' ELSE s_area.parentid = tv_1.uo_cur_info.cusareaid s_area.parenthandtype = tv_1.uo_cur_info.areaname END IF OpenWithParm(w_cusarea_add,s_area) s_r_area = Message.PowerObjectParm IF s_r_area.cusareaid = -1 THEN RETURN ll_cusareaid = f_sys_scidentity(0,"u_Cusarea","Cusareaid",arg_msg,TRUE,sqlca) IF ll_cusareaid <= 0 THEN MessageBox('提示',arg_msg, Information!, OK! ) ROLLBACK; END IF ls_Cusareaname = s_r_area.cusareaname ls_areaname = s_r_area.areaname ll_parentid = s_r_area.parentid li_sonflag = s_r_area.sonflag INSERT INTO u_Cusarea (Cusareaid, Cusareaname, areaname, sonflag, parentid, typecode, typecodestr ) VALUES (:ll_cusareaid, :ls_Cusareaname, :ls_areaname, :li_sonflag, :ll_parentid, :s_r_area.typecode, :s_r_area.typecodestr ) ; IF sqlca.SQLCode <> 0 THEN ROLLBACK; MessageBox('错误','新建地区"'+ls_Cusareaname+'"失败,可能是名称已经存在或网络故障!', StopSign!, OK! ) RETURN END IF UPDATE u_Cusarea SET sonflag = 0 Where u_Cusarea.cusareaid = :ll_parentid; IF sqlca.SQLCode <> 0 THEN ROLLBACK; MessageBox('错误','新建地区"'+ls_Cusareaname+'"失败,可能是名称已经存在或网络故障!', StopSign!, OK! ) RETURN END IF COMMIT; MessageBox('提示','新建地区操作成功!', Information!, OK! ) //第一个孩子将祖先的客户收入自己 Long cnt SELECT count(*) INTO :cnt FROM u_Cusarea Where u_Cusarea.parentid = :ll_parentid; IF sqlca.SQLCode <> 0 THEN cnt = 0 IF cnt = 1 THEN UPDATE u_cust SET cusareaid = :ll_cusareaid, cusareaname = :ls_Cusareaname, areaname = :ls_areaname Where cusareaid = :ll_parentid; IF sqlca.SQLCode <> 0 THEN ROLLBACK; MessageBox('错误','更新客户的区域'+ls_Cusareaname+'"失败!', StopSign!, OK! ) RETURN END IF COMMIT; END IF Long ll_handl TreeViewItem l_tvi ll_handl = tv_1.InsertItemSort(il_hand,ls_Cusareaname,2) IF tv_1.GetItem ( ll_handl, l_tvi) = 1 THEN l_tvi.Label = ls_Cusareaname l_tvi.Data = ll_cusareaid //增加新行 tv_1.f_ds_add(ll_cusareaid) tv_1.SetItem(ll_handl, l_tvi) tv_1.SetFocus() tv_1.SelectItem ( ll_handl ) END IF end event type cb_add from uo_imflatbutton within w_cusarea_def integer x = 151 integer width = 192 integer height = 172 integer taborder = 80 string text = "增同级" string normalpicname = "mx1.bmp" integer picsize = 16 toolbaralignment pic_align = alignattop! boolean border = false end type event clicked;call super::clicked;IF NOT f_power_ind(19) THEN MessageBox(publ_operator,'你没有使用权限!') RETURN END IF String ls_Cusareaname String ls_areaname Long ll_parentid Long ll_cusareaid Int li_sonflag String arg_msg String ls_parent_handtype s_cusarea s_area,s_r_area IF tv_1.uo_cur_info.Cusareaid = 0 THEN MessageBox("系统提示",'不能建立地区') RETURN END IF s_area.Cusareaid = 0 s_area.cusareaname = '' s_area.sonflag = 1 s_area.parentid = tv_1.uo_cur_info.parentid IF tv_1.uo_cur_info.parentid = 0 THEN s_area.parenthandtype = '' ELSE SELECT areaname INTO :ls_parent_handtype FROM u_cusarea Where Cusareaid = :tv_1.uo_cur_info.parentid; IF sqlca.SQLCode <> 0 THEN MessageBox('系统提示','查询上级区域资料失败') RETURN END IF s_area.parenthandtype = ls_parent_handtype END IF OpenWithParm(w_cusarea_add,s_area) s_r_area = Message.PowerObjectParm IF s_r_area.Cusareaid = -1 THEN RETURN ll_cusareaid = f_sys_scidentity(0,"u_Cusarea","Cusareaid",arg_msg,TRUE,sqlca) IF ll_cusareaid <= 0 THEN MessageBox(publ_operator,arg_msg) ROLLBACK; END IF ls_Cusareaname = s_r_area.cusareaname ls_areaname = s_r_area.areaname ll_parentid = s_r_area.parentid li_sonflag = s_r_area.sonflag INSERT INTO u_Cusarea (Cusareaid, Cusareaname, areaname, sonflag, parentid , typecode, typecodestr) VALUES (:ll_cusareaid, :ls_Cusareaname, :ls_areaname, :li_sonflag, :ll_parentid, :s_r_area.typecode, :s_r_area.typecodestr) ; IF sqlca.SQLCode <> 0 THEN ROLLBACK; MessageBox('失败','新建地区"'+ls_Cusareaname+'"失败,可能是名称已经存在或网络故障!') RETURN END IF UPDATE u_Cusarea SET sonflag = 0 Where u_cusarea.Cusareaid = :ll_parentid; IF sqlca.SQLCode <> 0 THEN ROLLBACK; MessageBox('失败','新建地区"'+ls_Cusareaname+'"失败,可能是名称已经存在或网络故障!') RETURN END IF COMMIT; MessageBox('成功','新建地区操作成功!') Long ll_hand,ll_handl TreeViewItem l_tvi ll_hand = tv_1.FindItem(parenttreeitem!,il_hand) ll_handl = tv_1.InsertItemSort(ll_hand,ls_Cusareaname,2) IF tv_1.GetItem ( ll_handl, l_tvi) = 1 THEN l_tvi.Label = ls_Cusareaname l_tvi.Data = ll_cusareaid //增加新行 tv_1.f_ds_add(ll_cusareaid) tv_1.SetItem(ll_handl, l_tvi) tv_1.SetFocus() tv_1.SelectItem ( ll_handl ) END IF end event type cb_refresh from uo_imflatbutton within w_cusarea_def integer width = 151 integer height = 172 integer taborder = 80 string text = "重查" string normalpicname = "refresh.bmp" integer picsize = 16 toolbaralignment pic_align = alignattop! boolean border = false end type event clicked;call super::clicked; tv_1.f_maketree() end event type cb_help from uo_imflatbutton within w_cusarea_def string tag = "帮助[F1]" integer x = 987 integer width = 151 integer height = 172 integer taborder = 110 boolean bringtotop = true string text = "帮助" string normalpicname = "help.bmp" integer picsize = 16 toolbaralignment pic_align = alignattop! boolean border = false end type event clicked;call super::clicked;PARENT.TriggerEvent('ue_help') end event type cb_choice from uo_imflatbutton within w_cusarea_def integer x = 837 integer width = 151 integer height = 172 integer taborder = 110 boolean bringtotop = true boolean enabled = false string text = "选定" string normalpicname = "ok.bmp" integer picsize = 16 toolbaralignment pic_align = alignattop! boolean border = false end type event clicked;call super::clicked;IF tv_1.uo_cur_info.cusareaid = 0 THEN MessageBox('提示','请选择当前区域!', Information!, OK! ) RETURN END IF IF tv_1.uo_cur_info.sonflag = 0 THEN MessageBox('提示','不是明细区域,不能选择!', Information!, OK! ) RETURN END IF s_rst.cusareaid = tv_1.uo_cur_info.cusareaid s_rst.cusareaname = tv_1.uo_cur_info.cusareaname s_rst.areaname = tv_1.uo_cur_info.areaname Close(PARENT) end event