Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Стрелочные часы через Canavas Формы.

Автор: Mal Hack 9.5.2004, 16:43

Всем привет. Очень надеюсь, что мне смогут помочь.
А проблема вот в чем.
На Канве формы рисуются стрелочные часы и организовывается движение стрелок. Деления на часах - по часам.
Тут - все понятно мне и никаких проблем нет.
Но, нужно сделать так, чтобы пользователь мог задавать форму часов, т.е. "Окружность", "Квадрат", "Прямоугольник", "Горизонтальный эллипс", "Ветикальный эллипс". Для этого есть 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;

Автор: Pakshin A. S. 9.5.2004, 16:49

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

Автор: Mal Hack 9.5.2004, 19:46

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

Автор: Pakshin A. S. 10.5.2004, 20:34

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

________________________________________________

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

Автор: Mal Hack 10.5.2004, 21:24

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

Автор: Mal Hack 24.5.2004, 19:43

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

Код

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.

Автор: Pathfider 3.1.2005, 21:52

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

Код


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, подобраны экспериментально.
На самом деле прогу не тестировал. Если кто займется этим, пожалуйста проинформируйте меня по мылу (см. профиль).