Всем привет. Очень надеюсь, что мне смогут помочь.
А проблема вот в чем.
На Канве формы рисуются стрелочные часы и организовывается движение стрелок. Деления на часах - по часам.
Тут - все понятно мне и никаких проблем нет.
Но, нужно сделать так, чтобы пользователь мог задавать форму часов, т.е. "Окружность", "Квадрат", "Прямоугольник", "Горизонтальный эллипс", "Ветикальный эллипс". Для этого есть ComboBox, в котором производится выбор нужного типа и при нажатии кнопки, происходит соответствующее изменение.
Но, при этом, деления при должны соприкасаться с гранью фигуры, а стрелка долна идти в одном-двух пикселях от этого деления.
Вот как сделать это я уже не понимаю. Перепробовал все, что можно. Запутался окончательно.
Искал что-то подобное и тут, и на других Дельфяшных сайтах - ничего не нашел.
Вот код программы:

Код

procedure TForm1.FormCreate(Sender: TObject); begin Form1.BorderStyle := BsSingle; Form1.BorderIcons := [biSystemMenu,biMinimize]; Timer1.Interval := 1000; Timer1.Enabled := false; CenterY := Form1.ClientHeight div 2 - 35; CenterX := CenterY; Radius := CenterX - 20; HourArrow := Radius - 30; MinArrow := Radius - 20; SecArrow := Radius - 10; tip := 0; end; procedure TForm1.FormPaint(Sender: TObject); var i , tmp : integer; begin with Form1.Canvas do  begin   Pen.Color := clBlue;   Pen.Width := 2;   Brush.Color :=clWhite;   case tip of    0: begin        smx := 0; smy := 0;        Ellipse( 20 , 20 , 20 + 2 * Radius , 20 + 2 * Radius );       end;    1: begin        smx := 0; smy := 0;        Rectangle( 20 , 20 , 20 + 2 * Radius , 20 + 2 * Radius );       end;    2: begin        smx := 0; smy := Radius div 4;        Rectangle( 20 , 20 + smy , 20 + 2 * Radius , 20 + 2 * Radius - smy );       end;    3: begin        smx := 0; smy := Radius div 4;        Ellipse( 20 , 20 + smy , 20 + 2 * Radius , 20 + 2 * Radius - smy );       end;    4: begin        smx := Radius div 4; smy := 0;        Ellipse( 20 + smx , 20 , 20 + 2 * Radius - smx  , 20 + 2 * Radius - smy);       end;   end;   Pen.Width := 2;   for i:=0 to 11 do    begin     if ( i in [0,3,6,9] ) OR ( tip in [0,3,4] ) then       begin        kat1 := 0;        kat2 := 0;       end     else       begin        if i in [2,4,8,10] then         begin          kat2 := 0;          tmp := round( ( Radius ) * sin( i / 6 * pi ) );           if tmp < 0 then            kat1 := Radius + tmp           else            kat1 := ( Radius - tmp ) * (-1);          end         else          begin           kat1 := 0;           tmp := round( ( Radius ) * cos( i / 6 * pi ) );            if tmp < 0 then             kat2 := Radius + tmp - 9            else             kat2 := ( Radius - tmp ) * (-1) + 9;          end;       end;     MoveTo(  CenterX - kat1 + round( ( Radius - 9 - smx ) * sin( i / 6 * pi ) ) ,  CenterY + kat2 - round( ( Radius - 9 - smy ) * cos( i / 6 * pi ) ) );     LineTo(  CenterX - kat1 + round( ( Radius - smx ) * sin( i / 6 * pi ) ) ,  CenterY +  kat2 - round( ( Radius - smy ) * cos( i / 6 * pi ) ) );    end;   Font.Height := 10;   Font.Color := clBlack;   Brush.Color := Form1.Color;   TextOut( CenterX - textWidth('12') div 2 , CenterY - Radius - TextHeight('12') - 5 + smy, '12' );   TextOut( CenterX + Radius + 5 - smx, CenterY , '3' );   TextOut( CenterX - textWidth('6') div 2 , CenterY + Radius + 5 - smy, '6' );   TextOut( CenterX - textWidth('9') + smx - Radius - 5 , CenterY , '9' );  end; end; procedure TForm1.Button1Click(Sender: TObject); begin if Button1.Caption = 'Ñòàðò' then  begin   FormPaint( Sender );   DecodeTime( Time , Hour , Min , Sec , MSec );   HourAngle := ( Hour mod 12 ) / 12 * 2 * pi;   MinAngle := Min / 60 * 2 * pi;   SecAngle := Sec / 60 * 2 * pi;   ArrowDraw( clRed );   Button1.Caption := 'Ñòîï';   Timer1.Enabled := true;  end else  begin   Button1.Caption := 'Ñòàðò';   Timer1.Enabled := false;  end; end; procedure TForm1.ArrowDraw(DrawColor: TColor); begin with Form1.Canvas do  begin   Pen.Color := DrawColor;   MoveTo( CenterX , CenterY );   Pen.Width := 8;   LineTo(  CenterX + round( HourArrow * sin( HourAngle ) ) ,  CenterY - round( HourArrow * cos( HourAngle ) ) );   MoveTo( CenterX , CenterY );   Pen.Width := 4;   LineTo(  CenterX + round( MinArrow * sin( MinAngle ) ) ,  CenterY - round( MinArrow * cos( MinAngle ) ) );   MoveTo( CenterX , CenterY );   Pen.Width := 1;   LineTo(  CenterX + round( SecArrow * sin( SecAngle ) ) ,  CenterY - round( SecArrow * cos( SecAngle ) ) );  end; end; procedure TForm1.Button2Click(Sender: TObject); begin Close; end; procedure TForm1.Timer1Timer(Sender: TObject); begin ArrowDraw( clWhite ); DecodeTime( Time , Hour , Min , Sec , MSec ); HourAngle := ( Hour mod 12 ) / 12 * 2 * pi; MinAngle := Min / 60 * 2 * pi; SecAngle := Sec / 60 * 2 * pi; ArrowDraw( clRed ); end; procedure TForm1.Button3Click(Sender: TObject); begin tip := ComboBox1.ItemIndex; Form1.Canvas.Brush.Color := Form1.Color; Form1.Canvas.Pen.Color := Form1.Color; Form1.Canvas.Rectangle(0,0,Form1.ClientWidth,Form1.ClientHeight-50); FormPaint( Sender ); end;

