请大侠帮忙把Vb代码改成DELPHI代码,谢谢!

cgh1970 2021-04-21 03:06:26
Option Explicit
Dim qq As Integer

Private Sub Command1_Click()
If Command1.Caption = "OPEN" Then
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
MSComm1.CommPort = CInt(Combo1.Text)
Timer1.Enabled = True
Command1.Caption = "CLOSE"
Else
Timer1.Enabled = False
Command1.Caption = "OPEN"
qq = 0
Label1.Caption = CStr(qq)
End If
End Sub

Private Sub Form_Load()
Combo1.ListIndex = 7
Combo2.ListIndex = 0
qq = 0
End Sub


Private Sub Timer1_Timer()
Dim Outadress(0) As Byte
Dim OutData(6) As Byte


Timer1.Enabled = False

If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
MSComm1.PortOpen = True
Else: MSComm1.PortOpen = True
End If

'MSComm1.Settings = "9600,m,8,1"

Outadress(0) = StrConv(CInt(Combo2.Text), vbFromUnicode)

'MSComm1.InputLen = 0
'MSComm1.InBufferCount = 0
'MSComm1.OutBufferCount = 0
MSComm1.Output = Outadress

'Pausett
Label2.ForeColor = &HFE
MSComm1.Settings = "9600,s,8,1"
OutData(0) = 2
OutData(1) = 254 '&HFE
OutData(2) = 0
OutData(3) = 0
OutData(4) = 0
OutData(5) = 0
OutData(6) = 1 'StrConv(CInt(Combo2.Text), vbFromUnicode)
Text5.Text = OutData(1)
MSComm1.RThreshold = 92
MSComm1.InputLen = 0
MSComm1.InBufferCount = 0
MSComm1.OutBufferCount = 0
MSComm1.Output = OutData

qq = qq + 1
Label1.Caption = CStr(qq)

Timer1.Enabled = True
End Sub

Private Sub MSComm1_OnComm()
Dim InBuffer
Dim i As Integer
Dim a As Double, b As Integer, iSign As Integer
Dim iCrc As Integer


If MSComm1.CommEvent = comEvReceive Then
InBuffer = MSComm1.Input

For i = 0 To 90
If IsNumeric(InBuffer(i)) = True Then
DoEvents

iCrc = iCrc + InBuffer(i)
Text4.Text = iCrc
End If
Next

iCrc = iCrc Mod 256
If iCrc = InBuffer(91) Then

If InBuffer(15) > 127 Then
iSign = -1
InBuffer(15) = InBuffer(15) - 128
Else
iSign = 1
End If
a = InBuffer(15) * 65536 * 256 + InBuffer(14) * 65536 + InBuffer(13) * 256 + InBuffer(12)
a = Int((a + (InBuffer(11) * 256 + InBuffer(10)) / 65536) * 1000 * iSign + 0.5) / 1000

Text1.Text = Format(a, "#0.00")

If InBuffer(2) > 127 Then
iSign = -1
InBuffer(2) = InBuffer(2) - 128
Else
iSign = 1
End If
If InBuffer(3) > 127 Then
b = InBuffer(3) - 256
Else
b = InBuffer(3)
End If
a = InBuffer(2) * 65536 + InBuffer(1) * 256 + InBuffer(0)
a = a * 2 ^ (b - 23) * iSign
a = Int(a * 1000 + 0.5) / 1000

Text2.Text = Format(a, "#0.00")

iSign = IIf(InBuffer(82) > 127, -1, 1)
If iSign = -1 Then InBuffer(82) = InBuffer(82) - 128
b = IIf(InBuffer(83) > 127, InBuffer(83) - 256, InBuffer(83))
a = InBuffer(82) * 2 ^ 16 + InBuffer(81) * 2 ^ 8 + InBuffer(80) * 2 ^ 0
a = a * 2 ^ (b - 23) * iSign

Text3.Text = Format(a, "#0.00")
End If
End If


End Sub

