Как написать часы со стрелками?

← →
tazik © (2005-03-15 21:17) [0]

Приспичило, а мозги не варят :) Помогите, чем сможете :)

← →
Fenik (2005-03-15 21:23) [1]

"Часы со стрелками". ты же сам уже правильно написал.

← →
Leeechhhh (2005-03-15 21:28) [2]

не, правильно "чисы са стрелкоми"

по теме: заюзай чейнить апишный компонент, или вобьми гденить гиф полноанимированного круга часов

← →
tazik © (2005-03-15 21:29) [3]

Да ладно вам, ну может есть исходники. Вообщето мне нужно под turbo pascal

← →
tazik © (2005-03-15 21:33) [4]

Да нет мне нужно стрелки самому рисовать. Я пробовал так:

var I: integer;
...
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Canvas.Pen.Color := clBlue;
Canvas.MoveTo(150,150);
for I := 0 to 360 do
Canvas.LineTo(Trunc(sin(i)),Trunc(cos(i)));
end;

← →
Fenik (2005-03-15 21:39) [5]

Canvas.MoveTo(Center.x, Center.y);
Canvas.LineTo(Center.x + Trunc(sin(i))*Radius, Center.y + Trunc(cos(i))*Radius);

← →
tazik © (2005-03-15 21:40) [6]

Благодарю!

← →
Virgo_Style © (2005-03-15 21:41) [7]

> Trunc(sin(i)),Trunc(cos(i))

Ох. А что, настало военное время, когда синус может быть больше единицы?

← →
Fenik (2005-03-15 21:42) [8]

sin(DegToRad(i)) !!

← →
tazik © (2005-03-15 21:42) [9]

Дело в том, что LineTo требует integer-значения, вот я их и округляю. А увас есть предложение?

← →
begin...end © (2005-03-15 21:44) [10]

> Fenik (15.03.05 21:39) [5]

> Center.x + Trunc(sin(i))*Radius

Думаю, лучше было бы так: Center.x + Trunc(Sin(i) * Radius).

Потому что Trunc(Sin(...)) всегда будет равен либо -1, либо 0, либо 1.

← →
tazik © (2005-03-15 21:44) [11]

Очень странно!!! У меня рисуется только крестик и все!

← →
Fenik (2005-03-15 21:46) [12]

>begin...end © (15.03.05 21:44) [10]

Верно :)

← →
tazik © (2005-03-15 21:47) [13]

А теперь и вовсе только точка на форме!

← →
begin...end © (2005-03-15 22:01) [14]

> tazik © (15.03.05 21:47) [13]

procedure TForm1.Timer1Timer(Sender: TObject); const Radius = 100; X0 = 150; Y0 = 150; begin if I < 59 then Inc(I) else I := 0; Refresh; Canvas.MoveTo(X0, Y0); Canvas.LineTo(X0 + Trunc(Sin(DegToRad(I * 6)) * Radius), Y0 - Trunc(Cos(DegToRad(I * 6)) * Radius)) end; procedure TForm1.FormCreate(Sender: TObject); begin Canvas.Pen.Color := clBlue end

Этот пример показывает только общий принцип вычисления координат конца очередной линии (через каждую секунду, например). Не более того.

← →
begin...end © (2005-03-15 22:01) [15]

Забыл добавить: uses Math.

← →
Юрий Зотов © (2005-03-15 22:34) [16]

И, конечно же, высшее образование...
Эх...

← →
DrPass © (2005-03-16 00:33) [17]

Тригонометрию, кажется, в седьмом классе проходят :)

Мне больше всего понравилось:

>tazik © (15.03.05 21:29) [3]
>>Да ладно вам, ну может есть исходники. Вообщето мне нужно под >>turbo pascal

--------------------------------------------------------------------------------
>tazik © (15.03.05 21:33) [4]
>>Да нет мне нужно стрелки самому рисовать. Я пробовал так:

>>var I: integer;
...
>>procedure TForm1.Timer1Timer(Sender: TObject);
>>begin
>>Canvas.Pen.Color := clBlue;
>>Canvas.MoveTo(150,150);
>>for I := 0 to 360 do
>>Canvas.LineTo(Trunc(sin(i)),Trunc(cos(i)));
>>end;

И где-ж это все он нашел в turbo pascal?

> tazik © (15.03.05 21:17)
> Приспичило, а мозги не варят :) Помогите, чем сможете :)

приблизиельно так:
Ищешь в инете флеш с часами (их дофига всяких разных есть).
Кидаешь на форму TWebbrowser, пишешь небольшую htm, засовываешь все что нужно в ресурсы.

:-))))

← →
Руслана (2005-03-16 09:10) [20]

Оставь мыло - вышлю