VAR объявлен следующим образом.

Код

var  Form1: TForm1;  CenterX , CenterY , Radius , HourArrow , MinArrow , SecArrow : integer;  HourAngle , MinAngle , SecAngle : real;  Hour , Min , Sec , MSec : word;  tip: word;  smx , smy : integer;  kat1 , kat2 , Radius1 , Radius2 : integer;

Sorry, код читать не стал, но мысля есть:
Для каждого вида часов создать TabSheet'ы, которые будут на PageControl.
Один раз прорисовал, а потом в зависимости от выбора из ComboBox'а вибираешь соответствующий TabSheet...

А разница. Все равно надо прорисовыват это, а как ???

1) Сделай заготовки фона и трелок в разных положениях, в *bmp к примеру;
2) Меняй соответствующие файлы в Image...

________________________________________________

Pegas Учту пожелания по прочтению кодов.......

Это сообщение отредактировал(а) Pakshin A. S. - 10.5.2004, 20:48

Pakshin A. S. фишка в том, что тут целиком чеерез канву надо...

Хоть и чуть криво, но вродже бы проблему решил. Вот код.

Код

unit Unit1; interface uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, ExtCtrls, StdCtrls; type  TForm1 = class(TForm)    Button1: TButton;    Timer1: TTimer;    Button2: TButton;    ComboBox1: TComboBox;    Label1: TLabel;    Button3: TButton;    procedure FormCreate(Sender: TObject);    procedure FormPaint(Sender: TObject);    procedure Button1Click(Sender: TObject);    procedure Button2Click(Sender: TObject);    procedure ArrowDraw(DrawColor: TColor);    procedure Timer1Timer(Sender: TObject);    procedure Button3Click(Sender: TObject);  private    { Private declarations }  public    { Public declarations }  end; var  Form1: TForm1;  CenterX , CenterY , Radius , HourArrow , MinArrow , SecArrow : integer;  HourAngle , MinAngle , SecAngle : real;  Hour , Min , Sec , MSec : word;  tip: word;  smx , smy : integer;  kat1 , kat2 , kat3 , kat4 : integer; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin Form1.BorderStyle := BsSingle; Form1.BorderIcons := [biSystemMenu,biMinimize]; Timer1.Interval := 1000; Timer1.Enabled := false; CenterY := Form1.ClientHeight div 2 - 35; CenterX := CenterY; Radius := CenterX - 20; HourArrow := Radius - 30; MinArrow := Radius - 20; SecArrow := Radius - 10; tip := 0; end; procedure TForm1.FormPaint(Sender: TObject); var i : integer; begin with Form1.Canvas do  begin   Pen.Color := clBlue;   Pen.Width := 2;   Brush.Color :=clWhite;   case tip of    0: begin        smx := 0; smy := 0;        Ellipse( 20 , 20 , 20 + 2 * Radius , 20 + 2 * Radius );       end;    1: begin        smx := 0; smy := 0;        Rectangle( 20 , 20 , 20 + 2 * Radius , 20 + 2 * Radius );       end;    2: begin        smx := 0; smy := Radius div 4;        Rectangle( 20 , 20 + smy , 20 + 2 * Radius , 20 + 2 * Radius - smy );       end;    3: begin        smx := 0; smy := Radius div 4;        Ellipse( 20 , 20 + smy , 20 + 2 * Radius , 20 + 2 * Radius - smy );       end;    4: begin        smx := Radius div 4; smy := 0;        Ellipse( 20 + smx , 20 , 20 + 2 * Radius - smx  , 20 + 2 * Radius - smy);       end;   end;   Pen.Width := 2;   for i:=0 to 11 do    begin     if ( tip in [1,2] ) AND ( i in[1,2,4,5,7,8,10,11] ) then      begin       kat1 := CenterX + round( ( Radius + ( 2 + Radius - abs( Radius * sin( i / 6 * pi ) ) ) - 9 - smx ) * sin( i / 6 * pi ) );       kat2 := CenterX + round( ( Radius + ( 2 + Radius - abs( Radius * sin( i / 6 * pi ) ) ) - smx ) * sin( i / 6 * pi ) );       kat3 := CenterX + round( ( Radius + ( Radius - abs( Radius * cos( i / 6 * pi ) ) ) - 9 - smy ) * cos( i / 6 * pi ) );       kat4 := CenterX + round( ( Radius + ( Radius - abs( Radius * cos( i / 6 * pi ) ) ) - smy ) * cos( i / 6 * pi ) );      end     else      begin       kat1 := CenterX + round( ( Radius - 9 - smx ) * sin( i / 6 * pi ) );       kat2 := CenterX + round( ( Radius - smx ) * sin( i / 6 * pi ) );       kat3 := CenterY - round( ( Radius - 9 - smy ) * cos( i / 6 * pi ) );       kat4 := CenterY - round( ( Radius - smy ) * cos( i / 6 * pi ) );      end;     MoveTo(  kat1 , kat3 );     LineTo(  kat2 , kat4 );    end;   Font.Height := 10;   Font.Color := clBlack;   Brush.Color := Form1.Color;   TextOut( CenterX - textWidth('12') div 2 , CenterY - Radius - TextHeight('12') - 5 + smy, '12' );   TextOut( CenterX + Radius + 5 - smx, CenterY , '3' );   TextOut( CenterX - textWidth('6') div 2 , CenterY + Radius + 5 - smy, '6' );   TextOut( CenterX - textWidth('9') + smx - Radius - 5 , CenterY , '9' );  end; end; procedure TForm1.Button1Click(Sender: TObject); begin if Button1.Caption = 'Ñòàðò' then  begin   FormPaint( Sender );   DecodeTime( Time , Hour , Min , Sec , MSec );   HourAngle := ( Hour mod 12 ) / 12 * 2 * pi;   MinAngle := Min / 60 * 2 * pi;   SecAngle := Sec / 60 * 2 * pi;   ArrowDraw( clRed );   Button1.Caption := 'Ñòîï';   Timer1.Enabled := true;  end else  begin   Button1.Caption := 'Ñòàðò';   Timer1.Enabled := false;  end; end; procedure TForm1.ArrowDraw(DrawColor: TColor); begin   case tip of    0: begin        smx := 0; smy := 0;       end;    1: begin        smx := 0; smy := 0;       end;    2: begin        smx := 0; smy := Radius div 4;       end;    3: begin        smx := 0; smy := Radius div 4;       end;    4: begin        smx := Radius div 4; smy := 0;       end;   end; with Form1.Canvas do  begin   Pen.Color := DrawColor;   MoveTo( CenterX , CenterY );   Pen.Width := 8;   if tip in [1,2] then    LineTo(  CenterX + round( ( HourArrow - smx + ( HourArrow - abs( HourArrow * sin( HourAngle ) ) ) ) * sin( HourAngle ) ) ,  CenterY - round( ( HourArrow - smy + ( HourArrow - abs( HourArrow * cos( HourAngle ) ) ) ) * cos( HourAngle ) ) )   else    LineTo(  CenterX + round( ( HourArrow - smx ) * sin( HourAngle ) ) ,  CenterY - round( ( HourArrow - smy ) * cos( HourAngle ) ) );   MoveTo( CenterX , CenterY );   Pen.Width := 4;   if tip in [1,2] then    LineTo(  CenterX + round( ( MinArrow - smx + ( MinArrow - abs( MinArrow * sin( MinAngle ) ) ) ) * sin( MinAngle ) ) ,  CenterY - round( ( MinArrow - smy + ( MinArrow - abs( MinArrow * cos( MinAngle ) ) ) ) * cos( MinAngle ) ) )   else    LineTo(  CenterX + round( ( MinArrow - smx ) * sin( MinAngle ) ) ,  CenterY - round( ( MinArrow - smy ) * cos( MinAngle ) ) );   MoveTo( CenterX , CenterY );   Pen.Width := 1;   if tip in [1,2] then    LineTo(  CenterX + round( ( SecArrow - smx + ( SecArrow - abs( SecArrow * sin( SecAngle ) ) ) ) * sin( SecAngle ) ) ,  CenterY - round( ( SecArrow - smy + ( SecArrow - abs( SecArrow * cos( SecAngle ) ) ) ) * cos( SecAngle ) ) )   else    LineTo(  CenterX + round( ( SecArrow - smx ) * sin( SecAngle ) ) ,  CenterY - round( ( SecArrow - smy ) * cos( SecAngle ) ) );  end; end; procedure TForm1.Button2Click(Sender: TObject); begin Close; end; procedure TForm1.Timer1Timer(Sender: TObject); begin ArrowDraw( clWhite ); DecodeTime( Time , Hour , Min , Sec , MSec ); HourAngle := ( Hour mod 12 ) / 12 * 2 * pi; MinAngle := Min / 60 * 2 * pi; SecAngle := Sec / 60 * 2 * pi; ArrowDraw( clRed ); end; procedure TForm1.Button3Click(Sender: TObject); begin tip := ComboBox1.ItemIndex; Form1.Canvas.Brush.Color := Form1.Color; Form1.Canvas.Pen.Color := Form1.Color; Form1.Canvas.Rectangle(0,0,Form1.ClientWidth,Form1.ClientHeight-50); FormPaint( Sender ); end; end.

