Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons;
type
TForm1 = class(TForm)
Image1: TImage;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Edit1: TEdit;
Timer1: TTimer;
Clickpl: TCheckBox;
procedure Timer1Timer(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
procedure Line(Image:TImage;x1,y1,x2,y2:integer);
begin
with Image.Canvas do begin
MoveTo(x1,y1); LineTo(x2,y2);
end;
end;
procedure Opora(Image:Timage;x,y,Orient:integer);
var i:integer;
begin
with Image.Canvas do begin
pen.Style:=psSolid;
pen.Width := 3;
case Orient of
0:begin
MoveTo(x+4,y-2); LineTo(x+20,y-10);
MoveTo(x+2,y+2); LineTo(x+20,y+10);
MoveTo(x+20,y-15); LineTo(x+20,y+15);
pen.Width:=1;
for i := 1 to 6 do begin
MoveTo(x+20,y-15+i*5);
LineTo(x+25,y-20+i*5);
end;
end;
90:begin
MoveTo(x+2,y-4); LineTo(x+10,y-20);
MoveTo(x-2,y-4); LineTo(x-10,y-20);
MoveTo(x-15,y-20); LineTo(x+15,y-20);
pen.Width:=1;
for i := 1 to 6 do begin
MoveTo(x-15+i*5,y-20);
LineTo(x-20+i*5,y-25);
end;
end;
180:begin
MoveTo(x-4,y-2); LineTo(x-20,y-10);
MoveTo(x-2,y+2); LineTo(x-20,y+10);
MoveTo(x-20,y-15); LineTo(x-20,y+15);
pen.Width:=1;
for i := 1 to 6 do begin
MoveTo(x-20,y-15+i*5);
LineTo(x-25,y-20+i*5);
end;
end;
270:begin
MoveTo(x+2,y+4); LineTo(x+10,y+20);
MoveTo(x-2,y+4); LineTo(x-10,y+20);
MoveTo(x-15,y+20); LineTo(x+15,y+20);
pen.Width:=1;
for i := 1 to 6 do begin
MoveTo(x-15+i*5,y+20);
LineTo(x-20+i*5,y+25);
end;
end;
end;
end;
end;
procedure uzel(Image:TImage; x,y:integer ;Name:string);
var i:integer;
begin
with Image.Canvas do begin
pen.Style:=psSolid;
pen.Width := 3;
Ellipse(x-4,y-4,x+4,y+4);
i:=Pen.Color;
Pen.Color := clBackground;
ellipse(x-2,y-2,x+2,y+2);
Pen.Color :=i;
TextOut(x+5,y-5,Name);
end;
end;
procedure StoykaVer(Image:Timage;x,y,lRt,LLf:integer);
const l1=10;
begin
with Image.Canvas do begin
pen.Style:=psSolid;
pen.Width := 3;
Line(Image,x-LLf,y-l1,x+LRt,y-l1);
Line(Image,x-LLf,y+l1,x+LRt,y+l1);
Arc(x-LLf-l1,y-l1,x-LLf+l1,y+l1,x-LLf,y-l1,x-LLf,y+l1);
Arc(x+LRt-l1,y-l1,x+LRt+l1,y+l1,x+LRt,y+l1,x+LRt,y-l1);
line(Image,x,y-l1,x,y-(LRt+LLf));
end;
end;
procedure NapravVer(Image:Timage;x,y,l:integer);
var i:integer;
const d=8;
begin
with Image.Canvas do begin
pen.Style:=psSolid;
pen.Width := 3;
line(Image,x-d,y-l,x-d,y);
line(Image,x+d,y-l,x+d,y);
pen.Width := 1;
for i := 0 to round(l/5-1) do
line(Image,x+d,y-l+i*5,x+2*d,y-l+(i+1)*5);
end;
end;
function Yp(H,B,e:real;a:real):real;
begin
Yp:=((H/2+B/2))+round(e*sin(a));
end;
function u(e, a:real):real;
begin
u:=e*cos(a);
end;
{$R *.dfm}
procedure TForm1.Timer1Timer(Sender: TObject);
var p,code,w,i:integer; e1,b1,d1,l1,h1,k:real;
a,e,b,d,l,h,Yp1:real; x0,y0,xa,ya,yb,xb:integer;
begin
p:=1;
e:=40;
d:=2*e+10;
b:=d+10;
l:=b+2*e;
h:=B+2*e+30;
{1}
if e=0 then e:=35;
k:= 45/e;
e1:=e*k;
b1:=b*k;
d1:=d*k;
l1:=l*k;
h1:=h*k;
val(Edit1.Text,p,code);
i:=i+p;
if i>360 then i:=i-360;
{2}
a:=i*Pi/180;
Yp1:=Yp(H1,B1,e1,a);
{3}
x0:=350; y0:=300;
xA:=(x0+round(e1*cos(a)));
yA:=(y0+round(e1*sin(a)));
xb:=x0;
Yb:=round(y0-(yp1-h1/2));
w:=round(b1/2);
if Clickpl.Checked
then Image1.Canvas.FillRect(Rect(0,0,Image1.Width,Image1.Height));
{5}
Opora(Image1,x0,y0,0);
image1.Canvas.Pen.Width:=3;
Image1.Canvas.MoveTo(x0,y0); Image1.Canvas.LineTo(xA, yA);
StoykaVer(Image1,x0,ya,w,w);
NapravVer(Image1,x0,y0-round(d1/2)-15,w);
Uzel(Image1,x0,y0, '');
Uzel(Image1,xA,yA, '');
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Timer1.Enabled:=true
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
Timer1.Enabled:=false
end;
end.