1. Accueil
  2. Delphi / Pascal
  3. Sources Delphi / Pascal
  4. Sources Date & Heure
  5. Composant horloge analogique en thread...

Composant horloge analogique en thread...

Soyez le premier à donner votre avis sur cette source.

Vue 7 845 fois - Téléchargée 829 fois

Télécharger le projet
Commenter

Description

Ce petit composant est un exemple,

Vous pouvez le modifier et l'utiliser comme bon vous semble.

Pour l'installer copier coller le source dans notepad, sauvez-le sous Clock.Pas

Ensuite dans delphi faite installer un composant, choisissez le fichier Clock.Pas
et faites ok., le composant est dans l'onglet "Samples".

Il s'utilise comme un pannel....

Source / Exemple : 


unit clock;

interface

////////////////////////////////////////////////////////
// Une chtite horloge en compos qui utilise un thread //
// (c)2002 ManChesTer                                 //
// Freeware Modifiable et utilisable a volontè        //
////////////////////////////////////////////////////////

uses
  Windows, Messages, SysUtils, Classes,graphics,ExtCtrls,Controls;

type
  Tdrawclock = procedure of object;
  TMyTimer = Class(Tthread)
  Private
   Delay      : Integer;
   FdrawClock : TDrawClock;
  Public
   Procedure Execute; override;
  end;

  TmClock = class(TCustomPanel)
  private
   FTimer       : TMyTimer;
   Ftime        : TTime;
   FDate        : TDate;
   Fgmt         : Integer;
   FDelay       : Integer;
   Fcolor       : Tcolor;
   FPenColor    : Tcolor;
   FBrushColor  : Tcolor;
   FLPenColor   : Tcolor;
   FLBrushColor : Tcolor;
  protected
   Procedure DrawClock;
   procedure paint; override;
  public
   Constructor create(Aowner:TComponent);Override;
   Destructor  Destroy;Override;
  published
   Property Align;
   Property Font;
   Property Time             : Ttime   Read Ftime;
   Property Date             : Tdate   Read Fdate;
   Property BackgroundColor  : Tcolor  Read Fcolor        Write Fcolor;
   Property ClockPenColor    : Tcolor  Read FPenColor     Write FPenColor;
   Property ClockBrushColor  : Tcolor  Read FBrushColor   Write FBrushColor;
   Property LancePenColor    : Tcolor  Read FLPenColor    Write FLPenColor;
   Property LanceBrushColor  : Tcolor  Read FLBrushColor  Write FLBrushColor;
   Property TimeRefresh      : Integer Read FDelay        Write FDelay;
  end;

procedure Register;

implementation
{$R clock.res}
Constructor Tmclock.Create(Aowner:TComponent);
begin
 Inherited Create(Aowner);
 Width:=50;
 Height:=100;
 Fdelay:=500;
 Fgmt:=0;
 Ftime:=Now;
 Fdate:=Now;
 Fcolor:=ClBtnFace;
 FBrushColor:=ClTeal;
 FPenColor:=ClInactiveCaption;
 FLBrushColor:=ClMaroon;
 FLPenColor:=ClBlack;
 FTimer:=TMyTimer.create(true);
 FTimer.FreeOnTerminate:=true;
 FTimer.delay:=Fdelay;
 Ftimer.FdrawClock:=DrawClock;
 FTimer.Resume;
end;

Destructor Tmclock.Destroy;
begin
 try
  FTimer.Terminate;
  Sleep(fdelay);
 finally
  inherited destroy;
 end;
end;

Procedure TmClock.Paint;
begin
 DrawClock;
end;

Procedure TmClock.DrawClock;
var Bmp      : Tbitmap;
    h,m,s,ms : word;
    cx,cy    : Longint;
    px1,py1  : Longint;
    px2,py2  : Longint;
    ax,ay    : Longint;
    j        : integer;
    stpx     : integer;
    stpy     : integer;
    hs       : String;
    hx       : real;
    hy       : real;
