Common cur%
Common dis%
Common FdCounts%
Common AutoCount%
Common ShowCount%
Common ModiQTY%
Common UniqueCode%
Dim arySys$(4,3)
Dim stock$(4)[50]
On Error GoTo ERRCOMM 'HANDLE ERROR
'******************************************************
' MODIFY IN(OUT) STOCK
'******************************************************
Sub sbModify$(strType$,strBar$)
If strType$="in" Then
pathfile$="A:IN.DAT"
Else
pathfile$="A:OUT.DAT"
End If
Open pathfile$ As #3
Select fdCounts%
Case 1
Field #3, Val(arySys$(1,2)) As sf1$
Case 2
Field #3, Val(arySys$(1,2)) As sf1$,Val(arySys$(2,2)) As sf2$
Case 3
Field #3, Val(arySys$(1,2)) As sf1$,Val(arySys$(2,2)) As sf2$,Val(arySys$(3,2)) As sf3$
Case 4
Field #3, Val(arySys$(1,2)) As sf1$,Val(arySys$(2,2)) As sf2$,Val(arySys$(3,2)) As sf3$,Val(arySys$(4,2)) As sf4$
End Select
If strBar$="" Then
Fin%=LOF(3)
End If
Get #3,Fin%
stock$(1)=sf1$
stock$(2)=sf2$
stock$(3)=sf3$
stock$(4)=sf4$
Rows%=1
flag%=0
For i=1 To FdCounts%
If arySys$(i,1)="条码" Then
Locate 1,Rows%,0 :Print arySys$(i,1);":"
Rows%=Rows%+4
Else
Locate 1,Rows%,0 :Print arySys$(i,1);":";
Rows%=Rows%+2
End If
If Rows%>=7 Then
Print stock$(i);
Else
Print stock$(i)
End If
If arySys$(i,1)="数量" Then
For j=1 To Len(stock$(i))
Print Chr$(8);
Next
Input s$
old$=stock$(i)
stock$(i)=s$
End If
Next
Open "A:STOCK.DAT" As #2
Select fdCounts%
Case 1
Field #2, Val(arySys$(1,2)) As sft1$
sft1$=stock$(1)
sf1$=stock$(1)
Case 2
Field #2, Val(arySys$(1,2)) As sft1$,Val(arySys$(2,2)) As sft2$
sft1$=stock$(1)
sft2$=stock$(2)
sf1$=stock$(1)
sf2$=stock$(2)
Case 3
Field #2, Val(arySys$(1,2)) As sft1$,Val(arySys$(2,2)) As sft2$,Val(arySys$(3,2)) As sft3$
sft1$=stock$(1)
sft2$=stock$(2)
sft3$=stock$(3)
sf1$=stock$(1)
sf2$=stock$(2)
sf3$=stock$(3)
Case 4
Field #2, Val(arySys$(1,2)) As sft1$,Val(arySys$(2,2)) As sft2$,Val(arySys$(3,2)) As sft3$,Val(arySys$(4,2)) As sft4$
sft1$=stock$(1)
sft2$=stock$(2)
sft3$=stock$(3)
sft4$=stock$(4)
sf1$=stock$(1)
sf2$=stock$(2)
sf3$=stock$(3)
sf4$=stock$(4)
End Select
For i=1 to FdCounts%
If arySys$(i,1)="条码" Then
Select i
Case 1
Fstock%=Search(#2,sft1$,stock$(i))
Case 2
Fstock%=Search(#2,sft2$,stock$(i))
Case 3
Fstock%=Search(#2,sft3$,stock$(i))
Case 4
Fstock%=Search(#2,sft4$,stock$(i))
End Select
End If
Next
Get #2,Fstock%
For i=1 to FdCounts%
If arySys$(i,1)="数量" Then
If strType$="in" Then
Select i
Case 1
sft1$=Mid$(Str$(Val(sft1$)+Val(sf1$)-Val(old$)),2)
Case 2
sft2$=Mid$(Str$(Val(sft2$)+Val(sf2$)-Val(old$)),2)
Case 3
sft3$=Mid$(Str$(Val(sft3$)+Val(sf3$)-Val(old$)),2)
Case 4
sft4$=Mid$(Str$(Val(sft4$)+Val(sf4$)-Val(old$)),2)
End Select
Else
Select i
Case 1
If Val(sft1$)-Val(sf1$)+1=>0 Then
sft1$=Mid$(Str$(Val(sft1$)-Val(sf1$)+Val(old$)),2)
Else
flag%=-1
End If
Case 2
If Val(sft2$)-Val(sf2$)+1=>0 Then
sft2$=Mid$(Str$(Val(sft2$)-Val(sf2$)+Val(old$)),2)
Else
flag%=-1
End If
Case 3
If Val(sft3$)-Val(sf3$)+1=>0 Then
sft3$=Mid$(Str$(Val(sft3$)-Val(sf3$)+Val(old$)),2)
Else
flag%=-1
End If
Case 4
If Val(sft4$)-Val(sf4$)+1=>0 Then
sft4$=Mid$(Str$(Val(sft4$)-Val(sf4$)+Val(old$)),2)
Else
flag%=-1
End If
End Select
End If
End If
Next
If flag%=-1 Then
Print
Screen 1,1 :Print "出库大于库存量!";
wait 0,1
Else
Put #3,Fin%
Put #2,Fstock%
End If
Close #3
Close #2
Beep
End Sub
'*********************************************************
' GET STRING FROM KEY OR SCAN
'*********************************************************
Function fGetkey$(Max%,strType$)
s$=""
While 1
Key$=Input$(1)
Beep ,,,0
Select Key$
Case Chr$(27) 'ESC
fGetkey$=Chr$(27)
Exit Function
Case Chr$(13) 'ENTER
If s$<>"" Then
fGetkey$=s$
Exit Function
End If
Case Chr$(8) 'BACKSPACEE
If Len(s$) Then
Print Chr$(8);
s$=Left$(s$,Len(s$)-1)
End If
If Len(s$)=0 Then
fGetkey$=Chr$(28)
Exit Function
End If
Case Chr$(24) 'CANCEL
While Len(s$)
Print chr$(8); 'CHR$(24) WILL CLEAR ALL
s$=Left$(s$,Len(s$)-1)
Wend
fGetkey$=CHR$(28)
Exit Function
Case Chr$(65)
If cur%=0 Or cur%=1 Or cur%=5 Then
fGetkey$=Chr$(65)
Exit Function
End If
Case Chr$(68)
If strType$<>"" And ModiQTY%=1 Then
Call sbModify$(strType$,"")
fGetkey$=CHR$(68)
Exit Function
End If
Case Else 'OTHER
If Len(s$) Print Key$;
s$=s$+Key$
End If
End Select
Wend
End Function
Function fGetstring$(Max%,scan$,strType$)
sc$=scan$
While 1
If sc$="1" Then 'SCAN
Open "BAR:" as #16 CODE "A","M","N","I","K","L","H"
Wait 0, 3 'Wait SCAN PORT
If Loc(#16) Then
Beep
s$=Input$(Max%,16)
fGetstring$=s$
Print s$;
Close #16
Exit Function
Else
Close #16
sc$="0" 'SCAN FILE FAIL,READ KEY
End If
End If
If sc$="0" Then 'KEYBOARD
s$=fGetKey$(Max%,strType$)
If s$<>Chr$(28) Then
fGetstring$=s$
Exit Function
Else
sc$=scan$
End If
End If
Wend
End Function
'******************************************************
' INTERFACE
'******************************************************
'******** Main Menu ********
Sub sbMainMenu(lct%)
Cls
Select Case dis%
Case 0
Screen 1,1 :Locate 1,1,0 :Print " ∞ 主 菜 单 ∞ "
Screen 1,0
Locate 4,3,0 :Print "1:入库"
Locate 13,3,0 :Print "2:出库"
Locate 4,5,0 :Print "3:下载"
Locate 13,5,0 :Print "4:上传"
Locate 4,7,0 :Print "5:查询";
Locate 13,7,0 :Print "6:设置";
Screen 1,1
Select lct%
Case 0
Locate 4,3,0 :Print "1:入库"
Case 1
Locate 13,3,0 :Print "2:出库"
Case 2
Locate 4,5,0 :Print "3:下载"
Case 3
Locate 13,5,0 :Print "4:上传"
Case 4
Locate 4,7,0 :Print "5:查询";
Case 5
Locate 13,7,0 :Print "6:系统";
End Select
Case 1
Screen 1,1
Locate 1,1,0 :Print " ≌ 主 菜 单 ≌ "
Screen 1,0
Locate 7,3,0 :Print "1: 盘 点"
Locate 7,5,0 :Print "2: 查 询"
Locate 7,7,0 :Print "3: 上 传"
Locate 7,9,0 :Print "4: 设 置";
Screen 1,1
Select lct%
Case 0
Locate 7,3,0 :Print "1: 盘 点"
Case 1
Locate 7,5,0 :Print "2: 查 询"
Case 2
Locate 7,7,0 :Print "3: 上 传"
Case 3
Locate 7,9,0 :Print "4: 设 置";
End Select
End Select
cur%=lct%
Screen 1,0
End Sub
'******** Set Field ********
Function fGetFN$
k$=""
While 1
Screen 1,0
Locate 2,5,0 :Print "1.编号"
Locate 10,5,0 :Print "2.条码"
Locate 2,7,0 :Print "3.数量";
Locate 10,7,0 :Print "4.价格";
Select k$
Case Chr$(13)
Exit Function
Case Chr$(49)
fGetFN$="编号"
Exit Function
Case Chr$(50)
fGetFN$="条码"
Exit Function
Case Chr$(51)
fGetFN$="数量"
Exit Function
Case Chr$(52)
fGetFN$="价格"
Exit Function
End Select
k$=Input$(1)
Beep ,,,0
Wend
End Function
'******** Set Display ********
Function fGetDIS%
k$=""
While 1
Screen 1,0
Locate 5,3,0 :Print "1.库存管理"
Locate 5,5,0 :Print "2.盘点管理"
Select k$
Case Chr$(49)
fGetDIS%=0
Exit Function
Case Chr$(50)
fGetDIS%=1
Exit Function
End Select
k$=Input$(1)
Beep ,,,0
Wend
End Function
'******** File Menu ********
Function fShowFL$
k$=""
Cls
While 1
Screen 1,0
Locate 6,3,0 :Print "1. 库存记录"
Locate 6,5,0 :Print "2. 入库记录"
If dis%=0 Then
Locate 6,7,0 :Print "3. 出库记录";
End If
Select k$
Case Chr$(27)
fShowFL$=Chr$(27)
Exit Function
Case Chr$(49)
Beep ,,,0
fShowFL$="A:STOCK.DAT"
Exit Function
Case Chr$(50)
Beep ,,,0
fShowFL$="A:IN.DAT"
Exit Function
Case Chr$(51)
If dis%=0 Then
Beep ,,,0
fShowFL$="A:OUT.DAT"
Exit Function
End If
End Select
k$=Input$(1)
Wend
End Function
'******** Child Menu ********
Function fChildMenu$(m1$,m2$,m3$,m4$)
k$=""
sel%=0
Cls
While 1
Screen 1,0
If m1$<>"" Then
Locate 6,1,0 :Print "1. ";m1$
End If
If m2$<>"" Then
Locate 6,3,0 :Print "2. ";m2$
End If
If m3$<>"" Then
Locate 6,5,0 :Print "3. ";m3$
End If
If m4$<>"" Then
Locate 6,7,0 :Print "4. ";m4$;
End If
Locate 3,9,0:Print "";
Screen 1,1
Select k$
Case Chr$(13)
Beep ,,,0
fChildMenu$=Mid$(Str$(sel%),2)
Exit Function
Case Chr$(27)
If m1$<>"" Then
Beep ,,,0
fChildMenu$=Chr$(27)
Exit Function
End If
Case Chr$(49)
If m1$<>"" Then
Beep ,,,0
Locate 6,1,0 :Print "1. ";m1$
sel%=1
End If
Case Chr$(50)
If m2$<>"" Then
Beep ,,,0
Locate 6,3,0 :Print "2. ";m2$
sel%=2
End If
Case Chr$(51)
If m3$<>"" Then
Beep ,,,0
Locate 6,5,0 :Print "3. ";m3$
sel%=3
End If
Case Chr$(52)
If m4$<>"" Then
Beep ,,,0
Locate 6,7,0 :Print "4. ";m4$;
sel%=4
End If
End Select
k$=Input$(1)
Wend
End Function
'*********************************************************
' Initial File
'*********************************************************
Sub InitFile
Open "A:IN.DAT" AS #1 RECORD 32767
Open "A:OUT.DAT" AS #2 RECORD 32767
Open "A:STOCK.DAT" AS #9 RECORD 32767
Close #1
Close #2
Close #9
End Sub
'*********************************************************
' SETTING SYSTEM
'*********************************************************
Sub SetSystem
'Delete All Stock File
Open "A:STOCK.DAT" As #9
Close #9
Kill "A:STOCK.DAT"
Open "A:IN.DAT" As #9
Close #9
Kill "A:IN.DAT"
Open "A:OUT.DAT" As #9
Close #9
Kill "A:OUT.DAT"
Open "A:SYSTEM.INI" As #8
Clfile #8 'Clear All File Record
Field #8, 4 As .sfFdName$, 2 As .sfFdValue$, 1 As .sfScan$
Cls
Screen 1,1 :Locate 1,1,0 :Print "菜单显示:"
Screen 1,0
.sfFdName$=".DIS"
.sfFdValue$=Mid$(Str$(fGetDIS%),2)
Put #8
Beep
.sfFdValue$=""
Cls
Screen 1,1 :Locate 1,1,0 :Print "字段数(1-4):"
Screen 1,0
.sfFdName$=".fds"
IsNum=0
While IsNum<>1
If Val(.sfFdValue$)>4 Or Val(.sfFdValue$)<1 Then
Locate 1,3,0 :Print Chr$(8);
.sfFdValue$=fGetstring$(1,"0","")
Else
IsNum=1
End If
Wend
Put #8
Beep
FdCount%=Val(.sfFdValue$)
For i=1 To FdCount%
Cls
Screen 1,1 :Locate 1,1,0 :Print "字段名(选择):"
Locate 15,1,0 :Print Mid$(Str$(i),2)
Screen 1,0
.sfFdName$=fGetFN$
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Cls
Screen 1,1 :Locate 1,1,0 :Print "字段名:"
Locate 14,1,0 :Print Mid$(Str$(i),2)
Screen 1,0 :Locate 1,3,0 :Print .sfFdName$
Screen 1,1 :Locate 1,5,0 :Print "字段长度:"
Screen 1,0
.sfFdValue$=fGetstring$(2,"0","")
Cls
Screen 1,1 :Locate 1,1,0 :Print "字段:";
Screen 1,0 :Print "名:";.sfFdName$;",";"长度:";.sfFdValue$
Screen 1,1 :Print "是否可扫描?(1/0)"
Screen 1,0
.sfScan$=fGetstring$(1,"0","")
Put #8
Beep
Next
Cls
Screen 1,1 :Locate 4,1,0 :Print "设置成功!"
Screen 1,0 :Locate 1,7,0 :Print "按任意键重新载入";
wait 0,1
k$=Input$(1)
Close #8
Call InitFile
chain "BHT8000.pd3"
End Sub
'*********************************************************
' INITIAL
'*********************************************************
Sub GetSystem
Screen 1,0
Open "A:SYSTEM.INI" As #8
LenFile%=LOF(8)
If LenFile%=0 Then
Locate 2,1,0 :Print "欢迎使用本系统"
Locate 1,5,0 :Print "系统尚未设置,按任意键开始设置";
Close #8
Wait 0,1
Call SetSystem
Else
Field #8, 4 As .sfFdName$, 2 As .sfFdValue$, 1 As .sfScan$
Found%=Search(#8,.sfFdName$,".fds")
If Found%=0 Then
Beep
Cls
Print "系统设置有误!!!请重新设置."
Wait 0,1
Call SetSystem
Close #8
Wait 0,1
Call SetSystem
Else
Get #8,Found%
FdCounts%=Val(.sfFdValue$)
For i=1 To FdCounts%
Get #8,i+2
arySys$(i,1)=.sfFdName$
arySys$(i,2)=.sfFdValue$
arySys$(i,3)=.sfScan$
Next
Found%=Search(#8,.sfFdName$,".DIS",1)
If Found%>0 Then
Get #8,Found%
dis%=Val(.sfFdValue$)
Else
dis%=0
End If
Found%=Search(#8,.sfFdName$,".ATC",1)
If Found%>0 Then
Get #8,Found%
If .sfFdValue$="1" Then
AutoCount%=1
Else
AutoCount%=0
End If
Else
AutoCount%=0
End If
Found%=Search(#8,.sfFdName$,".MDQ",1)
If Found%>0 Then
Get #8,Found%
If .sfFdValue$="1" Then
ModiQTY%=1
Else
ModiQTY%=0
End If
Else
ModiQTY%=0
End If
Found%=Search(#8,.sfFdName$,".UNI",1)
If Found%>0 Then
Get #8,Found%
If .sfFdValue$="1" Then
UniqueCode%=1
Else
UniqueCode%=0
End If
Else
UniqueCode%=0
End If
End If
End If
Close #8
End Sub
'******************************************************
' BROWER
'******************************************************
Sub sbBrower(PathFile$)
On error goto ERRCOMM
If PathFile$="" Then
sm$=fChildMenu$("序号查询","条码查询","","")
If sm$=Chr$(27) Then
Exit Sub
End If
Open "A:STOCK.DAT" As #2
Select fdCounts%
Case 1
Field #2, Val(arySys$(1,2)) As sf1$
Case 2
Field #2, Val(arySys$(1,2)) As sf1$,Val(arySys$(2,2)) As sf2$
Case 3
Field #2, Val(arySys$(1,2)) As sf1$,Val(arySys$(2,2)) As sf2$,Val(arySys$(3,2)) As sf3$
Case 4
Field #2, Val(arySys$(1,2)) As sf1$,Val(arySys$(2,2)) As sf2$,Val(arySys$(3,2)) As sf3$,Val(arySys$(4,2)) As sf4$
End Select
s$=""
Screen 1,0
While s$<>Chr$(27)
Cls
If sm$="1" Then
Locate :Print "序号:";
s$=fGetstring$(5,"0","")
If s$=Chr$(27) Then
Close #2
Exit Sub
End If
If Val(s$)>LOF(2) Or Val(s$)<0 Then
Found%=0
bFound$="False"
Else
Found%=Val(s$)
bFound$="True"
End If
Else
'********** Get Search Key **********
For i=1 to FdCounts%
If arySys$(i,1)="编号" Then
Locate :Print "编号:";
s$=fGetstring$(Val(arySys$(i,2)),arySys$(i,3),"")
If s$=Chr$(27) Then
Close #2
Exit Sub
End If
For j=Len(s$) To Val(arySys$(i,2))-1
s$=s$+" "
Next
wID$=s$
Print ""
End If
Next
For i=1 to FdCounts%
If arySys$(i,1)="条码" Then
Locate :Print "条码:";
s$=fGetstring$(Val(arySys$(i,2)),arySys$(i,3),"")
If s$=Chr$(27) Then
Close #2
Exit Sub
End If
For j=Len(s$) To Val(arySys$(i,2))-1
s$=s$+" "
Next
'********** Search **********
bar$=s$
Found%=1
bFound$="False"
While Found%>0 And bFound$="False"
For j=1 to FdCounts%
If arySys$(j,1)="条码" Then
Select j
Case 1
Found%=Search(#2,sf1$,bar$,Found%)
Case 2
Found%=Search(#2,sf2$,bar$,Found%)
Case 3
Found%=Search(#2,sf3$,bar$,Found%)
Case 4
Found%=Search(#2,sf4$,bar$,Found%)
End Select
If Found%>0 Then
wTmp$=""
For k=1 to FdCounts%
If arySys$(k,1)="编号" Then
Get #2,Found%
Select k
Case 1
wTmp$=sf1$
Case 2
wTmp$=sf2$
Case 3
wTmp$=sf3$
Case 4
wTmp$=sf4$
End Select
End If
Next
If wID$=wTmp$ Then
bFound$="True"
Else
bFound$="False"
Found%=Found%+1
End If
Else
bFound$="False"
End If Else
End If
Next
Wend
End If
Next
End If
If bFound$="True" Then
Get #2,Found%
Cls
Rows%=1
For i=1 To FdCounts%
If arySys$(i,1)="条码" Then
Locate 1,Rows%,0 :Print arySys$(i,1);":"
Rows%=Rows%+4
Else
Locate 1,Rows%,0 :Print arySys$(i,1);":";
Rows%=Rows%+2
End If
Select i
Case 1
Print sf1$;
Case 2
Print sf2$;
Case 3
Print sf3$;
Case 4
Print sf4$;
End Select
Next
Else
Cls
Locate 1,3 : Print "没找到相应记录!";
End If
Beep
Wait 0,3
s$=Input$(1)
'If s$=Chr$(66) Then
' sf1$=""
' sf2$=""
' sf3$=""
' sf4$=""
' Put #2,Found%
'End If
Wend
Close #2
Else
Open PathFile$ As #2
Select fdCounts%
Case 1
Field #2, Val(arySys$(1,2)) As sf1$
Case 2
Field #2, Val(arySys$(1,2)) As sf1$,Val(arySys$(2,2)) As sf2$
Case 3
Field #2, Val(arySys$(1,2)) As sf1$,Val(arySys$(2,2)) As sf2$,Val(arySys$(3,2)) As sf3$
Case 4
Field #2, Val(arySys$(1,2)) As sf1$,Val(arySys$(2,2)) As sf2$,Val(arySys$(3,2)) As sf3$,Val(arySys$(4,2)) As sf4$
End Select
s$=""
Screen 1,0
Found%=LOF(2)
While s$<>Chr$(27)
Cls
Select s$
Case Chr$(27)
Close #2
Exit Sub
Case Chr$(28)
If Found%>1 Then
Found%=Found%-1
Else
Found%=LOF(2)
End If
Case Chr$(29)
If Found% Found%=Found%+1
Else
Found%=1
End If
Case Chr$(30)
Found%=1
Case Chr$(31)
Found%=LOF(2)
End Select
Get #2,Found%
Cls
Rows%=1
Screen 1,1
Locate 17,1,0 :Print RIGHT$("00000"+MID$(STR$(Found%),2),5)
Screen 1,0
Locate 1,9,0:Print "↑/↓上/下一条 F2删除";
For i=1 To FdCounts%
If arySys$(i,1)="条码" Then
Locate 1,Rows%,0 :Print arySys$(i,1);":"
Rows%=Rows%+4
Else
Locate 1,Rows%,0 :Print arySys$(i,1);":";
Rows%=Rows%+2
End If
Select i
Case 1
Print sf1$;
Case 2
Print sf2$;
Case 3
Print sf3$;
Case 4
Print sf4$;
End Select
Next
Beep
Wait 0,3
s$=Input$(1)
If s$=Chr$(66) Then
Locate 1,9,0:Print "正在删除...,请稍候! ";
Open "A:TEMP.DAT" As #16 Record 32767
If LOF(16)>0 Then
CLFile #16
End If
Select fdCounts%
Case 1
Field #16, Val(arySys$(1,2)) As Temp1$
Case 2
Field #16, Val(arySys$(1,2)) As Temp1$,Val(arySys$(2,2)) As Temp2$
Case 3
Field #16, Val(arySys$(1,2)) As Temp1$,Val(arySys$(2,2)) As Temp2$,Val(arySys$(3,2)) As Temp3$
Case 4
Field #16, Val(arySys$(1,2)) As Temp1$,Val(arySys$(2,2)) As Temp2$,Val(arySys$(3,2)) As Temp3$,Val(arySys$(4,2)) As Temp4$
End Select
For i=1 To lof(2)
If i<>Found% Then
Get #2,i
Locate 1,9,0:Print Mid$(str$(i),2);
Temp1$=sf1$
Temp2$=sf2$
Temp3$=sf3$
Temp4$=sf4$
Put #16
End If
Next
CLFile #2
For i=1 To Lof(16)
Get #16,i
Locate 1,9,0:Print Mid$(str$(i),2);
sf1$=Temp1$
sf2$=Temp2$
sf3$=Temp3$
sf4$=Temp4$
Put #2,i
Next
Close #16
Kill "A:TEMP.DAT"
If Lof(2)=0 Then
Close
Exit Sub
End If
If Found%>Lof(2) Then
Found%=Found%-1
End If
Beep:Locate 1,9,0:Print "已删除,按任意键返回! ";
wait 0,1:s$=Input$(1)
End If
Wend
Close #2
End If
End Sub
'******************************************************
' IN(OUT) STOCK
'******************************************************
Sub sbStock(strType$)
On error goto ERRCOMM
If strType$="in" Then
pathfile$="A:IN.DAT"
Else
pathfile$="A:OUT.DAT"
End If
no$=""
wId$=""
bCode$=""
While 1
Cls
' ShowBottom(wId$,bCode$)
Open pathfile$ As #1
LenFile%=LOF(1)
Close #1
Screen 1,1 :Locate 17,1,0 :Print RIGHT$("00000"+MID$(STR$(LenFile%),2),5)
Screen 1,0
Locate 1,9,0:Print "M1返回上级 F1查询记录";
flag%=0
Rows%=1
For i=1 To FdCounts%
'********** Show Input value **********'
If arySys$(i,1)="条码" Then
Locate 1,Rows%,0 :Print arySys$(i,1);":"
Rows%=Rows%+4
Else
Locate 1,Rows%,0 :Print arySys$(i,1);":";
Rows%=Rows%+2
End If
'********** Get Input value **********'
If arySys$(i,1)="编号" Then
If no$="" Then
s$=fGetstring$(Val(arySys$(i,2)),arySys$(i,3),strType$)
no$=s$
Else
s$=no$
Print s$
End If
Else
If arySys$(i,1)="数量" And AutoCount%=1 Then
s$="1"
If Rows%>=7 Then
Print s$;
Else
Print s$
End If
Else
s$=fGetstring$(Val(arySys$(i,2)),arySys$(i,3),strType$)
End IF
End If
Select s$
Case Chr$(27)
Exit Sub
Case Chr$(65)
Call sbBrower(pathfile$)
Call sbStock(strType$)
Exit Sub
Case Chr$(68)
Call sbStock(strType$)
Exit Sub
Case Else
If arySys$(i,3)="1" Then
For j=Len(s$) To Val(arySys$(i,2))-1
s$=S$+" "
Next
End If
stock$(i)=s$
End Select
Next
'********** If Trigger be press **********'
While (INP(0) AND &h04)<>0
Wend
'********** Write Into records **********'
Open pathfile$ As #1
Open "A:STOCK.DAT" As #2
Select fdCounts%
Case 1
Field #1, Val(arySys$(1,2)) As sf1$
sf1$=stock$(1)
Field #2, Val(arySys$(1,2)) As sft1$
sft1$=stock$(1)
Case 2
Field #1, Val(arySys$(1,2)) As sf1$,Val(arySys$(2,2)) As sf2$
sf1$=stock$(1)
sf2$=stock$(2)
Field #2, Val(arySys$(1,2)) As sft1$,Val(arySys$(2,2)) As sft2$
sft1$=stock$(1)
sft2$=stock$(2)
Case 3
Field #1, Val(arySys$(1,2)) As sf1$,Val(arySys$(2,2)) As sf2$,Val(arySys$(3,2)) As sf3$
sf1$=stock$(1)
sf2$=stock$(2)
sf3$=stock$(3)
Field #2, Val(arySys$(1,2)) As sft1$,Val(arySys$(2,2)) As sft2$,Val(arySys$(3,2)) As sft3$
sft1$=stock$(1)
sft2$=stock$(2)
sft3$=stock$(3)
Case 4
Field #1, Val(arySys$(1,2)) As sf1$,Val(arySys$(2,2)) As sf2$,Val(arySys$(3,2)) As sf3$,Val(arySys$(4,2)) As sf4$
sf1$=stock$(1)
sf2$=stock$(2)
sf3$=stock$(3)
sf4$=stock$(4)
Field #2, Val(arySys$(1,2)) As sft1$,Val(arySys$(2,2)) As sft2$,Val(arySys$(3,2)) As sft3$,Val(arySys$(4,2)) As sft4$
sft1$=stock$(1)
sft2$=stock$(2)
sft3$=stock$(3)
sft4$=stock$(4)
End Select
For i=1 to FdCounts%
Select Case arySys$(i,1)
Case "条码"
bCode$=stock$(i)
Case "编号"
wId$=stock$(i)
End Select
Next
bFound$="False"
Found%=1
While bFound$="False" And Found%>0
For i=1 to FdCounts%
If arySys$(i,1)="条码" Then
Select i
Case 1
Found%=Search(#2,sft1$,stock$(i),Found%)
Case 2
Found%=Search(#2,sft2$,stock$(i),Found%)
Case 3
Found%=Search(#2,sft3$,stock$(i),Found%)
Case 4
Found%=Search(#2,sft4$,stock$(i),Found%)
End Select
End If
Next
If Found%>0 Then
Get #2,Found%
For i=1 to FdCounts%
If arySys$(i,1)="编号" Then
Select i
Case 1
wTemp$=sft1$
Case 2
wTemp$=sft2$
Case 3
wTemp$=sft3$
Case 4
wTemp$=sft4$
End Select
End If
Next
If wId$<>wTemp$ Then
bFound$="False"
Found%=Found%+1
Else
bFound$="True"
End If
End If
Wend
If bFound$="False" Then
For i=1 to FdCounts%
If arySys$(i,1)="编号" Then
Select i
Case 1
sft1$=wId$
Case 2
sft2$=wId$
Case 3
sft3$=wId$
Case 4
sft4$=wId$
End Select
End If
Next
End If
If UniqueCode%= 1 Then
If bFound$="False" Then
Put #1
Put #2
Else
Print ""
Screen 1,1 :Print "该条码已存在!"
Wait 0,1
End If
Else
If bFound$="False" Then
'sft3$="1"
If strType$="out" Then
Print
Screen 1,1 :Print "库存中无该记录!";
Wait 0,1
Else
Put #1
Put #2
End If
Else
Get #2,Found%
For i=1 to FdCounts%
If arySys$(i,1)="数量" Then
If strType$="in" Then
Select i
Case 1
sft1$=Mid$(Str$(Val(sft1$)+Val(sf1$)),2)
Case 2
sft2$=Mid$(Str$(Val(sft2$)+Val(sf2$)),2)
Case 3
sft3$=Mid$(Str$(Val(sft3$)+Val(sf3$)),2)
Case 4
sft4$=Mid$(Str$(Val(sft4$)+Val(sf4$)),2)
End Select
Else
Select i
Case 1
If Val(sft1$)-Val(sf1$)=>0 Then
sft1$=Mid$(Str$(Val(sft1$)-Val(sf1$)),2)
Else
flag%=-1
End If
Case 2
If Val(sft2$)-Val(sf2$)=>0 Then
sft2$=Mid$(Str$(Val(sft2$)-Val(sf2$)),2)
Else
flag%=-1
End If
Case 3
If Val(sft3$)-Val(sf3$)=>0 Then
sft3$=Mid$(Str$(Val(sft3$)-Val(sf3$)),2)
Else
flag%=-1
End If
Case 4
If Val(sft4$)-Val(sf4$)=>0 Then
sft4$=Mid$(Str$(Val(sft4$)-Val(sf4$)),2)
Else
flag%=-1
End If
End Select
End If
End If
Next
If flag%=-1 Then
Print
Screen 1,1 :Print "出库大于库存量!";
wait 0,1
Else
Put #1
Put #2,Found%
End If
End If
End If
Close #1
Close #2
Beep
Wend
End Sub
'*********************************************************
' FILE OPERATION
'*********************************************************
Sub sbDofile(msg$)
PathFile$=fShowFL$
If PathFile$=Chr$(27) Then
Exit Sub
End If
Cls
On Error GoTo FileErr
Select msg$
Case "清除"
Open PathFile$ As #16
CLFile #16 'Clear File Record
Close #16
Case "上传"
Open PathFile$ As #16
L%=LOF(16)
Close #16
If L%=0 Then
BEEP:Cls:Locate 3,4,0:Print "文件无记录！"
Locate 3,7,0:Print "按任意键返回"
wait 0,1:buf$=Input$(1):Exit sub
End If
LOCATE 5,3 :Print "上传中....."
LOCATE 5,5 :PRINT "00000/";RIGHT$("00000"+MID$(STR$(L%),2),5)
LOCATE 5,5
Open "Com:19200,N,8,1" As #16
XFILE PathFile$,"SPM"
Close #16
Case "下载"
LOCATE 5,3 :Print "下载中....."
Locate 5,5
Open "Com:19200,N,8,1" As #16
XFILE PathFile$ ,"SRM"
Close #16
End Select
Beep
Cls
Screen 1,1 :Locate 4,3 :Print msg$;"成功!"
Screen 1,0 :Locate 2,7 :Print " 按任意键返回 ";
Wait 0,&h01
Beep
s$=Input$(1)
Exit Sub
FileErr:
Cls
If Hex$(Err)="47" Then
Locate 6,4,0 :Print "用户取消!"
Locate 3,7,0 :Print "按任意键返回";
Beep 1
Wait 0,3
Buf$=Input$(1)
Close #16
Chain "BHT8000.PD3"
Exit Sub
Else
Beep 8
'Print "通讯传输失败!"
'Print
'Print "按任意键重新载入";
'Wait 0,3
'Buf$=Input$(1)
Chain "BHT8000.pd3"
End
End If
End Sub
'*********************************************************
' Begin Program
'*********************************************************
Function fDataMd(msg$,beSel%)
Cls
Screen 1,0
Locate 7,3,0 :Print msg$
Locate 4,7,0 :Print "ENT确认/F4选择";
k$=""
While K$<>Chr$(13)
If beSel%=1 Then
Locate 16,3,0 :Print "*"
Else
Locate 16,3,0 :Print " "
End If
K$=Input$(1)
If k$=Chr$(68) Then
If beSel%=1 Then
beSel%=0
Else
beSel%=1
End If
End If
Wend
Open "A:SYSTEM.INI" As #8
Field #8, 4 As .sfFdName$, 2 As .sfFdValue$, 1 As .sfScan$
Select msg$
Case "数量自增"
strName$=".ATC"
Case "条码唯一"
strName$=".UNI"
Case "自增可改"
strName$=".MDQ"
End Select
Found%=Search(#8,.sfFdName$,strName$,1)
.sfFdValue$=Mid$(str$(beSel%),2)
.sfFdName$=strName$
If Found%>0 Then
Put #8,Found%
Else
Put #8
End If
Close #8
fDataMd=beSel%
End Function
'*********************************************************
' Begin Program
'*********************************************************
Sub sbSystem
While 1
op$=fChildMenu$("重设系统","数据管理","","")
If op$=Chr$(27) Then
Exit Sub
End If
Cls
Select op$
Case "1"
Screen 1,1 :Locate 1,1,0 :Print "注意:"
Screen 1,0 :Locate 1,3,0 :Print "初始化系统将删除所有数据!"
Locate 1,7,0 :Print "是否开始?是/";
Screen 1,1 :Locate 13,7,0 :print "否";
k$=""
select%=0
While k$<>Chr$(27)
k$=Input$(1)
Beep ,,,0
Select k$
Case Chr$(13)
If select%=1 Then
Call SetSystem
Else
k$=Chr$(27)
End If
Case Chr$(30)
Screen 1,1
Locate 10,7,0 :Print "是";
Screen 1,0
Locate 12,7,0 :Print "/否";
select%=1
Case Chr$(31)
Screen 1,0
Locate 10,7,0 :Print "是/";
Screen 1,1
Locate 13,7,0 :Print "否";
select%=0
End Select
Wend
Case "2"
While op$<>Chr$(27)
op$=fChildMenu$("清除数据","输入方式","","")
Select op$
Case "1"
sbDofile("清除")
Case "2"
AutoCount%=fDataMd("数量自增",AutoCount%)
ModiQTY%=fDataMd("自增可改",ModiQTY%)
UniqueCode%=fDataMd("条码唯一",UniqueCode%)
' Case "333"
' While op$<>Chr$(27)
' op$=fChildMenu$("删除记录","条码修改","","")
' Select op$
' Case "1"
' Key$=""
' While Key$=Chr$(27)
'
' Case "2"
' End Select
' Wend
' op$=""
End Select
Wend
'Case "3"
' Cls:Screen 1,0
' Locate 8,1,0 :Print "深圳大鸥"
' Locate 4,3,0 :Print "条码技术有限公司"
' Locate 4,5,0 :Print "Tel:755-29822832"
' Locate 4,7,0 :Print "Fax:755-29822303";
' Locate 1,9,0 :Print "chinatharo.com";
' wait 0,1:buf$=Input$(1)
End Select
Wend
End Sub
'*********************************************************
' Begin Program
'*********************************************************
BEEP
KEY 5,CHR$(28)
Key 6,Chr$(29)
Key 7,Chr$(30)
Key 8,Chr$(31)
KEY 30,CHR$(27) 'M1 :ESC键退出键
MAIN:
Cls
Out &H6080,1 '0:standard-size; 1:the small-size
Call GetSystem
Call sbMainMenu(0)
While 1
k$=Input$(1)
Beep ,,,0
Select Case dis%
Case 0
Select k$
Case Chr$(13)
Select Cur%
Case 0
Call sbStock("in")
Case 1
Call sbStock("out")
Case 2
Call sbDofile("下载")
Case 3
Call sbDofile("上传")
Case 4
Call sbBrower("")
Case 5
Call sbSystem
End Select
sbMainMenu(cur%)
Case Chr$(28)
sbMainMenu((cur%-2+6) MOD 6)
Case Chr$(29)
sbMainMenu((cur%+2+6) MOD 6)
Case Chr$(30)
sbMainMenu((cur%-1+6) MOD 6)
Case Chr$(31)
sbMainMenu((cur%+1+6) MOD 6)
Case Chr$(49)
sbMainMenu(0)
Case Chr$(50)
sbMainMenu(1)
Case Chr$(51)
sbMainMenu(2)
Case Chr$(52)
sbMainMenu(3)
Case Chr$(53)
sbMainMenu(4)
Case Chr$(54)
sbMainMenu(5)
End Select
Case 1
Select k$
Case Chr$(13)
Select Cur%
Case 0
Call sbStock("in")
Case 1
Call sbBrower("")
Case 2
Call sbDofile("上传")
Case 3
Call sbSystem
End Select
sbMainMenu(cur%)
Case Chr$(28)
sbMainMenu((cur%-1+4) MOD 4)
Case Chr$(29)
sbMainMenu((cur%+1+4) MOD 4)
Case Chr$(49)
sbMainMenu(0)
Case Chr$(50)
sbMainMenu(1)
Case Chr$(51)
sbMainMenu(2)
Case Chr$(52)
sbMainMenu(3)
End Select
End Select
Wend
ERRCOMM:
Cls
Beep 8
'Print "操作错误:"
'Print
'Print "按任意键重新载入";
'Wait 0,1
'k$=Input$(1)
Chain "BHT8000.pd3"
End