Может и пупо но работает и синхронизировано с системным временем.

Код

unit Unit1; interface uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls, ExtCtrls, math, registry, RXShell, RxNotify, Menus; type  TForm1 = class(TForm)    Shape1: TShape;    StaticText1: TStaticText;    Timer1: TTimer;    Shape2: TShape;    Shape3: TShape;    Shape4: TShape;    Shape5: TShape;    Shape9: TShape;    Shape6: TShape;    Shape7: TShape;    Shape8: TShape;    Shape10: TShape;    Shape11: TShape;    Shape12: TShape;    Shape13: TShape;    RxTrayIcon1: TRxTrayIcon;    PopupMenu1: TPopupMenu;    Disableautorun1: TMenuItem;    Changecoloursheme1: TMenuItem;    Exit1: TMenuItem;    procedure Timer1Timer(Sender: TObject);    procedure FormPaint(Sender: TObject);    procedure FormCreate(Sender: TObject);    procedure Exit1Click(Sender: TObject);    procedure Disableautorun1Click(Sender: TObject);    procedure Changecoloursheme1Click(Sender: TObject);  private    { Private declarations }  public    { Public declarations }  end; var  Form1: TForm1;  angle, angle1, minangle, minangle1, hangle, hangle1: Extended;  c: integer; implementation uses Unit2; {$R *.dfm} procedure TForm1.Timer1Timer(Sender: TObject); var  r, minr, hr: integer; begin r:=(Shape1.Width div 2)-3; minr:=(Shape1.Width div 2)-12; hr:=(Shape1.Width div 2)-23; StaticText1.Caption:=TimeToStr(Time); if angle1<angle then begin Canvas.Pen.Color:=clNavy; Canvas.MoveTo(((Shape1.Width div 2)+8), ((Shape1.Height div 2)+8)); Canvas.LineTo(round(r*cos(angle1+4.71)+(Shape1.Width div 2)+8), round(r*sin(angle1+4.71)+(Shape1.Width div 2)+8)); Canvas.MoveTo(((Shape1.Width div 2)+8), ((Shape1.Height div 2)+8)); //---min--- Canvas.Pen.Color:=clNavy; Canvas.Pen.Width:=2; Canvas.MoveTo(((Shape1.Width div 2)+8), ((Shape1.Height div 2)+8)); Canvas.LineTo(round(minr*cos(minangle1+(4.71))+(Shape1.Width div 2)+8), round(minr*sin(minangle1+(4.71))+(Shape1.Width div 2)+8)); Canvas.MoveTo(((Shape1.Width div 2)+8), ((Shape1.Height div 2)+8)); Canvas.Pen.Width:=1; //---end min--- //---hour --- Canvas.Pen.Color:=clNavy; Canvas.Pen.Width:=4; Canvas.MoveTo(((Shape1.Width div 2)+8), ((Shape1.Height div 2)+8)); Canvas.LineTo(round(hr*cos(hangle+(4.71))+(Shape1.Width div 2)+8), round(hr*sin(hangle+(4.71))+(Shape1.Width div 2)+8)); Canvas.MoveTo(((Shape1.Width div 2)+8), ((Shape1.Height div 2)+8)); Canvas.Pen.Width:=1; //--- end hour --- if angle1<(0.10472*59) then  begin    angle1:=angle1+0.10472;  end else  begin    angle1:=0;  end; if minangle1<(0.10472*59) then  begin    minangle1:=minangle1+(0.10472/60);  end else  begin    minangle1:=0;  end; if hangle1<(0.10472*59) then  begin    hangle1:=hangle1+(0.10472/3600);  end else  begin    hangle1:=0;      end; end; Canvas.Pen.Color:=clLime; Canvas.MoveTo(((Shape1.Width div 2)+8), ((Shape1.Height div 2)+8)); Canvas.LineTo(round(r*cos(angle+4.71)+(Shape1.Width div 2)+8), round(r*sin(angle+4.71)+(Shape1.Width div 2)+8)); Canvas.MoveTo(((Shape1.Width div 2)+8), ((Shape1.Height div 2)+8)); //---min --- Canvas.Pen.Color:=clLime; Canvas.Pen.Width:=2; Canvas.MoveTo(((Shape1.Width div 2)+8), ((Shape1.Height div 2)+8)); Canvas.LineTo(round(minr*cos(minangle+(4.71))+(Shape1.Width div 2)+8), round(minr*sin(minangle+(4.71))+(Shape1.Width div 2)+8)); Canvas.MoveTo(((Shape1.Width div 2)+8), ((Shape1.Height div 2)+8)); Canvas.Pen.Width:=1; //--- end min --- //---hour --- Canvas.Pen.Color:=clLime; Canvas.Pen.Width:=4; Canvas.MoveTo(((Shape1.Width div 2)+8), ((Shape1.Height div 2)+8)); Canvas.LineTo(round(hr*cos(hangle+(4.71))+(Shape1.Width div 2)+8), round(hr*sin(hangle+(4.71))+(Shape1.Width div 2)+8)); Canvas.MoveTo(((Shape1.Width div 2)+8), ((Shape1.Height div 2)+8)); Canvas.Pen.Width:=1; //--- end hour --- if angle<=(0.10472*60) then  begin    angle:=angle+0.10472;  end else  begin    angle:=0;    angle:=angle+0.10472;  end; if minangle<=(0.10472*60) then  begin    minangle:=minangle+(0.10472/60);  end else  begin    minangle:=0;    minangle:=minangle+(0.10472/60);  end; if hangle<=(0.10472*60) then  begin    hangle:=hangle+(0.10472/3600);  end else  begin    hangle:=0;    hangle:=hangle+(0.10472/3600);  end; end; procedure TForm1.FormPaint(Sender: TObject); begin Canvas.Refresh; end; procedure TForm1.FormCreate(Sender: TObject); var Registry: TRegIniFile; begin Registry:=treginifile.create('Software'); Registry.rootkey:=hkey_local_machine; Registry.openkey('Software',true); Registry.openkey('Microsoft',true); Registry.openkey('Windows',true); Registry.openkey('CurrentVersion',true); Registry.writestring('Run','Clock', Application.ExeName); Registry.CloseKey; angle:=0.10472*StrToFloat(TimeToStr(Time)[length(TimeToStr(Time))-1]+TimeToStr(Time)[length(TimeToStr(Time))])+0.10472; angle1:=angle; minangle:=0.10472*StrToFloat(TimeToStr(Time)[length(TimeToStr(Time))-4]+TimeToStr(Time)[length(TimeToStr(Time))-3])+(angle/60)+(0.10472/60); minangle1:=minangle; if Length(TimeToStr(Time))=8 then  begin    hangle:=((0.10472*5)*(24/60))*(StrToFloat(TimeToStr(Time)[length(TimeToStr(Time))-7]+TimeToStr(Time)[length(TimeToStr(Time))-6]))+(minangle/60)+(angle/3600)+(0.10472/3600);    hangle1:=hangle;  end else  begin    hangle:=((0.10472*5)*(24/60))*(StrToFloat(TimeToStr(Time)[length(TimeToStr(Time))-6]))+(minangle/60)+(angle/3600)+(0.10472/3600);    hangle1:=hangle;  end; end; procedure TForm1.Exit1Click(Sender: TObject); begin Close; end; procedure TForm1.Disableautorun1Click(Sender: TObject); var  Registry: TRegIniFile; begin Registry:=treginifile.create('Software'); Registry.rootkey:=hkey_local_machine; Registry.openkey('Software',true); Registry.openkey('Microsoft',true); Registry.openkey('Windows',true); Registry.openkey('CurrentVersion',true); Registry.DeleteKey('Run','Clock'); Registry.CloseKey; end; procedure TForm1.Changecoloursheme1Click(Sender: TObject); begin Form2.Show; end; end.

Все цифры, типа 0.10472, подобраны экспериментально.
На самом деле прогу не тестировал. Если кто займется этим, пожалуйста проинформируйте меня по мылу (см. профиль).