Показать сообщение отдельно
Старый 25.05.2015, 14:18   #7 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

Цитата:
Сообщение от Asya_inter Посмотреть сообщение
а также изобразить именно ГЛАДКИЙ, а не матовый шар.
Увы-увы, у меня получается такой... шероховатый. В общем, надо издали смотреть и без очков - тогда нормально. Вот - в Turbo (Free):
Код:
Uses Graph, CRT;

Var
 R1,X1,Y1,X2,Y2,X,Y:Word;
 Sgm:Real;
 i:LongInt;

Procedure Gs(Sigma:Real; var Xg:Word; var Yg:Word);
var
 u,v,x,y:real;
begin
 u:=Random;
 v:=Random;
 x:=Sqrt(-Ln(v)*2)*Cos(u*2*Pi)*Sigma;
 y:=Sqrt(-Ln(v)*2)*Sin(u*2*Pi)*Sigma;
 if Sqrt(Sqr(X2+x-1.0*X1)+Sqr(1.0*Y2-y-Y1))>R1 then
  begin
   Xg:=X2;
   Yg:=Y2;
  end
 else
  begin
   Xg:=Round(1.0*X2+x);
   Yg:=Round(1.0*Y2-y);
  end;
end;

Begin
 InitGraph(...  { Тут - самостоятельно! }
 Randomize;
 SetBkColor(7);
 R1:=GetMaxY div 4;
 X1:=GetMaxX div 2;
 Y1:=GetMaxY div 2;
 SetColor(8);
 SetFillStyle(SolidFill,8);
 FillEllipse(X1,Y1,R1,R1);
 X2:=Round(X1+0.3*R1);
 Y2:=Round(Y1-0.3*R1);
 Sgm:=R1/3;  {Red}
 for i:=1 to 400000 do
  begin
   Gs(Sgm,X,Y);
   PutPixel(X,Y,4);
  end;
 Sgm:=R1/4;  {LightRed}
 for i:=1 to 80000 do
  begin
   Gs(Sgm,X,Y);
   PutPixel(X,Y,12);
  end;
 Sgm:=R1/5;  {Yellow}
 for i:=1 to 10000 do
  begin
   Gs(Sgm,X,Y);
   PutPixel(X,Y,14);
  end;
 ReadKey;
 CloseGraph;
End.
Изображения
 
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070