program clock; {$N+} uses Crt,Dos; const ClockRadius = 80; SecArrow = ClockRadius * 0.85; MinArrow = ClockRadius * 0.80; HouArrow = ClockRadius * 0.50; ScaleFactor = 1.2; CenterX = 160; CenterY = 100; var H,M,S,S100: Word; procedure Delay(msec: Word); assembler; asm push ds mov ax,msec xor dx,dx mov ds,dx mov cx,55 div cx add ax,word ptr ds:[46ch] @@wait: cmp ax,word ptr ds:[46ch] jnc @@wait pop ds end; procedure PutPixel(x,y: Word; color: Byte); begin mem[$A000:y*320+x] := color; end; function GetPixel(x,y :Word): Byte; begin GetPixel := mem[$A000:y*320+x]; end; procedure SetMode(Mode: Byte); assembler; asm xor ax,ax mov al,Mode int 10h end; procedure Circle(X,Y,R: Word; Color: Byte); var x1,y1,sigma,delta: Integer; f: Boolean; begin x1 := 0; y1 := r; delta := 2*(1-r); while y1 >= 0 do begin PutPixel(x+x1,y+y1,color); PutPixel(x-x1,y+y1,color); PutPixel(x+x1,y-y1,color); PutPixel(x-x1,y-y1,color); f := False; if delta < 0 then begin sigma := 2*(delta+y1)-1; if sigma <= 0 then begin Inc(x1); f := True; delta := delta + 2*x1+1; end; end else if delta > 0 then begin sigma := 2*(delta-x1)-1; if sigma > 0 then begin Dec(y1); f := True; delta := delta + 1-2*y1; end; end; if not f then begin Inc(x1); Dec(y1); delta := delta + 2*(x1-y1-1); end; end; end; Procedure Line(SX,SY,EX,EY:Integer; Color: Byte); var t,dist,Xerr,Yerr,DX,DY,INCX,INCY: Integer; Begin Xerr:=0; Yerr:=0; DX:=EX-SX; DY:=EY-SY; INCX:=1; INCY:=1; if DX = 0 then INCX := 0; if DX < 0 then INCX := -1; if DY = 0 then INCY := 0; if DY < 0 then INCY := -1; DX := Abs(DX); DY := Abs(DY); if DX > DY then Dist := DX else Dist := DY; Xerr := DX; Yerr := DY; for t := 0 to dist do begin PutPixel(Sx,Sy,Color); Xerr := Xerr + DX; Yerr := Yerr + DY; if Xerr > Dist then begin Xerr := Xerr - dist; Sx := Sx + INCX; end; if Yerr > Dist then begin Yerr := Yerr - dist; Sy := Sy + INCY; end; end; end; procedure Fill(X,Y: Word; Color: byte); var MyColor: Byte; xr,xl,i: Word; begin MyColor := GetPixel(X,Y); xr := x; xl := x-1; while GetPixel(xr,y) = MyColor do begin PutPixel(xr,y,Color); Inc(xr); end; while GetPixel(xl,y) = MyColor do begin PutPixel(xl,y,Color); Dec(xl); end; for i := xl+1 to xr-1 do begin if GetPixel(i,y+1) = MyColor then Fill(i,y+1,color); if GetPixel(i,y-1) = MyColor then Fill(i,y-1,color); end; end; procedure DrawMarks; var i: Byte; x,y: Word; begin for i := 0 to 11 do begin x := Round((CenterX+ClockRadius*cos(i*pi/6)*ScaleFactor)); y := Round(CenterY-ClockRadius*sin(i*pi/6)); Circle(x,y,2,1); Fill(x,y,1); end; end; procedure DrawArrows; var Angle: Double; begin Angle := 2*Pi*(m+45)/60; Line(CenterX,CenterY,Round(CenterX+MinArrow*cos(Angle)*ScaleFactor), Round(CenterY+MinArrow*sin(Angle)),0); Angle := 2 * Pi * (H + 9 + M / 60) / 12; Line(CenterX,CenterY,Round(CenterX+HouArrow*cos(Angle)*ScaleFactor), Round(CenterY+HouArrow*sin(Angle)),0); Angle := 2 * Pi * (S + 45) / 60; Line(CenterX,CenterY,Round(CenterX+SecArrow*cos(Angle)*ScaleFactor), Round(CenterY+SecArrow*sin(Angle)),0); GetTime(H,M,S,S100); Angle := 2*Pi*(m+45)/60; Line(CenterX,CenterY,Round(CenterX+MinArrow*cos(Angle)*ScaleFactor), Round(CenterY+MinArrow*sin(Angle)),2); Angle := 2 * Pi * (H + 9 + M / 60) / 12; Line(CenterX,CenterY,Round(CenterX+HouArrow*cos(Angle)*ScaleFactor), Round(CenterY+HouArrow*sin(Angle)),2); Angle := 2 * Pi * (S + 45) / 60; Line(CenterX,CenterY,Round(CenterX+SecArrow*cos(Angle)*ScaleFactor), Round(CenterY+SecArrow*sin(Angle)),4); end; begin SetMode($13); DrawMarks; repeat DrawArrows; Delay(1000); until KeyPressed; SetMode(3); end.

> Ох. А что, настало военное время, когда синус может быть больше единицы?
Нет. Зато при выполнении приведенного кода часики будут очаровательно-военными -- "стрелки" будут тянуться к всего пяти точечкам. %*)

ЗЫ. Смех без причины -- признак неоконченного высшего образования.

Эх, могу дома покопаться. Один из первых "проектов"

Как написать часы со стрелками? Найти похожие ветки