📄 bht8000.src.bak
字号:
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$)<Max% Then
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 "<M1返回 ENT确认>";
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"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -