⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 bht8000.src

📁 BHT8000数据采集器源码。本程序是串口通信。是一个最通用的程序。
💻 SRC
📖 第 1 页 / 共 3 页
字号:
🔍
123 
		.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
					ModiQTY%=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%<LOF(2) Then
							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删除";
				Locate 1,9,0:Print "↑/↓上/下一条";
				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
				If s$=Chr$(101) 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$)
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -