Skip to content

E
EtherBone Core
Commit c0cf079e authored by Marcus Zweig's avatar Marcus Zweig
Browse files
Options

--no commit message 

--no commit message
parent e3ac4734
Hide whitespace changes
Inline Side-by-side
Showing with 146 additions and 14 deletions
GUI/XMLdevice/Global.pas
View file @ c0cf079e
......@@ -24,6 +24,9 @@ var
DeviceCtrRegCount:Word;
DeviceDataCount :Word;
SendingCnt :integer;
PaketCnt :integer;
DeviceOffset:array[0..ArrayRange] of LongWord;
DeviceCtrReg:array[0..ArrayRange] of LongWord;
DeviceData :array[0..ArrayRange] of LongWord;
......
GUI/XMLdevice/XML_WR.dfm
View file @ c0cf079e
object Form1: TForm1
Left = 0
Top = 0
Width = 665
Width = 657
Height = 601
AutoSize = True
Caption = 'whiterabbit'
......@@ -84,7 +84,7 @@ object Form1: TForm1
end
end
object Panel3: TPanel
Left = 456
Left = 448
Top = 0
Width = 201
Height = 386
......@@ -197,10 +197,89 @@ object Form1: TForm1
OnClick = LoopSD_CheckBoxClick
end
end
object Panel7: TPanel
Left = 0
Top = 152
Width = 201
Height = 113
BevelInner = bvLowered
TabOrder = 2
object Label4: TLabel
Left = 8
Top = 16
Width = 48
Height = 18
Caption = 'Pakets:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
end
object Label5: TLabel
Left = 8
Top = 56
Width = 62
Height = 18
Caption = 'Sendings:'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
end
object PaketsCnt_Panel: TPanel
Left = 80
Top = 15
Width = 107
Height = 26
BevelInner = bvLowered
Caption = '0'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 0
end
object Sendings_Panel: TPanel
Left = 80
Top = 52
Width = 107
Height = 26
BevelInner = bvLowered
Caption = '0'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 1
end
object ClearCnt_Button: TButton
Left = 120
Top = 87
Width = 65
Height = 17
Caption = 'Clear'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 2
OnClick = ClearCnt_ButtonClick
end
end
end
object Timer1: TTimer
object PollSocket_Timer: TTimer
Interval = 100
OnTimer = Timer1Timer
OnTimer = PollSocket_TimerTimer
Left = 512
Top = 392
end
......
GUI/XMLdevice/XML_WR.pas
View file @ c0cf079e
......@@ -29,7 +29,7 @@ type
Panel5: TPanel;
SendData_Button: TButton;
Label3: TLabel;
Timer1: TTimer;
PollSocket_Timer: TTimer;
OpenDialog1: TOpenDialog;
MainMenu1: TMainMenu;
D1: TMenuItem;
......@@ -47,6 +47,13 @@ type
LoopSD_CheckBox: TCheckBox;
Lamp_Timer: TTimer;
LoopRD_CheckBox: TCheckBox;
Panel7: TPanel;
Label4: TLabel;
PaketsCnt_Panel: TPanel;
Label5: TLabel;
Sendings_Panel: TPanel;
ClearCnt_Button: TButton;
procedure ClearCnt_ButtonClick(Sender: TObject);
procedure LoopRD_CheckBoxClick(Sender: TObject);
procedure Lamp_TimerTimer(Sender: TObject);
procedure LoopSD_CheckBoxClick(Sender: TObject);
......@@ -56,7 +63,7 @@ type
procedure SendManual1Click(Sender: TObject);
procedure ReadData_ButtonClick(Sender: TObject);
//procedure myCallback(var user: eb_user_data_t; var status: eb_status_t; var data:eb_data_t );
procedure Timer1Timer(Sender: TObject);
procedure PollSocket_TimerTimer(Sender: TObject);
procedure Clear_ButtonClick(Sender: TObject);
procedure DisconnectDevice1Click(Sender: TObject);
procedure ConnectDevice1Click(Sender: TObject);
......@@ -65,6 +72,7 @@ type
procedure FormCreate(Sender: TObject);
procedure SendPacketsaway(offset:longword);
procedure NodeGetAttribute(node:IXMLNode; var kindknoten:TTreeNode; knoten:TTreeNode);
procedure UpdateCntPanels();
private
{ Private-Deklarationen }
public
......@@ -92,13 +100,23 @@ procedure TForm1.FormCreate(Sender: TObject);
begin
myDevice:= Twrdevice.Create;
myDeviceisOPen:=false;
PaketsCnt_Panel.Caption:='0';
Sendings_Panel.Caption:='0';
SendingCnt := 0;
PaketCnt := 0;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
myDeviceisOPen:=false;
LoopSD_CheckBox.Checked:=false;
Form1.Update;
Application.ProcessMessages();
myDevice.DeviceClose(myStatus);
myDevice.Free;
myDeviceisOPen:=false;
end;
procedure TForm1.Setup1Click(Sender: TObject);
......@@ -110,6 +128,7 @@ procedure TForm1.ConnectDevice1Click(Sender: TObject);
begin
messages_ListBox.Items.Add('Try to Open: '+ myDNSAdress+
' Port:'+IntTohex(myAddress,4));
messages_ListBox.TopIndex:= messages_ListBox.Items.Count-1;
if(myDevice.DeviceOpen(Pchar(myDNSAdress), myAddress, myStatus)) then begin
DeviceActiv_Shape.Brush.Color:=clLime;
......@@ -117,6 +136,7 @@ begin
end else DeviceActiv_Shape.Brush.Color:=clRed;
messages_ListBox.Items.Add('Device Open: '+myStatus);
messages_ListBox.TopIndex:= messages_ListBox.Items.Count-1;
end;
procedure TForm1.DisconnectDevice1Click(Sender: TObject);
......@@ -127,6 +147,7 @@ begin
end else DeviceActiv_Shape.Brush.Color:=clYellow;
messages_ListBox.Items.Add('Device Close: '+myStatus);
messages_ListBox.TopIndex:= messages_ListBox.Items.Count-1;
end;
procedure TForm1.Clear_ButtonClick(Sender: TObject);
......@@ -134,7 +155,7 @@ begin
messages_ListBox.Items.Clear;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
procedure TForm1.PollSocket_TimerTimer(Sender: TObject);
begin
myDevice.DevicePoll();
end;
......@@ -225,20 +246,36 @@ procedure TForm1.SendPacketsaway(offset:longword);
var index:integer;
status:string;
WrPacket:TWrPacket;
errorfound:boolean;
begin
errorfound:=false;
for index:= 0 to DeviceCtrRegCount-1 do begin
DeviceCtrReg[index]:= DeviceCtrReg[index] + offset;
WrPacket.r.Adr := DeviceCtrReg[index];
WrPacket.r.data:= DeviceData [index];
if not(myDevice.DeviceCacheWR(myAddress,WrPacket.wpack,status)) then
Application.MessageBox(PChar(status),'Dave? What are you doing?', 16)
else begin
myDevice.DeviceCacheSend(status);
if not(myDevice.DeviceCacheWR(myAddress,WrPacket.wpack,status)) then begin
messages_ListBox.Items.Add('DeviceCache:'+status);
errorfound:=true;
end else PaketCnt:=PaketCnt+1;
end;
if not errorfound then begin
if not (myDevice.DeviceCacheSend(status)) then
messages_ListBox.Items.Add('DeviceCacheSend:'+status);
SendingCnt:=SendingCnt+1;
if not (LoopSD_CheckBox.Checked) then begin
messages_ListBox.Items.Add('sending....');
messages_ListBox.TopIndex:= messages_ListBox.Items.Count-1;
UpdateCntPanels();
end else begin
if ((SendingCnt mod 100)=0)then begin
UpdateCntPanels();
end;
end;
end;
end;
......@@ -306,4 +343,19 @@ begin
ReadData_Button.Enabled:= true;
end;
procedure TForm1.ClearCnt_ButtonClick(Sender: TObject);
begin
PaketsCnt_Panel.Caption:='0';
Sendings_Panel.Caption:='0';
SendingCnt := 0;
PaketCnt := 0;
end;
procedure TForm1.UpdateCntPanels();
begin
Sendings_Panel.Caption :=IntToStr(SendingCnt);
PaketsCnt_Panel.Caption :=IntToStr(PaketCnt);
end;
end.
GUI/XMLdevice/XML_collector.pas
View file @ c0cf079e
......@@ -89,11 +89,9 @@ begin
except
BitPosH:=0;
end;
data:= StrToInt('$'+VarToStr(deep3[deep3_index].GetAttribute('value')));
ConvertData(data,BitPosL,BitPosH);
DeviceData[DeviceDataCount]:= DeviceData[DeviceDataCount] OR data;
//
end;
deep3_index:=deep3_index + 1;
end;//deep3
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment