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
myAddress :eb_address_t;
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
1: (wpack: Int64);
......
GUI/XMLdevice/WR.bdsproj.local
View file @ b2ea52d2
......@@ -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: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.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>
</BorlandProject>
GUI/XMLdevice/WR.dpr
View file @ b2ea52d2
......@@ -8,7 +8,8 @@ uses
device_unit in 'device_unit.pas',
Global in 'Global.pas',
UserSendData in 'UserSendData.pas' {SendUserdata_Form},
etherbone in '..\..\api\etherbone.pas';
etherbone in '..\..\api\etherbone.pas',
XML_collector in 'XML_collector.pas';
{$R *.res}
......
GUI/XMLdevice/XML_WR.dfm
View file @ b2ea52d2
......@@ -38,7 +38,7 @@ object Form1: TForm1
Height = 338
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Height = -13
Font.Name = 'Tahoma'
Font.Style = []
Indent = 19
......@@ -140,6 +140,7 @@ object Form1: TForm1
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
OnClick = SendData_ButtonClick
end
object Button1: TButton
Left = 24
......
GUI/XMLdevice/XML_WR.pas
View file @ b2ea52d2
......@@ -12,7 +12,7 @@ interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
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
TForm1 = class(TForm)
......@@ -45,6 +45,7 @@ type
XMLDoc: TXMLDocument;
Extras1: TMenuItem;
SendManual1: TMenuItem;
procedure SendData_ButtonClick(Sender: TObject);
procedure XMLLaden1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure SendManual1Click(Sender: TObject);
......@@ -57,6 +58,7 @@ type
procedure Setup1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure SendPacketsaway(offset:longword);
private
{ Private-Deklarationen }
public
......@@ -66,6 +68,7 @@ type
var
Form1 :TForm1;
myStatus :string;
XML_collector:TXML_collector;
implementation
......@@ -192,4 +195,41 @@ begin
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.
GUI/XMLdevice/wrdevice_unit.pas
View file @ b2ea52d2
......@@ -99,7 +99,7 @@ begin
if(IsDeviceOpen) then begin
// daten schreiben
eb_device_write(device, address, data);
eb_device_flush(device);
//eb_device_flush(device);
status:='Data sending:'+IntToHex(data,32);
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