vf.txt

仓库管理系统的VISAUL FOXPRO实现源代码

1：主程序源代码： 
SET TALK off 
set sysmenu off 
set cent on 
_screen.windowstate=2 
_screen.icon="iconshappy.ico" 
_screen.maxbutton=0 
_screen.minbutton=1 
_screen.closable=.f. 
modify window screen noclose 
MODIFY WINDOW SCREEN TITLE " 仓库管理信息系统 " 
ZOOM WINDOW SCREEN MAX 
set default to data 
do form 登录表单 
read events 
clear 
close all 
return 
endif 
2：登录表单的确定按钮控件的click源代码： 

locate for alltrim(用户名)==alltrim(thisform.combo1.value) and alltrim(密码)==alltrim(thisform.text1.value) 
if !eof() 
if alltrim(级别)=="管理员" 
public jb,username 
jb=1 
username=alltrim(thisform.combo1.value) 
else 
public jb,username 
jb=0 
username=alltrim(thisform.combo1.value) 
endif 
do menu.mpr 
thisform.release 
do form 仓库管理 
else 
#define missmatch_loc "用户或口令错，请重新登录！" 
wait window missmatch_loc timeout 1 
thisform.combo1.value='' 
thisform.text1.value='' 
thisform.text1.setfocus 

numcount=numcount+1 
if numcount=4 
numcount=0 
mess =messagebox("三次口令错，将退出程序！",4+16+2,"退出") 
clear event 
release thisform 
endif 
endif 
3：密码修改表单的修改按钮的click事件源代码： 
if empty(thisform.text4.value) 
mess=messagebox("用户名不能为空！",48,"警告") 
else 
if empty(thisform.text1.value) 
mess=messagebox("旧密码不能为空！",48,"警告") 
else 
if empty(thisform.text2.value) 
mess=messagebox("新密码不能为空！",48,"警告") 
else 
if empty(thisform.text3.value) 
mess=messagebox("重复密码不能为空！",48,"警告") 
else 
if alltrim(thisform.text2.value)<>alltrim(thisform.text3.value) or len(alltrim(thisform.text2.value))<>len(alltrim(thisform.text3.value)) 
mess=messagebox("二次密码不一致！",48,"警告") 
else 
locate for alltrim(用户名)==alltrim(thisform.text4.value) and alltrim(密码)==alltrim(thisform.text1.value) 
if eof() 
mess=messagebox("密码错误，系统将取消你的修改权利！",48,"警告") 
thisform.release 
else 
repl 密码 with alltrim(thisform.text3.value) 
mess=messagebox("密码修改成功！",48,"信息") 
thisform.release 
endif 
4：添加操作员表单的最首按钮的click事件源代码： 
go top 
thisform.grid1.setfocus 
thisform.grid1.refresh 
5：添加操作员表单的上一个按钮的click事件源代码： 
skip-1 
if bof() 
?? chr(7) 
=messagebox("警告，这已经是第一条记录！",48,"信息窗口") 
go top 
endif 
thisform.grid1.setfocus 
thisform.grid1.refresh 
6：添加操作员表单的下一个按钮的click事件源代码： 
skip 
if eof() 
?? chr(7) 
=messagebox("警告，这已经是最后一条记录！",48,"信息窗口") 
go bottom 
endif 
thisform.grid1.setfocus 
thisform.grid1.refresh 
7：添加操作员表单的最末按钮的click事件源代码： 
go bottom 
thisform.grid1.setfocus 
thisform.grid1.refresh 
8：添加操作员表单的修改按钮的click事件源代码： 
if thisform.command5.caption='修改' 
thisform.text1.readonly=.f. 
thisform.text2.readonly=.f. 
thisform.text3.readonly=.f. 
thisform.combo1.readonly=.f. 
thisform.command5.caption='保存' 
thisform.command1.enabled=.f. 
thisform.command2.enabled=.f. 
thisform.command3.enabled=.f. 
thisform.command4.enabled=.f. 
thisform.command6.enabled=.f. 
thisform.command7.enabled=.f. 
thisform.command8.enabled=.f. 
else 
thisform.command5.caption='修改' 
thisform.text1.readonly=.t. 
thisform.text2.readonly=.t. 
thisform.text3.readonly=.t. 
thisform.combo1.readonly=.t. 
thisform.command1.enabled=.t. 
thisform.command2.enabled=.t. 
thisform.command3.enabled=.t. 
thisform.command4.enabled=.t. 
thisform.command6.enabled=.t. 
thisform.command7.enabled=.t. 
thisform.command8.enabled=.t. 
endif 
thisform.grid1.setfocus 
thisform.grid1.refresh 
9：添加操作员表单的添加按钮的click事件源代码： 
if thisform.command6.caption='添加' 
thisform.text1.readonly=.f. 
thisform.text2.readonly=.f. 
thisform.text3.readonly=.f. 
thisform.combo1.readonly=.f. 
thisform.command6.caption='保存' 
thisform.command1.enabled=.f. 
thisform.command2.enabled=.f. 
thisform.command3.enabled=.f. 
thisform.command4.enabled=.f. 
thisform.command5.enabled=.f. 
thisform.command7.enabled=.f. 
thisform.command8.enabled=.f. 
appe blan 
else 
thisform.command6.caption='添加' 
thisform.text1.readonly=.t. 
thisform.text2.readonly=.t. 
thisform.text3.readonly=.t. 
thisform.combo1.readonly=.t. 
thisform.command1.enabled=.t. 
thisform.command2.enabled=.t. 
thisform.command3.enabled=.t. 
thisform.command4.enabled=.t. 
thisform.command5.enabled=.t. 
thisform.command7.enabled=.t. 
thisform.command8.enabled=.t. 
endif 
thisform.grid1.setfocus 
thisform.grid1.refresh 
10：添加操作员表单的删除按钮的click事件源代码： 
cMessageTitle='系统警告' 
cMessageText='确认要删除吗？' 
nDialogType=4+32 
nanswer=messagebox(cMessageText,nDialogType,cMessageTitle) 
if nanswer=6 
dele 
thisform.grid1.setfocus 
thisform.grid1.refresh 
endif 
11：类baseform的picrecord的源代码： 
IF TYPE("THIS.APP_MEDIATOR.BaseClass")#"C" 
RETURN 
ENDIF 