Private Sub Pausett(Optional pInterval As Single = 0.01)
Dim dt As Single, odt As Single
dt = Timer: odt = dt
Do
odt = Timer
If odt < dt Then dt = odt
DoEvents
Loop While odt < dt + pInterval
End Sub
...全文
238 9 打赏 收藏 举报
写回复
9 条回复
切换为时间正序
请发表友善的回复…
发表回复
doloopcn 2021-04-22
  • 打赏
  • 举报
回复
大概是这样,具体的你还得上机才能调试完成
doloopcn 2021-04-22
  • 打赏
  • 举报
回复
Option Explicit
Dim qq As Integer
Var
qq:Integer;

Private Sub Command1_Click()
If Command1.Caption = "OPEN" Then
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
MSComm1.CommPort = CInt(Combo1.Text)
Timer1.Enabled = True
Command1.Caption = "CLOSE"
Else
Timer1.Enabled = False
Command1.Caption = "OPEN"
qq = 0
Label1.Caption = CStr(qq)
End If
End Sub

procedure TForm1.Command1Click();
begin
if Command1.Caption='OPEN' then
begin
if MSComm1.PortOpen = True Then MSComm1.PortOpen = False;
MSComm1.CommPort := StrToInt(Combo1.Text);
Timer1.Enabled := True;
Command1.Caption := 'CLOSE';
end
else begin
Timer1.Enabled := False;
Command1.Caption := 'OPEN';
qq := 0;
Label1.Caption := IntToStr(qq);
end;
end;

Private Sub Form_Load()
Combo1.ListIndex = 7
Combo2.ListIndex = 0
qq = 0
End Sub

procedure TForm1.FormShow(Sender:TObject);
{DELPHI中,我一般都不在FormCreate中写代码,因为FormCreate的时候,其实窗口还没有完全创建好}
begin
Combo1.ItemIndex := 7;
Combo2.ItemIndex := 0;
qq := 0;
end;

Private Sub Timer1_Timer()
Dim Outadress(0) As Byte
Dim OutData(6) As Byte


Timer1.Enabled = False

If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
MSComm1.PortOpen = True
Else: MSComm1.PortOpen = True
End If

'MSComm1.Settings = "9600,m,8,1"

Outadress(0) = StrConv(CInt(Combo2.Text), vbFromUnicode)

'MSComm1.InputLen = 0
'MSComm1.InBufferCount = 0
'MSComm1.OutBufferCount = 0
MSComm1.Output = Outadress

'Pausett
Label2.ForeColor = &HFE
MSComm1.Settings = "9600,s,8,1"
OutData(0) = 2
OutData(1) = 254 '&HFE
OutData(2) = 0
OutData(3) = 0
OutData(4) = 0
OutData(5) = 0
OutData(6) = 1 'StrConv(CInt(Combo2.Text), vbFromUnicode)
Text5.Text = OutData(1)
MSComm1.RThreshold = 92
MSComm1.InputLen = 0
MSComm1.InBufferCount = 0
MSComm1.OutBufferCount = 0
MSComm1.Output = OutData

qq = qq + 1
Label1.Caption = CStr(qq)

Timer1.Enabled = True
End Sub

procedure TForm1.Timer1Timer(Sender: TObject);
var
Outadress: array [0..0] of Byte;
OutDataarray:array [0..6] of Byte;
begin
Timer1.Enabled = False;
If MSComm1.PortOpen = True Then
begin
MSComm1.PortOpen = False
MSComm1.PortOpen = True
end
Else
MSComm1.PortOpen = True;

//'MSComm1.Settings = '9600,m,8,1';

//Outadress(0) = StrConv(CInt(Combo2.Text), vbFromUnicode)
{这个不知道你想转的是什么?估计是将Int转为16进制吧}
{一个Byte是8位}
Outadress[0] := IntToHex(StrToInt(Combo2.Text),2);

//'MSComm1.InputLen = 0
//'MSComm1.InBufferCount = 0
//'MSComm1.OutBufferCount = 0
MSComm1.Output := Outadress;

