Delphi-PRAXiS
Seite 2 von 2     12   

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Sonstige Fragen zu Delphi (https://www.delphipraxis.net/19-sonstige-fragen-zu-delphi/)
-   -   Probleme Empfang TComPort DataPacket (https://www.delphipraxis.net/166897-probleme-empfang-tcomport-datapacket.html)

Wal 8. Mär 2012 15:03

AW: Probleme Empfang TComPort DataPacket
 
Habe hier mal einen Testaufbau mit einem Atmel Mega8 gemacht.
Sendet der Mega8 "AD" + Wert + #13#10 wird ComData1Packet angesprungen und die Progressbar zeigt einen Analogwert an, den ich mit einem Poti am Mega8 einstelle.
Bei den anderen ComData's sende ich einfach nur die entsprechenden Strings vom Mega8 aus. Das funktioniert bei mir hier immer und ohne Prob's.

Delphi-Quellcode:
unit uMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, CPort, Vcl.StdCtrls, Vcl.ExtCtrls,
  Vcl.ComCtrls;

type
  TfrmMain = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    ProgressBar1: TProgressBar;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    ComPort: TComPort;
    ComData1: TComDataPacket;
    ComData2: TComDataPacket;
    ComData3: TComDataPacket;
    ComData4: TComDataPacket;
    ComData5: TComDataPacket;
    ComData6: TComDataPacket;
    ComData7: TComDataPacket;
    ComData8: TComDataPacket;
    ComData9: TComDataPacket;
    ComData10: TComDataPacket;
    procedure ComData1Packet(Sender: TObject; const Str: string);
    procedure ComData2Packet(Sender: TObject; const Str: string);
    procedure ComData3Packet(Sender: TObject; const Str: string);
    procedure ComData4Packet(Sender: TObject; const Str: string);
    procedure ComData5Packet(Sender: TObject; const Str: string);
    procedure ComData6Packet(Sender: TObject; const Str: string);
    procedure ComData7Packet(Sender: TObject; const Str: string);
    procedure ComData8Packet(Sender: TObject; const Str: string);
    procedure ComData9Packet(Sender: TObject; const Str: string);
    procedure ComData10Packet(Sender: TObject; const Str: string);
  end;

var
  frmMain: TfrmMain;
  Buffer: PACKED ARRAY[0..9] OF Byte;

implementation

{$R *.dfm}

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ComData1.Free;
  ComData2.Free;
  ComData3.Free;
  ComData4.Free;
  ComData5.Free;
  ComData6.Free;
  ComData7.Free;
  ComData8.Free;
  ComData9.Free;
  ComData10.Free;
  ComPort.Close;
  ComPort.Free;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  ComPort := TComPort.Create(Nil);
  ComPort.Port := 'COM5';
  ComPort.BaudRate := br38400;
  ComData1 := TComDataPacket.Create(Nil);
  ComData1.ComPort := ComPort;
  ComData1.StartString := 'AD';
  ComData1.StopString := #13#10;
  ComData1.OnPacket := ComData1Packet;
  ComData2 := TComDataPacket.Create(Nil);
  ComData2.ComPort := ComPort;
  ComData2.StartString := 'PAUSE';
  ComData2.StopString := #13#10;
  ComData2.OnPacket := ComData2Packet;
  ComData3 := TComDataPacket.Create(Nil);
  ComData3.ComPort := ComPort;
  ComData3.StartString := 'ABSTART';
  ComData3.StopString := #13#10;
  ComData3.OnPacket := ComData3Packet;
  ComData4 := TComDataPacket.Create(Nil);
  ComData4.ComPort := ComPort;
  ComData4.StartString := 'ABSTOP';
  ComData4.StopString := #13#10;
  ComData4.OnPacket := ComData4Packet;
  ComData5 := TComDataPacket.Create(Nil);
  ComData5.ComPort := ComPort;
  ComData5.StartString := 'AUFSTART';
  ComData5.StopString := #13#10;
  ComData5.OnPacket := ComData5Packet;
  ComData6 := TComDataPacket.Create(Nil);
  ComData6.ComPort := ComPort;
  ComData6.StartString := 'AUFSTOP';
  ComData6.StopString := #13#10;
  ComData6.OnPacket := ComData6Packet;
  ComData7 := TComDataPacket.Create(Nil);
  ComData7.ComPort := ComPort;
  ComData7.StartString := 'SCHNELLSTART';
  ComData7.StopString := #13#10;
  ComData7.OnPacket := ComData7Packet;
  ComData8 := TComDataPacket.Create(Nil);
  ComData8.ComPort := ComPort;
  ComData8.StartString := 'SCHNELLSTOP';
  ComData8.StopString := #13#10;
  ComData8.OnPacket := ComData8Packet;
  ComData9 := TComDataPacket.Create(Nil);
  ComData9.ComPort := ComPort;
  ComData9.StartString := 'LANGSAMSTART';
  ComData9.StopString := #13#10;
  ComData9.OnPacket := ComData9Packet;
  ComData10 := TComDataPacket.Create(Nil);
  ComData10.ComPort := ComPort;
  ComData10.StartString := 'LANGSAMSTOP';
  ComData10.StopString := #13#10;
  ComData10.OnPacket := ComData10Packet;
  ComPort.Open;
end;

procedure TfrmMain.Button1Click(Sender: TObject);
begin
  Buffer[0]   := $66;
  Buffer[1]   := $30;
  Buffer[2]   := $51;
  Buffer[3]   := $00;
  Buffer[4]   := $00;
  Buffer[5]   := $00;
  Buffer[6]   := $00;
  Buffer[7]   := $00;
  Buffer[8]   := $00;
  Buffer[9]   := $66;
  ComPort.Write(Buffer, SizeOf(Buffer));
end;

procedure TfrmMain.ComData1Packet(Sender: TObject; const Str: string);
begin
  Progressbar1.Position := StrToInt(Str);
  ComPort.ClearBuffer(True,False);
end;

procedure TfrmMain.ComData2Packet(Sender: TObject; const Str: string);
begin
  Memo1.Text := Memo1.Text + 'PAUSE' + #13#10;
  ComPort.ClearBuffer(True,False);
end;

procedure TfrmMain.ComData3Packet(Sender: TObject; const Str: string);
begin
  Memo1.Text := Memo1.Text + 'ABSTART' + #13#10;
  ComPort.ClearBuffer(True,False);
end;

procedure TfrmMain.ComData4Packet(Sender: TObject; const Str: string);
begin
  Memo1.Text := Memo1.Text + 'ABSTOP' + #13#10;
  ComPort.ClearBuffer(True,False);
end;

procedure TfrmMain.ComData5Packet(Sender: TObject; const Str: string);
begin
  Memo1.Text := Memo1.Text + 'AUFSTART' + #13#10;
  ComPort.ClearBuffer(True,False);
end;

procedure TfrmMain.ComData6Packet(Sender: TObject; const Str: string);
begin
  Memo1.Text := Memo1.Text + 'AUFSTOP' + #13#10;
  ComPort.ClearBuffer(True,False);
end;

procedure TfrmMain.ComData7Packet(Sender: TObject; const Str: string);
begin
  Memo1.Text := Memo1.Text + 'SCHNELLSTART' + #13#10;
  ComPort.ClearBuffer(True,False);
end;

procedure TfrmMain.ComData8Packet(Sender: TObject; const Str: string);
begin
  Memo1.Text := Memo1.Text + 'SCHNELLSTOP' + #13#10;
  ComPort.ClearBuffer(True,False);
end;

procedure TfrmMain.ComData9Packet(Sender: TObject; const Str: string);
begin
  Memo1.Text := Memo1.Text + 'LANGSAMSTART' + #13#10;
  ComPort.ClearBuffer(True,False);
end;

procedure TfrmMain.ComData10Packet(Sender: TObject; const Str: string);
begin
  Memo1.Text := Memo1.Text + 'LANGSAMSTOP' + #13#10;
  ComPort.ClearBuffer(True,False);
end;

end.

Wal 8. Mär 2012 15:06

AW: Probleme Empfang TComPort DataPacket
 
Hier auch noch der Code vom Mega8 mit Bascom:

Delphi-Quellcode:
'--------------------------------------------------------------
'           mega8.bas
'   mega8 sample file
'--------------------------------------------------------------
$regfile = "m8def.dat"
$crystal = 16000000
$baud = 38400

Declare Sub Setelv(byval L As Byte)

Config Int0 = Falling
Config Portb = Output
Config Portd = Output
Portb = 11111000

Config Timer1 = Timer , Prescale = 256                      'Konfiguriere Timer1

Config Adc = Single , Prescaler = Auto , Reference = Avcc
Start Adc

On Urxc Rec_isr
On Int0 Int0_irq
On Timer1 Isr_von_timer1

Enable Interrupts
Enable Urxc
Enable Int0
Enable Timer1

Timer1 = 3036

Dim B As Bit                                               '1 = Befehl über RS323 empfangen

Dim Buffer(10) As Byte                                     'Datenbytes des Befehls
Dim E As Byte                                              '1 = Laufband Ab; 2 = Laufband Auf
Dim F As Byte                                              '1 = Laufband langsammer; 2 = Laufband schneller
Dim P As Byte                                              'SollSpeed
Dim S As Byte                                              'IstSpeed
Dim V As Byte                                              'SollSteigung
Dim Z As Byte                                              'Datenbyte Zähler

Dim I As Word                                              'Schleifenzähler
Dim T As Word                                              'IstSteigung
Dim W As Word                                              'SteigungsDigits

T = Getadc(0)

If T > 230 Then
   Portb.4 = 0
   E = 1
   W = 230
End If

If T < 220 Then
   Portb.3 = 0
   E = 2
   W = 230
End If

'--------------------------------------------------------------------
'                            Main
'--------------------------------------------------------------------
Main:

Do
   If B = 1 Then
       If Buffer(1) = &H66 Then
         If Buffer(10) = &H66 Then
            Select Case Buffer(2)

            Case &H00 : Set Portb.2

            Case &H10 :
                        Print "SCHNELLSTART"
                        P = Buffer(3)
                        F = 1

            Case &H20 :
                        Print "LANGSAMSTART"
                        P = Buffer(3)
                        F = 2

            Case &H30 : Call Setelv(buffer(3))


            Case &HFF : Reset Portb.2

            End Select
         End If
      End If
      Reset B
   End If

   T = Getadc(0)

   If T < 220 Then
      Portb.4 = 1
      Portb.3 = 0
      E = 2
      W = 230
   End If

   If T > 875 Then
      Portb.3 = 1
      Portb.4 = 0
      E = 1
      W = 865
   End If

   If E > 0 Then
      If E = 1 Then
         If T = W Or T < W Then
            Portb.4 = 1
            E = 0
            Print "ABSTOP"
         End If
      Else
         If T = W Or T > W Then
            Portb.3 = 1
            E = 0
            Print "AUFSTOP"
         End If
      End If
   End If

   If F > 0 Then
      Incr S
      If F = 1 Then
         Portb.1 = 1
         For I = 1 To 12000
         Next
         Portb.1 = 0
         For I = 1 To 5000
         Next
      Else
         Portb.0 = 1
         For I = 1 To 12000
         Next
         Portb.0 = 0
         For I = 1 To 5000
         Next
      End If
      If S = P Then
         If F = 2 Then
            Print "LANGSAMSTOP"
         Else
            Print "SCHNELLSTOP"
         End If
         F = 0
         S = 0
      End If
   End If
Loop
End
'--------------------------------------------------------------------


Rec_isr:
   Incr Z
   Buffer(z) = Udr
   If Z = 10 Then
      Set B
      Z = 0
   End If
Return


Int0_irq:
   Set Portb.2
   Print "PAUSE"
Return


Isr_von_timer1:                                            'ISR von Timer1
   Timer1 = 3036
   Print "AD" ; T
   Toggle Portd.6
Return


Sub Setelv(byval L As Byte)
   W = L * 43
   W = W + 230
   T = Getadc(0)
   If V > L And T > 230 Then
      Portb.4 = 0
      V = L
      E = 1
      Print "ABSTART"
   End If
   If V < L And T < 865 Then
      Portb.3 = 0
      V = L
      E = 2
      Print "AUFSTART"
   End If
End Sub


Alle Zeitangaben in WEZ +1. Es ist jetzt 17:21 Uhr.
Seite 2 von 2     12   

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz