Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 24.04.2012, 22:45   #1
novichokkk
Пользователь
 
Регистрация: 18.04.2012
Сообщений: 10
По умолчанию листинг программы

Помогите пожалуйста!!!
опешите листинг программы, а именно комментарий к процедурам хотелось бы!!

Код:
var
  Form1: TForm1;
  rnd,x1,x2,x3,y1,y2,y3,FinalAge:integer;
  c:char;
  ot:string;
cc,AngleR,AngleL,StartAngle,ConCoef:Real;
implementation

{$R *.dfm}
{Treugolnik Serpinskogo}


procedure Line(x1,y1,x2,y2:real; C:TCanvas);
begin
 c.Moveto(round(x1),round(y1));
 c.lineto(round(x2),round(y2));
 end;

Procedure TriS(age:integer;x1,y1,x2,y2,x3,y3:real);
var
xd,yd,xe,ye,xf,yf:real;
begin
inc(age);

if age= FinalAge then
begin
line(x1,y1,x2,y2, Form1.Image1.Canvas);
line(x2,y2,x3,y3, Form1.Image1.Canvas);
line(x3,y3,x1,y1, Form1.Image1.Canvas);
form1.Image1.Canvas.Refresh;
end
else
begin
xd:=round((x1+x2)/2);
yd:=round((y1+y2)/2);

xe:=round((x2+x3)/2);
ye:=round((y2+y3)/2);

xf:=round((x1+x3)/2);
yf:=round((y1+y3)/2);

TriS(age,x1,y1,xd,yd,xf,yf);
TriS(age,xd,yd,x2,y2,xe,ye);
TriS(age,xf,yf,xe,ye,x3,y3);
end;
end;




procedure TForm1.SpeedButton1Click(Sender: TObject);
begin

image1.Canvas.Brush.Color:=clWhite;
image1.Canvas.rectangle(0,0,image1.Width,image1.Height);

x1:=10;
y1:=10;
x2:=320;
y2:=470;
x3:=630;
y3:=10;

image1.Canvas.CleanupInstance;
image1.Canvas.rectangle(0,0,640,480);
if spinedit1.value >0 then
begin
Finalage:=Spinedit1.Value;
Tris(0,x1,y1,x2,y2,x3,y3);
end;
end;

Procedure drawtree(age,kx,ky,r:integer; naklon:real);
var
sx,sy:integer;
begin
 r:=round(r-0.2*r);
inc(AGe);
  if age=FinalAge then
  begin
   Line(kx,ky,round(kx + R * cos(naklon)), round(ky + R * sin(naklon)),form1.Image2.Canvas);
   sx:=round(kx + R * cos(naklon));
   sy:=round(ky + R * sin(naklon));
   Line(sx,sy,round(sx + R * cos(naklon-angleL)), round(sy + R * sin(naklon-angleL)), form1.Image2.Canvas);
   Line(sx,sy,round(sx + R * cos(naklon+angleR)), round(sy + R * sin(naklon+angleR)),form1.Image2.Canvas);
  end
 else
  begin
   sx:=round(kx + R * cos(naklon));
   sy:=round(ky + R * sin(naklon));
drawtree(age,sx,sy,r+random(rnd),naklon-angleL);
drawtree(age,sx,sy,r+random(rnd),naklon+angleR);
   Line(kx,ky,round(kx + R * cos(naklon)), round(ky + R * sin(naklon)),form1.Image2.Canvas);
  end;
end;


procedure TForm1.SpeedButton2Click(Sender: TObject);
var
StartX,StartY,StartHeight:integer;
ot,tm:string;
i,j,iter,Total:longint;
StartH,StartM,StartS,StartS1,StopH,StopM,StopS,StopS1:word;
begin

ConCoef:=(pi/180);

AngleL:=spinedit3.value*ConCoef;        AngleR:=Spinedit4.value*ConCoef;

 StartHeight:=spinedit7.Value;
 StartAngle:=3/2*pi;
 StartX:=320;
 StartY:=480;
 Color:=15;
 RND:=0;

 Image2.canvas.CleanupInstance;