IF THIS.APP_MEDIATOR.PickRecordToWorkOn() 
IF THIS.APP_MEDIATOR.lAdding AND !EMPTY(ALIAS()) 
THIS.REFRESH() 
* Check if we have blank record already from txtbtns 
IF GETFLDSTATE(1) #3 
THIS.AddRecord() 
ENDIF 
ENDIF 
ENDIF 
12：类baseform的queryunload的源代码： 
IF TYPE("THIS.APP_MEDIATOR.BaseClass")#"C" 
IF !THIS.ResolveConflicts() 
NODEFAULT 
RETURN .F. 
ENDIF 
RETURN 
ENDIF 
IF DODEFAULT() 
IF NOT THIS.App_Mediator.QueryUnload() 
NODEFAULT 
RETURN .F. 
ENDIF 
ELSE 
NODEFAULT 
RETURN .F. 
ENDIF 
13：类baseform的release的源代码： 
IF !THIS.Queryunload() 
NODEFAULT 
RETURN .F. 
ENDIF 
14：类baseform的resolveconflicts的源代码： 
#DEFINE PROMPTTOSAVE_LOC "Data has been changed. Would you like to save changes?" 

IF !THIS.lSaveBufferedData 
RETURN 
ENDIF 

LOCAL nDECursors, aDECursors, cDataEnvRef, lPromptSave,lHadPrompt 
LOCAL lcAlias, lnFields, nPromptSave, i, loCurrentControl 

* Flush current control 
IF TYPE("THIS.ActiveControl.baseclass")="C" AND; 
PEMSTATUS(THIS.ActiveControl,"value",5) AND; 
PEMSTATUS(THIS.ActiveControl,"controlsource",5) AND; 
!EMPTY(THIS.ActiveControl.controlsource) 
loCurrentControl = THIS.ActiveControl 
* Check if data actually changed 
IF !EVAL(loCurrentControl.controlsource)= loCurrentControl.Value 
loCurrentControl.Value = loCurrentControl.Value 
ENDIF 
loCurrentControl="" 
ENDIF 

nDECursors = 0 
cDataEnvRef = "" 
DIMENSION aDECursors[1] 
DO CASE 
CASE TYPE("THISFORM.DataEnvironment") = "O" 
nDECursors = AMEMBERS(aDECursors,THISFORM.DataEnvironment,2) 
cDataEnvRef = "THISFORM.DataEnvironment" 
CASE TYPE("THISFORMSET.DataEnvironment") = "O" 
nDECursors = AMEMBERS(aDECursors,THISFORMSET.DataEnvironment,2) 
cDataEnvRef = "THISFORMSET.DataEnvironment" 
CASE THIS.lUpdateAllBufferedTables 
nDECursors=AUSED(aDECursors) 
OTHERWISE 
IF !EMPTY(ALIAS()) 
aDECursors[1]=ALIAS() 
nDECursors=1 
ENDIF 
ENDCASE 

FOR i = 1 TO m.nDECursors 
IF EMPTY(m.cDataEnvRef) 
lcAlias = aDECursors[m.i] 
ELSE 
WITH EVAL(m.cDataEnvRef + "." + aDECursors[m.i]) 
IF ATC("CURSOR",.BaseClass)=0 &&skip relations 
LOOP 
ENDIF 
lcAlias = .ALIAS 
ENDWITH 
ENDIF 

IF USED(lcAlias) AND CursorGetProp("sourcetype",lcAlias )=3 AND ; 
CursorGetProp("buffering",lcAlias )>1 

IF !m.lHadPrompt 
IF CursorGetProp("buffering",lcAlias )>3 
IF GETNEXTMODIFIED(0,lcAlias )=0 
LOOP 
ENDIF 
ELSE 
lnFields = GETFLDSTATE(-1,lcAlias) 
IF REPLICATE("1",LEN(lnFields))=TRANS(lnFields) 
LOOP 
ENDIF 
ENDIF 
nPromptSave = MESSAGEBOX(PROMPTTOSAVE_LOC,35) 
IF nPromptSave=2 
RETURN .F. 
ENDIF 
lPromptSave=(nPromptSave=6) 
lHadPrompt = .T. 
ENDIF 
IF m.lPromptSave 
TableUpdate(.T.,.T.,lcAlias) && update on exit 
ELSE 
TableRevert(.T.,lcAlias) && update on exit 
ENDIF 
ENDIF 
ENDFOR 
15：类baseform的show的源代码： 
LPARAMETERS nStyle 
LOCAL lcAppRef 

IF TYPE("THIS.APP_MEDIATOR.BaseClass")#"C" OR !THIS.lShowFirstTime 
RETURN 
ENDIF 

THIS.lShowFirstTime = .F. 
THIS.lSaveBufferedData = .F. 
THIS.PickRecord()