This commit is contained in:
f1iwq2
2020-02-21 17:02:10 +01:00
parent dec80cafac
commit 107aa92290
24 changed files with 1264 additions and 519 deletions

View File

@@ -12,7 +12,7 @@
-$L+ -$L+
-$M- -$M-
-$N+ -$N+
-$O- -$O+
-$P+ -$P+
-$Q- -$Q-
-$R- -$R-
@@ -33,10 +33,3 @@
-K$00400000 -K$00400000
-LE"c:\program files (x86)\borland\delphi7\Projects\Bpl" -LE"c:\program files (x86)\borland\delphi7\Projects\Bpl"
-LN"c:\program files (x86)\borland\delphi7\Projects\Bpl" -LN"c:\program files (x86)\borland\delphi7\Projects\Bpl"
-U"c:\program files (x86)\borland\delphi7\Lib\Debug"
-O"c:\program files (x86)\borland\delphi7\Lib\Debug"
-I"c:\program files (x86)\borland\delphi7\Lib\Debug"
-R"c:\program files (x86)\borland\delphi7\Lib\Debug"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

View File

@@ -15,7 +15,7 @@ K=0
L=1 L=1
M=0 M=0
N=1 N=1
O=0 O=1
P=1 P=1
Q=0 Q=0
R=0 R=0
@@ -76,9 +76,9 @@ LocaleToUnicode=1
ImagebaseMultiple=1 ImagebaseMultiple=1
SuspiciousTypecast=1 SuspiciousTypecast=1
PrivatePropAccessor=1 PrivatePropAccessor=1
UnsafeType=0 UnsafeType=1
UnsafeCode=0 UnsafeCode=1
UnsafeCast=0 UnsafeCast=1
[Linker] [Linker]
MapFile=0 MapFile=0
OutputObjs=0 OutputObjs=0
@@ -94,8 +94,8 @@ OutputDir=
UnitOutputDir= UnitOutputDir=
PackageDLLOutputDir= PackageDLLOutputDir=
PackageDCPOutputDir= PackageDCPOutputDir=
SearchPath=$(DELPHI)\Lib\Debug SearchPath=
Packages=vcl;rtl;vclx;VclSmp;vclshlctrls Packages=
Conditionals= Conditionals=
DebugSourceDirs= DebugSourceDirs=
UsePackages=0 UsePackages=0
@@ -107,7 +107,7 @@ UseLauncher=0
DebugCWD= DebugCWD=
[Version Info] [Version Info]
IncludeVerInfo=1 IncludeVerInfo=1
AutoIncBuild=1 AutoIncBuild=0
MajorVer=1 MajorVer=1
MinorVer=0 MinorVer=0
Release=0 Release=0
@@ -130,9 +130,3 @@ OriginalFilename=
ProductName= ProductName=
ProductVersion=1.0.0.0 ProductVersion=1.0.0.0
Comments= Comments=
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[HistoryLists\hlSearchPath]
Count=1
Item0=$(DELPHI)\Lib\Debug

View File

@@ -6,7 +6,9 @@ uses
UnitDebug in 'UnitDebug.pas' {FormDebug}, UnitDebug in 'UnitDebug.pas' {FormDebug},
verif_version in 'verif_version.pas' {FormVersion}, verif_version in 'verif_version.pas' {FormVersion},
UnitPilote in 'UnitPilote.pas' {FormPilote}, UnitPilote in 'UnitPilote.pas' {FormPilote},
UnitSimule in 'UnitSimule.pas' {FormSimulation}; UnitSimule in 'UnitSimule.pas' {FormSimulation},
UnitTCO in 'UnitTCO.pas' {FormTCO},
listeusb in 'listeusb.pas';
{$R *.res} {$R *.res}
@@ -16,5 +18,6 @@ begin
Application.CreateForm(TFormDebug, FormDebug); Application.CreateForm(TFormDebug, FormDebug);
Application.CreateForm(TFormPilote, FormPilote); Application.CreateForm(TFormPilote, FormPilote);
Application.CreateForm(TFormSimulation, FormSimulation); Application.CreateForm(TFormSimulation, FormSimulation);
Application.CreateForm(TFormTCO, FormTCO);
Application.Run; Application.Run;
end. end.

Binary file not shown.

View File