begin
 bmp:=Tbitmap.create;
 bmp.Width:=width;
 bmp.Height:=height;
 bmp.Canvas.brush.color:=FColor;
 bmp.Canvas.Font:=font;
 Bmp.Canvas.FillRect(clientrect);
 cx:=width div 2;
 cy:=height div 2;
 stpx:=cx div 20;
 stpy:=cy div 20;
 h:=4;
 m:=bmp.canvas.textwidth('00')+stpx+stpy;
 for j:=1 to 60 do
 begin
  bmp.Canvas.brush.color:=FBrushColor;
  bmp.Canvas.pen.color:=FPenColor;
  ax:=cx+Round(cos((j*6)/(57.29577))*(cx-(stpx+1)));
  ay:=cy+Round(sin((j*6)/(57.29577))*(cy-(stpy+1)));
  Ellipse(bmp.canvas.handle,ax-(stpx div 2),ay-(stpy div 2),ax+(stpx div 2),ay+(stpy div 2));
  if j mod 5=0 then
  begin
   Ellipse(bmp.canvas.handle,ax-stpx,ay-stpy,ax+stpx,ay+stpy);
   hs:=inttostr(h);
   ax:=cx+Round(cos((j*6)/(57.29577))*(cx-m))-(bmp.canvas.textwidth(hs)div 2);
   ay:=cy+Round(sin((j*6)/(57.29577))*(cy-m))-(bmp.canvas.textheight(hs)div 2);
   bmp.Canvas.Brush.Style:=bsclear;
   bmp.Canvas.textout(ax,ay,hs);
   bmp.Canvas.Brush.Style:=bssolid;
   inc(h);
   if h=13 then
    h:=1;
  end;
 end;
 bmp.Canvas.brush.color:=FLBrushColor;
 bmp.Canvas.pen.color:=FLPenColor;
 decodetime(now,h,m,s,ms);
 // affiche les heures
 hx:=cos(((((h*5)+(m/12))-15)*6)/57.29577);
 hy:=sin(((((h*5)+(m/12))-15)*6)/57.29577);
 ax:=cx+round(hx*(cx-(cx div 2)));
 ay:=cy+round(hy*(cx-(cx div 2)));
 hx:=cos(((((h*5)+(m/12))-8)*6)/57.29577);
 hy:=sin(((((h*5)+(m/12))-8)*6)/57.29577);
 px1:=cx+trunc(hx*(stpx+stpx));
 py1:=cy+trunc(hy*(stpy+stpy));
 hx:=cos(((((h*5)+(m/12))+8)*6)/57.29577);
 hy:=sin(((((h*5)+(m/12))+8)*6)/57.29577);
 px2:=cx-trunc(hx*(stpx+stpx));
 py2:=cy-trunc(hy*(stpy+stpy));
 Bmp.Canvas.Polygon([point(px1,py1),point(ax,ay),point(px2,py2)]);
 //affiche les minutes
 ax:=cx+Round(cos(((m-15)*6)/(57.29577))*(cx-(cx div 4)));
 ay:=cy+Round(sin(((m-15)*6)/(57.29577))*(cy-(cy div 4)));
 px1:=cx+Round(cos(((m-8)*6)/(57.29577))*(stpx+(stpx div 2)));
 py1:=cy+Round(sin(((m-8)*6)/(57.29577))*(stpy+(stpy div 2)));
 px2:=cx-Round(cos(((m+8)*6)/(57.29577))*(stpx+(stpx div 2)));
 py2:=cy-Round(sin(((m+8)*6)/(57.29577))*(stpy+(stpy div 2)));
 Bmp.Canvas.Polygon([point(px1,py1),point(ax,ay),point(px2,py2)]);
 //affiche les secondes
 ax:=cx+Round(cos(((s-15)*6)/(57.29577))*(cx-(cx div 10)));
 ay:=cy+Round(sin(((s-15)*6)/(57.29577))*(cy-(cx div 10)));
 px1:=cx+Round(cos(((s-8)*6)/(57.29577))*(stpx div 2));
 py1:=cy+Round(sin(((s-8)*6)/(57.29577))*(stpy div 2));
 px2:=cx-Round(cos(((s+8)*6)/(57.29577))*(stpx div 2));
 py2:=cy-Round(sin(((s+8)*6)/(57.29577))*(stpy div 2));
 Bmp.Canvas.Polygon([point(px1,py1),point(ax,ay),point(px2,py2)]);
 Ellipse(bmp.canvas.handle,cx-(stpx+stpx),cy-(stpy+stpy),cx+(stpx+stpx),cy+(stpy+stpy));
 bitblt(canvas.Handle,0,0,width,height,bmp.canvas.handle,0,0,srccopy);
 bmp.free;
end;

Procedure TmyTimer.Execute;
begin
 while not terminated do
 begin
  sleep(delay);
  if assigned(FdrawClock) then
   FDrawClock;
 end;
end;

procedure Register;
begin
 RegisterComponents('Samples', [Tmclock]);
end;

end.

Conclusion :


Bon Coding a vous....

ManChesTer.

Ps : j'ai ajouter le zip...
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaire
cs_koko
Messages postés
654
Date d'inscription
lundi 14 janvier 2002
Statut
Membre
Dernière intervention
20 février 2005
7 janv. 2003 à 07:19
un petit zip aurait été mieux je trouve...
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_ManChesTer)