//'Pausett
{不知道这个是什么颜色,用红色代替}
//Label2.ForeColor = &HFE
Label2.Font.Color := clRed;
MSComm1.Settings := '9600,s,8,1';
OutData[0] := 2;
OutData[1] := 254; //'&HFE
OutData[2] := 0;
OutData[3] := 0;
OutData[4] := 0;
OutData[5] := 0;
OutData[6] := 1; //'StrConv(CInt(Combo2.Text), vbFromUnicode)
Text5.Text := Format('%.2x', [OutData[1]]);
MSComm1.RThreshold := 92;
MSComm1.InputLen := 0;
MSComm1.InBufferCount := 0;
MSComm1.OutBufferCount := 0;
MSComm1.Output := OutData;

qq := qq + 1;
Label1.Caption = IntToStr(qq);

Timer1.Enabled = True
end;

Private Sub MSComm1_OnComm()
Dim InBuffer
Dim i As Integer
Dim a As Double, b As Integer, iSign As Integer
Dim iCrc As Integer


If MSComm1.CommEvent = comEvReceive Then
InBuffer = MSComm1.Input

For i = 0 To 90
If IsNumeric(InBuffer(i)) = True Then
DoEvents

iCrc = iCrc + InBuffer(i)
Text4.Text = iCrc
End If
Next

iCrc = iCrc Mod 256
If iCrc = InBuffer(91) Then

If InBuffer(15) > 127 Then
iSign = -1
InBuffer(15) = InBuffer(15) - 128
Else
iSign = 1
End If
a = InBuffer(15) * 65536 * 256 + InBuffer(14) * 65536 + InBuffer(13) * 256 + InBuffer(12)
a = Int((a + (InBuffer(11) * 256 + InBuffer(10)) / 65536) * 1000 * iSign + 0.5) / 1000

Text1.Text = Format(a, "#0.00")

If InBuffer(2) > 127 Then
iSign = -1
InBuffer(2) = InBuffer(2) - 128
Else
iSign = 1
End If
If InBuffer(3) > 127 Then
b = InBuffer(3) - 256
Else
b = InBuffer(3)
End If
a = InBuffer(2) * 65536 + InBuffer(1) * 256 + InBuffer(0)
a = a * 2 ^ (b - 23) * iSign
a = Int(a * 1000 + 0.5) / 1000

Text2.Text = Format(a, "#0.00")

iSign = IIf(InBuffer(82) > 127, -1, 1)
If iSign = -1 Then InBuffer(82) = InBuffer(82) - 128
b = IIf(InBuffer(83) > 127, InBuffer(83) - 256, InBuffer(83))
a = InBuffer(82) * 2 ^ 16 + InBuffer(81) * 2 ^ 8 + InBuffer(80) * 2 ^ 0
a = a * 2 ^ (b - 23) * iSign

Text3.Text = Format(a, "#0.00")
End If
End If


End Sub

Private Sub Pausett(Optional pInterval As Single = 0.01)
Dim dt As Single, odt As Single
dt = Timer: odt = dt
Do
odt = Timer
If odt < dt Then dt = odt
DoEvents
Loop While odt < dt + pInterval
End Sub
procedure Pausett(pInterval :Real = 0.01);
var
dt , odt : Real;
begin
dt := Timer;
odt := dt;
repeat
odt := Timer
If odt < dt Then dt := odt;
DoEvents;
until odt >= dt + pInterval
End

procedure TForm1.MSComm1OnComm(Sender:TObject);
var
InBuffer:array of Varaint;//DELPHI中记得引用Varaint单元
i : Integer;
a : Real; b , iSign : Integer;
iCrc : Integer;
{DELPHI 没有ISNUMERIC函数,得自己编写一个}
function IsNumeric(strInPut:Varaint):Boolean;
var
Value:Double;
Code:Integer;
begin
result:=False;
try
Val(VarToStr(strInPut),Value,Code);
result:=Code=0;
except
end;
end;
function IIf(Condition:Boolean;Result1,Result2:Varaint):Varaint;
begin
if Condition then
Result:=Result1
else
Result:=Result2;
end;
begin
{不清楚MSCOMM的用法,不知道会不会自动初始化InBuffer}
//如果不会就得加下面一行
//SetLength(InBuffer,1024);//1K的缓冲
If MSComm1.CommEvent = comEvReceive Then
InBuffer := MSComm1.Input;