@@ -1,6 +1,6 @@
object FormDebug: TFormDebug object FormDebug: TFormDebug
Left = 509 Left = 302
Top = 108 Top = 166
BorderStyle = bsSingle BorderStyle = bsSingle
Caption = 'Fen'#234'tre de d'#233'bug' Caption = 'Fen'#234'tre de d'#233'bug'
ClientHeight = 639 ClientHeight = 639
@@ -19,8 +19,8 @@ object FormDebug: TFormDebug
PixelsPerInch = 96 PixelsPerInch = 96
TextHeight = 13 TextHeight = 13
object Label1: TLabel object Label1: TLabel
Left = 456 Left = 464
Top = 36 Top = 28
Width = 108 Width = 108
Height = 13 Height = 13
Caption = 'Niveau du Debug (0-3)' Caption = 'Niveau du Debug (0-3)'
@@ -64,8 +64,8 @@ object FormDebug: TFormDebug
WordWrap = True WordWrap = True
end end
object EditNivDebug: TEdit object EditNivDebug: TEdit
Left = 576 Left = 592
Top = 36 Top = 20
Width = 73 Width = 73
Height = 21 Height = 21
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
@@ -117,7 +117,7 @@ object FormDebug: TFormDebug
end end
object CheckAffSig: TCheckBox object CheckAffSig: TCheckBox
Left = 448 Left = 448
Top = 64 Top = 48
Width = 297 Width = 297
Height = 17 Height = 17
Caption = 'Affichage du fonctionnement des signaux' Caption = 'Affichage du fonctionnement des signaux'
@@ -176,10 +176,11 @@ object FormDebug: TFormDebug
end end
object CheckAffAffecTrains: TCheckBox object CheckAffAffecTrains: TCheckBox
Left = 448 Left = 448
Top = 88 Top = 64
Width = 289 Width = 289
Height = 17 Height = 17
Caption = 'Affichage d'#39'affectation des trains aux d'#233'tecteurs' Caption = 'Affichage d'#39'affectation des trains aux d'#233'tecteurs'
Enabled = False
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack Font.Color = clBlack
Font.Height = -11 Font.Height = -11
@@ -191,7 +192,7 @@ object FormDebug: TFormDebug
end end
object CheckBoxTraceLIste: TCheckBox object CheckBoxTraceLIste: TCheckBox
Left = 448 Left = 448
Top = 112 Top = 80
Width = 289 Width = 289
Height = 17 Height = 17
Caption = 'Affichage des '#233'valuations des routes' Caption = 'Affichage des '#233'valuations des routes'
@@ -204,8 +205,33 @@ object FormDebug: TFormDebug
TabOrder = 10 TabOrder = 10
OnClick = CheckBoxTraceLIsteClick OnClick = CheckBoxTraceLIsteClick
end end
object SaveDialog: TSaveDialog object CheckTrame: TCheckBox
Left = 464 Left = 448
Top = 96
Width = 281
Height = 17
Caption = 'Affichage des trames '#233'chang'#233'es avec LENZ'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
TabOrder = 11
OnClick = CheckTrameClick
end
object ButtonCop: TButton
Left = 448
Top = 384 Top = 384
Width = 97
Height = 49
Caption = 'Copie fen'#234'te principale dans debug'
TabOrder = 12
WordWrap = True
OnClick = ButtonCopClick
end
object SaveDialog: TSaveDialog
Left = 680
Top = 8
end end
end end

View File

@@ -23,6 +23,8 @@ type
ButtonAffEvtChrono: TButton; ButtonAffEvtChrono: TButton;
CheckAffAffecTrains: TCheckBox; CheckAffAffecTrains: TCheckBox;
CheckBoxTraceLIste: TCheckBox; CheckBoxTraceLIste: TCheckBox;
CheckTrame: TCheckBox;
ButtonCop: TButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure ButtonEcrLogClick(Sender: TObject); procedure ButtonEcrLogClick(Sender: TObject);
@@ -33,6 +35,8 @@ type
procedure ButtonAffEvtChronoClick(Sender: TObject); procedure ButtonAffEvtChronoClick(Sender: TObject);
procedure CheckAffAffecTrainsClick(Sender: TObject); procedure CheckAffAffecTrainsClick(Sender: TObject);
procedure CheckBoxTraceLIsteClick(Sender: TObject); procedure CheckBoxTraceLIsteClick(Sender: TObject);
procedure CheckTrameClick(Sender: TObject);
procedure ButtonCopClick(Sender: TObject);
private private
{ Déclarations privées } { Déclarations privées }
public public
@@ -159,7 +163,7 @@ begin
begin begin
i:=0; i:=0;
repeat repeat
trouve:= pos('erreur',Lines[i])<>0; trouve:=pos('erreur',Lines[i])<>0;
inc(i); inc(i);
until (i>=Lines.Count) or trouve; until (i>=Lines.Count) or trouve;
if trouve then if trouve then
@@ -172,7 +176,6 @@ begin
end; end;
end; end;
procedure TFormDebug.ButtonAffEvtChronoClick(Sender: TObject); procedure TFormDebug.ButtonAffEvtChronoClick(Sender: TObject);
var i,j,etat : integer; var i,j,etat : integer;
s : string; s : string;
@@ -201,4 +204,15 @@ begin
TraceListe:=CheckBoxTraceLIste.checked; TraceListe:=CheckBoxTraceLIste.checked;
end; end;
procedure TFormDebug.CheckTrameClick(Sender: TObject);
begin
trace:=CheckTrame.Checked;
end;
procedure TFormDebug.ButtonCopClick(Sender: TObject);
var i : integer;
begin
MemoDebug.Lines:=Formprinc.ListBox1.Items
end;
end. end.

Binary file not shown.

View File

@@ -4,7 +4,7 @@ object FormPilote: TFormPilote
BorderStyle = bsDialog BorderStyle = bsDialog
Caption = 'Pilotage' Caption = 'Pilotage'
ClientHeight = 350 ClientHeight = 350
ClientWidth = 542 ClientWidth = 346
Color = clBtnFace Color = clBtnFace
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
@@ -202,48 +202,4 @@ object FormPilote: TFormPilote
Text = 'EditNbFeux' Text = 'EditNbFeux'
OnKeyPress = EditNbreFeuxKeyPress OnKeyPress = EditNbreFeuxKeyPress
end end
object GroupBox3: TGroupBox
Left = 328
Top = 48
Width = 209
Height = 97
Caption = 'pilotage unisemaf'
TabOrder = 4
object RadioButton1: TRadioButton
Left = 8
Top = 24
Width = 145
Height = 17
Caption = 'Algo1 pilotage inverse'
TabOrder = 0
OnClick = RadioButton1Click
end
object RadioButton2: TRadioButton
Left = 8
Top = 40
Width = 145
Height = 17
Caption = 'Algo2 pilotage normal'
TabOrder = 1
OnClick = RadioButton2Click
end
object RadioButton3: TRadioButton
Left = 8
Top = 56
Width = 193
Height = 17
Caption = 'Algo3 pilotage bits '#224' 1 seuls normal'
TabOrder = 2
OnClick = RadioButton3Click
end
object RadioButton4: TRadioButton
Left = 8
Top = 72
Width = 193
Height = 17
Caption = 'Algo4 pilotage bits '#224' 1 seuls inverse'
TabOrder = 3
OnClick = RadioButton4Click
end
end
end end

