easylinux/SignauxComplexes
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

V1.444

Browse Source
This commit is contained in:
f1iwq2
2020-03-29 23:02:08 +02:00
parent f81f270a23
commit 5c39a980b8
15 changed files with 1161 additions and 661 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
UnitConfig.dcu
View File

Binary file not shown.

BIN
UnitConfigTCO.dcu
View File

Binary file not shown.

21
UnitConfigTCO.dfm
View File

@@ -44,7 +44,7 @@ object FormConfigTCO: TFormConfigTCO
end
object LabelNbCellX: TLabel
Left = 192
Top = 56
Top = 52
Width = 96
Height = 20
Caption = 'LabelNbCellX'
@@ -57,7 +57,7 @@ object FormConfigTCO: TFormConfigTCO
end
object LabelNbCellY: TLabel
Left = 192
Top = 80
Top = 76
Width = 96
Height = 20
Caption = 'LabelNbCellX'
@@ -93,4 +93,21 @@ object FormConfigTCO: TFormConfigTCO
TabOrder = 2
Text = 'EditTailleCellY'
end
object ButtonDessine: TButton
Left = 24
Top = 176
Width = 75
Height = 25
Caption = 'Dessine'
TabOrder = 3
OnClick = ButtonDessineClick
end
object CheckDessineGrille: TCheckBox
Left = 16
Top = 104
Width = 105
Height = 17
Caption = 'dessine grille'
TabOrder = 4
end
end

34
UnitConfigTCO.pas
View File

