AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Probleme Empfang TComPort DataPacket

Ein Thema von sambadancer · begonnen am 4. Mär 2012 · letzter Beitrag vom 8. Mär 2012
Antwort Antwort
Seite 2 von 2     12   
Wal

Registriert seit: 22. Sep 2006
57 Beiträge
 
#11

AW: Probleme Empfang TComPort DataPacket

  Alt 8. Mär 2012, 16:03
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.
Gruß Wal

Es gibt viel zu tun, sitzen wir's aus ! 0(°~°)0
  Mit Zitat antworten Zitat
Wal

Registriert seit: 22. Sep 2006
57 Beiträge
 
#12

AW: Probleme Empfang TComPort DataPacket

  Alt 8. Mär 2012, 16:06
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
Gruß Wal

Es gibt viel zu tun, sitzen wir's aus ! 0(°~°)0
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 2 von 2     12   


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 08:50 Uhr.
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