Skip to content

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

--no commit message 

--no commit message
parent 7ab0754e
Hide whitespace changes
Inline Side-by-side
Showing with 55 additions and 4 deletions
GUI/XMLdevice/Global.pas
View file @ b2ea52d2
...@@ -19,6 +19,14 @@ var ...@@ -19,6 +19,14 @@ var
myAddress :eb_address_t; myAddress :eb_address_t;
myDevice :Twrdevice; myDevice :Twrdevice;
DeviceOffsetCount:Word;
DeviceCtrRegCount:Word;
DeviceDataCount :Word;
DeviceOffset:array[0..256] of LongWord;
DeviceCtrReg:array[0..256] of LongWord;
DeviceData :array[0..256] of LongWord;
type TWrPacket= RECORD CASE Int64 OF type TWrPacket= RECORD CASE Int64 OF
1: (wpack: Int64); 1: (wpack: Int64);
......
GUI/XMLdevice/WR.bdsproj.local
View file @ b2ea52d2
...@@ -20,5 +20,6 @@ ...@@ -20,5 +20,6 @@
<Transaction>2011.04.06 15:41:29.485.pas,F:\Projekte\Timing\etherbone-core\api\etherbone.pas=</Transaction> <Transaction>2011.04.06 15:41:29.485.pas,F:\Projekte\Timing\etherbone-core\api\etherbone.pas=</Transaction>
<Transaction>2011.04.06 15:41:30.172.pas,F:\Projekte\Timing\etherbone-core\GUI\XMLdevice\device_setup.pas=</Transaction> <Transaction>2011.04.06 15:41:30.172.pas,F:\Projekte\Timing\etherbone-core\GUI\XMLdevice\device_setup.pas=</Transaction>
<Transaction>2011.04.06 15:41:30.172.dfm,F:\Projekte\Timing\etherbone-core\GUI\XMLdevice\device_setup.dfm=</Transaction> <Transaction>2011.04.06 15:41:30.172.dfm,F:\Projekte\Timing\etherbone-core\GUI\XMLdevice\device_setup.dfm=</Transaction>
<Transaction>2011.04.08 15:55:31.433.pas,F:\Projekte\Timing\etherbone-core\GUI\XMLdevice\Unit1.pas=F:\Projekte\Timing\etherbone-core\GUI\XMLdevice\XML_collector.pas</Transaction>
</Transactions> </Transactions>
</BorlandProject> </BorlandProject>
GUI/XMLdevice/WR.dpr
View file @ b2ea52d2
...@@ -8,7 +8,8 @@ uses ...@@ -8,7 +8,8 @@ uses
device_unit in 'device_unit.pas', device_unit in 'device_unit.pas',
Global in 'Global.pas', Global in 'Global.pas',
UserSendData in 'UserSendData.pas' {SendUserdata_Form}, UserSendData in 'UserSendData.pas' {SendUserdata_Form},
etherbone in '..\..\api\etherbone.pas'; etherbone in '..\..\api\etherbone.pas',
XML_collector in 'XML_collector.pas';
{$R *.res} {$R *.res}
......
GUI/XMLdevice/XML_WR.dfm
View file @ b2ea52d2
...@@ -38,7 +38,7 @@ object Form1: TForm1 ...@@ -38,7 +38,7 @@ object Form1: TForm1
Height = 338 Height = 338
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
Font.Height = -15 Font.Height = -13
Font.Name = 'Tahoma' Font.Name = 'Tahoma'
Font.Style = [] Font.Style = []
Indent = 19 Indent = 19
...@@ -140,6 +140,7 @@ object Form1: TForm1 ...@@ -140,6 +140,7 @@ object Form1: TForm1
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
TabOrder = 0 TabOrder = 0
OnClick = SendData_ButtonClick
end end
object Button1: TButton object Button1: TButton
Left = 24 Left = 24
......
GUI/XMLdevice/XML_WR.pas
View file @ b2ea52d2
...@@ -12,7 +12,7 @@ interface ...@@ -12,7 +12,7 @@ interface
uses uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, xmldom, XMLIntf, Menus, msxmldom, XMLDoc, ComCtrls, ExtCtrls, Dialogs, xmldom, XMLIntf, Menus, msxmldom, XMLDoc, ComCtrls, ExtCtrls,
StdCtrls,wrdevice_unit, device_setup,etherbone,Global,UserSendData; StdCtrls,wrdevice_unit, device_setup,etherbone,Global,UserSendData,XML_collector;
type type
TForm1 = class(TForm) TForm1 = class(TForm)
...@@ -45,6 +45,7 @@ type ...@@ -45,6 +45,7 @@ type
XMLDoc: TXMLDocument; XMLDoc: TXMLDocument;
Extras1: TMenuItem; Extras1: TMenuItem;
SendManual1: TMenuItem; SendManual1: TMenuItem;
procedure SendData_ButtonClick(Sender: TObject);
procedure XMLLaden1Click(Sender: TObject); procedure XMLLaden1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject); procedure Exit1Click(Sender: TObject);
procedure SendManual1Click(Sender: TObject); procedure SendManual1Click(Sender: TObject);
...@@ -57,6 +58,7 @@ type ...@@ -57,6 +58,7 @@ type
procedure Setup1Click(Sender: TObject); procedure Setup1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure SendPacketsaway(offset:longword);
private private
{ Private-Deklarationen } { Private-Deklarationen }
public public
...@@ -66,6 +68,7 @@ type ...@@ -66,6 +68,7 @@ type
var var
Form1 :TForm1; Form1 :TForm1;
myStatus :string; myStatus :string;
XML_collector:TXML_collector;
implementation implementation
...@@ -192,4 +195,41 @@ begin ...@@ -192,4 +195,41 @@ begin
end; end;
end; end;
procedure TForm1.SendData_ButtonClick(Sender: TObject);
var index:integer;
nodes: IXMLNodeList;
begin
if XMLDoc.Active then begin
nodes:= XMLDoc.DocumentElement.ChildNodes;
for index:=0 to Nodes.Count-1 do begin
XML_collector.AnalyseXMLTree(Nodes[index].Childnodes);
SendPacketsaway(StrToInt('$'+VarToStr(Nodes[index].GetAttribute('value'))));
end;
end;
end;
procedure TForm1.SendPacketsaway(offset:longword);
var index:integer;
status:string;
WrPacket:TWrPacket;
begin
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);
end;
myDevice.DeviceCacheSend(status);
end;
end. end.
GUI/XMLdevice/wrdevice_unit.pas
View file @ b2ea52d2
...@@ -99,7 +99,7 @@ begin ...@@ -99,7 +99,7 @@ begin
if(IsDeviceOpen) then begin if(IsDeviceOpen) then begin
// daten schreiben // daten schreiben
eb_device_write(device, address, data); eb_device_write(device, address, data);
eb_device_flush(device); //eb_device_flush(device);
status:='Data sending:'+IntToHex(data,32); status:='Data sending:'+IntToHex(data,32);
DeviceCacheWR:= true; DeviceCacheWR:= true;
......
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