本文介绍了关于指定寄存器的VB6编程的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!
问题描述
您好,我遇到了vb6编程问题。我通过rs232将我的笔记本电脑连接到外部设备发送数据,代码已经用C编程编写,我应该存储变量的值,直到现在他们通过键盘在机器中手动编辑值,但现在我应该存储通过VB6编程的值,并通过rs232发送值。我怎么能这样做。在C中他们使用了C8051F120寄存器
我尝试过:
Hello,I'm having problem with vb6 programming. I am connecting my laptop to external device through rs232 to send data and the code is already written in C programming and I should store the values for the variables as till now they are editting the values manually in the machine through keyboard but now i should store the values through VB6 programming and send the values through rs232.How can i do that. In C they have used C8051F120 registers
What I have tried:
Option Explicit
Dim con As New adodb.Connection
Dim rs As New adodb.Recordset
Dim str As String
Dim bytes() As Byte
Dim i, fil1 As Integer
Dim x As Long
Dim strng, hexcod, methd, fil2, slpe, prntr, usrloc, str1 As String
Dim temp, unit, stndrd, reagvol, smplevol, aspvol, conc, factr, read, delta, delay, linear, minval, maxval As Double
Private Sub glucose_Click()
Label26.Caption = "" & glucose.Caption
End Sub
Private Sub chol_Click()
Label26.Caption = "" & chol.Caption
End Sub
Private Sub bun_Click()
Label26.Caption = "" & bun.Caption
End Sub
Private Sub crtn_Click()
Label26.Caption = "" & crtn.Caption
End Sub
Private Sub urea_Click()
Label26.Caption = "" & urea.Caption
End Sub
Private Sub trig_Click()
Label26.Caption = "" & trig.Caption
End Sub
Private Sub sgot_Click()
Label26.Caption = "" & sgot.Caption
End Sub
Private Sub sgpt_Click()
Label26.Caption = "" & sgpt.Caption
End Sub
Private Sub hdl_Click()
Label26.Caption = "" & hdl.Caption
End Sub
Private Sub ldl_Click()
Label26.Caption = "" & ldl.Caption
End Sub
Private Sub ck_Click()
Label26.Caption = "" & ck.Caption
End Sub
Private Sub ckmb_Click()
Label26.Caption = "" & ckmb.Caption
End Sub
Private Sub d_bil_Click()
Label26.Caption = "" & d_bil.Caption
End Sub
Private Sub t_bil_Click()
Label26.Caption = "" & t_bil.Caption
End Sub
Private Sub ldh_Click()
Label26.Caption = "" & ldh.Caption
End Sub
Private Sub aklp_Click()
Label26.Caption = "" & aklp.Caption
End Sub
Private Sub alb_Click()
Label26.Caption = "" & alb.Caption
End Sub
Private Sub tpr_Click()
Label26.Caption = "" & tpr.Caption
End Sub
Private Sub a_amy_Click()
Label26.Caption = "" & a_amy.Caption
End Sub
Private Sub g_gt_Click()
Label26.Caption = "" & g_gt.Caption
End Sub
Private Sub ca_Click()
Label26.Caption = "" & ca.Caption
End Sub
Private Sub phos_Click()
Label26.Caption = "" & phos.Caption
End Sub
Private Sub fe_Click()
Label26.Caption = "" & fe.Caption
End Sub
Private Sub cl_Click()
Label26.Caption = "" & cl.Caption
End Sub
Private Sub uric_Click()
Label26.Caption = "" & uric.Caption
End Sub
Private Sub ghb_Click()
Label26.Caption = "" & ghb.Caption
End Sub
Private Sub na_Click()
Label26.Caption = "" & na.Caption
End Sub
Private Sub k_Click()
Label26.Caption = "" & k.Caption
End Sub
Sub display()
Dim a As Long
Dim meth, filt1, filt2, tem, prnt, loc, slp, unt, stnd, regvol, fctr, readtme, dly, dlta, lin, normin, normax, asp, smple, concen As String
'If Label26.Caption = rs!nameoftest Then
Combo1.Text = rs!method
methd = Combo1.Text
For a = 1 To Len(methd) Step 2
meth = meth & Chr(Val("&H" & Mid$(methd, a, 2)))
Next
Combo1.Text = meth
Combo2.Text = rs!filter1
fil1 = Combo2.Text
filt1 = CInt("&H" & fil1)
Combo2.Text = filt1
Combo3.Text = rs!filter2
fil2 = Combo3.Text
For a = 1 To Len(fil2) Step 2
filt2 = filt2 & Chr(Val("&H" & Mid$(fil2, a, 2)))
Next
Combo3.Text = filt2
Combo4.Text = rs!temperature
temp = Combo4.Text
tem = CInt("&H" & temp)
Combo4.Text = tem
Text5.Text = rs!units
unit = Text5.Text
unt = CInt("&H" & unit)
Text5.Text = unt
Text6.Text = rs!nostandards
stndrd = Text6.Text
stnd = CInt("&H" & stndrd)
Text6.Text = stnd
Text7.Text = rs!reagentvolume
reagvol = Text7.Text
regvol = CInt("&H" & reagvol)
Text7.Text = regvol
Text8.Text = rs!samplevolume
smplevol = Text8.Text
smple = CInt("&H" & smplevol)
Text8.Text = smple
Text9.Text = rs!aspirationvolume
aspvol = Text9.Text
asp = CInt("&H" & aspvol)
Text9.Text = asp
Text10.Text = rs!concentration
conc = Text10.Text
concen = CInt("&H" & conc)
Text10.Text = concen
Text11.Text = rs!factor
factr = Text11.Text
fctr = CInt("&H" & factr)
Text11.Text = fctr
Text12.Text = rs!readtime
read = Text12.Text
readtme = CInt("&H" & read)
Text12.Text = readtme
Text13.Text = rs!deltatime
delta = Text13.Text
dlta = CInt("&H" & delta)
Text13.Text = dlta
Text14.Text = rs!delaytime
delay = Text14.Text
dly = CInt("&H" & delay)
Text14.Text = dly
Text15.Text = rs!linearity
linear = Text15.Text
lin = CInt("&H" & linear)
Text15.Text = lin
Text16.Text = rs!normalminvalue
minval = Text16.Text
normin = CInt("&H" & minval)
Text16.Text = normin
Text17.Text = rs!normalmaxvalue
maxval = Text17.Text
normax = CInt("&H" & maxval)
Text17.Text = normax
Text18.Text = rs!printeronoff
prntr = Text18.Text
For a = 1 To Len(prntr) Step 2
prnt = prnt & Chr(Val("&H" & Mid$(prntr, a, 2)))
Next
Text18.Text = prnt
Text19.Text = rs!UserLocation
usrloc = Text19.Text
For a = 1 To Len(usrloc) Step 2
loc = loc & Chr(Val("&H" & Mid$(usrloc, a, 2)))
Next
Text19.Text = loc
Combo5.Text = rs!slope
slpe = Combo5.Text
For a = 1 To Len(slpe) Step 2
slp = slp & Chr(Val("&H" & Mid$(slpe, a, 2)))
Next
Combo5.Text = slp
'End If
End Sub
Private Sub Form_Load()
con.Open "PROVIDER= Microsoft.Jet.OLEDB.4.0;data source=C:\Users\Raghava\Desktop\Database\artoss.mdb;"
rs.Open "Select * from Table1", con, adOpenDynamic, adLockPessimistic
clear
End Sub
Private Sub save_data_Click()
rs.AddNew
' //////name of test///////
str = Label26.Caption
bytes = StrConv(str, vbFromUnicode)
str = ""
For i = LBound(bytes) To UBound(bytes)
str = str & Format$(Hex$(bytes(i)), "00")
'Print #1, "DOM" & <fs> & TempList.Fields("TLGRef").Value & <fs> & <lf>
Next i
Label26.Caption = str
str = StrConv(bytes, vbUnicode)
rs.Fields("NameofTest").Value = Label26.Caption
' ////method////////
methd = Combo1.Text
bytes = StrConv(methd, vbFromUnicode)
methd = ""
For i = LBound(bytes) To UBound(bytes)
methd = methd & Format$(Hex$(bytes(i)), "00")
Next i
Combo1.Text = methd
methd = StrConv(bytes, vbUnicode)
rs.Fields("Method").Value = Combo1.Text
' ////filter1////////
fil1 = Combo2.Text
Do While fil1 > 0
strng = fil1 Mod 16
If strng > 9 Then
strng = Chr(CInt(strng))
End If
hexcod = hexcod & strng
fil1 = fil1 / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("Filter1").Value = hexcod
' ////filter2////////
fil2 = Combo3.Text
bytes = StrConv(fil2, vbFromUnicode)
fil2 = ""
For i = LBound(bytes) To UBound(bytes)
fil2 = fil2 & Format$(Hex$(bytes(i)), "00")
Next i
Combo3.Text = fil2
fil2 = StrConv(bytes, vbUnicode)
rs.Fields("Filter2").Value = Combo3.Text
' ////temperature/////
strng = ""
hexcod = ""
temp = Combo4.Text
Do While temp > 0
strng = temp Mod 16
If strng > 9 Then
strng = Chr(CInt(strng) + 55)
End If
hexcod = hexcod & strng
temp = temp / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("Temperature").Value = hexcod
' /////units//////
strng = ""
hexcod = ""
unit = Text5.Text
Do While unit > 0
strng = unit Mod 16
If strng > 9 Then
strng = Chr(CInt(strng) + 55)
End If
hexcod = hexcod & strng
unit = unit / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("Units").Value = hexcod
' ////no.of standards////////
strng = ""
hexcod = ""
stndrd = Text6.Text
Do While stndrd > 0
strng = stndrd Mod 16
If strng > 9 Then
strng = Chr(CInt(strng) + 55)
End If
hexcod = hexcod & strng
stndrd = stndrd / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("NoStandards").Value = hexcod
' ////reagent vol/////////
strng = ""
hexcod = ""
reagvol = Text7.Text
Do While reagvol > 0
strng = reagvol Mod 16
If strng > 9 Then
strng = Chr(CInt(strng) + 55)
End If
hexcod = hexcod & strng
reagvol = reagvol / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("ReagentVolume").Value = hexcod
' ////sample vol/////
strng = ""
hexcod = ""
smplevol = Text8.Text
Do While smplevol > 0
strng = smplevol Mod 16
If strng > 9 Then
strng = Chr(CInt(strng) + 55)
End If
hexcod = hexcod & strng
smplevol = smplevol / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("SampleVolume").Value = hexcod
' ////aspiration volume////
strng = ""
hexcod = ""
aspvol = Text9.Text
Do While aspvol > 0
strng = aspvol Mod 16
If strng > 9 Then
strng = Chr(CInt(strng) + 55)
End If
hexcod = hexcod & strng
aspvol = aspvol / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("AspirationVolume").Value = hexcod
' ///concentration///
strng = ""
hexcod = ""
conc = Text10.Text
Do While conc > 0
strng = conc Mod 16
If strng > 9 Then
strng = Chr(CInt(strng) + 55)
End If
hexcod = hexcod & strng
conc = conc / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("Concentration").Value = hexcod
' ///factor///
strng = ""
hexcod = ""
factr = Text11.Text
Do While factr > 0
strng = factr Mod 16
If strng > 9 Then
strng = Chr(CInt(strng) + 55)
End If
hexcod = hexcod & strng
factr = factr / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("Factor").Value = hexcod
' ///read time////
strng = ""
hexcod = ""
read = Text12.Text
Do While read > 0
strng = read Mod 16
If strng > 9 Then
strng = Chr(CInt(strng) + 55)
End If
hexcod = hexcod & strng
read = read / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("ReadTime").Value = hexcod
' ///delta time///
strng = ""
hexcod = ""
delta = Text13.Text
Do While delta > 0
strng = delta Mod 16
If strng > 9 Then
strng = Chr(CInt(strng) + 55)
End If
hexcod = hexcod & strng
delta = delta / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("DeltaTime").Value = hexcod
' ///delay time////
strng = ""
hexcod = ""
delay = Text14.Text
Do While delay > 0
strng = delay Mod 16
If strng > 9 Then
strng = Chr(CInt(strng) + 55)
End If
hexcod = hexcod & strng
delay = delay / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("DelayTime").Value = hexcod
' ////slope////
slpe = Combo5.Text
bytes = StrConv(slpe, vbFromUnicode)
slpe = ""
For i = LBound(bytes) To UBound(bytes)
slpe = slpe & Format$(Hex$(bytes(i)), "00")
Next i
Combo5.Text = slpe
slpe = StrConv(bytes, vbUnicode)
rs.Fields("slope").Value = Combo5.Text
' ///linearity////
strng = ""
hexcod = ""
linear = Text15.Text
Do While linear > 0
strng = linear Mod 16
If strng > 9 Then
strng = Chr(CInt(strng) + 55)
End If
hexcod = hexcod & strng
linear = linear / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("Linearity").Value = hexcod
' ////nor min val////
strng = ""
hexcod = ""
minval = Text16.Text
Do While minval > 0
strng = minval Mod 16
If strng > 9 Then
strng = Chr(CInt(strng) + 55)
End If
hexcod = hexcod & strng
minval = minval / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("NormalMinValue").Value = hexcod
' ////nor max val////
strng = ""
hexcod = ""
maxval = Text17.Text
Do While maxval > 0
strng = maxval Mod 16
If strng > 9 Then
strng = Chr(CInt(strng) + 55)
End If
hexcod = hexcod & strng
maxval = maxval / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("NormalMaxValue").Value = hexcod
' ///printer on/off////
prntr = Text18.Text
bytes = StrConv(prntr, vbFromUnicode)
prntr = ""
For i = LBound(bytes) To UBound(bytes)
prntr = prntr & Format$(Hex$(bytes(i)), "00")
Next i
Text18.Text = prntr
prntr = StrConv(bytes, vbUnicode)
rs.Fields("Printeronoff").Value = Text18.Text
' /////user location////
usrloc = Text19.Text
bytes = StrConv(usrloc, vbFromUnicode)
usrloc = ""
For i = LBound(bytes) To UBound(bytes)
usrloc = usrloc & Format$(Hex$(bytes(i)), "00")
Next i
Text19.Text = usrloc
usrloc = StrConv(bytes, vbUnicode)
rs.Fields("UserLocation").Value = Text19.Text
clear
MsgBox "Data is saved successfully...!!", vbInformation
rs.update
End Sub
Sub clear()
Label26.Caption = ""
Combo1.Text = "Select a Method"
Combo2.Text = "Nil"
Combo3.Text = "Nil"
Combo4.Text = "Nil"
Combo5.Text = "Nil"
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
Text11.Text = ""
Text12.Text = ""
Text13.Text = ""
Text14.Text = ""
Text15.Text = ""
Text16.Text = ""
Text17.Text = ""
Text18.Text = ""
Text19.Text = ""
End Sub
Private Sub delete_Click()
confirm = MsgBox("Do You want to delete the data?", vbYesNo + vbCritical, "Deletion Confirmation")
If confirm = vbYes Then
rs.delete adAffectCurrent
MsgBox "Record has been deleted successfully", vbInformation, "Message"
rs.update
Else
MsgBox "Data not deleted...!!", vbInformation, "Message"
End If
clear
End Sub
Private Sub view_Click()
Label26.Caption = rs!nameoftest
rs.Close
rs.Open "Select * from Table1 where NameofTest='" & Label26.Caption & "'", con, adOpenDynamic, adLockPessimistic
'.Recordset = "Select * from Table1 WHERE (((Table1.NameofTest) Between # " & StartStg & " # And # " & EndStg + " #)) "
str = Label26.Caption
For x = 1 To Len(str) Step 2
str1 = str1 & Chr(Val("&H" & Mid$(str, x, 2)))
Next
Label26.Caption = str1
If rs.EOF Then
display
Else
MsgBox "Record not Found..!!", vbInformation
Label26.Caption = ""
End If
'Set rs = Nothing
End Sub
Private Sub ok_Click()
clear
End Sub
Private Sub cancel_Click()
End
End Sub
Private Sub update_Click()
' ////method////////
methd = Combo1.Text
bytes = StrConv(methd, vbFromUnicode)
methd = ""
For i = LBound(bytes) To UBound(bytes)
methd = methd & Format$(Hex$(bytes(i)), "00")
Next i
Combo1.Text = methd
methd = StrConv(bytes, vbUnicode)
rs.Fields("Method").Value = Combo1.Text
' ////filter1////////
fil1 = Combo2.Text
Do While fil1 > 0
strng = fil1 Mod 16
If strng > 9 Then
strng = Chr(CInt(strng))
End If
hexcod = hexcod & strng
fil1 = fil1 / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("Filter1").Value = hexcod
' ////filter2////////
fil2 = Combo3.Text
bytes = StrConv(fil2, vbFromUnicode)
fil2 = ""
For i = LBound(bytes) To UBound(bytes)
fil2 = fil2 & Format$(Hex$(bytes(i)), "00")
Next i
Combo3.Text = fil2
fil2 = StrConv(bytes, vbUnicode)
rs.Fields("Filter2").Value = Combo3.Text
' ////temperature/////
strng = ""
hexcod = ""
temp = Combo4.Text
Do While temp > 0
strng = temp Mod 16
If strng > 9 Then
strng = Chr(CInt(strng))
End If
hexcod = hexcod & strng
temp = temp / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("Temperature").Value = hexcod
' /////units//////
strng = ""
hexcod = ""
unit = Text5.Text
Do While unit > 0
strng = unit Mod 16
If strng > 9 Then
strng = Chr(CInt(strng))
End If
hexcod = hexcod & strng
unit = unit / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("Units").Value = hexcod
' ////no.of standards////////
strng = ""
hexcod = ""
stndrd = Text6.Text
Do While stndrd > 0
strng = stndrd Mod 16
If strng > 9 Then
strng = Chr(CInt(strng))
End If
hexcod = hexcod & strng
stndrd = stndrd / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("NoStandards").Value = hexcod
' ////reagent vol/////////
strng = ""
hexcod = ""
reagvol = Text7.Text
Do While reagvol > 0
strng = reagvol Mod 16
If strng > 9 Then
strng = Chr(CInt(strng))
End If
hexcod = hexcod & strng
reagvol = reagvol / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("ReagentVolume").Value = hexcod
' ////sample vol/////
strng = ""
hexcod = ""
smplevol = Text8.Text
Do While smplevol > 0
strng = smplevol Mod 16
If strng > 9 Then
strng = Chr(CInt(strng))
End If
hexcod = hexcod & strng
smplevol = smplevol / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("SampleVolume").Value = hexcod
' ////aspiration volume////
strng = ""
hexcod = ""
aspvol = Text9.Text
Do While aspvol > 0
strng = aspvol Mod 16
If strng > 9 Then
strng = Chr(CInt(strng))
End If
hexcod = hexcod & strng
aspvol = aspvol / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("AspirationVolume").Value = hexcod
' ///concentration///
strng = ""
hexcod = ""
conc = Text10.Text
Do While conc > 0
strng = conc Mod 16
If strng > 9 Then
strng = Chr(CInt(strng))
End If
hexcod = hexcod & strng
conc = conc / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("Concentration").Value = hexcod
' ///factor///
strng = ""
hexcod = ""
factr = Text11.Text
Do While factr > 0
strng = factr Mod 16
If strng > 9 Then
strng = Chr(CInt(strng))
End If
hexcod = hexcod & strng
factr = factr / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("Factor").Value = hexcod
' ///read time////
strng = ""
hexcod = ""
read = Text12.Text
Do While read > 0
strng = read Mod 16
If strng > 9 Then
strng = Chr(CInt(strng))
End If
hexcod = hexcod & strng
read = read / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("ReadTime").Value = hexcod
' ///delta time///
strng = ""
hexcod = ""
delta = Text13.Text
Do While delta > 0
strng = delta Mod 16
If strng > 9 Then
strng = Chr(CInt(strng))
End If
hexcod = hexcod & strng
delta = delta / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("DeltaTime").Value = hexcod
' ///delay time////
strng = ""
hexcod = ""
delay = Text14.Text
Do While delay > 0
strng = delay Mod 16
If strng > 9 Then
strng = Chr(CInt(strng))
End If
hexcod = hexcod & strng
delay = delay / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("DelayTime").Value = hexcod
' ////slope////
slpe = Combo5.Text
bytes = StrConv(slpe, vbFromUnicode)
slpe = ""
For i = LBound(bytes) To UBound(bytes)
slpe = slpe & Format$(Hex$(bytes(i)), "00")
Next i
Combo5.Text = slpe
slpe = StrConv(bytes, vbUnicode)
rs.Fields("slope").Value = Combo5.Text
' ///linearity////
strng = ""
hexcod = ""
linear = Text15.Text
Do While linear > 0
strng = linear Mod 16
If strng > 9 Then
strng = Chr(CInt(strng))
End If
hexcod = hexcod & strng
linear = linear / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("Linearity").Value = hexcod
' ////nor min val////
strng = ""
hexcod = ""
minval = Text16.Text
Do While minval > 0
strng = minval Mod 16
If strng > 9 Then
strng = Chr(CInt(strng))
End If
hexcod = hexcod & strng
minval = minval / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("NormalMinValue").Value = hexcod
' ////nor max val////
strng = ""
hexcod = ""
maxval = Text17.Text
Do While maxval > 0
strng = maxval Mod 16
If strng > 9 Then
strng = Chr(CInt(strng))
End If
hexcod = hexcod & strng
maxval = maxval / 16
Loop
hexcod = StrReverse(hexcod)
rs.Fields("NormalMaxValue").Value = hexcod
' ///printer on/off////
prntr = Text18.Text
bytes = StrConv(prntr, vbFromUnicode)
prntr = ""
For i = LBound(bytes) To UBound(bytes)
prntr = prntr & Format$(Hex$(bytes(i)), "00")
Next i
Text18.Text = prntr
prntr = StrConv(bytes, vbUnicode)
rs.Fields("Printeronoff").Value = Text18.Text
' /////user location////
usrloc = Text19.Text
bytes = StrConv(usrloc, vbFromUnicode)
usrloc = ""
For i = LBound(bytes) To UBound(bytes)
usrloc = usrloc & Format$(Hex$(bytes(i)), "00")
Next i
Text19.Text = usrloc
usrloc = StrConv(bytes, vbUnicode)
MsgBox "Data is updated successfully...!!", vbInformation
rs.update
clear
End Sub
推荐答案
这篇关于关于指定寄存器的VB6编程的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!