Текущий архив: 2005.03.27;
Скачать: CL | DM;
Вниз
Как написать часы со стрелками? Найти похожие ветки
← →
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]Тригонометрию, кажется, в седьмом классе проходят :)
← →
Германн © (2005-03-16 02:26) [18]Мне больше всего понравилось:
>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?
← →
SergP © (2005-03-16 07:21) [19]
> tazik © (15.03.05 21:17)
> Приспичило, а мозги не варят :) Помогите, чем сможете :)
приблизиельно так:
Ищешь в инете флеш с часами (их дофига всяких разных есть).
Кидаешь на форму TWebbrowser, пишешь небольшую htm, засовываешь все что нужно в ресурсы.
:-))))
← →
Руслана (2005-03-16 09:10) [20]Оставь мыло - вышлю
← →
Kerk © (2005-03-16 09:25) [21]
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.
← →
Kerk © (2005-03-16 09:29) [22]Kerk © (16.03.05 9:25) [21]
писано на 2м курсе. детали работы разбирать влом. сам давай.
← →
Чапаев © (2005-03-16 10:26) [23]> Ох. А что, настало военное время, когда синус может быть больше единицы?
Нет. Зато при выполнении приведенного кода часики будут очаровательно-военными -- "стрелки" будут тянуться к всего пяти точечкам. %*)
ЗЫ. Смех без причины -- признак неоконченного высшего образования.
← →
TUser © (2005-03-16 12:30) [24]Эх, могу дома покопаться. Один из первых "проектов"
Страницы: 1 вся ветка
Текущий архив: 2005.03.27;
Скачать: CL | DM;
Память: 0.53 MB
Время: 0.042 c