For i := 0 To 90 do
begin
If IsNumeric(InBuffer(i)) = True Then
begin
DoEvents;

iCrc := iCrc + VarToInt(InBuffer(i));
Text4.Text := IntToStr(iCrc);
End
end

iCrc := iCrc Mod 256
If iCrc = VarToInt(InBuffer(91)) Then
begin

If VarToInt(InBuffer(15)) > 127 Then
begin
iSign := -1;
InBuffer(15) := InBuffer(15) - 128;
end;
Else
iSign := 1;

a := InBuffer(15) * 65536 * 256 + InBuffer(14) * 65536 + InBuffer(13) * 256 + InBuffer(12);
{DELPHI中没有INT,强制取整用Trunc,忽略小数点}
a := Trunc(((a + (InBuffer(11) * 256 + InBuffer(10)) / 65536) * 1000 * iSign + 0.5) / 1000;

Text1.Text := Format('%f.2',[a]);

If InBuffer(2) > 127 Then
begin
iSign := -1;
InBuffer(2) := InBuffer(2) - 128;
end
Else
iSign := 1;

If InBuffer(3) > 127 Then
b := InBuffer(3) - 256
Else
b = InBuffer(3);

a := InBuffer(2) * 65536 + InBuffer(1) * 256 + InBuffer(0);
a := a * 2 ^ (b - 23) * iSign;
a := Int(a * 1000 + 0.5) / 1000;

Text2.Text := Format('%f.2',[a]);

iSign := IIf(InBuffer(82) > 127, -1, 1);
If iSign := -1 Then InBuffer(82) := InBuffer(82) - 128;
//DELPHI 没有IIF函数
b := IIf(InBuffer(83) > 127, InBuffer(83) - 256, InBuffer(83));
a := InBuffer(82) * 2 ^ 16 + InBuffer(81) * 2 ^ 8 + InBuffer(80) * 2 ^ 0;
a := a * 2 ^ (b - 23) * iSign;

Text3.Text := Format('%f.2',[a]);
End
End


End
cgh1970 2021-04-22
  • 打赏
  • 举报
回复
请问怎么转换
秋天之落叶 2021-04-22
  • 打赏
  • 举报
回复
引用 6 楼 cgh1970 的回复:
Outadress[0] := IntToHex(StrToInt(ComboBox2.Text),2); 运行提示[Error] Unit1.pas(222): Incompatible types: 'Byte' and 'String'
左边是Byte,右边是16进制形式的字符串,不一致
cgh1970 2021-04-22
  • 打赏
  • 举报
回复
我就是参考VB代码的,VB是可以运行正常的,但delphi有问题。就是发送和读取转换有问题。inputModeVB用的是 comInputModeBinary模式。
cgh1970 2021-04-22
  • 打赏
  • 举报
回复
Outadress[0] := IntToHex(StrToInt(ComboBox2.Text),2); 运行提示[Error] Unit1.pas(222): Incompatible types: 'Byte' and 'String'
tanqth 2021-04-22
  • 打赏
  • 举报
回复
你这个应该是取串口数据并转换,最好的方式是看他文档再参照VB的代码处理。
cgh1970 2021-04-22
  • 打赏
  • 举报
回复
好的,我试试!谢谢了!
cgh1970 2021-04-21
  • 打赏
  • 举报
回复
分数还可以加哟,麻烦大侠们了。急!急!急!
发帖
网络通信/分布式开发

1589

社区成员

Delphi 网络通信/分布式开发
社区管理员
  • 网络通信/分布式开发社区
加入社区
帖子事件
创建了帖子
2021-04-21 03:06
社区公告
暂无公告