View File

@@ -31,11 +31,6 @@ type
ButtonPilote: TButton; ButtonPilote: TButton;
EditNbreFeux: TEdit; EditNbreFeux: TEdit;
LabelNbFeux: TLabel; LabelNbFeux: TLabel;
GroupBox3: TGroupBox;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
RadioButton4: TRadioButton;
procedure RadioVertClick(Sender: TObject); procedure RadioVertClick(Sender: TObject);
procedure RadioVertCliClick(Sender: TObject); procedure RadioVertCliClick(Sender: TObject);
procedure RadioJauneClick(Sender: TObject); procedure RadioJauneClick(Sender: TObject);
@@ -54,10 +49,6 @@ type
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure ButtonPiloteClick(Sender: TObject); procedure ButtonPiloteClick(Sender: TObject);
procedure EditNbreFeuxKeyPress(Sender: TObject; var Key: Char); procedure EditNbreFeuxKeyPress(Sender: TObject; var Key: Char);
procedure RadioButton1Click(Sender: TObject);
procedure RadioButton2Click(Sender: TObject);
procedure RadioButton3Click(Sender: TObject);
procedure RadioButton4Click(Sender: TObject);
private private
{ Déclarations privées } { Déclarations privées }
public public
@@ -263,36 +254,5 @@ if ord(Key) = VK_RETURN then
end; end;
end; end;
procedure TFormPilote.RadioButton1Click(Sender: TObject);
begin
uni1:=RadioButton1.checked;
uni2:=RadioButton2.checked;
uni3:=RadioButton3.checked;
uni4:=RadioButton4.checked;
end;
procedure TFormPilote.RadioButton2Click(Sender: TObject);
begin
uni1:=RadioButton1.checked;
uni2:=RadioButton2.checked;
uni3:=RadioButton3.checked;
uni4:=RadioButton4.checked;
end;
procedure TFormPilote.RadioButton3Click(Sender: TObject);
begin
uni1:=RadioButton1.checked;
uni2:=RadioButton2.checked;
uni3:=RadioButton3.checked;
uni4:=RadioButton4.checked;
end;
procedure TFormPilote.RadioButton4Click(Sender: TObject);
begin
uni1:=RadioButton1.checked;
uni2:=RadioButton2.checked;
uni3:=RadioButton3.checked;
uni4:=RadioButton4.checked;
end;
end. end.

Binary file not shown.

View File

