Аналоговые часы трабла со стрелками

Форум для изучающих FPC и их учителей.

Модератор: Модераторы

Re: Аналоговые часы трабла со стрелками

Сообщение Водород » 26.05.2010 19:52:30

дааа, аааа яяяя нннеееее мммммоооогггуууууу
Водород
новенький
 
Сообщения: 28
Зарегистрирован: 12.05.2010 12:29:35

Re: Аналоговые часы трабла со стрелками

Сообщение скалогрыз » 26.05.2010 19:55:18

Водород писал(а):дааа, аааа яяяя нннеееее мммммоооогггуууууу

ну что поделать!

я тебе уже как бы намекнул (ткнул пальцем), насчёт переменных RM1, a1,b1 или как они там... что их начальное значение **иногда** оставляет желать лучшего (что и приводит к развалу минутной стрелки).

ах... да: процедуры и функции - твои друзья
скалогрыз
долгожитель
 
Сообщения: 1803
Зарегистрирован: 03.09.2008 02:36:48

Re: Аналоговые часы трабла со стрелками

Сообщение Водород » 26.05.2010 19:57:41

блин я это сквощь пальцев не пустил пытался что то делать но не фига сёдня весь день этим паскалем занимаюсь мозги просто кепят
Водород
новенький
 
Сообщения: 28
Зарегистрирован: 12.05.2010 12:29:35

Re: Аналоговые часы трабла со стрелками

Сообщение скалогрыз » 26.05.2010 19:58:30

Водород писал(а):блин я это сквощь пальцев не пустил пытался что то делать но не фига сёдня весь день этим паскалем занимаюсь мозги просто кепят

подруги, пиво, свежий воздух!
у тебя до пятницы ещё четверг есть!

нужно давать себе отдых!
скалогрыз
долгожитель
 
Сообщения: 1803
Зарегистрирован: 03.09.2008 02:36:48

Re: Аналоговые часы трабла со стрелками

Сообщение Водород » 26.05.2010 19:59:46

четверг это отдельно, ехать нужно трудоустраиваться на лето... хлапот ппц
Водород
новенький
 
Сообщения: 28
Зарегистрирован: 12.05.2010 12:29:35

Re: Аналоговые часы трабла со стрелками

Сообщение скалогрыз » 26.05.2010 20:00:38

Водород писал(а):четверг это отдельно, ехать нужно трудоустраиваться на лето... хлапот ппц

т.е. я должен тебя избавить от хлопот?! %)

я же говорю, что начальные значения переменных у тебя левые. и "исправляются" только после 1й или 2й минуты...
вывод: нужно либо явно задать начальные значения, либо как-то иначе!
Последний раз редактировалось скалогрыз 26.05.2010 20:01:37, всего редактировалось 1 раз.
скалогрыз
долгожитель
 
Сообщения: 1803
Зарегистрирован: 03.09.2008 02:36:48

Re: Аналоговые часы трабла со стрелками

Сообщение Водород » 26.05.2010 20:01:11

я тебя не прошу ехать за меня трудоустраиваться))))
Водород
новенький
 
Сообщения: 28
Зарегистрирован: 12.05.2010 12:29:35

Re: Аналоговые часы трабла со стрелками

Сообщение скалогрыз » 26.05.2010 20:02:04

Водород писал(а):я тебя не прошу ехать за меня трудоустраиваться))))

давай я тоже тебе пожалуюсь! мне вот vds нужно проплачивать!
скалогрыз
долгожитель
 
Сообщения: 1803
Зарегистрирован: 03.09.2008 02:36:48

Re: Аналоговые часы трабла со стрелками

Сообщение Водород » 26.05.2010 20:02:51

