V1.3
This commit is contained in:
f1iwq2
280
UnitTCO.pas
280
UnitTCO.pas
@@ -8,7 +8,6 @@ uses
|
||||
|
||||
type
|
||||
TFormTCO = class(TForm)
|
||||
DrawGrid: TDrawGrid;
|
||||
Button1: TButton;
|
||||
LabelX: TLabel;
|
||||
Label2: TLabel;
|
||||
@@ -19,14 +18,25 @@ type
|
||||
PopupMenu1: TPopupMenu;
|
||||
Position1: TMenuItem;
|
||||
N1: TMenuItem;
|
||||
Insrer1: TMenuItem;
|
||||
aiguillageG_PG: TMenuItem;
|
||||
Label1: TLabel;
|
||||
aiguillageD_PD: TMenuItem;
|
||||
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);
|
||||
procedure ImageTCOContextPopup(Sender: TObject; MousePos: TPoint;
|
||||
var Handled: Boolean);
|
||||
procedure aiguillageG_PGClick(Sender: TObject);
|
||||
procedure dessin_AigPG_AG(x,y : integer;couleur : Tcolor);
|
||||
procedure dessin_AigPD_AD(x,y : integer;couleur : Tcolor);
|
||||
procedure dessin_cbgd(x,y : integer;couleur : Tcolor);
|
||||
procedure dessin_cdbas(x,y : integer;couleur : Tcolor);
|
||||
procedure Entoure_cell(x,y : integer);
|
||||
procedure FormKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
procedure aiguillageD_PDClick(Sender: TObject);
|
||||
private
|
||||
{ Déclarations privées }
|
||||
public
|
||||
@@ -36,8 +46,9 @@ type
|
||||
|
||||
var
|
||||
FormTCO: TFormTCO;
|
||||
Forminit : boolean;
|
||||
NbreCellX,NbreCellY,HtImageTCO,LargImageTCO,XclicCell,YclicCell : integer;
|
||||
LargeurCell,HauteurCell,Xclic,Yclic : integer;
|
||||
LargeurCell,HauteurCell,Xclic,Yclic,XClicCellInserer,YClicCellInserer : integer;
|
||||
tco : array[1..20,1..20] of Tbranche;
|
||||
|
||||
procedure construit_TCO;
|
||||
@@ -80,6 +91,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
// élément de voie horizontale
|
||||
procedure dessin_voie(x,y : integer);
|
||||
var x1,y1 : integer;
|
||||
r : Trect;
|
||||
@@ -91,25 +103,25 @@ begin
|
||||
end;
|
||||
with formTCO.ImageTCO.canvas do
|
||||
begin
|
||||
r:=Rect(x1,y1+(HauteurCell div 2)-5,x1+LargeurCell,y1 + (HauteurCell div 2)+5);
|
||||
r:=Rect(x1,y1+(HauteurCell div 2)-3,x1+LargeurCell,y1 + (HauteurCell div 2)+3);
|
||||
Brush.COlor:=ClRed;
|
||||
FillRect(r);
|
||||
end;
|
||||
end;
|
||||
|
||||
// aiguillage pointe à gauche, monte gauche
|
||||
procedure dessin_AigPGMG(x,y : integer;couleur : Tcolor);
|
||||
// aiguillage pointe à gauche, aiguillage gauche
|
||||
procedure TFormTCO.dessin_AigPG_AG(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;
|
||||
x0:=(x-1)*LargeurCell;
|
||||
y0:=(y-1)*HauteurCell;
|
||||
|
||||
with formTCO.ImageTCO.canvas do
|
||||
with ImageTCO.canvas do
|
||||
begin
|
||||
Brush.COlor:=couleur;
|
||||
Brush.Color:=couleur;
|
||||
pen.color:=couleur;
|
||||
|
||||
Pen.Mode:=PmCopy;
|
||||
jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup
|
||||
jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf
|
||||
|
||||
@@ -131,18 +143,50 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
// aiguillage pointe à droite, aiguillage droit
|
||||
procedure TFormTCO.dessin_AigPD_AD(x,y : integer;couleur : Tcolor);
|
||||
var x0,y0,x1,y1,x2,y2,x3,y3,x4,y4,jy1,jy2 : integer;
|
||||
r : Trect;
|
||||
begin
|
||||
x0:=(x-1)*LargeurCell;
|
||||
y0:=(y-1)*HauteurCell;
|
||||
|
||||
with ImageTCO.canvas do
|
||||
begin
|
||||
Brush.COlor:=couleur;
|
||||
Pen.Mode:=PmCopy;
|
||||
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+3; y2:=y0;
|
||||
x3:=x0; y3:=y0+3;
|
||||
x4:=x0+(largeurCell div 2); y4:=jy2;
|
||||
Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4-1,y4-1)]);
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
// courbe bas gauche vers droit
|
||||
procedure dessin_cbgd(x,y : integer;couleur : Tcolor);
|
||||
procedure TFormTCO.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;
|
||||
x0:=(x-1)*LargeurCell;
|
||||
y0:=(y-1)*HauteurCell;
|
||||
|
||||
with formTCO.ImageTCO.canvas do
|
||||
with ImageTCO.canvas do
|
||||
begin
|
||||
Brush.COlor:=Couleur;
|
||||
pen.color:=Couleur;
|
||||
Pen.Mode:=PmCopy;
|
||||
|
||||
jy1:=y0+(HauteurCell div 2)-3; // pos Y de la bande sup
|
||||
jy2:=y0+(HauteurCell div 2)+3; // pos Y de la bande inf
|
||||
@@ -163,7 +207,41 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
// courbe: droit vers bas -\
|
||||
procedure TFormTCO.dessin_cdbas(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-1)*LargeurCell;
|
||||
y0:=(y-1)*HauteurCell;
|
||||
|
||||
with ImageTCO.canvas do
|
||||
begin
|
||||
Brush.COlor:=Couleur;
|
||||
Pen.Mode:=PmCopy;
|
||||
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 div 2),jy2);
|
||||
FillRect(r);
|
||||
|
||||
// brush.color:=clblue;
|
||||
x1:=x0+(LargeurCell div 2) ;
|
||||
y1:=jy1;
|
||||
x2:=x0+LargeurCell;
|
||||
y2:=y0+HauteurCell-3;
|
||||
x3:=x0+LargeurCell -2;
|
||||
y3:=y0+HauteurCell;
|
||||
x4:=x0+(LargeurCell div 2);
|
||||
y4:=jy2;
|
||||
Polygon([point(x1,y1),Point(x2,y2),Point(x3,y3),Point(x4,y4)]);
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
// transforme les branches en TCO
|
||||
// à voir, trop compliqué. Il faudra dessiner son TCO soit meme
|
||||
procedure construit_TCO;
|
||||
var x,y,i,j,Max,indexMax : integer;
|
||||
begin
|
||||
@@ -193,8 +271,6 @@ begin
|
||||
TCO[i,5].Adresse:=BrancheN[IndexMax,i].Adresse;
|
||||
TCO[i,5].Btype:=BrancheN[IndexMax,i].Btype;
|
||||
end;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
procedure Affiche_TCO ;
|
||||
@@ -220,7 +296,7 @@ begin
|
||||
if Btype=2 then s:='A'+s;
|
||||
if Btype=3 then s:='A'+s+'B';
|
||||
|
||||
Textout(Xorg+2,Yorg+2,s);
|
||||
if i<>0 then Textout(Xorg+2,Yorg+2,s);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@@ -228,114 +304,146 @@ end;
|
||||
|
||||
procedure TFormTCO.FormCreate(Sender: TObject);
|
||||
begin
|
||||
|
||||
caption:='TCO';
|
||||
NbreCellX:=20;
|
||||
NbreCellY:=10;
|
||||
LargeurCell:=35;
|
||||
HauteurCell:=35;
|
||||
//grille;
|
||||
// HtImageTCO:=ImageTCO.Height;
|
||||
|
||||
XclicCell:=1;
|
||||
YclicCell:=1;
|
||||
KeyPreview:=true; // valide les évènements clavier
|
||||
// grille;
|
||||
// Entoure_cell(XclicCell,YclicCell);
|
||||
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);
|
||||
repaint;
|
||||
end;
|
||||
|
||||
|
||||
// clic gauche sur image
|
||||
procedure TFormTCO.ImageTCOClick(Sender: TObject);
|
||||
var Position: TPoint;
|
||||
begin
|
||||
Entoure_cell(XclicCell,YclicCell);
|
||||
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);
|
||||
|
||||
|
||||
label1.caption:='clicContext';
|
||||
XclicCellInserer:=XClicCell;
|
||||
YclicCellInserer:=YClicCell;
|
||||
Entoure_cell(XclicCellInserer,YclicCellInserer);
|
||||
end;
|
||||
|
||||
procedure TformTCO.Entoure_cell(x,y : integer);
|
||||
var r : Trect;
|
||||
x0,y0 : integer;
|
||||
begin
|
||||
x0:=(x-1)*LargeurCell+1;
|
||||
y0:=(y-1)*HauteurCell+1;
|
||||
with ImageTCO.canvas do
|
||||
begin
|
||||
Pen.width:=3;
|
||||
Pen.Color:=clyellow;
|
||||
Brush.Color:=clBlack;
|
||||
Brush.Style:=bsSolid;
|
||||
Pen.Mode:=PmXor;
|
||||
r:=Rect(x0,y0,x0+largeurCell,y0+LargeurCell);
|
||||
Rectangle(r);
|
||||
// FillRect(r);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
|
||||
procedure TFormTCO.FormActivate(Sender: TObject);
|
||||
begin
|
||||
|
||||
grille;
|
||||
if not(Forminit) then
|
||||
begin
|
||||
FormInit:=true;
|
||||
grille;
|
||||
Entoure_cell(XclicCell,YclicCell);
|
||||
end;
|
||||
{
|
||||
dessin_voie(3,3);
|
||||
dessin_voie(10,4);
|
||||
dessin_AigPGMG(7,6,clyellow);
|
||||
dessin_AigPG_AG(7,6,clyellow);
|
||||
dessin_AigPD_AD(12,6,clyellow);
|
||||
|
||||
dessin_cbgd(8,5,clyellow);
|
||||
|
||||
formprinc.Hide;
|
||||
dessin_voie(9,5);dessin_voie(10,5);
|
||||
dessin_cdbas(11,5,clyellow); }
|
||||
//formprinc.Hide;
|
||||
end;
|
||||
|
||||
// evt qui se produit quand on clic droit dans l'image
|
||||
procedure TFormTCO.ImageTCOContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
|
||||
var Position: TPoint;
|
||||
begin
|
||||
// efface le carré pointeur
|
||||
Entoure_cell(XclicCell,YclicCell);
|
||||
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);
|
||||
|
||||
label1.caption:='clicContext';
|
||||
XclicCellInserer:=XClicCell;
|
||||
YclicCellInserer:=YClicCell;
|
||||
Entoure_cell(XclicCellInserer,YclicCellInserer);
|
||||
end;
|
||||
|
||||
// menu droit "clic aiguillage G PG"
|
||||
procedure TFormTCO.aiguillageG_PGClick(Sender: TObject);
|
||||
var Position: TPoint;
|
||||
begin
|
||||
// effacer le carré pointeur
|
||||
Entoure_cell(XclicCell,YclicCell);
|
||||
GetCursorPos(Position);
|
||||
// dessine le dessin
|
||||
dessin_AigPG_AG(XClicCellInserer,YClicCellInserer,clyellow);
|
||||
// remet le carré pointeur
|
||||
Entoure_cell(XclicCell,YclicCell);
|
||||
GetCursorPos(Position);
|
||||
end;
|
||||
|
||||
// menu droit "clic aiguillage D PD"
|
||||
procedure TFormTCO.aiguillageD_PDClick(Sender: TObject);
|
||||
var Position: TPoint;
|
||||
begin
|
||||
// effacer le carré pointeur
|
||||
Entoure_cell(XclicCell,YclicCell);
|
||||
GetCursorPos(Position);
|
||||
// dessine le dessin
|
||||
dessin_AigPD_AD(XClicCellInserer,YClicCellInserer,clyellow);
|
||||
// remet le carré pointeur
|
||||
Entoure_cell(XclicCell,YclicCell);
|
||||
GetCursorPos(Position);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure TFormTCO.FormKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
|
||||
begin
|
||||
Entoure_cell(XclicCell,YclicCell);
|
||||
case Key of
|
||||
VK_right : if XClicCell<NbreCellX then inc(XClicCell);
|
||||
VK_left : if XClicCell>1 then dec(XClicCell);
|
||||
VK_down : if YClicCell<NbreCellY then inc(YClicCell);
|
||||
VK_up : if YClicCell>1 then dec(YClicCell);
|
||||
end;
|
||||
LabelX.caption:=IntToSTR(XClicCell);
|
||||
LabelY.caption:=IntToSTR(YClicCell);
|
||||
Entoure_cell(XclicCell,YclicCell);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user