@@ -4,7 +4,7 @@ interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
Dialogs, StdCtrls , UnitTCO;
type
TFormConfigTCO = class(TForm)
@@ -17,21 +17,24 @@ type
Label4: TLabel;
LabelNbCellX: TLabel;
LabelNbCellY: TLabel;
ButtonDessine: TButton;
CheckDessineGrille: TCheckBox;
procedure ButtonOKClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ButtonDessineClick(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
FormConfigTCO: TFormConfigTCO;
LargeurCell,HauteurCell,NbreCellX,NbreCellY : integer ;
var FormConfigTCO: TFormConfigTCO;
AvecGrille : boolean;
implementation
uses UnitTCO;
uses UnitPrinc;
{$R *.dfm}
@@ -46,8 +49,9 @@ begin
begin
ImageTCO.Width:=LargeurCell*NbreCellX;
ImageTCO.Height:=HauteurCell*NbreCellY;
Affiche_TCO;
end;
AvecGrille:=checkDessineGrille.Checked;
formTCO.affiche_TCO;
close;
end;
@@ -62,4 +66,22 @@ end;
procedure TFormConfigTCO.ButtonDessineClick(Sender: TObject);
var i,erreur : integer;
r : Trect;
c : tCanvas;
begin
Val(EditTailleCellX.Text,i,erreur);
LargeurCell:=i;
Val(EditTailleCellY.Text,i,erreur);
HauteurCell:=i;
with formTCO do
begin
ImageTCO.Width:=LargeurCell*NbreCellX;
ImageTCO.Height:=HauteurCell*NbreCellY;
end;
formTCO.affiche_TCO;
end;
end.

BIN
UnitDebug.dcu
View File

Binary file not shown.

BIN
UnitPilote.dcu
View File

Binary file not shown.

9
UnitPilote.pas
View File

@@ -97,16 +97,19 @@ var i : integer;
begin
i:=Index_feu(AdrPilote); // adresse du feu d'origine
if i<>0 then
Vcanvas:=FormPilote.ImagePilote.picture.bitmap.canvas;
//ImagePilote.Picture.Bitmap:=FormPilote.ImagePilote.picture.bitmap;
EtatFeuPilote:=EtatSignalCplx[0];
Vcanvas:=FormPilote.ImagePilote.picture.bitmap.Canvas;
case feux[i].aspect of
// feux de signalisation
2 : dessine_feu2(Vcanvas,EtatFeupilote);
3 : dessine_feu3(Vcanvas,EtatFeupilote);
4 : dessine_feu4(VCanvas,EtatFeupilote);
4 : dessine_feu4(VCanvas,0,0,1,1,EtatFeupilote,1);
5 : dessine_feu5(VCanvas,EtatFeupilote);
7 : dessine_feu7(VCanvas,EtatFeupilote);
9 : dessine_feu9(VCanvas,EtatFeupilote);
9 : dessine_feu9(VCanvas,0,0,1,1,EtatFeupilote,1);
// indicateurs de direction
12 : dessine_dir2(VCanvas,EtatFeupilote);
13 : dessine_dir3(VCanvas,EtatFeupilote);

BIN
UnitPrinc.dcu
View File

Binary file not shown.

808
UnitPrinc.dfm
View File

File diff suppressed because it is too large Load Diff

296
UnitPrinc.pas
View File

@@ -325,10 +325,10 @@ var
function Index_feu(adresse : integer) : integer;
procedure dessine_feu2(Acanvas : Tcanvas;EtatSignal : word);
procedure dessine_feu3(Acanvas : Tcanvas;EtatSignal : word);
procedure dessine_feu4(Acanvas : Tcanvas;EtatSignal : word);
procedure dessine_feu4(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer);
procedure dessine_feu5(Acanvas : Tcanvas;EtatSignal : word);
procedure dessine_feu7(Acanvas : Tcanvas;EtatSignal : word);
procedure dessine_feu9(Acanvas : Tcanvas;EtatSignal : word);
procedure dessine_feu9(Acanvas : Tcanvas;x,y : integer;frX,frY : real;etatsignal : word;orientation : integer);
procedure dessine_dir2(Acanvas : Tcanvas;EtatSignal : word);
procedure dessine_dir3(Acanvas : Tcanvas;EtatSignal : word);
procedure dessine_dir4(Acanvas : Tcanvas;EtatSignal : word);
@@ -393,8 +393,10 @@ begin
with Acanvas do
begin
brush.Color:=couleur;
Pen.Color:=clBlack;
Ellipse(x-rayon,y-rayon,x+rayon,y+rayon);
end;
//Affiche(IntToSTR(y),clyellow);
end;
// dessine les feux sur une cible à 2 feux
@@ -428,25 +430,45 @@ begin
end;
// dessine les feux sur une cible à 4 feux
procedure dessine_feu4(Acanvas : Tcanvas;EtatSignal : word);
var code : integer;
// orientation=1 vertical
procedure dessine_feu4(Acanvas : Tcanvas;x,y : integer;frX,frY : real;EtatSignal : word;orientation : integer);
var Temp,code,rayon,xSem,Ysem,xJaune,Yjaune,Xcarre,Ycarre,Xvert,Yvert,
LgImage,HtImage : integer;
begin
code:=code_to_aspect(Etatsignal); // et aspect
rayon:=round(6*frX);
Xcarre:=round(13*frX); ycarre:=round(11*frY);
Xvert:=round(13*frX); Yvert:=round(22*frY);
xSem:=round(13*frX); ySem:=round(33*frY);
xJaune:=round(13*frX); yJaune:=round(44*frY);
LgImage:=round(frx*Formprinc.Image9feux.Picture.Width);
HtImage:=round(fry*Formprinc.Image9feux.Picture.Height);
if (orientation=2) then
begin
//rotation 90° vers la gauche des feux
Temp:=HtImage-yjaune;YJaune:=XJaune;Xjaune:=Temp;
Temp:=HtImage-ycarre;Ycarre:=Xcarre;Xcarre:=Temp;
Temp:=HtImage-ySem;YSem:=XSem;XSem:=Temp;
Temp:=HtImage-yvert;Yvert:=Xvert;Xvert:=Temp;
end;
//extinctions
cercle(ACanvas,13,11,6,GrisF);
if not((code=semaphore_cli) and clignotant) then cercle(ACanvas,13,33,6,GrisF);
if not((code=vert_cli) and clignotant) then cercle(ACanvas,13,22,6,GrisF);
if not((code=jaune_cli) and clignotant) then cercle(ACanvas,13,44,6,GrisF);
// cercle(ACanvas,x+round(13*frX),y+round(11*frY),rayon,GrisF);
if not((code=semaphore_cli) and clignotant) then cercle(ACanvas,x+Xsem,y+round(y+Ysem),rayon,GrisF);
if not((code=vert_cli) and clignotant) then cercle(ACanvas,x+Xvert,y+yvert,rayon,GrisF);
if not((code=jaune_cli) and clignotant) then cercle(ACanvas,x+Xjaune,y+YJaune,rayon,GrisF);
// allumages
if ((code=vert_cli) and (clignotant)) or (code=vert) then cercle(ACanvas,13,22,6,clGreen);
if ((code=jaune_cli) and (clignotant)) or (code=jaune) then cercle(Acanvas,13,44,6,clOrange);
if ((code=semaphore_cli) and (clignotant)) or (code=semaphore) then cercle(ACanvas,13,33,6,clRed);
if ((code=vert_cli) and (clignotant)) or (code=vert) then cercle(ACanvas,x+xVert,y+yVert,rayon,clGreen);
if ((code=jaune_cli) and (clignotant)) or (code=jaune) then cercle(Acanvas,x+Xjaune,y+yJaune,rayon,clOrange);
if ((code=semaphore_cli) and (clignotant)) or (code=semaphore) then cercle(ACanvas,x+xSem,y+ySem,rayon,clRed);
if code=carre then
begin
cercle(ACanvas,13,33,6,clRed);
cercle(ACanvas,13,11,6,clRed);
cercle(ACanvas,x+xSem,y+Ysem,rayon,clRed);
cercle(ACanvas,x+xCarre,y+yCarre,rayon,clRed);
end;
end;
@@ -474,6 +496,162 @@ begin
if ((code=jaune_cli) and (clignotant)) or (code=jaune) then cercle(ACanvas,13,55,6,clorange);
end;
// dessine les feux sur une cible à 7 feux
procedure dessine_feu7(Acanvas : Tcanvas;EtatSignal : word);
var code : integer;
begin
code:=code_to_aspect(Etatsignal); // et combine
// effacements
if not((code=blanc_cli) and clignotant) then cercle(ACanvas,13,23,6,grisF);
if not((code=ral_60) and clignotant) or not((combine=ral_60) and clignotant) then
begin
cercle(ACanvas,13,11,6,grisF);cercle(ACanvas,37,11,6,GrisF);
end;
if not((code=vert_cli) and clignotant) then cercle(ACanvas,13,45,6,GrisF);
cercle(ACanvas,13,35,6,GrisF);cercle(ACanvas,13,55,6,GrisF);
if not((code=jaune_cli) and clignotant) then cercle(ACanvas,13,66,6,GrisF);
if not((code=semaphore_cli) and clignotant) then cercle(ACanvas,13,56,6,GrisF);
// Allumages
if (code=ral_30) or (combine=ral_30) or ((code=ral_60) or (combine=ral_60)) and clignotant then
begin
cercle(ACanvas,13,11,6,clOrange);cercle(ACanvas,37,11,6,clOrange);
end;
if (code=jaune) or ((code=jaune_cli) and clignotant) then cercle(Acanvas,13,66,6,clOrange);
if ((code=semaphore_cli) and (clignotant)) or (code=semaphore) then cercle(ACanvas,13,56,6,clRed);
if ((code=vert_cli) and (clignotant)) or (code=vert) then cercle(ACanvas,13,45,6,clGreen);
if ((code=blanc_cli) and (clignotant)) or (code=blanc) then cercle(ACanvas,13,23,6,clWhite);
if code=carre then
begin
cercle(ACanvas,13,35,6,clRed);
cercle(ACanvas,13,55,6,clRed);
end;
end;
// dessine les feux sur une cible à 9 feux
procedure dessine_feu9(Acanvas : Tcanvas;x,y : integer;frX,frY : real;etatsignal : word;orientation : integer);
var code,rayon,
XBlanc,Yblanc,xJaune,yJaune,Xsem,YSem,Xvert,YVert,Xcarre,Ycarre,Xral1,Yral1,Xral2,YRal2,
Xrap1,Yrap1,Xrap2,Yrap2,Temp : integer;
LgImage,HtImage,xt,yt : integer;
TempF : double;
begin
rayon:=round(6*frX);
code:=code_to_aspect(Etatsignal); // et aspect
// Affiche('Dessine feu9 FrX='+FloatToSTR(frx)+' FrY='+FloatToSTR(fry)+' orientation='+IntToSTr(orientation),clorange);
// mise à l'échelle des coordonnées des feux en fonction du facteur de réduction frX et frY et x et y (offsets)
// Temp:=HtImage-y;Y:=X;X:=Temp;
// x:=round(frx*x);y:=round(fry*y);
if orientation=2 then begin
// TempF:=frX;frX:=frY;frY:=TempF;
end;
XBlanc:=13; YBlanc:=36;
Xral1:=13; YRal1:=24;
Xral2:=37; YRal2:=24;
xJaune:=13; yJaune:=80;
xRap1:=37; yRap1:=12;
xrap2:=37; yRap2:=37;
Xcarre:=13; Ycarre:=47;
XSem:=13; Ysem:=69;
XVert:=13; YVert:=58;
Acanvas.MoveTo(0,0);ACanvas.LineTo(1,1);
LgImage:=Formprinc.Image9feux.Picture.Bitmap.Width;
HtImage:=Formprinc.Image9feux.Picture.Bitmap.Height;
if (orientation=2) then
begin
//rotation 90° vers la gauche des feux
// calcul des facteurs de réduction pour la rotation
frX:=2*LargeurCell/HtImage;
frY:=HauteurCell/LgImage;
Temp:=HtImage-yjaune;YJaune:=XJaune;Xjaune:=Temp;
Temp:=HtImage-yBlanc;YBlanc:=XBlanc;XBlanc:=Temp;
Temp:=HtImage-yRal1;YRal1:=XRal1;XRal1:=Temp;
Temp:=HtImage-yRal2;YRal2:=XRal2;XRal2:=Temp;
Temp:=HtImage-ycarre;Ycarre:=Xcarre;Xcarre:=Temp;
Temp:=HtImage-ySem;YSem:=XSem;XSem:=Temp;
Temp:=HtImage-yvert;Yvert:=Xvert;Xvert:=Temp;
Temp:=HtImage-yRap1;YRap1:=XRap1;XRap1:=Temp;
Temp:=HtImage-yRap2;YRap2:=XRap2;XRap2:=Temp;
end;
if (orientation=3) then
begin
//rotation 90° vers la droite des feux
//rotation 90° vers la gauche des feux
// calcul des facteurs de réduction pour la rotation
frX:=2*LargeurCell/HtImage;
frY:=HauteurCell/LgImage;
Temp:=LgImage-Xjaune;XJaune:=YJaune;Yjaune:=Temp;
Temp:=LgImage-XSem;XSem:=YSem;YSem:=Temp;
Temp:=LgImage-Xvert;Xvert:=Yvert;Yvert:=Temp;
Temp:=LgImage-Xcarre;Xcarre:=Ycarre;Ycarre:=Temp;
Temp:=LgImage-Xblanc;Xblanc:=Yblanc;Yblanc:=Temp;
Temp:=LgImage-Xral1;Xral1:=Yral1;Yral1:=Temp;
Temp:=LgImage-Xral2;Xral2:=Yral2;Yral2:=Temp;
Temp:=LgImage-Xrap1;Xrap1:=Yrap1;Yrap1:=Temp;
Temp:=LgImage-Xrap2;Xrap2:=Yrap2;Yrap2:=Temp;
end;
XJaune:=round(Xjaune*Frx)+x; YJaune:=round(Yjaune*Fry)+Y;
Xblanc:=round(XBlanc*FrX)+x; YBlanc:=round(YBlanc*FrY)+Y;
XRal1:=round(XRal1*FrX)+x; YRal1:=round(YRal1*FrY)+Y;
XRal2:=round(XRal2*FrX)+x; YRal2:=round(YRal2*FrY)+Y;
Xvert:=round(Xvert*FrX)+x; Yvert:=round(Yvert*FrY)+Y;
XSem:=round(XSem*FrX)+x; YSem:=round(YSem*FrY)+Y;
Xcarre:=round(Xcarre*FrX)+x; Ycarre:=round(Ycarre*FrY)+Y;
XRap1:=round(XRap1*FrX)+x; YRap1:=round(YRap1*FrY)+Y;
XRap2:=round(XRap2*FrX)+x; YRap2:=round(YRap2*FrY)+Y;
// extinctions
if not((code=blanc_cli) and clignotant) then cercle(ACanvas,xBlanc,yBlanc,Rayon,grisF);
if not((code=ral_60) and clignotant) or not((combine=ral_60) and clignotant) then
begin
cercle(ACanvas,Xral1,Yral1,rayon,grisF);cercle(ACanvas,xRal2,yRal2,rayon,grisF);
end;
if not((code=jaune_cli) and clignotant) then cercle(ACanvas,xJaune,yJaune,rayon,grisF);
if not((code=rappel_60) and clignotant) or not((combine=rappel_60) and clignotant) then
begin
cercle(ACanvas,xrap1,yrap1,rayon,grisF);cercle(ACanvas,xrap2,yrap2,rayon,grisF);
end;
cercle(ACanvas,xcarre,Ycarre,rayon,grisF); // carré supérieur
if not((code=semaphore_cli) and clignotant) then cercle(ACanvas,xSem,ySem,rayon,grisF);
if not((code=vert_cli) and clignotant) then cercle(ACanvas,xvert,yvert,rayon,grisF);
// allumages
if ((code=ral_60) and clignotant) or (code=ral_30) or
((combine=ral_60) and clignotant) or (combine=ral_30) then
begin
cercle(ACanvas,Xral1,yRal1,rayon,clOrange);cercle(ACanvas,xral2,yral2,rayon,clOrange);
end;
if ((code=rappel_60) and clignotant) or (code=rappel_30) or
((combine=rappel_60) and clignotant) or (combine=rappel_30) then
begin
cercle(ACanvas,xrap1,yrap2,rayon,clOrange);cercle(ACanvas,xrap2,yrap2,rayon,clOrange);
end;
if ((code=jaune_cli) and clignotant) or (code=jaune) then cercle(Acanvas,xjaune,yjaune,rayon,clOrange);
if ((code=semaphore_cli) and clignotant) or (code=semaphore) then cercle(ACanvas,Xsem,ySem,rayon,clRed);
if ((code=vert_cli) and clignotant) or (code=vert) then cercle(ACanvas,xvert,yvert,rayon,clGreen);
if ((code=blanc_cli) and clignotant) or (code=blanc) then cercle(ACanvas,xBlanc,yBlanc,rayon,clWhite);
if code=carre then
begin
cercle(ACanvas,xcarre,yCarre,rayon,clRed);
cercle(ACanvas,xsem,ysem,rayon,clRed);
end;
end;
// dessine les feux sur une cible directionnelle à 2 feux
procedure dessine_dir3(Acanvas : Tcanvas;EtatSignal : word);
begin
@@ -706,83 +884,6 @@ end;
// dessine les feux sur une cible à 7 feux
procedure dessine_feu7(Acanvas : Tcanvas;EtatSignal : word);
var code : integer;
begin
code:=code_to_aspect(Etatsignal); // et combine
// effacements
if not((code=blanc_cli) and clignotant) then cercle(ACanvas,13,23,6,grisF);
if not((code=ral_60) and clignotant) or not((combine=ral_60) and clignotant) then
begin
cercle(ACanvas,13,11,6,grisF);cercle(ACanvas,37,11,6,GrisF);
end;
if not((code=vert_cli) and clignotant) then cercle(ACanvas,13,45,6,GrisF);
cercle(ACanvas,13,35,6,GrisF);cercle(ACanvas,13,55,6,GrisF);
if not((code=jaune_cli) and clignotant) then cercle(ACanvas,13,66,6,GrisF);
if not((code=semaphore_cli) and clignotant) then cercle(ACanvas,13,56,6,GrisF);
// Allumages
if (code=ral_30) or (combine=ral_30) or ((code=ral_60) or (combine=ral_60)) and clignotant then
begin
cercle(ACanvas,13,11,6,clOrange);cercle(ACanvas,37,11,6,clOrange);
end;
if (code=jaune) or ((code=jaune_cli) and clignotant) then cercle(Acanvas,13,66,6,clOrange);
if ((code=semaphore_cli) and (clignotant)) or (code=semaphore) then cercle(ACanvas,13,56,6,clRed);
if ((code=vert_cli) and (clignotant)) or (code=vert) then cercle(ACanvas,13,45,6,clGreen);
if ((code=blanc_cli) and (clignotant)) or (code=blanc) then cercle(ACanvas,13,23,6,clWhite);
if code=carre then
begin
cercle(ACanvas,13,35,6,clRed);
cercle(ACanvas,13,55,6,clRed);
end;
end;
// dessine les feux sur une cible à 9 feux
procedure dessine_feu9(Acanvas : Tcanvas;etatsignal : word);
var code : integer;
begin
code:=code_to_aspect(Etatsignal); // et aspect
// extinctions
if not((code=blanc_cli) and clignotant) then cercle(ACanvas,13,36,6,grisF);
if not((code=ral_60) and clignotant) or not((combine=ral_60) and clignotant) then
begin
cercle(ACanvas,13,24,6,grisF);cercle(ACanvas,37,24,6,grisF);
end;
if not((code=jaune_cli) and clignotant) then cercle(ACanvas,13,80,6,grisF);
if not((code=rappel_60) and clignotant) or not((combine=rappel_60) and clignotant) then
begin
cercle(ACanvas,37,12,6,grisF);cercle(ACanvas,37,37,6,grisF);
end;
cercle(ACanvas,13,47,6,grisF); // carré supérieur
if not((code=semaphore_cli) and clignotant) then cercle(ACanvas,13,69,6,grisF);
if not((code=vert_cli) and clignotant) then cercle(ACanvas,13,58,6,grisF);
// allumages
if ((code=ral_60) and clignotant) or (code=ral_30) or
((combine=ral_60) and clignotant) or (combine=ral_30) then
begin
cercle(ACanvas,13,24,6,clOrange);cercle(ACanvas,37,24,6,clOrange);
end;
if ((code=rappel_60) and clignotant) or (code=rappel_30) or
((combine=rappel_60) and clignotant) or (combine=rappel_30) then
begin
cercle(ACanvas,37,12,6,clOrange);cercle(ACanvas,37,37,6,clOrange);
end;
if ((code=jaune_cli) and clignotant) or (code=jaune) then cercle(Acanvas,13,80,6,clOrange);
if ((code=semaphore_cli) and clignotant) or (code=semaphore) then cercle(ACanvas,13,69,6,clRed);
if ((code=vert_cli) and clignotant) or (code=vert) then cercle(ACanvas,13,58,6,clGreen);
if ((code=blanc_cli) and clignotant) or (code=blanc) then cercle(ACanvas,13,36,6,clWhite);
if code=carre then
begin
cercle(ACanvas,13,47,6,clRed);
cercle(ACanvas,13,69,6,clRed);
end;
end;
// renvoie l'index du feu dans le tableau feux[] en fonction de son adresse
//si pas de feu renvoie 0
@@ -808,10 +909,10 @@ begin
// feux de signalisation
2 : dessine_feu2(Feux[i].Img.Canvas,EtatSignalCplx[adresse]);
3 : dessine_feu3(Feux[i].Img.Canvas,EtatSignalCplx[adresse]);
4 : dessine_feu4(Feux[i].Img.Canvas,EtatSignalCplx[adresse]);
4 : dessine_feu4(Feux[i].Img.Canvas,0,0,1,1,EtatSignalCplx[adresse],1);
5 : dessine_feu5(Feux[i].Img.Canvas,EtatSignalCplx[adresse]);
7 : dessine_feu7(Feux[i].Img.Canvas,EtatSignalCplx[adresse]);
9 : dessine_feu9(Feux[i].Img.Canvas,EtatSignalCplx[adresse]);
9 : dessine_feu9(Feux[i].Img.Canvas,0,0,1,1,EtatSignalCplx[adresse],1);
// indicateurs de direction
12 : dessine_dir2(Feux[i].Img.Canvas,EtatSignalCplx[adresse]);
13 : dessine_dir3(Feux[i].Img.Canvas,EtatSignalCplx[adresse]);
@@ -844,6 +945,9 @@ begin
ImagePilote.top:=40;ImagePilote.left:=220;
ImagePilote.Parent:=FormPilote;
ImagePilote.Picture.Bitmap.TransparentMode:=tmAuto;
ImagePilote.Picture.Bitmap.TransparentColor:=clblue;
ImagePilote.Transparent:=true;
ImagePilote.Picture.BitMap:=Feux[i].Img.Picture.Bitmap;
LabelTitrePilote.Caption:='Pilotage du signal '+intToSTR(AdrPilote);
EtatSignalCplx[0]:=EtatSignalCplx[AdrPilote];
@@ -885,6 +989,11 @@ begin
if feux[rang].Btype_suiv1=5 then s:=s+' (aig bis)';
Hint:=s;
onClick:=Formprinc.Imageonclick;
//width:=100;
//Height:=100;
Picture.Bitmap.TransparentMode:=tmAuto;
Picture.Bitmap.TransparentColor:=clblue;
Transparent:=true;
case TypeFeu of // charger le bit map depuis le fichier
2 : picture.bitmap:=Formprinc.Image2feux.picture.Bitmap;
@@ -893,6 +1002,7 @@ begin
5 : picture.bitmap:=Formprinc.Image5feux.picture.Bitmap;
7 : picture.bitmap:=Formprinc.Image7feux.picture.Bitmap;
9 : picture.bitmap:=Formprinc.Image9feux.picture.Bitmap;
12 : picture.bitmap:=Formprinc.Image2Dir.picture.Bitmap;
13 : picture.bitmap:=Formprinc.Image3Dir.picture.Bitmap;
14 : picture.bitmap:=Formprinc.Image4Dir.picture.Bitmap;
@@ -7643,4 +7753,6 @@ begin
end;
end;
begin

BIN
UnitSimule.dcu
View File

Binary file not shown.

BIN
UnitTCO.dcu
View File

Binary file not shown.

93
UnitTCO.dfm
View File

@@ -82,7 +82,7 @@ object FormTCO: TFormTCO
end
object Label5: TLabel
Left = 24
Top = 512
Top = 520
Width = 150
Height = 25
Caption = 'Type de l'#39#233'l'#233'ment: '
@@ -293,7 +293,7 @@ object FormTCO: TFormTCO
end
object Label15: TLabel
Left = 24
Top = 544
Top = 560
Width = 158
Height = 25
Caption = 'Image de l'#39#233'l'#233'ment: '
@@ -348,19 +348,48 @@ object FormTCO: TFormTCO
Font.Style = [fsBold]
ParentFont = False
end
object Label18: TLabel
Left = 200
Top = 10
Width = 83
Height = 13
Caption = 'Taille des cellules'
object ImageFeu: TImage
Left = 584
Top = 576
Width = 25
Height = 41
DragMode = dmAutomatic
Stretch = True
OnEndDrag = ImageFeuEndDrag
OnMouseDown = ImageFeuMouseDown
end
object Label19: TLabel
Left = 336
Top = 10
Width = 5
object Label18: TLabel
Left = 560
Top = 584
Width = 18
Height = 19
Caption = '12'
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
end
object ImageTemp: TImage
Left = 304
Top = 504
Width = 97
Height = 97
end
object SourisX: TLabel
Left = 232
Top = 8
Width = 36
Height = 13
Caption = '/'
Caption = 'SourisX'
end
object SourisY: TLabel
Left = 288
Top = 8
Width = 36
Height = 13
Caption = 'SourisY'
end
object EditAdrElement: TEdit
Left = 200
@@ -378,7 +407,7 @@ object FormTCO: TFormTCO
end
object EditTypeElement: TEdit
Left = 200
Top = 512
Top = 520
Width = 89
Height = 33
Font.Charset = ANSI_CHARSET
@@ -412,13 +441,13 @@ object FormTCO: TFormTCO
object ScrollBox: TScrollBox
Left = 16
Top = 40
Width = 865
Height = 433
Width = 873
Height = 425
TabOrder = 4
object ImageTCO: TImage
Left = 0
Top = 0
Width = 846
Width = 865
Height = 409
PopupMenu = PopupMenu1
OnClick = ImageTCOClick
@@ -431,7 +460,7 @@ object FormTCO: TFormTCO
end
object EditTypeImage: TEdit
Left = 200
Top = 552
Top = 560
Width = 89
Height = 33
Font.Charset = ANSI_CHARSET
@@ -461,31 +490,13 @@ object FormTCO: TFormTCO
TabOrder = 7
OnClick = Button2Click
end
object EditCellX: TEdit
Left = 296
Top = 8
Width = 33
Height = 21
TabOrder = 8
Text = 'EditCellX'
OnKeyPress = EditCellXKeyPress
end
object EditCellY: TEdit
Left = 352
Top = 8
Width = 33
Height = 21
TabOrder = 9
Text = 'EditCellY'
OnKeyPress = EditCellYKeyPress
end
object ButtonConfigTCO: TButton
Left = 576
Top = 8
Width = 113
Height = 25
Caption = 'Configuration TCO'
TabOrder = 10
TabOrder = 8
OnClick = ButtonConfigTCOClick
end
object PopupMenu1: TPopupMenu
@@ -554,5 +565,13 @@ object FormTCO: TFormTCO
OnClick = CourbeSupG1Click
end
end
object Tourner90G: TMenuItem
Caption = 'Tourner 90'#176' '#224' gauche'
OnClick = Tourner90GClick
end
object Tourner90D: TMenuItem
Caption = 'Tourner 90'#176' '#224' droite'
OnClick = Tourner90DClick
end
end
end

537
UnitTCO.pas
View File

@@ -4,7 +4,7 @@ interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids , UnitPrinc, StdCtrls, ExtCtrls, Menus , UnitConfigTCO;
Dialogs, Grids , UnitPrinc, StdCtrls, ExtCtrls, Menus, UnitPilote ;
type
TFormTCO = class(TForm)
@@ -65,11 +65,14 @@ type
Label16: TLabel;
ImageDiag2: TImage;
Label17: TLabel;
Label18: TLabel;
EditCellX: TEdit;
EditCellY: TEdit;
Label19: TLabel;
ButtonConfigTCO: TButton;
ImageFeu: TImage;
Label18: TLabel;
ImageTemp: TImage;
Tourner90G: TMenuItem;
Tourner90D: TMenuItem;
SourisX: TLabel;
SourisY: TLabel;
procedure FormCreate(Sender: TObject);
procedure ImageTCOClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
@@ -136,7 +139,7 @@ type
Y: Integer);
procedure ImageTCOMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure EffaceCellule(Canvas : Tcanvas;x,y : integer; couleur : Tcolor;Mode : TPenMode);
procedure Efface_Cellule(Canvas : Tcanvas;x,y : integer; couleur : Tcolor;Mode : TPenMode);
procedure MenuCopierClick(Sender: TObject);
procedure MenuCollerClick(Sender: TObject);
procedure ButtonRedessineClick(Sender: TObject);
@@ -154,9 +157,12 @@ type
procedure ImageDiag2EndDrag(Sender, Target: TObject; X, Y: Integer);
procedure ImageDiag2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure EditCellXKeyPress(Sender: TObject; var Key: Char);
procedure EditCellYKeyPress(Sender: TObject; var Key: Char);
procedure ButtonConfigTCOClick(Sender: TObject);
procedure ImageFeuEndDrag(Sender, Target: TObject; X, Y: Integer);
procedure ImageFeuMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Tourner90GClick(Sender: TObject);
procedure Tourner90DClick(Sender: TObject);
private
{ Déclarations privées }
@@ -165,9 +171,11 @@ type
end;
TTCO = array[1..100] of array[1..50] of record
BType : integer ; // 1= détecteur 2= aiguillage 3=bis 4=Buttoir
Adresse : integer ; // adresse du détecteur ou de l'aiguillage
BImage : integer ; // 0=rien 1=voie 2=
BType : integer ; // 1= détecteur 2= aiguillage 3=bis 4=Buttoir
Adresse : integer ; // adresse du détecteur ou de l'aiguillage ou du feu
BImage : integer ; // 0=rien 1=voie 2=aiguillage gauche gauche ... 12=feu
FeuAspect : integer; // aspect du feu (2 feux...9 feux)
FeuOriente : integer ; // orientation du feu : 1 vertical en bas / 2 horizontal gauche / 3 horizontal droit
end;
const
@@ -186,11 +194,18 @@ var
x1,y1,x2,y2 : integer;
end;
rAncien : TRect;
PCanvasTCO : Tcanvas;
PBitMapTCO : TBitMap;
PScrollBoxTCO : TScrollBox;
PImageTCO : Timage;
PImageTemp : TImage;
procedure construit_TCO;
LargeurCell,HauteurCell,NbreCellX,NbreCellY : integer ;
implementation
uses UnitConfigTCO;
{$R *.dfm}
@@ -262,11 +277,18 @@ begin
tco[x,y].adresse:=valeur;
delete(s,1,i);
i:=pos(')',s);
i:=pos(',',s);
if i=0 then begin closefile(fichier);exit;end;
val(copy(s,1,i-1),valeur,erreur);if erreur<>0 then begin closefile(fichier);exit;end;
tco[x,y].Bimage:=valeur;
delete(s,1,i);
i:=pos(')',s);
if i=0 then begin closefile(fichier);exit;end;
val(copy(s,1,i-1),valeur,erreur);if erreur<>0 then begin closefile(fichier);exit;end;
tco[x,y].FeuOriente:=valeur;
delete(s,1,i);
inc(x);
until s='';
@@ -284,14 +306,15 @@ var fichier : textfile;
begin
AssignFile(fichier,'tco.cfg');
rewrite(fichier);
writeln(fichier,'/type(0=rien 1=voie/détecteur 2=aig 3=aigBis , adresse , image=1 à 10 ');
writeln(fichier,'/type(0=rien 1=voie/détecteur 2=aig 3=aigBis , adresse , image=1 à 10 ,orientation');
writeln(fichier,'/Dalle TCO');
for y:=1 to NbreCellY do
begin
s:='';
for x:=1 to NbreCellX do
begin
s:=s+'('+IntToSTR(TCO[x,y].BType)+','+Format('%.*d',[3,TCO[x,y].Adresse])+','+IntToSTR(TCO[x,y].BImage)+')';
s:=s+'('+IntToSTR(TCO[x,y].BType)+','+Format('%.*d',[3,TCO[x,y].Adresse])+','+
IntToSTR(TCO[x,y].BImage)+','+IntToSTR(TCO[x,y].FeuOriente)+')';
end;
writeln(fichier,s);
end;
@@ -304,11 +327,8 @@ procedure TformTCO.grille;
var x,y : integer;
r : Trect;
begin
HtImageTCO:=FormTCO.ImageTCO.Height;
HtImageTCO:=FormTCO.ImageTCO.Height;
LargImageTCO:=FormTCO.ImageTCO.Width;
With ImageTCO.canvas do
if not(AvecGrille) then exit;
With PCanvasTCO do
begin
pen.color:=ClGrille;
// lignes verticales
@@ -705,15 +725,204 @@ begin
x3:=x0+largeurCell-3;y3:=y0+HauteurCell;
x4:=x0+(largeurCell div 2);y4:=jy2;
Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4-1,y4-1)]);
end;
end;
procedure TFormTCO.EffaceCellule(Canvas : Tcanvas;x,y : integer; couleur : Tcolor;Mode : TPenMode);
// Affiche dans le TCO en x,y un Feu à 90° d'après l'image transmise
// x y en coordonnées grille (cellule)
procedure Feu_90G(ImageSource : TImage;x,y : integer);
var p : array[0..2] of TPoint;
x0,y0,HtFeu,LgFeu : integer;
begin
x0:=(x-2)*LargeurCell;
y0:=(y-1)*HauteurCell;
HtFeu:=ImageSource.Picture.Height;
lgFeu:=ImageSource.Picture.Width;
// Affiche('Taille X feu_90G='+IntToSTR(lgFeu),clLime);
//PImageTCO.Picture.Bitmap.TransparentMode:=tmFixed; // tmAuto;
//PImageTCO.Picture.Bitmap.TransparentColor:=clBlue;
//PImageTCO.Transparent:=true;
// copie à 90°G sans mise à l'échelle dans l'image provisoire
p[0].X:=HtFeu; //90;
p[0].Y:=0; //0;
p[1].X:=HtFeu; //90;
p[1].Y:=LgFeu; //49;
p[2].X:=0; //0;
p[2].Y:=0; //0;
PlgBlt(PImageTemp.Canvas.Handle,p,ImageSource.Canvas.Handle,0,0,lgFeu,HtFeu,0,0,0);
PImageTemp.Picture.Bitmap.Modified:=True;
//PlgBlt(PImageTemp.Canvas.Handle,p,formprinc.Image5feux.Canvas.Handle,0,0,49,90,0,0,0);
// et copier l'image tournée sur le TCO
//StretchBlt(PcanvasTCO.Handle,x0,y0,LargeurCell*2,HauteurCell,
// PImageTemp.Canvas.Handle,0,0,HtFeu,LgFeu,srccopy);
TransparentBlt(PcanvasTCO.Handle,x0,y0,LargeurCell*2,HauteurCell,
PImageTemp.Canvas.Handle,0,0,HtFeu,LgFeu,clBlue); // clblue est la couleur de transparence
PImageTCO.Picture.Bitmap.Modified:=True; // rafraichit l'affichage sinon le stretchblt n'apparaît pas.
end;
// copie de l'image du feu à 90° dans le canvas source et le tourne de 90° et le met dans l'image temporaire
procedure Feu_90D(ImageSource : TImage;x,y : integer);
var p : array[0..2] of TPoint;
x0,y0,HtFeu,LgFeu : integer;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
HtFeu:=ImageSource.Picture.Height;
lgFeu:=ImageSource.Picture.Width;
// copie à 90°D dans l'image provisoire
p[0].X:=0;
p[0].Y:=LgFeu; //49;
p[1].X:=0;
p[1].Y:=0;
p[2].X:=HtFeu; //90;
p[2].Y:=LgFeu; //49;
PlgBlt(PImageTemp.Canvas.Handle,p,ImageSource.Canvas.Handle,0,0,LgFeu,HtFeu,0,0,0);
PImageTemp.Picture.Bitmap.Modified:=True;
// et copier l'image avec mise à l'échelle tournée sur le TCO
TransparentBlt(PcanvasTCO.Handle,x0,y0,LargeurCell*2,HauteurCell,
PImageTemp.Canvas.Handle,0,0,HtFeu,LgFeu,clBlue);
PImageTCO.Picture.Bitmap.Modified:=True; // rafraichit l'affichage sinon le stretchblt n'apparaît pas.
end;
// copie de l'image du feu à 180° depuis le canvas source et le met dans l'image temporaire
procedure Feu_180(CanvasSource : TCanvas);
var src,dest : Trect;
begin
dest:=bounds(0, 0, 49, 90);
src:=rect(0, 0, 49, 90); // V flip
// dest:=bounds(0, 0, image1.Picture.Width, image1.Picture.Height);
//src:=rect(0, image1.Picture.Height-1, image1.Picture.Width-1, 0); // Vertical flip
//src:=rect(image1.Picture.Width-1, 0, 0, image1.Picture.Height-1); // Horizontal flip
//src:=rect(image1.Picture.Width-1, image1.Picture.Height-1, 0, 0); // Both flip
PimageTemp.Picture.Bitmap.Canvas.StretchDraw(dest,Formprinc.Image9feux.Picture.Graphic);
PImageTemp.Picture.Bitmap.Modified:=True;
end;
// renvoie un pointeur vers l'image du feu suivant l'aspect du feu de adresse
// ne marche pas
function PointeurImage(adresse : integer) : TImage;
var i,aspect : integer;
Pim : TImage;
begin
// trouver l'aspect du feu
i:=Index_feu(adresse);
aspect:=feux[i].aspect;
case aspect of
2 : Pim:=Formprinc.Image2feux;
3 : Pim:=Formprinc.Image3feux;
4 : Pim:=Formprinc.Image4feux;
5 : Pim:=Formprinc.Image5feux;
7 : Pim:=Formprinc.Image7feux;
9 : Pim:=Formprinc.Image9feux;
else Pim:=Formprinc.Image3feux;
end;
PointeurImage:=Pim;
end;
// provisoire
procedure cercle(ACanvas : Tcanvas;x,y,rayon : integer;couleur : Tcolor);
begin
with PCanvasTCO do
begin
brush.Color:=couleur;
Ellipse(x-rayon,y-rayon,x+rayon,y+rayon);
end;
end;
// Dessine un feu dans le canvas en x,y , dont l'adresse se trouve à la cellule x,y
procedure dessin_feu(CanvasDest : Tcanvas;x,y : integer; couleur : Tcolor;Mode : TPenMode);
var x0,y0,orientation,adresse,i,aspect,TailleX,TailleY : integer;
ImageFeu : Timage;
frX,frY : real;
begin
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
Orientation:=TCO[x,y].FeuOriente;
Adresse:=TCO[x,y].Adresse;
i:=Index_feu(adresse);
aspect:=feux[i].aspect;
case aspect of
2 : ImageFeu:=Formprinc.Image2feux;
3 : ImageFeu:=Formprinc.Image3feux;
4 : ImageFeu:=Formprinc.Image4feux;
5 : ImageFeu:=Formprinc.Image5feux;
7 : ImageFeu:=Formprinc.Image7feux;
9 : ImageFeu:=Formprinc.Image9feux;
else ImageFeu:=Formprinc.Image3feux;
end;
//ImageFeu:=PointeurImage(adresse); // pointeur vers le type de feu à dessiner
TailleY:=ImageFeu.picture.BitMap.Height; // 50 taille du feu d'origine (verticale)
TailleX:=ImageFeu.picture.BitMap.Width; //91n
//Facteurs de réductions X et Y pour un signal vertical
frX:=LargeurCell/TailleX;
frY:=2*HauteurCell/TailleY;
//Affiche('FrX='+floatToSTR(frX)+' FrY='+floatToSTR(frY),clyellow);
// affiche l'icône du signal---------------
if (Orientation=1) then
begin
//Affiche('Adresse='+intToSTR(Adresse)+' Xfeu='+IntToSTR(X0)+' Yfeu='+intToSTR(y0),clyellow);
TransparentBlt(canvasDest.Handle,x0,y0,LargeurCell,HauteurCell*2,
ImageFeu.Canvas.Handle,0,0,TailleX,TailleY,clBlue);
PImageTCO.Picture.Bitmap.Modified:=True; // rafraichit l'affichage sinon le stretchblt n'apparaît pas.
end;
if Orientation=2 then
begin
Feu_90G(ImageFeu,x,y); // ici on passe l'origine du feu
x0:=x0-largeurCell;
//Affiche('Adresse='+intToSTR(Adresse)+' Xfeu='+IntToSTR(X0)+' Yfeu='+intToSTR(y0),clyellow);
// y0:=y0+largeurCell;
end;
if Orientation=3 then
begin
Feu_90D(ImageFeu,x,y);
end;
// écrire le texte ------------------
with PcanvasTCO do
begin
font.Size:=5;
Brush.Color:=fond;
Font.Color:=CouleurAdresse;
if Aspect=9 then TextOut(x0-LargeurCell,y0+8,IntToSTR(Adresse))
else TextOut(x0+1,y0+8,IntToSTR(Adresse));
end;
// allumage des feux du signal -----------------
(*TailleY:=HauteurCell*2;
TailleX:=LargeurCell;
frX:=LargeurCell/TailleX;
frY:=HauteurCell/TailleY;*)
case aspect of
4 : dessine_feu4(canvasDest,x0,y0,frX,frY,etatsignalcplx[adresse],orientation);
9 : dessine_feu9(canvasDest,x0,y0,frX,frY,etatsignalcplx[adresse],orientation);
end;
end;
procedure TFormTCO.Efface_Cellule(Canvas : Tcanvas;x,y : integer; couleur : Tcolor;Mode : TPenMode);
var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer;
r : TRect;
begin
if y>1 then
begin
// si la cellule au dessus contient un feu vertical, ne pas effacer la cellule
if (tco[x,y-1].BImage=12) and (tco[x,y-1].FeuOriente=1) then exit;
end;
if x<NbreCellX then
begin
// si la cellule à gauche contient un feu 90D, ne pas effacer la cellule
if (tco[x-1,y].BImage=12) and (tco[x-1,y].FeuOriente=3) then exit;
end;
x0:=(x-1)*LargeurCell;
y0:=(y-1)*HauteurCell;
r:=Rect(x0,y0,x0+LargeurCell,y0+HauteurCell);
@@ -724,7 +933,7 @@ begin
Pen.color:=clLime;
Brush.Color:=Fond;
Brush.style:=bsSolid;
rectangle(r);
rectangle(r);
fillRect(r);
end;
end;
@@ -777,35 +986,42 @@ begin
if Btype=2 then s:='A'+s;
if Btype=3 then s:='A'+s+'B';
case Bimage of
// ne pas passer la forme ds le paremètre canvas, çà ne s'afficherapas
0 : effacecellule(ImageTCO.Canvas,x,y,Clyellow,Mode);
1 : dessin_AigPD_AD(ImageTCO.Canvas,X,Y,Clyellow,Mode);
2 : dessin_AigG_PD(ImageTCO.Canvas,X,Y,Clyellow,mode);
3 : dessin_AigPG_AG(ImageTCO.Canvas,X,Y,Clyellow,mode);
4 : dessin_AigD_PG(ImageTCO.Canvas,X,Y,Clyellow,Mode);
5 : dessin_voie(ImageTCO.Canvas,X,Y,Clyellow,Mode);
6 : dessin_SupG(ImageTCO.Canvas,X,Y,Clyellow,Mode);
7 : dessin_SupD(ImageTCO.Canvas,X,Y,Clyellow,Mode);
8 : dessin_infD(ImageTCO.Canvas,X,Y,Clyellow,Mode);
9 : dessin_infG(ImageTCO.Canvas,X,Y,Clyellow,mode);
10 : dessin_Diag1(ImageTCO.Canvas,X,Y,Clyellow,mode);
11 : dessin_Diag2(ImageTCO.Canvas,X,Y,Clyellow,mode);
else entoure_cell(x,y);
end;
if (BImage>=2) and (i<>0) then
if y>1 then if (tco[x,y-1].Bimage=12) and (tco[x,y-1].FeuOriente=1) then exit;
case Bimage of
// ne pas passer la forme ds le paramètre canvas, çà ne s'affichera pas
// 0 : efface_cellule(PCanvasTCO,x,y,Clyellow,Mode); &&&&&&&&&
1 : dessin_AigPD_AD(PCanvasTCO,X,Y,Clyellow,Mode);
2 : dessin_AigG_PD(PCanvasTCO,X,Y,Clyellow,mode);
3 : dessin_AigPG_AG(PCanvasTCO,X,Y,Clyellow,mode);
4 : dessin_AigD_PG(PCanvasTCO,X,Y,Clyellow,Mode);
5 : dessin_voie(PCanvasTCO,X,Y,Clyellow,Mode);
6 : dessin_SupG(PCanvasTCO,X,Y,Clyellow,Mode);
7 : dessin_SupD(PCanvasTCO,X,Y,Clyellow,Mode);
8 : dessin_infD(PCanvasTCO,X,Y,Clyellow,Mode);
9 : dessin_infG(PCanvasTCO,X,Y,Clyellow,mode);
10 : dessin_Diag1(PCanvasTCO,X,Y,Clyellow,mode);
11 : dessin_Diag2(PCanvasTCO,X,Y,Clyellow,mode);
12 : dessin_feu(PCanvasTCO,X,Y,Clyellow,mode);
//else entoure_cell(x,y);
end;
if (BImage>=2) and (BImage<12) and (i<>0) then
begin // Adresse de l'élément
with ImageTCO.Canvas do
with PCanvasTCO do
begin
font.Size:=5;
Brush.Color:=fond;
Font.Color:=CouleurAdresse;
TextOut(xOrg+1,yOrg+1,s);
end;
end;
end
else
if (BImage=1) and (i<>0) then
begin // Adresse de l'élément
with ImageTCO.Canvas do
with PCanvasTCO do
begin
font.Size:=5;
Brush.Color:=fond;
@@ -813,31 +1029,48 @@ begin
TextOut(xOrg+1,yOrg+21,s);
end;
end;
//canvasTCO.TextOut(xOrg+1,yOrg+1,IntToSTR(x));
end;
// affiche le tco suivant le tableau TCO
procedure TformTCO.Affiche_TCO ;
var x,y : integer;
var x,y,DimX,DimY : integer;
s : string;
r : Trect;
begin
with ImageTCO.Canvas do
DimX:=LargeurCell*NbreCellX;
DimY:=HauteurCell*NbreCellY;
PImageTCO.Height:=DimY;
PImageTCO.Width:=DimX;
PBitMapTCO.Height:=DimY;
PBitMapTCO.Width:=DimX;
PScrollBoxTCO.HorzScrollBar.Range:=DimX;
PScrollBoxTCO.VertScrollBar.Range:=DimY;
//effacer tout
with PcanvasTCO do
begin
Brush.Color:=clWhite;
r:=rect(1,1,ImageTCO.Width,ImageTCO.height);
r:=rect(0,0,ImageTCO.Width,ImageTCO.height);
FillRect(r);
Brush.Style:=bsSolid;
Brush.Color:=fond;
pen.color:=clyellow;
r:=rect(1,1,NbreCellX*LargeurCell,NbreCelly*HauteurCell);
r:=rect(0,0,NbreCellX*LargeurCell,NbreCelly*HauteurCell);
FillRect(r);
end;
//afficher les cellules
for y:=1 to NbreCellY do
for x:=1 to NbreCellX do
begin
//Affiche(IntToSTR(x),clyellow);
affiche_cellule(x,y,PmCopy);
end;
// afficher la grille
grille;
end;
@@ -847,8 +1080,7 @@ begin
caption:='TCO';
LargeurCell:=25;
HauteurCell:=25;
EditCellX.text:=IntToSTR(LargeurCell);
EditCellY.text:=IntToSTR(HauteurCell);
AvecGrille:=true;
XclicCell:=1;
YclicCell:=1;
@@ -870,6 +1102,7 @@ begin
GetCursorPos(Position);
Position:=ImageTCO.screenToCLient(Position);
//Affiche(IntToSTR(position.x),clyellow);
Xclic:=position.X;YClic:=position.Y;
XclicCell:=Xclic div largeurCell +1;
YclicCell:=Yclic div hauteurCell +1;
@@ -917,6 +1150,22 @@ begin
if not(Forminit) then
begin
FormInit:=true;
lire_fichier_tco;
ImageTCO.Width:=LargeurCell*NbreCellX;
ImageTCO.Height:=HauteurCell*NbreCellY;
ImageTCO.Picture.Create;
ImageTCO.Picture.Bitmap.Height:=HauteurCell*NbreCellY;
ImageTCO.Picture.BitMap.Width:=LargeurCell*NbreCellX;
PCanvasTCO:=FormTCO.ImageTCO.Picture.Bitmap.Canvas;
PBitMapTCO:=FormTCO.ImageTCO.Picture.Bitmap;
PScrollBoxTCO:=FormTCO.ScrollBox;
PImageTCO:=FormTCO.ImageTCO;
PImageTemp:=FormTCO.ImageTemp;
PImageTemp.Canvas.Rectangle(0,0,PImageTemp.Width,PimageTemp.Height);
// dessiner les icônes
dessin_AigPD_AD(ImagePalette1.Canvas,1,1,clyellow,pmCopy);
dessin_AigG_PD(ImagePalette2.Canvas,1,1,clyellow,pmCopy);
@@ -929,9 +1178,14 @@ begin
dessin_infG(ImageInfG.canvas,1,1,Clyellow,pmCopy);
dessin_Diag1(ImageDiag1.Canvas,1,1,Clyellow,pmCopy);
dessin_Diag2(ImageDiag2.Canvas,1,1,Clyellow,pmCopy);
lire_fichier_tco;
ImageTCO.Width:=LargeurCell*NbreCellX;
ImageTCO.Height:=HauteurCell*NbreCellY;
With ImageFeu do
begin
Picture.Bitmap.TransparentMode:=tmAuto;
Picture.Bitmap.TransparentColor:=clblue;
Transparent:=true;
Picture.Bitmap:=Formprinc.Image9feux.Picture.Bitmap;
end;
Affiche_tco;
end;
@@ -1110,7 +1364,7 @@ end;
procedure TFormTCO.ImageTCODragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept:=source is TImage;
// Accept:=source is TImage;
end;
@@ -1361,8 +1615,8 @@ begin
xCell1:=XminiSel div LargeurCell +1;
xCell2:=XmaxiSel div LargeurCell +1;
yCell1:=yminiSel div LargeurCell +1;
yCell2:=ymaxiSel div LargeurCell +1;
yCell1:=yminiSel div HauteurCell +1;
yCell2:=ymaxiSel div HauteurCell +1;
for y:=yCell1 to yCell2 do
for x:=xCell1 to xCell2 do
@@ -1370,36 +1624,56 @@ begin
tco[x,y].BType:=0;
tco[x,y].Adresse:=0;
tco[x,y].BImage:=0;
effacecellule(ImageTCO.Canvas,X,Y,Clyellow,PmCopy);
//Affiche('Efface cellules '+IntToSTR(X)+' '+intToSTR(y),clyellow);
efface_cellule(ImageTCO.Canvas,X,Y,Clyellow,PmCopy);
end;
end;
procedure TFormTCO.ImageTCOMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure TFormTCO.ImageTCOMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
var position : Tpoint;
begin
if button=mbLeft then
begin
xMiniSel:=999;yMiniSel:=999;
xMaxiSel:=0;yMaxiSel:=0;
sourisclic:=true;
if SelectionAffichee then
if button=mbLeft then
begin
with imageTCO.Canvas do
xMiniSel:=999;yMiniSel:=999;
xMaxiSel:=0;yMaxiSel:=0;
sourisclic:=true;
if SelectionAffichee then
begin
Pen.Mode:=PmXor;
Pen.color:=clGrille;
Brush.Color:=clblue;
//FillRect(r);
Rectangle(rAncien);
with imageTCO.Canvas do
begin
Pen.Mode:=PmXor;
Pen.color:=clGrille;
Brush.Color:=clblue;
//FillRect(r);
Rectangle(rAncien);
end;
SelectionAffichee:=false;
end;
SelectionAffichee:=false;
end;
if button=mbRight then
begin
GetCursorPos(Position);
Position:=ImageTCO.screenToCLient(Position);
Xclic:=position.X;
YClic:=position.Y;
end;
// coordonnées grilleg
XclicCell:=Xclic div largeurCell + 1;
YclicCell:=Yclic div hauteurCell + 1;
LabelX.caption:=IntToSTR(XclicCell);
LabelY.caption:=IntToSTR(YclicCell);
XclicCellInserer:=XClicCell;
YclicCellInserer:=YClicCell;
//Entoure_cell(XclicCellInserer,YclicCellInserer);
EditAdrElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].Adresse);
EdittypeElement.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BType);
EdittypeImage.Text:=IntToSTR(tco[XClicCellInserer,YClicCellInserer].BImage);
end;
end;
procedure TFormTCO.ImageTCOMouseMove(Sender: TObject; Shift: TShiftState;X, Y: Integer);
@@ -1409,6 +1683,9 @@ var Position: TPoint;
begin
//Affiche('MouseMove',clyellow);
//Affiche(IntToSTR(X),clyellow);
SourisX.Caption:=IntToSTR(x);
SourisY.Caption:=IntToSTR(y);
if not(sourisclic) then exit;
//Affiche('MouseMove',clyellow);
GetCursorPos(Position);
@@ -1416,7 +1693,7 @@ begin
Xclic:=position.X;
YClic:=position.Y;
// coordonnées grilleg
// coordonnées grille
XclicCell:=Xclic div largeurCell + 1;
YclicCell:=Yclic div hauteurCell + 1;
@@ -1439,6 +1716,8 @@ begin
if xMaxiSel<x0 then xmaxiSel:=x0;
if yMaxiSel<y0 then ymaxiSel:=y0;
//Affiche('xMiniSel='+IntToSTR(xMiniSel)+' xMaxiSel='+IntToSTR(xMaxiSel)+' yMiniSel='+IntToSTR(yMiniSel)+' yMaxiSel='+IntToSTR(yMaxiSel),clOrange);
if SelectionAffichee then
with imageTCO.Canvas do
begin
@@ -1562,6 +1841,13 @@ procedure TFormTCO.Button1Click(Sender: TObject);
begin
Detecteur[513]:=true;
Maj_tco(513,true);
with PCanvasTCO do
begin
pen.Mode:=pmCopy;
pen.color:=clRed;
brush.color:=clGreen;
Rectangle(2,2,140,140);
end;
end;
procedure TFormTCO.Button2Click(Sender: TObject);
@@ -1615,35 +1901,6 @@ begin
ImageDiag2.BeginDrag(true);
end;
procedure TFormTCO.EditCellXKeyPress(Sender: TObject; var Key: Char);
var i, erreur : integer;
begin
val(EditCellX.text,i,erreur);
if (erreur=0) and (i>9) and (i<40) then
begin
LargeurCell:=i;
NbreCellX:=FormTCO.ImageTCO.Width div (LargeurCell);
Affiche('NbrecellX='+intToSTR(NbrecellX),clyellow);
Affiche_TCO;
end;
end;
procedure TFormTCO.EditCellYKeyPress(Sender: TObject; var Key: Char);
var i,erreur : integer;
begin
val(EditCellY.text,i,erreur);
if (erreur=0) and (i>9) and (i<40) then
begin
HauteurCell:=i;
NbreCellY:=FormTCO.ImageTCO.Height div (LargeurCell);
Affiche('NbrecellY='+intToSTR(NbrecellY),clyellow);
Affiche_TCO;
end;
end;
procedure TFormTCO.ButtonConfigTCOClick(Sender: TObject);
begin
TformconfigTCO.create(self);
@@ -1651,4 +1908,74 @@ begin
formconfigTCO.close;
end;
procedure TFormTCO.ImageFeuEndDrag(Sender, Target: TObject; X, Y: Integer);
var r : Trect;
begin
if (x=0) and (y=0) then exit;
Xclic:=X;YClic:=Y;
XclicCell:=Xclic div largeurCell +1;
YclicCell:=Yclic div hauteurCell +1;
//PCanvasTCO.Draw((xClicCell-1)*LargeurCell,(yClicCell-1)*HauteurCell,ImageFeu.Picture.Bitmap);
tco[XClicCell,YClicCell].BType:=0; // rien
tco[XClicCell,YClicCell].BImage:=12;
tco[XClicCell,YClicCell].Adresse:=0;
tco[XClicCell,YClicCell].FeuOriente:=1;
Affiche(IntToSTR(XclicCell),clyellow);
Affiche(IntToSTR(YclicCell),clyellow);
TransparentBlt(PcanvasTCO.Handle,(xClicCell-1)*LargeurCell,(yClicCell-1)*HauteurCell,LargeurCell,HauteurCell*2,Formprinc.Image9feux.Canvas.Handle,0,0,
Formprinc.Image9feux.Picture.Bitmap.Width,Formprinc.Image9feux.Picture.Bitmap.Height,clBlue);
PImageTCO.Picture.Bitmap.Modified:=True; // rafraichit l'affichage sinon le stretchblt n'apparaît pas.
EditAdrElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Adresse);
EdittypeElement.Text:=IntToSTR( tco[XClicCell,YClicCell].Btype);
EdittypeImage.Text:=IntToSTR(tco[XClicCell,YClicCell].BImage);
end;
procedure TFormTCO.ImageFeuMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ImageFeu.BeginDrag(true);
end;
procedure TFormTCO.Tourner90GClick(Sender: TObject);
var BImage,aspect,adresse : integer;
ImageFeu : TImage;
begin
BImage:=TCO[XClicCell,YClicCell].Bimage;
if Bimage<>12 then exit;
adresse:=TCO[XClicCell,YClicCell].Adresse;
ImageFeu:=PointeurImage(adresse);
TCO[XClicCell,YClicCell].FeuOriente:=2; // feu orienté à 90° gauche
// effacer le feu
Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,clred,PmCopy);
Feu_90G(ImageFeu,XClicCell,YclicCell);
Efface_cellule(PCanvasTCO,xClicCell,yClicCell+1,clred,PmCopy); // efface la partie basse du feu vertical
end;
procedure TFormTCO.Tourner90DClick(Sender: TObject);
var BImage ,aspect,adresse : integer;
ImageFeu : TImage;
begin
BImage:=TCO[XClicCell,YClicCell].Bimage;
if Bimage<>12 then exit;
adresse:=TCO[XClicCell,YClicCell].Adresse;
ImageFeu:=PointeurImage(adresse);
TCO[XClicCell,YClicCell].FeuOriente:=3; // feu orienté à 90° droit
// effacer le feu
Efface_Cellule(PCanvasTCO,xClicCell,yClicCell,clred,PmCopy);
Feu_90D(ImageFeu,XClicCell,YclicCell);
Efface_cellule(PcanvasTCO,xClicCell,yClicCell+1,clred,PmCopy); // efface la partie basse du feu vertical
end;
end.

BIN
verif_version.dcu
View File

Binary file not shown.