@@ -1,9 +1,9 @@
object FormPrinc: TFormPrinc object FormPrinc: TFormPrinc
Left = 33 Left = 34
Top = 205 Top = 494
BorderStyle = bsSingle BorderStyle = bsSingle
Caption = 'Client TCP-IP CDM Rail ou USB - syst'#232'me LENZ' Caption = 'Client TCP-IP CDM Rail ou USB - syst'#232'me LENZ'
ClientHeight = 607 ClientHeight = 601
ClientWidth = 1196 ClientWidth = 1196
Color = clBtnFace Color = clBtnFace
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
@@ -33,9 +33,9 @@ object FormPrinc: TFormPrinc
ParentFont = False ParentFont = False
end end
object LabelEtat: TLabel object LabelEtat: TLabel
Left = 440 Left = 344
Top = 8 Top = 8
Width = 80 Width = 305
Height = 22 Height = 22
Caption = 'LabelEtat' Caption = 'LabelEtat'
Font.Charset = ANSI_CHARSET Font.Charset = ANSI_CHARSET
@@ -596,10 +596,10 @@ object FormPrinc: TFormPrinc
Visible = False Visible = False
end end
object Image3feux: TImage object Image3feux: TImage
Left = 600 Left = 616
Top = 0 Top = 0
Width = 49 Width = 33
Height = 105 Height = 57
Picture.Data = { Picture.Data = {
07544269746D617006090000424D060900000000000036040000280000001A00 07544269746D617006090000424D060900000000000036040000280000001A00
00002C0000000100080000000000D0040000C40E0000C40E0000000100000000 00002C0000000100080000000000D0040000C40E0000C40E0000000100000000
@@ -678,7 +678,7 @@ object FormPrinc: TFormPrinc
end end
object Image2feux: TImage object Image2feux: TImage
Left = 1096 Left = 1096
Top = 104 Top = 128
Width = 33 Width = 33
Height = 57 Height = 57
Picture.Data = { Picture.Data = {
@@ -1090,8 +1090,8 @@ object FormPrinc: TFormPrinc
Visible = False Visible = False
end end
object Image6Dir: TImage object Image6Dir: TImage
Left = 1120 Left = 1112
Top = 96 Top = 128
Width = 81 Width = 81
Height = 25 Height = 25
Picture.Data = { Picture.Data = {
@@ -1198,8 +1198,8 @@ object FormPrinc: TFormPrinc
Visible = False Visible = False
end end
object BoutVersion: TButton object BoutVersion: TButton
Left = 656 Left = 1008
Top = 0 Top = 8
Width = 83 Width = 83
Height = 33 Height = 33
Caption = 'Dem version' Caption = 'Dem version'
@@ -1225,7 +1225,7 @@ object FormPrinc: TFormPrinc
end end
object BoutonRaf: TButton object BoutonRaf: TButton
Left = 912 Left = 912
Top = 64 Top = 8
Width = 89 Width = 89
Height = 33 Height = 33
Caption = 'Rafraichissement' Caption = 'Rafraichissement'
@@ -1234,18 +1234,18 @@ object FormPrinc: TFormPrinc
end end
object ScrollBox1: TScrollBox object ScrollBox1: TScrollBox
Left = 648 Left = 648
Top = 164 Top = 160
Width = 537 Width = 537
Height = 401 Height = 405
Color = clWhite Color = clWhite
ParentColor = False ParentColor = False
TabOrder = 3 TabOrder = 3
end end
object GroupBox1: TGroupBox object GroupBox1: TGroupBox
Left = 656 Left = 656
Top = 40 Top = 0
Width = 249 Width = 249
Height = 65 Height = 97
Caption = 'Commande d'#39'accessoires' Caption = 'Commande d'#39'accessoires'
TabOrder = 4 TabOrder = 4
object Label2: TLabel object Label2: TLabel
@@ -1282,6 +1282,7 @@ object FormPrinc: TFormPrinc
Top = 32 Top = 32
Width = 41 Width = 41
Height = 21 Height = 21
Hint = 'Entrez 1 ou 2 pour un accessoire DCC et 1 '#224' 255 pour un CV'
TabOrder = 1 TabOrder = 1
Text = '1' Text = '1'
OnEnter = EditvalEnter OnEnter = EditvalEnter
@@ -1291,25 +1292,37 @@ object FormPrinc: TFormPrinc
Top = 24 Top = 24
Width = 109 Width = 109
Height = 33 Height = 33
Hint = 'Ecriture des accessoires DCC'
Caption = 'Envoi commande' Caption = 'Envoi commande'
TabOrder = 2 TabOrder = 2
WordWrap = True WordWrap = True
OnClick = ButtonCommandeClick OnClick = ButtonCommandeClick
end end
object ButtonEcrCV: TButton
Left = 8
Top = 64
Width = 225
Height = 25
Hint = 'Ecriture CV en mode direct sur voie de programmation'
Caption = 'Ecriture CV - 1 '#224' 255 par bus XpressNet'
TabOrder = 3
WordWrap = True
OnClick = ButtonEcrCVClick
end
end end
object ButtonTest: TButton object ButtonTest: TButton
Left = 832 Left = 912
Top = 0 Top = 88
Width = 105 Width = 89
Height = 33 Height = 33
Caption = 'Demande '#233'tat de la r'#233'trosignalisation' Caption = 'Demande '#233'tat r'#233'trosignalisation'
TabOrder = 5 TabOrder = 5
WordWrap = True WordWrap = True
OnClick = ButtonTestClick OnClick = ButtonTestClick
end end
object ButtonInfo: TButton object ButtonInfo: TButton
Left = 1008 Left = 1008
Top = 64 Top = 48
Width = 81 Width = 81
Height = 33 Height = 33
Caption = 'Informations' Caption = 'Informations'
@@ -1318,11 +1331,12 @@ object FormPrinc: TFormPrinc
end end
object GroupBox2: TGroupBox object GroupBox2: TGroupBox
Left = 654 Left = 654
Top = 111 Top = 103
Width = 419 Width = 211
Height = 46 Height = 46
Caption = 'Trains' Caption = 'Trains'
TabOrder = 6 TabOrder = 6
Visible = False
object Label1: TLabel object Label1: TLabel
Left = 16 Left = 16
Top = 20 Top = 20
@@ -1342,15 +1356,15 @@ object FormPrinc: TFormPrinc
end end
object StatusBar1: TStatusBar object StatusBar1: TStatusBar
Left = 0 Left = 0
Top = 577 Top = 571
Width = 1196 Width = 1196
Height = 30 Height = 30
Panels = <> Panels = <>
SimplePanel = True SimplePanel = True
end end
object MSCommUSBLenz: TMSComm object MSCommUSBLenz: TMSComm
Left = 1120 Left = 880
Top = 8 Top = 128
Width = 32 Width = 32
Height = 32 Height = 32
OnComm = MSCommUSBLenzComm OnComm = MSCommUSBLenzComm
@@ -1359,8 +1373,8 @@ object FormPrinc: TFormPrinc
00020000802500000000080000000000000000003F00000001000000} 00020000802500000000080000000000000000003F00000001000000}
end end
object loco: TButton object loco: TButton
Left = 944 Left = 1096
Top = 0 Top = 8
Width = 75 Width = 75
Height = 33 Height = 33
Caption = 'loco' Caption = 'loco'
@@ -1368,19 +1382,31 @@ object FormPrinc: TFormPrinc
OnClick = locoClick OnClick = locoClick
end end
object ButtonAffDebug: TButton object ButtonAffDebug: TButton
Left = 744 Left = 912
Top = 0 Top = 48
Width = 81 Width = 89
Height = 33 Height = 33
Caption = 'Affiche debug' Caption = 'Affiche debug'
TabOrder = 11 TabOrder = 11
OnClick = ButtonAffDebugClick OnClick = ButtonAffDebugClick
end end
object ButtonReprise: TButton
Left = 1096
Top = 48
Width = 75
Height = 33
Hint =
'Relance du bus DCC apr'#232's une '#233'criture d'#39'un CV ou une mise hors t' +
'ension de la centrale'
Caption = 'Reprise DCC'
TabOrder = 12
OnClick = ButtonRepriseClick
end
object Timer1: TTimer object Timer1: TTimer
Interval = 100 Interval = 100
OnTimer = Timer1Timer OnTimer = Timer1Timer
Left = 1072 Left = 888
Top = 8 Top = 80
end end
object ClientSocketLenz: TClientSocket object ClientSocketLenz: TClientSocket
Active = False Active = False
@@ -1464,6 +1490,9 @@ object FormPrinc: TFormPrinc
Caption = 'Divers' Caption = 'Divers'
object FichierSimu: TMenuItem object FichierSimu: TMenuItem
Caption = 'Ouvrir un fichier de simulation' Caption = 'Ouvrir un fichier de simulation'
Hint =
'Ouvre un fichier de simulation des d'#233'tecteurs pour simuler un fo' +
'nctionnement'
OnClick = FichierSimuClick OnClick = FichierSimuClick
end end
object Versions1: TMenuItem object Versions1: TMenuItem
@@ -1471,6 +1500,23 @@ object FormPrinc: TFormPrinc
Hint = 'Versions' Hint = 'Versions'
OnClick = Versions1Click OnClick = Versions1Click
end end
object N1: TMenuItem
Caption = '-'
end
object LireunfichierdeCV1: TMenuItem
Caption = 'Lire un fichier de CV vers un accessoire'
Hint =
'Ouvre un fichier de CV pour l'#39'envoyer vers un accessoire branch'#233 +
' sur la voie de programmation'
OnClick = LireunfichierdeCV1Click
end
object LireunaccessoireversunfichierdeCV1: TMenuItem
Caption = 'Lire un accessoire vers un fichier de CV'
Hint =
'Lire les CV d'#39'un accessoire branch'#233' sur la voie de programmation' +
' vers un fichier'
OnClick = LireunaccessoireversunfichierdeCV1Click
end
end end
end end
object ClientSocketCDM: TClientSocket object ClientSocketCDM: TClientSocket
@@ -1483,4 +1529,12 @@ object FormPrinc: TFormPrinc
OnError = ClientSocketCDMError OnError = ClientSocketCDMError
Left = 352 Left = 352
end end
object OpenDialog: TOpenDialog
Left = 1080
Top = 88
end
object SaveDialog: TSaveDialog
Left = 1120
Top = 88
end
end end

File diff suppressed because it is too large Load Diff

Binary file not shown.

BIN
UnitTCO.dcu Normal file

Binary file not shown.

94
UnitTCO.dfm Normal file
View File

@@ -0,0 +1,94 @@
object FormTCO: TFormTCO
Left = 1549
Top = 156
Width = 928
Height = 590
Caption = 'FormTCO'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnActivate = FormActivate
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object LabelX: TLabel
Left = 32
Top = 16
Width = 53
Height = 19
Caption = 'LabelX'
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
end
object Label2: TLabel
Left = 16
Top = 16
Width = 13
Height = 13
Caption = 'X='
end
object Label3: TLabel
Left = 104
Top = 16
Width = 13
Height = 13
Caption = 'X='
end
object LabelY: TLabel
Left = 120
Top = 16
Width = 51
Height = 19
Caption = 'Label1'
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
end
object DrawGrid: TDrawGrid
Left = 48
Top = 408
Width = 521
Height = 137
Color = clBlack
DefaultColWidth = 30
DefaultRowHeight = 30
FixedCols = 0
FixedRows = 0
TabOrder = 0
OnDrawCell = DrawGridDrawCell
end
object Button1: TButton
Left = 320
Top = 16
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 1
OnClick = Button1Click
end
object ScrollBox: TScrollBox
Left = 16
Top = 40
Width = 865
Height = 353
TabOrder = 2
object ImageTCO: TImage
Left = 0
Top = 0
Width = 857
Height = 345
OnClick = ImageTCOClick
end
end
end

323
UnitTCO.pas Normal file
View File

@@ -0,0 +1,323 @@
unit UnitTCO;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids , UnitPrinc, StdCtrls, ExtCtrls;
type
TFormTCO = class(TForm)
DrawGrid: TDrawGrid;
Button1: TButton;
LabelX: TLabel;
Label2: TLabel;
Label3: TLabel;
LabelY: TLabel;
ScrollBox: TScrollBox;
ImageTCO: TImage;
procedure FormCreate(Sender: TObject);
procedure DrawGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure Button1Click(Sender: TObject);
procedure ImageTCOClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
FormTCO: TFormTCO;
NbreCellX,NbreCellY,HtImageTCO,LargImageTCO,XclicCell,YclicCell : integer;
LargeurCell,HauteurCell,Xclic,Yclic : integer;
tco : array[1..20,1..20] of Tbranche;
procedure construit_TCO;
procedure affiche_TCO;
implementation
{$R *.dfm}
procedure grille;
var x,y : integer;
r : Trect;
begin
HtImageTCO:=FormTCO.ImageTCO.Height;
HtImageTCO:=FormTCO.ImageTCO.Height;
LargImageTCO:=FormTCO.ImageTCO.Width;
With FormTCO.ImageTCO.canvas do
begin
Brush.Style:=bsSolid;
Brush.Color:=clBlack;
pen.color:=clyellow;
r:=rect(1,1,LargImageTCO,HtImageTco);
FillRect(r);
pen.color:=$707070;
for x:=1 to NbreCellx do
begin
moveto(x*LargeurCell,1);
LineTo(x*LargeurCell,HtImageTCO);
end;
for y:=1 to NbreCelly do
begin
moveto(1,y*HauteurCell);
LineTo(LargimageTCO,y*HauteurCell);
end;
end;
end;
procedure dessin_voie(x,y : integer);
var x1,y1 : integer;
r : Trect;
begin
with FormTCO.ImageTCO.Canvas do
begin
x1:=x*LargeurCell;
y1:=y*HauteurCell;
end;
with formTCO.ImageTCO.canvas do
begin
r:=Rect(x1,y1+(HauteurCell div 2)-5,x1+LargeurCell,y1 + (HauteurCell div 2)+5);
Brush.COlor:=ClRed;
FillRect(r);
end;
end;
// aiguillage pointe à gauche, monte gauche
procedure dessin_AigPGMG(x,y : integer;couleur : Tcolor);
var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer;
r : Trect;
begin
x0:=x*LargeurCell;
y0:=y*HauteurCell;
with formTCO.ImageTCO.canvas do
begin
Brush.COlor:=couleur;
pen.color:=couleur;
jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup
jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf
r:=Rect(x0,jy1,x0+LargeurCell,jy2);
FillRect(r);
//brush.color:=clblue;
x1:=x0+(largeurCell div 2);
y1:=jy1;
x2:=x0+largeurCell-3;
y2:=y0;
x3:=x0+largeurCell;
y3:=y0+3;
x4:=x0+(largeurCell div 2)+7;
y4:=jy1;
Polygon([point(x1,y1),Point(x2,y2),Point(x3+2,y3-2),Point(x4+2,y4-2)]);
end;
end;
// courbe bas gauche vers droit
procedure dessin_cbgd(x,y : integer;couleur : Tcolor);
var jy1,jy2,x0,y0,i,x1,y1,x2,y2,x3,y3,x4,y4 : integer;
r : Trect;
begin
x0:=x*LargeurCell;
y0:=y*HauteurCell;
with formTCO.ImageTCO.canvas do
begin
Brush.COlor:=Couleur;
pen.color:=Couleur;
jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup
jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf
r:=Rect(x0+(largeurCell div 2),jy1,x0+LargeurCell,jy2);
FillRect(r);
// brush.color:=clblue;
x1:=x0;
y1:=y0+HauteurCell-3;
x2:=x0+(LargeurCell div 2) -0;
y2:=jy1;
x3:=x0+(LargeurCell div 2) +2;
y3:=jy2;
x4:=x0+3;
y4:=y0+HauteurCell;
Polygon([point(x1-2,y1+2),Point(x2,y2),Point(x3,y3),Point(x4-2,y4+2)]);
end;
end;
procedure construit_TCO;
var x,y,i,j,Max,indexMax : integer;
begin
// étape 0 Raz du TCO
for y:=1 to 20 do
for x:=1 to 20 do
begin
TCO[x,y].Adresse:=0;
TCO[x,y].Btype:=0;
end;
//étape 1 trouver la branche la plus longue
Max:=0;
for i:=1 to NbreBranches do
begin
j:=0;
repeat
inc(j);
until BrancheN[i,j].Adresse=0;
if j>Max then begin Max:=j-1;IndexMax:=i;end;
end;
Affiche('La branche la plus grande a pour index '+IntToSTR(IndexMax),clOrange);
// stocker cette branche au milieu du TCO (en 5)
for i:=1 to Max do
begin
TCO[i,5].Adresse:=BrancheN[IndexMax,i].Adresse;
TCO[i,5].Btype:=BrancheN[IndexMax,i].Btype;
end;
end;
procedure Affiche_TCO ;
var i,j,x,y,xOrg,Yorg,btype : integer;
s : string;
begin
with formTCO.ImageTCO.Canvas do
begin
Brush.color:=ClBlack;
font.color:=clWhite;
end;
for y:=1 to 10 do
for x:=1 to 20 do
begin
i:=tco[x,y].Adresse;
btype:=tco[x,y].Btype;
with formTCO.ImageTCO.Canvas do
begin
Xorg:=(x-1)*LargeurCell;
Yorg:=(y-1)*HauteurCell;
s:=IntToSTR(i);
if Btype=2 then s:='A'+s;
if Btype=3 then s:='A'+s+'B';
Textout(Xorg+2,Yorg+2,s);
end;
end;
end;
procedure TFormTCO.FormCreate(Sender: TObject);
begin
caption:='TCO';
NbreCellX:=20;
NbreCellY:=10;
LargeurCell:=35;
HauteurCell:=35;
//grille;
// HtImageTCO:=ImageTCO.Height;
end;
// x y = numéro cellule
Procedure dessine(x,y : integer);
Var Xorg,Yorg : integer;
begin
Xorg:=x*LargeurCell;
Yorg:=y*HauteurCell;
with FormTCO.DrawGrid.Canvas do
begin
Pen.width:=3;
Pen.Color:=clyellow;
Brush.Style:=bsSolid;
MoveTo(xorg,yorg);LineTo(xorg+120,yorg+150) ;
Pen.Color:=clred;
MoveTo(1,1);LineTo(120,160) ;
end;
formTCO.refresh;
end;
procedure TFormTCO.DrawGridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var s : string;
aCanvas : Tcanvas;
begin
exit;
dessine(2,2);
if (Acol=3) and (ARow=3) then with Sender as TDrawGrid do Canvas.Draw(Rect.left,Rect.Top,Formprinc.Image6Dir.picture.bitmap);
if (Acol=2) and (Arow=1) then
begin
with Sender as TDrawGrid do
begin
//Canvas.Pen:=psSolid;
With canvas do
begin
Pen.width:=3;
Pen.Color:=clyellow;
MoveTo(1,1);LineTo(150,150) ;
end;
end;
end;
end;
procedure TFormTCO.Button1Click(Sender: TObject);
begin
grille;
dessin_voie(3,3);
dessin_voie(10,4);
dessin_AigPGMG(7,6,clyellow);
end;
procedure TFormTCO.ImageTCOClick(Sender: TObject);
var Position: TPoint;
begin
GetCursorPos(Position);
Position:=ImageTCO.screenToCLient(Position);
Xclic:=position.X;YClic:=position.Y;
XclicCell:=Xclic div largeurCell +1;
YclicCell:=Yclic div hauteurCell +1;
LabelX.caption:=IntToSTR(XclicCell);
LabelY.caption:=IntToSTR(YclicCell);
end;
procedure TFormTCO.FormActivate(Sender: TObject);
begin
grille;
dessin_voie(3,3);
dessin_voie(10,4);
dessin_AigPGMG(7,6,clyellow);
dessin_cbgd(8,5,clyellow);
formprinc.Hide;
end;
end.

View File

@@ -29,12 +29,14 @@
192.168.1.23:5550 192.168.1.23:5550
/ /
/ port COM de l'adresse USB de l'interface LI100 / port COM de l'adresse USB de l'interface LI100
/ attention de 1 à 9 - Si le port de l'interface USB LI100 >9, il faut le changer / attention de COM1 à 9 - Si le port de l'interface USB LI100 >9, il faut le changer
/ manuellement dans le gestionnaire des périphériques / manuellement dans le gestionnaire des périphériques
/ mettre 0 si inutilisée ou si CDM est utilisé en parallèle de ce programme (car CDM utilise la liaison USB) / mettre 0 si inutilisée ou si CDM est utilisé en parallèle de ce programme (car CDM utilise la liaison USB)
/ Le programme ne tentera pas de se connecter à la centrale si CDM rail est détécté / Le programme ne tentera pas de se connecter à la centrale si CDM rail est détécté
/ COMx:57600,N,8,1,2 = interfaces LENZ LI-USB et compatibles (le dernier paramètre est le protocole matériel: 0=aucun 1=Xon-Xoff 2=cts 3=RTS-Xon-Xoff)
/ COMx:9600,N,8,1,0 = interfaces GENLI USB-RS232 et compatibles (0=pas de protocole)
/ /
3 COM3:57600,N,8,1,2
/ /
/ Avec (1) ou sans (0) initialisation des aiguillages au démarrage selon le tableau ci après / Avec (1) ou sans (0) initialisation des aiguillages au démarrage selon le tableau ci après
0 0

View File

@@ -107,7 +107,6 @@ A31,0
476,9,0,1,(538,A23),1 476,9,0,1,(538,A23),1
497,9,0,4,(531,A19),1 497,9,0,4,(531,A19),1
600,7,0,0,(521,A8),1 600,7,0,0,(521,A8),1
197,5,0,6,(520,A20),0,51
0 0
/ /

30
liste_cv.txt Normal file
View File

@@ -0,0 +1,30 @@
Fichier décodeur unisemaf
cible de forme 51
CV valeur
----aspect1
35 63 affecte les sorties aspect
36 36
37 0
38 0
-----aspect2
39 63
40 33
41 0
42 0
-----aspect3
43 63
44 34
45 0
46 0
-----aspect4
47 63
48 10
49 0
50 0
-----aspect5
51 63
52 16
53 0
54 0

BIN
listeusb.dcu Normal file

Binary file not shown.

167
listeusb.pas Normal file
View File

@@ -0,0 +1,167 @@
unit listeusb;
//=================================================//
// Nicolas Paglieri (ni69) //
// www.ni69.info //
// & www.delphifr.com //
//=================================================//
// Merci à DelphiProg pour son aide précieuse ! ;) //
//=================================================//
interface
uses Registry,ShellAPI, ComCtrls,
Windows, Messages, SysUtils, Variants, Classes;// Graphics, Controls,
var
line : array of string;
NumLine : integer;
procedure EnumerateDevices;
implementation
//============================================================================//
// Fonction de traduction en français des noms anglais des catégories de périphériques
// On ajoute ici l'index de l'icône de catégorie après un # pour gérer l'affichage
//============================================================================//
function Translate(English: string): string;
begin
if English = 'CDROM' then result := 'Lecteurs de CD-ROM/DVD-ROM#09'
else if English = 'Computer' then result := 'Ordinateur#14'
else if English = 'DiskDrive' then result := 'Lecteurs de disque#10'
else if English = 'Display' then result := 'Cartes Graphiques#01'
else if English = 'fdc' then result := 'Contrôleur de lecteur de disquettes#04'
else if English = 'FloppyDisk' then result := 'Lecteurs de disquettes#11'
else if English = 'hdc' then result := 'Contrôleurs ATA/ATAPI IDE#05'
else if English = 'Image' then result := 'Périphériques d''image#15'
else if English = 'Keyboard' then result := 'Claviers#03'
else if English = 'LegacyDriver' then result := 'Pilotes non Plug-and-Play#17'
else if English = 'MEDIA' then result := 'Contrôleurs audio, vidéo et jeu#06'
else if English = 'Modem' then result := 'Modems#12'
else if English = 'Monitor' then result := 'Moniteurs#13'
else if English = 'Mouse' then result := 'Souris et autres périphériques de pointage#20'
else if English = 'Net' then result := 'Cartes réseau#02'
else if English = 'NtApm' then result := 'Prise en charge NT APM/hérité#19'
else if English = 'Ports' then result := 'Ports (COM et LPT)#18'
else if English = 'Printer' then result := 'Imprimantes#08'
else if English = 'System' then result := 'Périphériques Système#14'
else if English = 'USB' then result := 'Contrôleurs de bus USB#07'
else if English = 'Volume' then result := 'Volumes de stockage#21'
else result := English+'#22'; // Périphérique inconnu
end;
//============================================================================//
//============================================================================//
// PROCEDURE D'ENUMERATION DES PERIPHERIQUES SUR WINDOWS XP-7 //
// ne marche pas avec W10
//============================================================================//
procedure EnumerateDevices;
var
CategoriesList, SubCatList, SubSubCatList, FinalList : TStringList;
nb, nb2, nb3 ,num: integer;
Reg1, Reg2, Reg3 : TRegistry;
HasBeenFound : boolean;
listeCles : Tstrings;
begin
CategoriesList := TStringList.Create; // Liste des catégories principales du registre
SubCatList := TStringList.Create; // Liste intermédiaire
SubSubCatList := TStringList.Create; // Liste intermédiaire
FinalList := TStringList.Create; // Liste finale comprenant les périphériques
// On crée les objets TRegistry qui serviront à parcourir l'arborescence
Reg1 := TRegistry.Create;
Reg2 := TRegistry.Create;
Reg3 := TRegistry.Create;
try
// Définition de la clé racine
Reg1.RootKey := HKEY_LOCAL_MACHINE;
Reg2.RootKey := HKEY_LOCAL_MACHINE;
Reg3.RootKey := HKEY_LOCAL_MACHINE;
//----------------------------------------------------------------------------------------
// 1ère ETAPE : ENUMARTION DES CATEGORIES DU REGISTRE (différentes des catégories finales)
with TRegistry.Create do try
RootKey := HKEY_LOCAL_MACHINE;
//! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// IMPORTANT : DROITS D'ACCES
// On ouvre les clés en lecture seule avec OpenKeyReadOnly
// car on dispose de la valeur de sécurité d'accès KEY_READ.
// En effet, seul SYSTEM a le droit d'ouvrir cette clé en écriture en temps normal.
//! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum');
GetKeyNames(CategoriesList); // Récupération des catégories
CloseKey;
finally
free;
end;
num:=1;Setlength(line,num+1);
//-----------------------------------------------------------------------------------------------------------------------------------
// 2eme ETAPE : PARCOURS DE L'ARBORESCENCE DU REGISTRE (les clés contenant les informations utiles sont contenues dans d'autres clés)
for nb := 0 to CategoriesList.Count-1 do begin
Reg1.OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\'+CategoriesList[nb]);
Reg1.GetKeyNames(SubCatList);
Reg1.CloseKey;
for nb2 := 0 to SubCatList.Count-1 do begin
Reg2.OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\'+CategoriesList[nb]+'\'+SubCatList[nb2]);
Reg2.GetKeyNames(SubSubCatList);
Reg2.CloseKey;
for nb3 := 0 to SubSubCatList.Count-1 do begin
Reg3.OpenKeyReadOnly('SYSTEM\CurrentControlSet\Enum\'+CategoriesList[nb]+'\'+SubCatList[nb2]+'\'+SubSubCatList[nb3]);
// Si on ne dispose ni du type de périphérique, ni de son nom,
// Ou alors si le périphérique n'est plus disponible (si la clé "Control" n'est pas présente), on ne l'ajoute pas
if ((Reg3.ReadString('Class')='') and (Reg3.ReadString('DeviceDesc')='')) or (not Reg3.KeyExists('Control')) then begin
Reg3.CloseKey;
continue;
// Si il s'agit d'un lecteur CD, d'un disque dur ou d'un port (COM ou LPT), on remplace la description du périphérique par un nom plus parlant
end else if (Reg3.ReadString('Class')='CDROM') or (Reg3.ReadString('Class')='DiskDrive') or (Reg3.ReadString('Class')='Ports') then
line[num] := Translate(Reg3.ReadString('Class'))+'|'+Reg3.ReadString('FriendlyName')
else line[num] := Translate(Reg3.ReadString('Class'))+'|'+Reg3.ReadString('DeviceDesc');
// Ajout des informations si elles sont présentes dans le registre
if Reg3.ValueExists('DeviceDesc') then Line[num] := Line[num] + '§Description@'+Reg3.ReadString('DeviceDesc');
if Reg3.ValueExists('FriendlyName') then Line[num] := Line[num] + '§FriendlyName@'+Reg3.ReadString('FriendlyName');
if Reg3.ValueExists('Mfg') then Line[num] := Line[num] + '§Fabriquant@'+Reg3.ReadString('Mfg');
if Reg3.ValueExists('Service') then Line[num] := Line[num] + '§Service@'+Reg3.ReadString('Service');
if Reg3.ValueExists('LocationInformation') then Line[num] := Line[num] + '§Emplacement@'+Reg3.ReadString('LocationInformation');
if Reg3.ValueExists('Class') then Line[num] := Line[num] + '§Enumérateur@'+Reg3.ReadString('Class');
FinalList.Add(line[num]);
inc(num);
//Affiche(line,clyellow);
Reg3.CloseKey;Setlength(line,num+1);
end;
end;
end;
NumLine:=num-1;
finally
// On libère les éléments créés au départ
Reg3.Free;
Reg2.Free;
Reg1.Free;
FinalList.Free;
SubSubCatList.Free;
SubCatList.Free;
CategoriesList.Free;
end;
end;
end.

Binary file not shown.

View File

@@ -22,7 +22,7 @@ var
FormVersion: TFormVersion; FormVersion: TFormVersion;
Lance_verif : integer; Lance_verif : integer;
Const Version='1.2';// sert à la comparaison de la version publiée Const Version='1.3'; //Version='1.2';// sert à la comparaison de la version publiée
implementation implementation
@@ -97,7 +97,7 @@ procedure verifie_version;
var s,s2,s3,Version_p,Url,LocalFile : string; var s,s2,s3,Version_p,Url,LocalFile : string;
trouve_version,trouve_zip : boolean; trouve_version,trouve_zip : boolean;
fichier : text; fichier : text;
i,j : integer; i,j,erreur : integer;
V_publie,V_utile : real; V_publie,V_utile : real;
begin begin
//Affiche('vérifie version',clLime); //Affiche('vérifie version',clLime);
@@ -147,12 +147,13 @@ begin
// changer le . en , // changer le . en ,
s:=Version_p; s:=Version_p;
i:=pos('.',s);if i<>0 then s[i]:=','; // i:=pos('.',s);if i<>0 then s[i]:=',';
s2:=version; s2:=version;
i:=pos('.',s2);if i<>0 then s2[i]:=','; // i:=pos('.',s2);if i<>0 then s2[i]:=',';
val(s,V_publie,erreur); if erreur<>0 then exit;
val(s2,V_utile,erreur); if erreur<>0 then exit;
V_publie:=StrToFloat(s);
V_utile:=StrToFloat(s2);
if V_utile<V_publie then if V_utile<V_publie then
begin begin
FormVersion.show; FormVersion.show;