image2.Canvas.Brush.Color:=clWhite;
 image2.Canvas.rectangle(0,0,image2.Width,image2.Height);

if (spinedit2.Value>0) and (spinedit5.Value>=0) then
begin
RND:=spinedit5.Value;
FinalAge:=Spinedit2.Value;
drawtree(0,StartX,StartY,StartHeight,StartAngle);
end;



end;



Procedure DrawDragon(age:integer;x1,y1,x2,y2:real;n:real);
var
dx,dy,AC,CD,AD,cx,cy:real;
begin

inc(age);
if Age=FinalAge then
begin
line(x1,y1,x2,y2, form1.image3.canvas);
end

else

begin

cx:=(x2+x1)/2;
cy:=(y2+y1)/2;

AC:=sqrt(sqr(cx-x1)+sqr(cy-y1));
dx:=cx + AC * (cos(n+pi/2));
dy:=cy + AC * (sin(n+pi/2));
drawdragon(age,x1,y1,dx,dy,n+45*cc);
drawdragon(age,x2,y2,dx,dy,n+90*cc+45*cc);

end;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin

x1:=145;
y1:=160;
x2:=560;
y2:=160;

CC:=(pi/180);

FinalAge:=spinedit6.Value;

image3.Canvas.Brush.Color:=clWhite;
image3.Canvas.rectangle(0,0,image3.Width,image3.Height);
DrawDragon(0,x1,y1,x2,y2,0);


end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var zr,zi,zzr,zzi,x,y,ib,jb,dl:real;
i,j,n:integer;
label l;
begin
ib:=((sx.value*8)/400)-2;
jb:=((sy.value*8)/400)-2;
dl:=400/(sn.Value);
for i:=1 to 400 do begin
application.ProcessMessages;
for j:=1 to 400 do begin
zi:=0;zr:=0;
x:=ib+i*(dl/400);
y:=jb+j*(dl/400);
for n:=0 to sn.value do begin
zzr:=zr*zr-zi*zi+x;
zzi:=2*zr*zi+y;
if(abs(zzi)>=2)or(abs(zzr)>=2)or((zzi*zzi+zzr*zzr)>=4)then goto l;
zr:=zzr;
zi:=zzi;
end;
l:
image4.Canvas.Pixels[i,j]:=round(16777216-5200*n);
end;
end;

end;

end.

Последний раз редактировалось novichokkk; 24.04.2012 в 23:27.
novichokkk вне форума Ответить с цитированием
Старый 24.04.2012, 22:51   #2
novichokkk
Пользователь
 
Регистрация: 18.04.2012
Сообщений: 10
По умолчанию

программа строит фракталы
novichokkk вне форума Ответить с цитированием
Старый 24.04.2012, 23:07   #3
spinogryz_ua
Форумчанин
 
Аватар для spinogryz_ua
 
Регистрация: 14.01.2012
Сообщений: 150
По умолчанию

Уважаемый, большая просьба, не забывайте нажимать на "#" перед тем как вставляете код програмы. Уважайте тех кто захочет ВАМ помочь
spinogryz_ua вне форума Ответить с цитированием
Старый 24.04.2012, 23:22   #4
novichokkk
Пользователь
 
Регистрация: 18.04.2012
Сообщений: 10
По умолчанию

Извините я не совсем понял что я должен сделать)) просто новенький еще может чего не догоняю... программа на Pascal
novichokkk вне форума Ответить с цитированием
Старый 24.04.2012, 23:28   #5
novichokkk
Пользователь
 
Регистрация: 18.04.2012
Сообщений: 10
По умолчанию

Понял поправил)))
novichokkk вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Необходимо разработать программное средство. Листинг программы присутствует) С++ Builder XE Faster_kill Помощь студентам 5 24.02.2012 21:27
Найти значение арифметического выражения (напишите листинг программы на ассемблере) POMOGIteMNE Помощь студентам 2 02.12.2011 17:37
Есть листинг программы. Нужно его упростить. micr0 Помощь студентам 0 01.12.2011 18:42
Проверьте листинг ARtor Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 0 08.06.2011 17:35
Cамый краткий листинг - самый подробный листинг. katia2011 Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 2 13.04.2011 19:10