Skip to content

E
etherbone-core
Commit e47be2be authored by Marcus Zweig's avatar Marcus Zweig
Browse files
Options

XNL GUI

parent 0d83bdc8
Hide whitespace changes
Inline Side-by-side
Showing with 1528 additions and 118 deletions
GUI/XMLdevice/Global.pas 0 → 100644
View file @ e47be2be
unit Global;
interface
uses etherbone,wrdevice_unit;
const
First_DNSAdress = 'asl720.acc.gsi.de:8989';
First_PortNumber= '400';
var
myDNSAdress :string;
myAddress :eb_address_t;
myDevice :Twrdevice;
type TWrPacket= RECORD CASE Int64 OF
1: (wpack: Int64);
2: (r : PACKED RECORD
data : LongWord;
Adr : LongWord;
END;);
END;
implementation
end.
GUI/XMLdevice/UserSendData.dfm 0 → 100644
View file @ e47be2be
object SendUserdata_Form: TSendUserdata_Form
Left = 0
Top = 0
Width = 505
Height = 275
AutoSize = True
Caption = 'Send User data'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 19
object Loop_SpeedButton: TSpeedButton
Left = 0
Top = 208
Width = 89
Height = 33
AllowAllUp = True
GroupIndex = 1
Caption = 'Loop'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
OnClick = Loop_SpeedButtonClick
end
object Send_SpeedButton: TSpeedButton
Left = 408
Top = 208
Width = 89
Height = 33
AllowAllUp = True
GroupIndex = 1
Caption = 'Send'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
OnClick = Send_SpeedButtonClick
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 497
Height = 201
BevelInner = bvLowered
TabOrder = 0
object Label1: TLabel
Left = 16
Top = 139
Width = 131
Height = 19
Caption = 'Data to send (hex)'
end
object Label2: TLabel
Left = 16
Top = 8
Width = 79
Height = 19
Caption = 'Offset(hex)'
end
object Label3: TLabel
Left = 16
Top = 72
Width = 130
Height = 19
Caption = 'Register Adr.(hex)'
end
object DataToWrite_Edit: TEdit
Left = 13
Top = 161
Width = 250
Height = 27
TabOrder = 0
OnKeyPress = DataToWrite_EditKeyPress
end
object Offset_Edit: TEdit
Left = 15
Top = 30
Width = 98
Height = 27
TabOrder = 1
OnKeyPress = Offset_EditKeyPress
end
object RegArd_Edit: TEdit
Left = 15
Top = 94
Width = 130
Height = 27
TabOrder = 2
OnKeyPress = RegArd_EditKeyPress
end
object Panel2: TPanel
Left = 272
Top = 0
Width = 225
Height = 201
BevelInner = bvLowered
TabOrder = 3
object Send_Label: TLabel
Left = 16
Top = 16
Width = 80
Height = 19
Caption = 'Sending...'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
end
object Adress_Panel: TPanel
Left = 15
Top = 38
Width = 97
Height = 25
BevelInner = bvLowered
Caption = '00000000'
TabOrder = 0
end
object Data_Panel: TPanel
Left = 110
Top = 38
Width = 97
Height = 25
BevelInner = bvLowered
Caption = '00000000'
TabOrder = 1
end
end
end
object Timer1: TTimer
OnTimer = Timer1Timer
Left = 224
Top = 208
end
end
GUI/XMLdevice/UserSendData.pas 0 → 100644
View file @ e47be2be
unit UserSendData;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, StdCtrls, ExtCtrls,Global, etherbone, wrdevice_unit;
type
TSendUserdata_Form = class(TForm)
Panel1: TPanel;
Label1: TLabel;
Loop_SpeedButton:TSpeedButton;
Send_SpeedButton: TSpeedButton;
Timer1: TTimer;
DataToWrite_Edit: TEdit;
Label2: TLabel;
Offset_Edit: TEdit;
Label3: TLabel;
RegArd_Edit: TEdit;
Panel2: TPanel;
Send_Label: TLabel;
Adress_Panel: TPanel;
Data_Panel: TPanel;
procedure DataToWrite_EditKeyPress(Sender: TObject; var Key: Char);
procedure RegArd_EditKeyPress(Sender: TObject; var Key: Char);
procedure Offset_EditKeyPress(Sender: TObject; var Key: Char);
procedure Loop_SpeedButtonClick(Sender: TObject);
procedure Send_SpeedButtonClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormShow(Sender: TObject);
function ReadUserInput(var WrPacket:TWrPacket):boolean;
const
Text_Send= 'Sending...';
public
{ Public-Deklarationen }
end;
Var
SendUserdata_Form:TSendUserdata_Form;
implementation
{$R *.dfm}
procedure TSendUserdata_Form.FormShow(Sender: TObject);
begin
Send_Label.Caption:='';
end;
procedure TSendUserdata_Form.Timer1Timer(Sender: TObject);
begin
if(Loop_Speedbutton.Down) or (Send_Speedbutton.Down) then begin
if(Send_Label.Caption = Text_Send) then Send_Label.Caption:=''
else Send_Label.Caption:= Text_Send
end else Send_Label.Caption:='';
Application.ProcessMessages;
end;
// User daten einmal an device senden
procedure TSendUserdata_Form.Send_SpeedButtonClick(Sender: TObject);
var status:string;
WrPacket:TWrPacket;
begin
if(Send_SpeedButton.Down) then begin
if (ReadUserInput(WrPacket)) then begin
// datenanzeigen
Adress_Panel.Caption:= IntToHex(WrPacket.r.Adr,8);
Data_Panel.Caption := IntToHex(WrPacket.r.data,8);
// daten schreiben
if not(myDevice.DeviceCacheWR(myAddress,WrPacket.wpack,status)) then
Application.MessageBox(PChar(status),'Dave? What are you doing?', 16);
myDevice.DeviceCacheSend(status);
end;
Send_SpeedButton.Down:=false;
Send_SpeedButton.Click;
end;
end;
// User daten im loop an die device senden
procedure TSendUserdata_Form.Loop_SpeedButtonClick(Sender: TObject);
var WrPacket:TWrPacket;
status:string;
index:integer;
begin
index:= 0;
if (ReadUserInput(WrPacket)) then begin
// datenanzeigen
Adress_Panel.Caption:= IntToHex(WrPacket.r.Adr,8);
Data_Panel.Caption := IntToHex(WrPacket.r.data,8);
while(Loop_SpeedButton.Down) do begin
index:=index+1;
if (ReadUserInput(WrPacket)) then begin
// daten schreiben
if not(myDevice.DeviceCacheWR(myAddress,WrPacket.wpack,status)) then begin
Application.MessageBox(PChar(status),'Finish Him', 16);
Loop_SpeedButton.Down:=false;
Loop_SpeedButton.Click;
end else myDevice.DeviceCacheSend(status);
end;
if((index mod 100)=0) then begin
index:= 0;
Application.ProcessMessages;
end;
end;
end;
end;
// User daten uebernehem und in das record uebertragen
function TSendUserdata_Form.ReadUserInput(var WrPacket:TWrPacket):boolean;
var offset :LongWord;
ErrFound :boolean;
begin
ErrFound:= false;
while length(Offset_Edit.Text)< 8 do
Offset_Edit.Text:='0'+Offset_Edit.Text;
//Offset uebernehem
try
offset:= StrToInt('$'+ Offset_Edit.Text);
except
Application.MessageBox('This is not a valid hex data', 'You will never win !', 16);
ErrFound:= true;
end;
while length(RegArd_Edit.Text)< 8 do
RegArd_Edit.Text:='0'+RegArd_Edit.Text;
//Adresse uebernehmen
if not(ErrFound) then begin
try
WrPacket.r.Adr:= StrToInt('$'+RegArd_Edit.Text);
except
Application.MessageBox('This is not a valid hex Adress', 'You are false data...', 16);
ErrFound:= true;
end;
end;
while length(DataToWrite_Edit.Text)< 8 do
DataToWrite_Edit.Text:='0'+DataToWrite_Edit.Text;
//Daten uebernehmen
if not(ErrFound) then begin
try
WrPacket.r.data:= StrToInt('$'+ DataToWrite_Edit.Text);
except
Application.MessageBox('This is not a valid hex Adress', 'Let there be light...', 16);
ErrFound:= true;
end;
end;
//Adresse + Offset -> device prefix
if not(ErrFound) then begin
WrPacket.r.Adr:= WrPacket.r.Adr + offset;
end;
ReadUserInput:= not(ErrFound)
end;
procedure TSendUserdata_Form.Offset_EditKeyPress(Sender: TObject;
var Key: Char);
begin
if not(Key in ['0'..'9', 'A'..'F', 'a'..'f'])or (length(Offset_Edit.Text)>= 8) then begin
//Edit_WR_Constant.Text:='0000';
Key:= #0;
end;
end;
procedure TSendUserdata_Form.RegArd_EditKeyPress(Sender: TObject;
var Key: Char);
begin
begin
if not(Key in ['0'..'9', 'A'..'F', 'a'..'f'])or (length(RegArd_Edit.Text)>= 8) then begin
//Edit_WR_Constant.Text:='0000';
Key:= #0;
end;
end;
end;
procedure TSendUserdata_Form.DataToWrite_EditKeyPress(Sender: TObject;
var Key: Char);
begin
begin
if not(Key in ['0'..'9', 'A'..'F', 'a'..'f'])or (length(DataToWrite_Edit.Text) >= 8) then begin
//Edit_WR_Constant.Text:='0000';
Key:= #0;
end;
end;
end;
end.
\ No newline at end of file
GUI/XMLdevice/WR.bdsproj 0 → 100644
View file @ e47be2be
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject>
<PersonalityInfo>
<Option>
<Option Name="Personality">Delphi.Personality</Option>
<Option Name="ProjectType"></Option>
<Option Name="Version">1.0</Option>
<Option Name="GUID">{9F7D8C2C-2DA7-40E2-B9A0-F41948DA895D}</Option>
</Option>
</PersonalityInfo>
<Delphi.Personality>
<Source>
<Source Name="MainSource">WR.dpr</Source>
</Source>
<FileVersion>
<FileVersion Name="Version">7.0</FileVersion>
</FileVersion>
<Compiler>
<Compiler Name="A">8</Compiler>
<Compiler Name="B">0</Compiler>
<Compiler Name="C">1</Compiler>
<Compiler Name="D">1</Compiler>
<Compiler Name="E">0</Compiler>
<Compiler Name="F">0</Compiler>
<Compiler Name="G">1</Compiler>
<Compiler Name="H">1</Compiler>
<Compiler Name="I">1</Compiler>
<Compiler Name="J">0</Compiler>
<Compiler Name="K">0</Compiler>
<Compiler Name="L">1</Compiler>
<Compiler Name="M">0</Compiler>
<Compiler Name="N">1</Compiler>
<Compiler Name="O">1</Compiler>
<Compiler Name="P">1</Compiler>
<Compiler Name="Q">0</Compiler>
<Compiler Name="R">0</Compiler>
<Compiler Name="S">0</Compiler>
<Compiler Name="T">0</Compiler>
<Compiler Name="U">0</Compiler>
<Compiler Name="V">1</Compiler>
<Compiler Name="W">0</Compiler>
<Compiler Name="X">1</Compiler>
<Compiler Name="Y">1</Compiler>
<Compiler Name="Z">1</Compiler>
<Compiler Name="ShowHints">True</Compiler>
<Compiler Name="ShowWarnings">True</Compiler>
<Compiler Name="UnitAliases">WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;</Compiler>
<Compiler Name="NamespacePrefix"></Compiler>
<Compiler Name="GenerateDocumentation">False</Compiler>
<Compiler Name="DefaultNamespace"></Compiler>
<Compiler Name="SymbolDeprecated">True</Compiler>
<Compiler Name="SymbolLibrary">True</Compiler>
<Compiler Name="SymbolPlatform">True</Compiler>
<Compiler Name="SymbolExperimental">True</Compiler>
<Compiler Name="UnitLibrary">True</Compiler>
<Compiler Name="UnitPlatform">True</Compiler>
<Compiler Name="UnitDeprecated">True</Compiler>
<Compiler Name="UnitExperimental">True</Compiler>
<Compiler Name="HResultCompat">True</Compiler>
<Compiler Name="HidingMember">True</Compiler>
<Compiler Name="HiddenVirtual">True</Compiler>
<Compiler Name="Garbage">True</Compiler>
<Compiler Name="BoundsError">True</Compiler>
<Compiler Name="ZeroNilCompat">True</Compiler>
<Compiler Name="StringConstTruncated">True</Compiler>
<Compiler Name="ForLoopVarVarPar">True</Compiler>
<Compiler Name="TypedConstVarPar">True</Compiler>
<Compiler Name="AsgToTypedConst">True</Compiler>
<Compiler Name="CaseLabelRange">True</Compiler>
<Compiler Name="ForVariable">True</Compiler>
<Compiler Name="ConstructingAbstract">True</Compiler>
<Compiler Name="ComparisonFalse">True</Compiler>
<Compiler Name="ComparisonTrue">True</Compiler>
<Compiler Name="ComparingSignedUnsigned">True</Compiler>
<Compiler Name="CombiningSignedUnsigned">True</Compiler>
<Compiler Name="UnsupportedConstruct">True</Compiler>
<Compiler Name="FileOpen">True</Compiler>
<Compiler Name="FileOpenUnitSrc">True</Compiler>
<Compiler Name="BadGlobalSymbol">True</Compiler>
<Compiler Name="DuplicateConstructorDestructor">True</Compiler>
<Compiler Name="InvalidDirective">True</Compiler>
<Compiler Name="PackageNoLink">True</Compiler>
<Compiler Name="PackageThreadVar">True</Compiler>
<Compiler Name="ImplicitImport">True</Compiler>
<Compiler Name="HPPEMITIgnored">True</Compiler>
<Compiler Name="NoRetVal">True</Compiler>
<Compiler Name="UseBeforeDef">True</Compiler>
<Compiler Name="ForLoopVarUndef">True</Compiler>
<Compiler Name="UnitNameMismatch">True</Compiler>
<Compiler Name="NoCFGFileFound">True</Compiler>
<Compiler Name="MessageDirective">True</Compiler>
<Compiler Name="ImplicitVariants">True</Compiler>
<Compiler Name="UnicodeToLocale">True</Compiler>
<Compiler Name="LocaleToUnicode">True</Compiler>
<Compiler Name="ImagebaseMultiple">True</Compiler>
<Compiler Name="SuspiciousTypecast">True</Compiler>
<Compiler Name="PrivatePropAccessor">True</Compiler>
<Compiler Name="UnsafeType">False</Compiler>
<Compiler Name="UnsafeCode">False</Compiler>
<Compiler Name="UnsafeCast">False</Compiler>
<Compiler Name="OptionTruncated">True</Compiler>
<Compiler Name="WideCharReduced">True</Compiler>
<Compiler Name="DuplicatesIgnored">True</Compiler>
</Compiler>
<Linker>
<Linker Name="MapFile">0</Linker>
<Linker Name="OutputObjs">0</Linker>
<Linker Name="ConsoleApp">1</Linker>
<Linker Name="DebugInfo">False</Linker>
<Linker Name="RemoteSymbols">False</Linker>
<Linker Name="GenerateDRC">False</Linker>
<Linker Name="MinStackSize">16384</Linker>
<Linker Name="MaxStackSize">1048576</Linker>
<Linker Name="ImageBase">4194304</Linker>
<Linker Name="ExeDescription"></Linker>
</Linker>
<Directories>
<Directories Name="OutputDir"></Directories>
<Directories Name="UnitOutputDir"></Directories>
<Directories Name="PackageDLLOutputDir"></Directories>
<Directories Name="PackageDCPOutputDir"></Directories>
<Directories Name="SearchPath"></Directories>
<Directories Name="Packages">rtl;vcl;dbrtl;vcldb;vclx;adortl;dbxcds;dbexpress;vclib;ibxpress;IntrawebDB_72_90;Intraweb_72_90;xmlrtl;vclie;inet;inetdbbde;inetdbxpress;IndySystem;IndyCore;dclOfficeXP;VclSmp;soaprtl;dsnap;IndyProtocols;inetdb;bdertl;vcldbx;webdsnap;websnap;vclactnband;vclshlctrls;teeui;teedb;tee;dsnapcon;Rave60VCL</Directories>
<Directories Name="Conditionals"></Directories>
<Directories Name="DebugSourceDirs"></Directories>
<Directories Name="UsePackages">False</Directories>
</Directories>
<Parameters>
<Parameters Name="RunParams"></Parameters>
<Parameters Name="HostApplication"></Parameters>
<Parameters Name="Launcher"></Parameters>
<Parameters Name="UseLauncher">False</Parameters>
<Parameters Name="DebugCWD"></Parameters>
<Parameters Name="RemoteHost"></Parameters>
<Parameters Name="RemotePath"></Parameters>
<Parameters Name="RemoteLauncher"></Parameters>
<Parameters Name="RemoteCWD"></Parameters>
<Parameters Name="RemoteDebug">False</Parameters>
</Parameters>
<Language>
<Language Name="ActiveLang"></Language>
<Language Name="ProjectLang">$00000000</Language>
<Language Name="RootDir"></Language>
</Language>
<VersionInfo>
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">1</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">0</VersionInfo>
<VersionInfo Name="Build">0</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
<VersionInfo Name="Special">False</VersionInfo>
<VersionInfo Name="Private">False</VersionInfo>
<VersionInfo Name="DLL">False</VersionInfo>
<VersionInfo Name="Locale">1031</VersionInfo>
<VersionInfo Name="CodePage">1252</VersionInfo>
</VersionInfo>
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName"></VersionInfoKeys>
<VersionInfoKeys Name="FileDescription"></VersionInfoKeys>
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="InternalName"></VersionInfoKeys>
<VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys>
<VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
<VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys>
<VersionInfoKeys Name="ProductName"></VersionInfoKeys>
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments"></VersionInfoKeys>
</VersionInfoKeys>
</Delphi.Personality>
</BorlandProject>
GUI/XMLdevice/WR.bdsproj.local 0 → 100644
View file @ e47be2be
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject>
<Transactions>
<Transaction>2011.04.01 12:19:06.708.pas,E:\Documents and Settings\localadmin\My Documents\Borland Studio-Projekte\Unit1.pas=F:\Projekte\Timing\xml\whiterabbit\XMLdevice\XML_WR.pas</Transaction>
<Transaction>2011.04.01 12:19:06.708.dfm,E:\Documents and Settings\localadmin\My Documents\Borland Studio-Projekte\Unit1.dfm=F:\Projekte\Timing\xml\whiterabbit\XMLdevice\XML_WR.dfm</Transaction>
<Transaction>2011.04.04 09:14:45.590.pas,F:\Projekte\Timing\xml\whiterabbit\XMLdevice\Unit1.pas=F:\Projekte\Timing\xml\whiterabbit\XMLdevice\device_unit.pas</Transaction>
<Transaction>2011.04.04 12:02:24.754.pas,F:\Projekte\Timing\xml\whiterabbit\XMLdevice\device_unit.pas=F:\Projekte\Timing\xml\whiterabbit\XMLdevice\wrdevice_unit.pas</Transaction>
<Transaction>2011.04.04 16:05:21.523.pas,F:\Projekte\Timing\xml\whiterabbit\XMLdevice\Unit2.pas=F:\Projekte\Timing\xml\whiterabbit\XMLdevice\device_setup.pas</Transaction>
<Transaction>2011.04.04 16:05:21.523.dfm,F:\Projekte\Timing\xml\whiterabbit\XMLdevice\Unit2.dfm=F:\Projekte\Timing\xml\whiterabbit\XMLdevice\device_setup.dfm</Transaction>
<Transaction>2011.04.04 16:34:13.557.pas,F:\Projekte\Timing\xml\whiterabbit\XMLdevice\Unit1.pas=F:\Projekte\Timing\xml\whiterabbit\XMLdevice\Global.pas</Transaction>
<Transaction>2011.04.05 08:57:37.062.pas,F:\Projekte\Timing\xml\whiterabbit\XMLdevice\Unit2.pas=F:\Projekte\Timing\xml\whiterabbit\XMLdevice\UserSendData.pas</Transaction>
<Transaction>2011.04.05 08:57:37.062.dfm,F:\Projekte\Timing\xml\whiterabbit\XMLdevice\Unit2.dfm=F:\Projekte\Timing\xml\whiterabbit\XMLdevice\UserSendData.dfm</Transaction>
<Transaction>2011.04.06 13:59:40.907.pas,F:\Projekte\Timing\xml\whiterabbit\XMLdevice\UserSendData.pas=</Transaction>
<Transaction>2011.04.06 13:59:40.907.dfm,F:\Projekte\Timing\xml\whiterabbit\XMLdevice\UserSendData.dfm=</Transaction>
</Transactions>
</BorlandProject>
GUI/XMLdevice/WR.cfg 0 → 100644
View file @ e47be2be
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-LE"E:\Documents and Settings\localadmin\My Documents\Borland Studio-Projekte\Bpl"
-LN"E:\Documents and Settings\localadmin\My Documents\Borland Studio-Projekte\Bpl"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST
GUI/XMLdevice/WR.dpr 0 → 100644
View file @ e47be2be
program WR;
uses
Forms,
XML_WR in 'XML_WR.pas' {Form1},
wrdevice_unit in 'wrdevice_unit.pas',
etherbone in '..\..\..\etherbone-core\api\etherbone.pas',
device_setup in 'device_setup.pas' {DevSet_Form},
Global in 'Global.pas',
UserSendData in 'UserSendData.pas';
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TDevSet_Form, DevSet_Form);
Application.Run;
end.
GUI/XMLdevice/XML_WR.dfm 0 → 100644
View file @ e47be2be
object Form1: TForm1
Left = 0
Top = 0
Width = 512
Height = 601
AutoSize = True
Caption = 'whiterabbit'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Tahoma'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 19
object Panel1: TPanel
Left = 0
Top = 0
Width = 353
Height = 385
BevelInner = bvLowered
TabOrder = 0
object Label1: TLabel
Left = 16
Top = 7
Width = 66
Height = 19
Caption = 'XML Tree'
end
object TreeView1: TTreeView
Left = 15
Top = 31
Width = 313
Height = 338
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = []
Indent = 19
ParentFont = False
TabOrder = 0
end
end
object Panel2: TPanel
Left = 0
Top = 384
Width = 504
Height = 163
BevelInner = bvLowered
TabOrder = 1
object messages_ListBox: TListBox
Left = 8
Top = 8
Width = 487
Height = 129
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = []
ItemHeight = 18
ParentFont = False
TabOrder = 0
end
object Clear_Button: TButton
Left = 429
Top = 140
Width = 65
Height = 17
Caption = 'Clear'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
TabOrder = 1
OnClick = Clear_ButtonClick
end
end
object Panel3: TPanel
Left = 351
Top = 0
Width = 153
Height = 385
BevelInner = bvLowered
TabOrder = 2
object Panel4: TPanel
Left = 0
Top = 0
Width = 153
Height = 49
BevelInner = bvLowered
TabOrder = 0
object Label2: TLabel
Left = 8
Top = 13
Width = 91
Height = 19
Caption = 'Device active'
end
object DeviceActiv_Shape: TShape
Left = 108
Top = 11
Width = 33
Height = 25
Brush.Color = clRed
Shape = stCircle
end
end
object Panel5: TPanel
Left = 0
Top = 102
Width = 153
Height = 122
BevelInner = bvLowered
TabOrder = 1
object Label3: TLabel
Left = 8
Top = 8
Width = 46
Height = 19
Caption = 'Device'
end
object SendData_Button: TButton
Left = 23
Top = 39
Width = 105
Height = 25
Caption = 'Send Data'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
end
object Button1: TButton
Left = 24
Top = 80
Width = 105
Height = 25
Caption = 'Read Data'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 1
OnClick = Button1Click
end
end
object Panel6: TPanel
Left = 0
Top = 47
Width = 153
Height = 57
BevelInner = bvLowered
TabOrder = 2
object ShowXML_Button: TButton
Left = 23
Top = 16
Width = 105
Height = 25
Caption = 'Analyse XML'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
end
end
end
object Timer1: TTimer
Interval = 100
OnTimer = Timer1Timer
Left = 360
Top = 232
end
object OpenDialog1: TOpenDialog
Left = 360
Top = 264
end
object MainMenu1: TMainMenu
Left = 360
Top = 296
object D1: TMenuItem
Caption = 'Datei'
object XMLLaden1: TMenuItem
Caption = 'XML-Laden'
end
object Exit1: TMenuItem
Caption = 'Exit'
end
end
object Device1: TMenuItem
Caption = 'Device'
object Setup1: TMenuItem
Caption = 'Setup'
OnClick = Setup1Click
end
object ConnectDevice1: TMenuItem
Caption = 'Connect Device'
OnClick = ConnectDevice1Click
end
object DisconnectDevice1: TMenuItem
Caption = 'Disconnect Device'
OnClick = DisconnectDevice1Click
end
end
object Extras1: TMenuItem
Caption = 'Extras'
object SendManual1: TMenuItem
Caption = 'Send Manual'
OnClick = SendManual1Click
end
end
end
object XMLDocument1: TXMLDocument
Left = 360
Top = 336
DOMVendorDesc = 'MSXML'
end
end
GUI/XMLdevice/XML_WR.pas 0 → 100644
View file @ e47be2be
unit XML_WR;
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;
type
TForm1 = class(TForm)
Panel1: TPanel;
TreeView1: TTreeView;
Label1: TLabel;
Panel2: TPanel;
messages_ListBox: TListBox;
Clear_Button: TButton;
Panel3: TPanel;
Panel4: TPanel;
Label2: TLabel;
DeviceActiv_Shape: TShape;
Panel5: TPanel;
SendData_Button: TButton;
Button1: TButton;
Panel6: TPanel;
ShowXML_Button: TButton;
Label3: TLabel;
Timer1: TTimer;
OpenDialog1: TOpenDialog;
MainMenu1: TMainMenu;
D1: TMenuItem;
XMLLaden1: TMenuItem;
Exit1: TMenuItem;
Device1: TMenuItem;
ConnectDevice1: TMenuItem;
DisconnectDevice1: TMenuItem;
Setup1: TMenuItem;
XMLDocument1: TXMLDocument;
Extras1: TMenuItem;
SendManual1: TMenuItem;
procedure SendManual1Click(Sender: TObject);
procedure Button1Click(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 Clear_ButtonClick(Sender: TObject);
procedure DisconnectDevice1Click(Sender: TObject);
procedure ConnectDevice1Click(Sender: TObject);
procedure Setup1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1 :TForm1;
myStatus :string;
implementation
{$R *.dfm}
procedure myCallback(var user: eb_user_data_t; var status: eb_status_t; var data:eb_data_t );
begin
Form1.messages_ListBox.Items.Add('Data receive: '+IntToHex(data,32));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
myDevice:= Twrdevice.Create;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
myDevice.DeviceClose(myStatus);
myDevice.Free;
end;
procedure TForm1.Setup1Click(Sender: TObject);
begin
DevSet_Form.Show;
end;
procedure TForm1.ConnectDevice1Click(Sender: TObject);
begin
messages_ListBox.Items.Add('Try to Open: '+ myDNSAdress+
' Port:'+IntTohex(myAddress,4));
if(myDevice.DeviceOpen(Pchar(myDNSAdress), myAddress, myStatus)) then
DeviceActiv_Shape.Brush.Color:=clLime
else DeviceActiv_Shape.Brush.Color:=clRed;
messages_ListBox.Items.Add('Device Open: '+myStatus);
end;
procedure TForm1.DisconnectDevice1Click(Sender: TObject);
begin
if(myDevice.DeviceClose(myStatus)) then
DeviceActiv_Shape.Brush.Color:= clRed
else DeviceActiv_Shape.Brush.Color:=clYellow;
messages_ListBox.Items.Add('Device Close: '+myStatus);
end;
procedure TForm1.Clear_ButtonClick(Sender: TObject);
begin
messages_ListBox.Items.Clear;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
myDevice.DevicePoll();
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not(myDevice.DeviceRead(@myCallback, myAddress, myStatus)) then
messages_ListBox.Items.Add('Device Read: '+myStatus);
end;
procedure TForm1.SendManual1Click(Sender: TObject);
begin
SendUserdata_Form.Show();
end;
end.
GUI/XMLdevice/device_setup.dfm 0 → 100644
View file @ e47be2be
object DevSet_Form: TDevSet_Form
Left = 0
Top = 0
Width = 329
Height = 251
AutoSize = True
Caption = 'Device Setup'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 18
object Panel1: TPanel
Left = 0
Top = 0
Width = 321
Height = 161
BevelInner = bvLowered
TabOrder = 0
object Label1: TLabel
Left = 24
Top = 16
Width = 92
Height = 18
Caption = 'Device Adress'
end
object Label2: TLabel
Left = 24
Top = 80
Width = 87
Height = 18
Caption = 'Port Nr.(hex)'
end
object DevAdr_Edit: TEdit
Left = 24
Top = 37
Width = 265
Height = 26
TabOrder = 0
end
object PortNr_Edit: TEdit
Left = 24
Top = 104
Width = 265
Height = 26
TabOrder = 1
end
end
object OK: TButton
Left = 96
Top = 168
Width = 145
Height = 49
Caption = 'OK'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -15
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 1
OnClick = OKClick
end
end
GUI/XMLdevice/device_setup.pas 0 → 100644
View file @ e47be2be
unit device_setup;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls,etherbone, Global;
type
TDevSet_Form = class(TForm)
Panel1: TPanel;
DevAdr_Edit: TEdit;
Label1: TLabel;
Label2: TLabel;
PortNr_Edit: TEdit;
OK: TButton;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure OKClick(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
DevSet_Form: TDevSet_Form;
implementation
{$R *.dfm}
procedure TDevSet_Form.OKClick(Sender: TObject);
var error:boolean;
begin
error:= false;
myDNSAdress:= DevAdr_Edit.Text;
try
myAddress := StrToInt('$'+ PortNr_Edit.Text);
except
Application.MessageBox('This is not a valid hex-adress', 'So What ?', 16);
error:= true;
end;
if not (error) then DevSet_Form.Close;
end;
procedure TDevSet_Form.FormShow(Sender: TObject);
begin
DevAdr_Edit.Text:= myDNSAdress;
PortNr_Edit.Text:= IntToHex(myAddress, 4);
end;
procedure TDevSet_Form.FormCreate(Sender: TObject);
begin
DevAdr_Edit.Text:= First_DNSAdress;
PortNr_Edit.Text:= First_PortNumber;
myDNSAdress:= First_DNSAdress;
myAddress := StrToInt('$'+ First_PortNumber);
end;
end.
GUI/XMLdevice/device_unit.pas 0 → 100644
View file @ e47be2be
unit device_unit;
interface
implementation
end.
GUI/XMLdevice/wrdevice_unit.pas 0 → 100644
View file @ e47be2be
unit wrdevice_unit;
interface
uses etherbone,SysUtils,StdCtrls;
type
Twrdevice = class
constructor Create;
function DeviceOpen(netaddress:eb_network_address_t;address :eb_address_t;var status:string):boolean;
function DeviceClose(var status:string):boolean;
function DeviceCacheWR(address :eb_address_t;data: eb_data_t;var status:string):boolean;
function DeviceCacheSend(var status:string):boolean;
function DeviceRead(cb:eb_read_callback_t;address :eb_address_t;var status:string):boolean;
procedure DevicePoll();
private
IsDeviceOpen:boolean;
socket :eb_socket_t;
device :eb_device_t;
public
end;
implementation
var my_status: eb_status;
constructor Twrdevice.Create;
begin
inherited;
IsDeviceOpen:=false;
end;
function Twrdevice.DeviceOpen(netaddress:eb_network_address_t;address :eb_address_t;var status:string):boolean;
begin
if not (IsDeviceOpen) then begin
IsDeviceOpen:= true;
// eb socket oeffnen
my_status:=eb_socket_open(0, 0, @socket);
if(my_status<> EB_OK) then begin
status:='ERROR: Failed to open Etherbone socket';
IsDeviceOpen:=false;
end else status:='Open Etherbone socket successful';
// etherbone device oeffnen
if(IsDeviceOpen) then begin
my_status:= eb_device_open(socket, netaddress, EB_DATAX, @device);
if(my_status<> EB_OK) then begin
status:='ERROR: Failed to open Etherbone device';
IsDeviceOpen:=false;
end else status:= 'Open Etherbone device successful';
end;
end;
DeviceOpen:= IsDeviceOpen;
end;
function Twrdevice.DeviceClose(var status:string):boolean;
var my_status:eb_status ;
begin
if(IsDeviceOpen) then begin
// etherbone device schliessen
my_status:= eb_device_close(device);
if(my_status<> EB_OK) then status:= 'ERROR: Failed to close Etherbone device'
else begin
status:='Close Etherbone device successful';
IsDeviceOpen:=false;
end;
// eb socket schliesen
my_status:= eb_socket_close(socket);
if(my_status<> EB_OK) then status:='ERROR: Failed to close Etherbone socket'
else begin
status:='Close Etherbone socket successful';
IsDeviceOpen:=false;
end;
end else status:='Nothing to close here';
DeviceClose:= not(IsDeviceOpen);
end;
function Twrdevice.DeviceCacheWR(address :eb_address_t;data: eb_data_t;var status:string):boolean;
begin
if(IsDeviceOpen) then begin
// daten schreiben
eb_device_write(device, address, data);
eb_device_flush(device);
status:='Data sending:'+IntToHex(data,32);
DeviceCacheWR:= true;
end else begin
status:='ERROR: Device/socket not open yet';
DeviceCacheWR:= false;
end;
end;
function Twrdevice.DeviceCacheSend(var status:string):boolean;
begin
DeviceCacheSend:=false;
if(IsDeviceOpen) then begin
eb_device_flush(device);
status:= 'The Cache is gone';
DeviceCacheSend:=true;
end else status:= 'ERROR: Device/socket not open yet fool';
end;
function Twrdevice.DeviceRead(cb:eb_read_callback_t;address :eb_address_t;var status:string):boolean;
var stop:integer;
begin
DeviceRead:=false;
if(IsDeviceOpen) then begin
eb_device_read(device, address, @stop, cb);
eb_device_flush(device);
DeviceRead:= true;
end else status:='ERROR: Device/socket not open, buddy';
end;
procedure Twrdevice.DevicePoll();
begin
if(IsDeviceOpen) then eb_socket_poll(socket);
end;
end.
api/etherbone.pas
View file @ e47be2be
// Copyright (C) 2011
// GSI Helmholtzzentrum fr Schwerionenforschung GmbH
//
// Author: Wesley W. Terpstra <w.terpstra@gsi.de>
// converted in Delphi: M.Zweig
// not everything was converted
unit etherbone;
interface
......@@ -53,13 +60,14 @@ EB_DATAX =$f;
// Callback types
type eb_user_data_t = Pointer;
type eb_read_callback_t = procedure(var user: eb_user_data_t;
type eb_read_callback_t =procedure (var user: eb_user_data_t;
var status: eb_status_t;
result:eb_data_t );cdecl;
var result:eb_data_t );cdecl;
type b_cycle_callback_t = procedure(var user: eb_user_data_t;
var status: eb_status_t;
result:eb_data_t );cdecl;
var result:eb_data_t );cdecl;
//todo:
{ Handler descriptor */
......
api/src/Unit1.dfm
View file @ e47be2be
object Form1: TForm1
Left = 0
Top = 0
Width = 655
Height = 409
Width = 816
Height = 428
Caption = 'first etherbone test'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
......@@ -11,92 +11,153 @@ object Form1: TForm1
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 19
object Label1: TLabel
Left = 16
object Label6: TLabel
Left = 299
Top = 8
Width = 48
Width = 127
Height = 19
Caption = 'Adress'
end
object Label2: TLabel
Left = 16
Top = 72
Width = 67
Height = 19
Caption = 'Port Nr. :'
end
object Label3: TLabel
Left = 16
Top = 144
Width = 102
Height = 19
Caption = 'Data to write :'
end
object Lampe_Shape: TShape
Left = 112
Top = 272
Width = 33
Height = 25
Brush.Color = clRed
Shape = stCircle
Caption = 'System Messages'
end
object sysmessage_ListBox: TListBox
Left = 192
Top = 5
Width = 441
Left = 301
Top = 29
Width = 492
Height = 353
ItemHeight = 19
TabOrder = 0
end
object Button1: TButton
Left = 16
Top = 200
Width = 89
Height = 25
Caption = 'Send'
object Panel1: TPanel
Left = -1
Top = 230
Width = 290
Height = 90
BevelInner = bvLowered
TabOrder = 1
OnClick = Button1Click
object Label3: TLabel
Left = 8
Top = 14
Width = 133
Height = 19
Caption = 'Data to write (hex)'
end
object DataToWrite_Edit: TEdit
Left = 8
Top = 38
Width = 145
Height = 27
TabOrder = 0
end
object Button1: TButton
Left = 168
Top = 38
Width = 89
Height = 25
Caption = 'Send'
TabOrder = 1
OnClick = Button1Click
end
end
object Adress_Edit: TEdit
Left = 16
Top = 32
Width = 161
Height = 27
object Panel2: TPanel
Left = 0
Top = 127
Width = 289
Height = 105
BevelInner = bvLowered
TabOrder = 2
object Lampe_Shape: TShape
Left = 165
Top = 39
Width = 33
Height = 25
Brush.Color = clRed
Shape = stCircle
end
object Label4: TLabel
Left = 200
Top = 41
Width = 43
Height = 19
Caption = 'Status'
end
object Open_Button: TButton
Left = 8
Top = 20
Width = 113
Height = 25
Caption = 'Open Device'
TabOrder = 0
OnClick = Open_ButtonClick
end
object Close_Button: TButton
Left = 8
Top = 60
Width = 113
Height = 25
Caption = 'Close Device'
TabOrder = 1
OnClick = Close_ButtonClick
end
end
object Port_Edit: TEdit
Left = 16
Top = 96
Width = 145
Height = 27
object Panel3: TPanel
Left = 0
Top = 0
Width = 289
Height = 129
BevelInner = bvLowered
TabOrder = 3
object Label1: TLabel
Left = 16
Top = 8
Width = 99
Height = 19
Caption = 'Device Adress'
end
object Label2: TLabel
Left = 16
Top = 70
Width = 98
Height = 19
Caption = 'Port Nr. (hex)'
end
object Adress_Edit: TEdit
Left = 16
Top = 32
Width = 257
Height = 27
TabOrder = 0
end
object Port_Edit: TEdit
Left = 16
Top = 90
Width = 153
Height = 27
TabOrder = 1
end
end
object DataToWrite_Edit: TEdit
Left = 16
Top = 168
Width = 145
Height = 27
object Panel4: TPanel
Left = -1
Top = 318
Width = 290
Height = 65
BevelInner = bvLowered
TabOrder = 4
object Read_Button: TButton
Left = 106
Top = 20
Width = 89
Height = 25
Caption = 'Read Data'
TabOrder = 0
OnClick = Read_ButtonClick
end
end
object Open_Button: TButton
Left = 16
Top = 272
Width = 81
Height = 25
Caption = 'Open'
TabOrder = 5
OnClick = Open_ButtonClick
end
object Close_Button: TButton
Left = 16
Top = 312
Width = 81
Height = 25
Caption = 'Close'
TabOrder = 6
OnClick = Close_ButtonClick
object CallBack: TTimer
Interval = 100
OnTimer = CallBackTimer
Left = 608
end
end
api/src/Unit1.pas
View file @ e47be2be
......@@ -9,16 +9,27 @@ uses
type
TForm1 = class(TForm)
sysmessage_ListBox: TListBox;
Button1: TButton;
Adress_Edit: TEdit;
Port_Edit: TEdit;
Label1: TLabel;
Label2: TLabel;
Panel1: TPanel;
Label3: TLabel;
DataToWrite_Edit: TEdit;
Button1: TButton;
Panel2: TPanel;
Open_Button: TButton;
Close_Button: TButton;
Lampe_Shape: TShape;
Panel3: TPanel;
Label1: TLabel;
Adress_Edit: TEdit;
Label2: TLabel;
Port_Edit: TEdit;
Label4: TLabel;
Panel4: TPanel;
Read_Button: TButton;
Label6: TLabel;
CallBack: TTimer;
procedure CallBackTimer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Read_ButtonClick(Sender: TObject);
procedure Close_ButtonClick(Sender: TObject);
procedure Open_ButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
......@@ -34,14 +45,27 @@ type
var
Form1: TForm1;
socket :eb_socket_t;
device :eb_device_t;
address :eb_address_t;
socket :eb_socket_t;
device :eb_device_t;
address :eb_address_t;
device_open: boolean;
implementation
{$R *.dfm}
procedure set_stop(var user: eb_user_data_t; var status: eb_status_t; var data:eb_data_t );
begin
Form1.sysmessage_ListBox.Items.Add('Data receive: '+IntToHex(data,32));
end;
procedure test(myCallback:eb_read_callback_t);
begin
Form1.sysmessage_ListBox.Items.Add('Super');
end;
procedure TForm1.Button1Click(Sender: TObject);
var
......@@ -52,14 +76,20 @@ var
stop:integer;
begin
data:= StrToInt('$'+ DataToWrite_Edit.Text);
if(device_open) then begin
// daten schreiben
eb_device_write(device, address, data);
eb_device_flush(device);
try
data:= StrToInt('$'+ DataToWrite_Edit.Text);
except
data:=0;
end;
sysmessage_ListBox.Items.Add('Data sending:'+IntToHex(data,32));
// daten schreiben
eb_device_write(device, address, data);
eb_device_flush(device);
sysmessage_ListBox.Items.Add('Data sending:'+IntToHex(data,32));
end else sysmessage_ListBox.Items.Add('Device/socket not open yet');
end;
procedure TForm1.FormCreate(Sender: TObject);
......@@ -71,6 +101,8 @@ begin
socket:=0;
device:=0;
device_open:=false;
Lampe_Shape.Brush.Color:=clRed;
end;
......@@ -85,45 +117,82 @@ var
stop:integer;
begin
netaddress:= PChar(Adress_Edit.Text);
address:= StrToInt('$'+ Port_Edit.Text);
Lampe_Shape.Brush.Color:=clLime;
// eb socket oeffnen
status:=eb_socket_open(0, 0, @socket);
if(status<> EB_OK) then begin
sysmessage_ListBox.Items.Add('ERROR: Failed to open Etherbone socket');
Lampe_Shape.Brush.Color:=clRed;
end else sysmessage_ListBox.Items.Add('Open Etherbone socket successful');
// etherbone device oeffnen
status:= eb_device_open(socket, netaddress, EB_DATAX, @device);
if(status<> EB_OK) then begin
sysmessage_ListBox.Items.Add('ERROR: Failed to open Etherbone device');
Lampe_Shape.Brush.Color:=clRed;
end else sysmessage_ListBox.Items.Add('Open Etherbone device successful');
if not(device_open)then begin
netaddress:= PChar(Adress_Edit.Text);
address:= StrToInt('$'+ Port_Edit.Text);
Lampe_Shape.Brush.Color:=clLime;
device_open:= true;
// eb socket oeffnen
status:=eb_socket_open(0, 0, @socket);
if(status<> EB_OK) then begin
sysmessage_ListBox.Items.Add('ERROR: Failed to open Etherbone socket');
Lampe_Shape.Brush.Color:=clRed;
device_open:=false;
end else sysmessage_ListBox.Items.Add('Open Etherbone socket successful');
// etherbone device oeffnen
if(device_open) then begin
status:= eb_device_open(socket, netaddress, EB_DATAX, @device);
if(status<> EB_OK) then begin
sysmessage_ListBox.Items.Add('ERROR: Failed to open Etherbone device');
Lampe_Shape.Brush.Color:=clRed;
device_open:=false;
end else sysmessage_ListBox.Items.Add('Open Etherbone device successful');
end;
end else sysmessage_ListBox.Items.Add('Device/socket allready open');
end;
procedure TForm1.Close_ButtonClick(Sender: TObject);
var status :eb_status ;
var status:eb_status ;
begin
if(device_open) then begin
// etherbone device schliessen
status:= eb_device_close(device);
if(status<> EB_OK) then sysmessage_ListBox.Items.Add('ERROR: Failed to close Etherbone device')
else begin
sysmessage_ListBox.Items.Add('Close Etherbone device successful');
device_open:=false;
Lampe_Shape.Brush.Color:=clRed;
end;
// eb socket schliesen
status:= eb_socket_close(socket);
if(status<> EB_OK) then sysmessage_ListBox.Items.Add('ERROR: Failed to close Etherbone socket')
else begin
sysmessage_ListBox.Items.Add('Close Etherbone socket successful');
device_open:=false;
Lampe_Shape.Brush.Color:=clRed;
end;
end else sysmessage_ListBox.Items.Add('Nothing to close here');
end;
procedure TForm1.Read_ButtonClick(Sender: TObject);
var stop:integer;
begin
if(device_open) then begin
eb_device_read(device, address, @stop, @set_stop);
// eb_device_read(device, address, @stop, @test);
eb_device_flush(device);
end else sysmessage_ListBox.Items.Add('Device/socket not open, buddy');
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Form1.Close_Button.Click;
end;
procedure TForm1.CallBackTimer(Sender: TObject);
begin
// etherbone device schliessen
status:= eb_device_close(device);
if(status<> EB_OK) then begin
sysmessage_ListBox.Items.Add('ERROR: Failed to close Etherbone device');
Lampe_Shape.Brush.Color:=clRed;
end else sysmessage_ListBox.Items.Add('Close Etherbone device successful');
// eb socket schliesen
status:= eb_socket_close(socket);
if(status<> EB_OK) then begin
sysmessage_ListBox.Items.Add('ERROR: Failed to close Etherbone socket');
Lampe_Shape.Brush.Color:=clRed;
end else sysmessage_ListBox.Items.Add('Close Etherbone socket successful')
if(device_open) then eb_socket_poll(socket);
end;
end.
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