всего то помочь с программой, я не виноват что у меня не получаеться((( пытаюсь как могу
Водород
новенький
 
Сообщения: 28
Зарегистрирован: 12.05.2010 12:29:35

Re: Аналоговые часы трабла со стрелками

Сообщение скалогрыз » 26.05.2010 20:03:38

Водород писал(а):всего то помочь с программой, я не виноват что у меня не получаеться((( пытаюсь как могу

а я не помог? :)
скалогрыз
долгожитель
 
Сообщения: 1803
Зарегистрирован: 03.09.2008 02:36:48

Re: Аналоговые часы трабла со стрелками

Сообщение Водород » 26.05.2010 20:03:55

ууу выделенный сервер это не шутки))))

Добавлено спустя 42 секунды:
помог, я не жалуюсь вот токо я не могу воспользоваться твоим советом потому что не понимаю как(((
Водород
новенький
 
Сообщения: 28
Зарегистрирован: 12.05.2010 12:29:35

Re: Аналоговые часы трабла со стрелками

Сообщение скалогрыз » 26.05.2010 20:04:37

Водород писал(а):ууу выделенный сервер это не шутки))))

ну он же виртуальный! если упадёт, так виртуально!

Добавлено спустя 27 секунд:
Водород писал(а):помог, я не жалуюсь вот токо я не могу воспользоваться твоим советом потому что не понимаю как(((

и с какого слово ты начинаешь не понимать?!
хотя нет... стоп. подождём, вдруг кто ещё объяснит что к чему. Скорей всего у других это получиться лучше! )
Последний раз редактировалось скалогрыз 26.05.2010 20:05:47, всего редактировалось 1 раз.
скалогрыз
долгожитель
 
Сообщения: 1803
Зарегистрирован: 03.09.2008 02:36:48

Re: Аналоговые часы трабла со стрелками

Сообщение Водород » 26.05.2010 20:05:45

я вообще не понимаю про что ты гвоорил когда я часы делал пример был перед глазами а тут...
Водород
новенький
 
Сообщения: 28
Зарегистрирован: 12.05.2010 12:29:35

Re: Аналоговые часы трабла со стрелками

Сообщение Putnick » 27.05.2010 08:37:10

Водород, подружитесь с процедурами и функциями! Они ребята хорошие :wink:
Касательно Вашей задачи:
Код: Выделить всё
Program fdgfaf;
uses graph, crt, SysUtils;

type
  TPoint=record
    x,y:integer
  end;
  pt=array [0..16000] of TPoint;

const
  Grd : double=pi/180;
  HourC=2;
  MinC=3;
  SecC=5;

var
  T : TSystemTime;     
  gd, gm, r: integer;
  PrH, PrM, PrS : integer;
  AHour, AMin, ASec:array [0..3] of TPoint;

Procedure GenArrow(L, th:integer; var Arrow);
begin
  PT(Arrow)[0].x:=0;
  PT(Arrow)[0].Y:=0;
  PT(Arrow)[1].x:=th;
  PT(Arrow)[1].Y:=-L div 2;
  PT(Arrow)[2].x:=0;
  PT(Arrow)[2].Y:=-L;
  PT(Arrow)[3].x:=-th;
  PT(Arrow)[3].Y:=-L div 2
end;

procedure FilledCircle(x,y,r,c:integer);
var
  tx,ty:integer;
begin
  SetColor(c);
  for ty:=0 to r do begin
    tx:=round(sqrt(r*r-ty*ty));
    Line(x-tx,y-ty,x+tx,y-ty);
    Line(x-tx,y+ty,x+tx,y+ty)
  end
end;

procedure FilledTriangle(x1,y1,x2,y2,x3,y3,c:integer);
var
  y:integer;
  dx1,dx2,dx3:real;
begin
  SetColor(c);
  if y1<y2 then begin
    y1:=y1+y2;
    y2:=y1-y2;
    y1:=y1-y2;
    x1:=x1+x2;
    x2:=x1-x2;
    x1:=x1-x2;
  end;
  if y1<y3 then begin
    y1:=y1+y3;
    y3:=y1-y3;
    y1:=y1-y3;
    x1:=x1+x3;
    x3:=x1-x3;
    x1:=x1-x3;
  end;
  if y2<y3 then begin
    y2:=y2+y3;
    y3:=y2-y3;
    y2:=y2-y3;
    x2:=x2+x3;
    x3:=x2-x3;
    x2:=x2-x3;
  end;
  if y1=y2 then dx1:=0 else dx1:=(x2-x1)/(y2-y1);
  if y2=y3 then dx2:=0 else dx2:=(x3-x2)/(y3-y2);
  if y1=y3 then dx3:=0 else dx3:=(x3-x1)/(y3-y1);
  for y:=y1 downto y2 do
    Line(x1+round(dx1*(y-y1)),y,x1+round(dx3*(y-y1)),y);
  for y:=y2 downto y3 do
    Line(x2+round(dx2*(y-y2)),y,x1+round(dx3*(y-y1)),y);
end;

procedure DrawArrow(x,y:integer; angle:real; c, np:integer; var Arrow);
var
  i:integer;
  sn, cs:real;
  SP:TPoint;
begin
  if np<3 then exit;
  sn:=sin(angle); 
  cs:=cos(angle);
  SP.X:=X+round(pt(Arrow)[0].X*cs-pt(Arrow)[0].Y*sn);
  SP.Y:=Y+round(pt(Arrow)[0].X*sn+pt(Arrow)[0].Y*cs);
  for i:=1 to np-2 do begin
    FilledTriangle(
   SP.X,
   SP.Y,
   X+round(pt(Arrow)[i].X*cs-pt(Arrow)[i].Y*sn),
   Y+round(pt(Arrow)[i].X*sn+pt(Arrow)[i].Y*cs),
   X+round(pt(Arrow)[i+1].X*cs-pt(Arrow)[i+1].Y*sn),
   Y+round(pt(Arrow)[i+1].X*sn+pt(Arrow)[i+1].Y*cs),
       c)
  end;
end;


BEGIN
gd:=vga;
gm:=2;
InitGraph(gd,gm,'');
r:=174;

GenArrow(R-10,5,ASec);
GenArrow(R-30,5,AMin);
GenArrow(R-70,5,AHour);

FilledCircle(300,250,200,12);
FilledCircle(300,250,180,10);
FilledCircle(300,250,174,15);
SetFillStyle(1,12);
Bar(150,247,170,253);
Bar(435,247,455,253);
Bar(297,389,303,409);
Bar(297,95,303,115);

GetLocalTime(T);
PrS:=T.Second;
PrM:=T.Minute;
PrH:=T.Hour;
SetColor(0);
OutTextXY(350,247,Format('%.2d.%.2d.%.4d',[T.Day, T.Month, T.Year]));
OutTextXY(270,370,Format('%.2d:%.2d:%.2d',[T.Hour, T.Minute, T.Second]));
DrawArrow(300,250, PrH*30*Grd, HourC, 4, AHour);
DrawArrow(300,250, PrM*6*Grd, MinC, 4, AMin);
DrawArrow(300,250, PrS*6*Grd, SecC, 4, ASec);

repeat
  GetLocalTime(T);
  if T.Second<>PrS then begin
    DrawArrow(300,250, PrH*30*Grd, 15, 4, AHour);
    DrawArrow(300,250, PrM*6*Grd, 15, 4, AMin);
    DrawArrow(300,250, PrS*6*Grd, 15, 4, ASec);
    SetFillStyle(1,12);
    Bar(150,247,170,253);
    Bar(435,247,455,253);
    Bar(297,389,303,409);
    Bar(297,95,303,115);
    SetFillStyle(1, 15);
    Bar(345,240,400,255);
    Bar(265,365,370,390);
    SetColor(0);
    OutTextXY(350,247,Format('%.2d.%.2d.%.4d',[T.Day, T.Month, T.Year]));
    OutTextXY(270,370,Format('%.2d:%.2d:%.2d',[T.Hour, T.Minute, T.Second]));
    PrS:=T.Second;
    if T.Hour<>PrH then PrH:=T.Hour;
    if T.Minute<>PrM then PrM:=T.Minute;
    DrawArrow(300,250, PrH*30*Grd, HourC, 4, AHour);
    DrawArrow(300,250, PrM*6*Grd, MinC, 4, AMin);
    DrawArrow(300,250, PrS*6*Grd, SecC, 4, ASec)
  end
until keypressed;

CloseGraph;
END.

Если слегка доработать, то можно так:
Код: Выделить всё
Program fdgfaf;
uses graph, crt, SysUtils;

type
  TPoint=record
    x,y:integer
  end;
  pt=array [0..16000] of TPoint;

const
  Grd : double=pi/180;
  HourC=2;
  MinC=3;
  SecC=5;

var
  T : TSystemTime;     
  gd, gm, r: integer;
  PrH, PrM, PrS : integer;
  AHour, AMin, ASec:array [0..3] of TPoint;

Procedure GenArrow(L, th:integer; var Arrow);
begin
  PT(Arrow)[0].x:=0;
  PT(Arrow)[0].Y:=0;
  PT(Arrow)[1].x:=th;
  PT(Arrow)[1].Y:=-L div 2;
  PT(Arrow)[2].x:=0;
  PT(Arrow)[2].Y:=-L;
  PT(Arrow)[3].x:=-th;
  PT(Arrow)[3].Y:=-L div 2
end;

procedure FilledCircle(x,y,r,c:integer);
var
  tx,ty:integer;
begin
  SetColor(c);
  for ty:=0 to r do begin
    tx:=round(sqrt(r*r-ty*ty));
    Line(x-tx,y-ty,x+tx,y-ty);
    Line(x-tx,y+ty,x+tx,y+ty)
  end
end;

procedure FilledTriangle(x1,y1,x2,y2,x3,y3,c:integer);
var
  y:integer;
  dx1,dx2,dx3:real;
begin
  SetColor(c);
  if y1<y2 then begin
    y1:=y1+y2;
    y2:=y1-y2;
    y1:=y1-y2;
    x1:=x1+x2;
    x2:=x1-x2;
    x1:=x1-x2;
  end;
  if y1<y3 then begin
    y1:=y1+y3;
    y3:=y1-y3;
    y1:=y1-y3;
    x1:=x1+x3;
    x3:=x1-x3;
    x1:=x1-x3;
  end;
  if y2<y3 then begin
    y2:=y2+y3;
    y3:=y2-y3;
    y2:=y2-y3;
    x2:=x2+x3;
    x3:=x2-x3;
    x2:=x2-x3;
  end;
  if y1=y2 then dx1:=0 else dx1:=(x2-x1)/(y2-y1);
  if y2=y3 then dx2:=0 else dx2:=(x3-x2)/(y3-y2);
  if y1=y3 then dx3:=0 else dx3:=(x3-x1)/(y3-y1);
  for y:=y1 downto y2 do
    Line(x1+round(dx1*(y-y1)),y,x1+round(dx3*(y-y1)),y);
  for y:=y2 downto y3 do
    Line(x2+round(dx2*(y-y2)),y,x1+round(dx3*(y-y1)),y);
end;

procedure DrawArrow(x,y:integer; angle:real; c, np:integer; var Arrow);
var
  i:integer;
  sn, cs:real;
  SP:TPoint;
begin
  if np<3 then exit;
  sn:=sin(angle); 
  cs:=cos(angle);
  SP.X:=X+round(pt(Arrow)[0].X*cs-pt(Arrow)[0].Y*sn);
  SP.Y:=Y+round(pt(Arrow)[0].X*sn+pt(Arrow)[0].Y*cs);
  for i:=1 to np-2 do begin
    FilledTriangle(
   SP.X,
   SP.Y,
   X+round(pt(Arrow)[i].X*cs-pt(Arrow)[i].Y*sn),
   Y+round(pt(Arrow)[i].X*sn+pt(Arrow)[i].Y*cs),
   X+round(pt(Arrow)[i+1].X*cs-pt(Arrow)[i+1].Y*sn),
   Y+round(pt(Arrow)[i+1].X*sn+pt(Arrow)[i+1].Y*cs),
       c)
  end;
end;


BEGIN
gd:=vga;
gm:=2;
InitGraph(gd,gm,'');
r:=174;

GenArrow(R-10,5,ASec);
GenArrow(R-30,5,AMin);
GenArrow(R-70,5,AHour);

FilledCircle(300,250,200,12);
FilledCircle(300,250,180,10);
FilledCircle(300,250,174,15);
SetFillStyle(1,12);
Bar(150,247,170,253);
Bar(435,247,455,253);
Bar(297,389,303,409);
Bar(297,95,303,115);
SetColor(0);
for PrS:=0 to 59 do begin
  if (PrS mod 5)=0 then SetLineStyle(0,0,3) else SetLineStyle(0,0,1);
  Line(
   300+round(176*sin(Prs*6*Grd)),
   250-round(176*cos(Prs*6*Grd)),
   300+round(179*sin(Prs*6*Grd)),
   250-round(179*cos(Prs*6*Grd))
   )
end;

GetLocalTime(T);
PrS:=T.Second;
PrM:=T.Minute;
PrH:=T.Hour;
SetColor(0);
OutTextXY(350,247,Format('%.2d.%.2d.%.4d',[T.Day, T.Month, T.Year]));
OutTextXY(270,370,Format('%.2d:%.2d:%.2d',[T.Hour, T.Minute, T.Second]));
DrawArrow(300,250, (PrH+PrM/60+PrS/3600)*30*Grd, HourC, 4, AHour);
DrawArrow(300,250, (PrM+PrS/60)*6*Grd, MinC, 4, AMin);
DrawArrow(300,250, PrS*6*Grd, SecC, 4, ASec);

repeat
  GetLocalTime(T);
  if T.Second<>PrS then begin
    DrawArrow(300,250, (PrH+PrM/60+PrS/3600)*30*Grd, 15, 4, AHour);
    DrawArrow(300,250, (PrM+PrS/60)*6*Grd, 15, 4, AMin);
    DrawArrow(300,250, PrS*6*Grd, 15, 4, ASec);
    SetFillStyle(1,12);
    Bar(150,247,170,253);
    Bar(435,247,455,253);
    Bar(297,389,303,409);
    Bar(297,95,303,115);
    SetFillStyle(1, 15);
    Bar(345,240,400,255);
    Bar(265,365,370,390);
    SetColor(0);
    OutTextXY(350,247,Format('%.2d.%.2d.%.4d',[T.Day, T.Month, T.Year]));
    OutTextXY(270,370,Format('%.2d:%.2d:%.2d',[T.Hour, T.Minute, T.Second]));
    PrS:=T.Second;
    if T.Hour<>PrH then PrH:=T.Hour;
    if T.Minute<>PrM then PrM:=T.Minute;
    DrawArrow(300,250, (PrH+PrM/60+PrS/3600)*30*Grd, HourC, 4, AHour);
    DrawArrow(300,250, (PrM+PrS/60)*6*Grd, MinC, 4, AMin);
    DrawArrow(300,250, PrS*6*Grd, SecC, 4, ASec)
  end
until keypressed;

CloseGraph;
END.
Putnick
новенький
 
Сообщения: 62
Зарегистрирован: 18.03.2009 13:02:56

Re: Аналоговые часы трабла со стрелками

Сообщение rPy3-200 » 15.10.2010 22:52:14

Блин отдохнул прямо таки, интересно водород защитился, да и летом много заработал?
rPy3-200
новенький
 
Сообщения: 10
Зарегистрирован: 14.10.2010 15:44:11

Пред.След.

Вернуться в Обучение Free Pascal

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 9

Рейтинг@Mail.ru
cron