home *** CD-ROM | disk | FTP | other *** search
- PROGRAM ProbaTriangle; { Dibujado de triangulos rellenos. Navi/PhyMosys }
-
- USES Crt;
-
- VAR i : Integer;
-
- PROCEDURE Modo(x : WORD); Assembler;
- ASM
- mov ax, x
- int 10h
- END;
-
- PROCEDURE Linea(X, Y, tamany : Integer; color : BYTE; dreta : Boolean);
- VAR
- i : Integer;
- BEGIN
- If dreta Then
- For i:=0 to tamany do
- Mem[$A000:(Y*320+X+i)]:=color
- Else
- For i:=0 to tamany do
- Mem[$A000:(Y*320+X-i)]:=color;
- END;
-
- PROCEDURE Triangle(x1,y1, x2,y2, x3,y3 : Integer; col : BYTE);
- PROCEDURE Canviar(VAR a, b : Integer);
- VAR Aux : Integer;
- BEGIN
- Aux:=b;
- b:=a;
- a:=Aux;
- END;
- VAR
- Cy1,
- Cx1, Cx2 : Real;
- m1, m2 : Real;
- com : Boolean;
- BEGIN
- If NOT (y1<y2) Then
- BEGIN
- Canviar(x1,x2);
- Canviar(y1,y2);
- END;
- If NOT (y1<y3) Then
- BEGIN
- Canviar(x1,x3);
- Canviar(y1,y3);
- END;
- If NOT (y2<y3) Then
- BEGIN
- Canviar(x2,x3);
- Canviar(y2,y3);
- END; { Ordenados! }
- Cx1:=x1; Cy1:=y1;
- Cx2:=x1;
- m1:=(x1-x3)/(y1-y3);
- m2:=(x2-x1)/(y2-y1);
- If x2>x1 Then
- com:=TRUE
- Else
- com:=FALSE;
- While Cy1<y2 do
- BEGIN
- Linea(Integer(Round(Cx1)), Integer(Round(Cy1)),
- Integer(Abs(Round(Cx2-Cx1))), col, com);
- Cx1:=Cx1+m1;
- Cx2:=Cx2+m2;
- Cy1:=Cy1+1;
- END;
- m2:=(x2-x3)/(y2-y3);
- While Cy1<=y3 do
- BEGIN
- Linea(Integer(Round(Cx1)), Integer(Round(Cy1)),
- Integer(Abs(Round(Cx2-Cx1))), col, com);
- Cx1:=Cx1+m1;
- Cx2:=Cx2+m2;
- Cy1:=Cy1+1;
- END;
- END;
-
- BEGIN
- WriteLn('Demo de dibujado de triangulos');
- ReadLn;
- Modo($13);
-
- For i:=1 to 200 do
- BEGIN
- Triangle(130,80, 100,20, 40,130, i);
- Triangle(20,60, 20,30, 100,40, i);
- Triangle(310,0, 170,110, 190,15, i);
- Triangle(134,150, 95,135, 120,115, i);
- END;
-
- ReadLn;
- Modo(3);
- END.
-