479 lines
12 KiB
ObjectPascal
479 lines
12 KiB
ObjectPascal
unit UnitClock;
|
|
|
|
{ FBitMap est le Bitmap d'arrière plan et contient le tour de l'horloge
|
|
il est créé au démarrage.
|
|
|
|
ABitMap contient les aiguilles
|
|
|
|
DrawArrow dessine les aiguilles dans ABitmap:
|
|
- le crée, dessine
|
|
Abitmap.canvas.copyrect(
|
|
- copie dans horloge : canvas.draw(0,0,ABitMap)
|
|
|
|
}
|
|
interface
|
|
uses
|
|
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
|
Dialogs, ExtCtrls,Math , UnitHorloge, StdCtrls, Buttons, ImgList, Menus;
|
|
|
|
const pisur180=pi/180;
|
|
pisur360=pi/360;
|
|
pisur6=pi/6;
|
|
type
|
|
TFormClock = class(TForm)
|
|
BitBtnMarHor: TBitBtn;
|
|
ImageList24x24: TImageList;
|
|
BitBtnArrHorl: TBitBtn;
|
|
BitBtnInitHor: TBitBtn;
|
|
ButtonParametres: TButton;
|
|
PopupMenuH: TPopupMenu;
|
|
TjsDev: TMenuItem;
|
|
Dverrouiller1: TMenuItem;
|
|
ButtonGH: TButton;
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormResize(Sender: TObject);
|
|
procedure BitBtnMarHrClick(Sender: TObject);
|
|
procedure BitBtnArrHorlClick(Sender: TObject);
|
|
procedure BitBtnInitHorClick(Sender: TObject);
|
|
procedure ButtonParametresClick(Sender: TObject);
|
|
procedure TjsVerClick(Sender: TObject);
|
|
procedure Dverrouiller1Click(Sender: TObject);
|
|
procedure ButtonGHClick(Sender: TObject);
|
|
|
|
private
|
|
procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
|
|
public
|
|
end;
|
|
|
|
TClock = class(TGraphicControl)
|
|
private
|
|
Ticker : TTimer;
|
|
|
|
FPen: TPen; // couleur de crayon
|
|
FBitMap : TBitMap; // arrière plan
|
|
// Clock variables
|
|
CenterPoint : TPoint; // Centre des aiguilles
|
|
Radius : integer; // rayon d'horloge
|
|
LapStepW : integer; // espacement des maqueurs minutes
|
|
ShowSecond : boolean; // Affiche ou non l'aiguille des seondes
|
|
FArrowColor : TColor; // couleur des aiguilles
|
|
FFaceColor : TColor; // Couleur d'horloge
|
|
|
|
procedure SetFaceColor( Value : TColor);
|
|
procedure SetArrowColor( Value : TColor);
|
|
procedure SetShowSecond( Value : boolean);
|
|
function HourAngle( Hou, Min : word) : real; // Hour arrow angle
|
|
procedure CalcClockSettings;
|
|
procedure DrawClockBkg; // Draw clock background on FBitMap
|
|
|
|
protected
|
|
procedure Paint; override;
|
|
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure tickercall;
|
|
procedure DrawArrows; // Draw clock arrows
|
|
|
|
published
|
|
property Align;
|
|
property Enabled;
|
|
property ParentShowHint;
|
|
property ShowHint;
|
|
property Visible;
|
|
property ClkArrowColor : TColor read FArrowColor write SetArrowColor default clBlack;
|
|
property ClkFaceColor : TColor read FFaceColor write SetFaceColor default clBtnFace;
|
|
property SecArrow : boolean read ShowSecond write SetShowSecond;
|
|
end;
|
|
|
|
var FormClock: TFormClock;
|
|
clock : Tclock;
|
|
FormClockInit,Verrouille : boolean;
|
|
SecThick,MinThick,HouThick,DeltaFPCX,DeltaFPCY,largeurFC,hauteurFC,OffsetXFC,OffsetYFC : integer;
|
|
|
|
procedure affiche_horloge;
|
|
procedure calcul_pos_horloge;
|
|
|
|
implementation
|
|
|
|
uses UnitConfigCellTCO, UnitPrinc, UnitFicheHoraire;
|
|
{$R *.dfm}
|
|
|
|
const
|
|
SecScale=1; // longueur de l'aiguille des secondes
|
|
MinScale=0.95; // longueur de l'aiguille des minutes
|
|
HouScale=0.60; // longueur de l'aiguille des heures
|
|
offsetx=20; // décalage x du bitmap l'horloge par rapport à la fenetre
|
|
offsety=60; // y
|
|
|
|
constructor TClock.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FormClockInit:=false;
|
|
// taille de l'horloge
|
|
Width:=(AOwner as Tform).Width-offsetx;
|
|
Height:=(AOwner as Tform).Height-offsety;
|
|
|
|
FFaceColor:=clBtnFace;
|
|
FArrowColor:=clBlack;
|
|
ShowSecond:=true;
|
|
|
|
// Crée le crayon horloge pour le bitmap
|
|
FPen:=TPen.Create;
|
|
// Crée le bitmap d'arrière plan
|
|
FBitMap:=TBitMap.Create;
|
|
FBitMap.Width:=Width;
|
|
FBitMap.Height:=Height;
|
|
end;
|
|
|
|
procedure TClock.SetFaceColor( Value : TColor);
|
|
begin FFaceColor:=Value; invalidate; end;
|
|
|
|
procedure TClock.SetArrowColor( Value : TColor);
|
|
begin FArrowColor := Value; invalidate; end;
|
|
|
|
procedure TClock.SetShowSecond( Value : boolean);
|
|
begin
|
|
ShowSecond := Value;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TClock.Paint;
|
|
begin
|
|
CalcClockSettings;
|
|
DrawClockBkg;
|
|
DrawArrows;
|
|
end;
|
|
|
|
destructor TClock.Destroy;
|
|
begin
|
|
FPen.Free;
|
|
FBitMap.Free;
|
|
Ticker.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TClock.HourAngle( Hou, Min : word) : real;
|
|
begin
|
|
HourAngle:=(Hou MOD 12) * pisur6 + (Min*pisur360);
|
|
end;
|
|
|
|
procedure Tclock.TickerCall;
|
|
begin
|
|
// ne rien faire pendant la création
|
|
//if (csDesigning in ComponentState) or
|
|
//Affiche('Ticker Call',clLime);
|
|
if (formClock=nil) or not(FormclockInit) then exit;
|
|
if not(assigned(formclock)) then exit;
|
|
if not(ShowSecond) then exit;
|
|
DrawArrows;
|
|
end;
|
|
|
|
// dessine les flèches dans A bitmap et le copie dans le canvas de l'horloge
|
|
procedure TClock.DrawArrows;
|
|
var
|
|
ABitMap : TBitMap;
|
|
sin,cos :extended;
|
|
|
|
// Dessine les flèches dans le bitmap hors écran
|
|
procedure DrawArrow( Angle, Scale : real; AWidth : integer);
|
|
var SR : real;
|
|
begin
|
|
with ABitMap.Canvas do
|
|
begin
|
|
Pen.Width:=AWidth;
|
|
MoveTo(CenterPoint.X, CenterPoint.Y);
|
|
SR:=Scale*Radius;
|
|
sincos(Angle,sin,cos);
|
|
LineTo(round(SR*sin)+ CenterPoint.X,
|
|
round(-SR*cos)+ CenterPoint.Y);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
// Crée le bitmap AbitMap hors écran
|
|
ABitMap:=TBitMap.Create;
|
|
FPen.Color:=ClkArrowColor;
|
|
try
|
|
// dessine les aiguilles sur l'image hors écran
|
|
// Attributs du bitmap hors écran
|
|
ABitMap.Width:=Width;
|
|
ABitMap.Height:=Height;
|
|
with ABitMap.Canvas do
|
|
begin
|
|
Pen:=FPen;
|
|
Brush.Color:=clred;
|
|
end;
|
|
// Copie l'image de fond du bitmap dans le bitmap hors écran
|
|
ABitMap.Canvas.CopyMode:=cmSrcCopy;
|
|
ABitMap.Canvas.CopyRect(ABitMap.Canvas.ClipRect,FBitMap.Canvas,FBitMap.Canvas.ClipRect);
|
|
// Dessine les nouvelles aiguilles dans le bitmap hors écran
|
|
if ShowSecond then DrawArrow( seconde*pi/30, SecScale, SecThick); // seconde
|
|
DrawArrow(minute*pi/30,MinScale, MinThick); // minute
|
|
DrawArrow(HourAngle(heure,minute),HouScale,HouThick); // heure
|
|
|
|
// Dessine le bitmap hors écran dans l'horloge
|
|
Canvas.CopyMode:=cmSrcCopy;
|
|
Canvas.Draw(0,0,ABitMap);
|
|
formclock.Caption:=format('%.2dh%.2d:%.2d',[heure,minute,seconde] );
|
|
finally
|
|
ABitMap.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TClock.CalcClockSettings;
|
|
begin
|
|
//Créer une nouvelle image de fond dans Fbitmap
|
|
FBitMap.Free;
|
|
FBitMap:=TBitMap.Create;
|
|
FBitMap.Width:=Width;
|
|
FBitMap.Height:=Height;
|
|
// calcule le centre de l'horloge
|
|
CenterPoint:=Point(Width div 2,Height div 2);
|
|
// Calcule le rayon de l'horloge
|
|
with CenterPoint do
|
|
if x<=y then Radius:=x
|
|
else Radius:=y;
|
|
|
|
LapStepW:=Radius div 8;
|
|
if LapStepW<6 then LapStepW:=6;
|
|
|
|
dec(Radius,LapStepW+2);
|
|
end;
|
|
|
|
// Dessine le fond (le tour) de l'horloge sur FbitMap
|
|
procedure TClock.DrawClockBkg;
|
|
|
|
// Dessine les tirets minute sur FBitMap
|
|
procedure DrawMinSteps;
|
|
const EpGd=2; // epaisseurs des aiguilles
|
|
LgGd=25;
|
|
EpPt=1;
|
|
LgPt=7;
|
|
var
|
|
ep,lg,OfsX : integer;
|
|
Angle : word;
|
|
SR : real;
|
|
sin, cos : extended;
|
|
x1,y1,x2,y2,x3,y3,x4,y4 : integer;
|
|
begin
|
|
OfsX := LapStepW DIV 2;
|
|
Angle:=0;
|
|
FBitMap.Canvas.Pen.color:=ClkArrowColor;
|
|
Fbitmap.canvas.Brush.Color:=clkArrowColor;
|
|
while Angle<360 do
|
|
begin
|
|
if Angle mod 15 = 0 then
|
|
begin
|
|
// grands marqueurs
|
|
ep:=EpGd;
|
|
lg:=LgGd;
|
|
end
|
|
else
|
|
begin
|
|
ep:=EpPt;
|
|
lg:=LgPt;
|
|
end;
|
|
|
|
sr:=Radius + OfsX;
|
|
sincos((Angle+Ep)*pisur180,sin,cos);
|
|
x1:=round(sr*sin)+centerPoint.X; y1:=round(sr*cos)+centerPoint.y;
|
|
|
|
sincos((Angle-Ep)*pisur180,sin,cos);
|
|
x2:=round(sr*sin)+centerPoint.X; y2:=round(sr*cos)+centerPoint.y;
|
|
|
|
// marqueurs des 3 heures
|
|
if Angle=0 then //6h
|
|
begin
|
|
inc(x2);
|
|
x3:=x2;y3:=y2-lg;
|
|
x4:=x1;y4:=y1-lg;
|
|
end
|
|
else
|
|
if Angle=90 then //3h
|
|
begin
|
|
inc(y1);
|
|
x3:=x2-lg;y3:=y2;
|
|
x4:=x1-lg;y4:=y1;
|
|
end
|
|
else
|
|
if Angle=180 then //0h
|
|
begin
|
|
inc(x1);
|
|
x3:=x2;y3:=y2+lg;
|
|
x4:=x1;y4:=y1+lg;
|
|
end
|
|
else
|
|
if Angle=270 then //9h
|
|
begin
|
|
inc(y2);
|
|
x3:=x2+lg;y3:=y2;
|
|
x4:=x1+lg;y4:=y1;
|
|
end
|
|
else
|
|
begin
|
|
sr:=(Radius-lg) + OfsX;
|
|
sincos((Angle-Ep)*pisur180,sin,cos);
|
|
x3:=round(sr*sin)+centerPoint.X; y3:=round(sr*cos)+centerPoint.y;
|
|
|
|
sincos((Angle+Ep)*pisur180,sin,cos);
|
|
x4:=round(sr*sin)+centerPoint.X; y4:=round(sr*cos)+centerPoint.y;
|
|
end;
|
|
|
|
Fbitmap.canvas.polygon([point(x1,y1),point(x2,y2),point(x3,y3),point(x4,y4)]);
|
|
|
|
inc(Angle,6);
|
|
end;
|
|
end; // DrawMinSteps
|
|
|
|
begin
|
|
with FBitMap.Canvas do
|
|
begin
|
|
Brush.Style:=bsSolid;
|
|
Brush.Color:=ClkFaceColor;
|
|
FillRect( ClipRect);
|
|
end;
|
|
DrawMinSteps;
|
|
end;
|
|
|
|
procedure calcul_pos_horloge;
|
|
begin
|
|
if LargeurFC<150 then
|
|
begin
|
|
LargeurFC:=250;
|
|
HauteurFC:=250;
|
|
formclock.width:=LargeurFC;
|
|
formclock.height:=HauteurFC;
|
|
end;
|
|
|
|
OffsetYFC:=(formprinc.top+formPrinc.height)-FormClock.height-32;
|
|
OffsetXFC:=(formprinc.left+formPrinc.width)-formClock.width;
|
|
|
|
// écart entre fenetre principale et clock
|
|
DeltaFPCY:=OffsetYFC-formprinc.top;
|
|
DeltaFPCX:=OffsetXFC-formprinc.left;
|
|
|
|
formclock.top:=OffsetYFC;
|
|
formclock.left:=OffsetXFC;
|
|
|
|
end;
|
|
|
|
|
|
procedure TFormClock.FormCreate(Sender: TObject);
|
|
begin
|
|
// inits
|
|
// Affiche('FormClock create',clYellow);
|
|
if formClock<>nil then
|
|
begin
|
|
SetWindowPos(FormClock.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NoMove or SWP_NoSize);
|
|
Verrouille:=true;
|
|
|
|
|
|
clock:=tClock.Create(formClock);
|
|
clock.Parent:=formclock;
|
|
|
|
clock.CalcClockSettings;
|
|
clock.DrawClockBkg;
|
|
clock.ClkFaceColor:=$e0e0e0;
|
|
clock.ClkArrowColor:=clBlack;
|
|
|
|
ImageList24x24.GetBitmap(0,BitBtnMarHor.Glyph);
|
|
BitBtnMarHor.Height:=26;
|
|
BitBtnMarHor.Width:=26;
|
|
|
|
ImageList24x24.GetBitmap(1,BitBtnArrHorl.Glyph);
|
|
BitBtnMarHor.Height:=26;
|
|
BitBtnMarHor.Width:=26;
|
|
|
|
ImageList24x24.GetBitmap(2,BitBtnInitHor.Glyph);
|
|
BitBtnMarHor.Height:=26;
|
|
BitBtnMarHor.Width:=26;
|
|
|
|
color:=clock.ClkFaceColor;
|
|
SecThick:=2; MinThick:=10;
|
|
HouThick:=12;
|
|
|
|
FormClockInit:=true;
|
|
end;
|
|
end;
|
|
|
|
// fixer les valeurs maxi et mini de la taille de la fenetre
|
|
procedure TFormClock.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
|
|
var MinMaxInfo : PMinMaxInfo;
|
|
begin
|
|
inherited;
|
|
MinMaxInfo:=Message.MinMaxInfo;
|
|
MinMaxInfo^.ptMaxTrackSize.X:=400; // Maximum Width
|
|
MinMaxInfo^.ptMaxTrackSize.Y:=400; // Maximum Height
|
|
MinMaxInfo^.ptMinTrackSize.X:=150; // Minimum Width
|
|
MinMaxInfo^.ptMinTrackSize.Y:=150; // Minimum Height
|
|
end;
|
|
|
|
procedure TFormClock.FormResize(Sender: TObject);
|
|
begin
|
|
if (csDesigning in ComponentState) or (formClock=nil) or not(FormClockInit) then exit;
|
|
clock.Width:=formClock.Width-offsetx;
|
|
clock.Height:=formClock.Height-offsety;
|
|
HouThick:=round(12*width/250);
|
|
MinThick:=round(10*width/250);
|
|
SecThick:=round(2*width/250);
|
|
end;
|
|
|
|
procedure TFormClock.BitBtnMarHrClick(Sender: TObject);
|
|
begin
|
|
Demarre_horloge;
|
|
end;
|
|
|
|
procedure TFormClock.BitBtnArrHorlClick(Sender: TObject);
|
|
begin
|
|
horloge:=false;
|
|
end;
|
|
|
|
procedure TFormClock.BitBtnInitHorClick(Sender: TObject);
|
|
begin
|
|
init_horloge;
|
|
end;
|
|
|
|
procedure TFormClock.ButtonParametresClick(Sender: TObject);
|
|
begin
|
|
if formHorloge<>nil then formHorloge.showModal;
|
|
end;
|
|
|
|
procedure TFormClock.TjsVerClick(Sender: TObject);
|
|
begin
|
|
SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NoMove or SWP_NoSize);
|
|
// le checked ne fonctionne pas sous D7, fonctionne sous D11.
|
|
TjsDev.Checked:=true;
|
|
Dverrouiller1.Checked:=false;
|
|
Verrouille:=true;
|
|
end;
|
|
|
|
procedure TFormClock.Dverrouiller1Click(Sender: TObject);
|
|
begin
|
|
SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NoMove or SWP_NoSize);
|
|
TjsDev.Checked:=false;
|
|
Dverrouiller1.Checked:=true;
|
|
Verrouille:=false;
|
|
end;
|
|
|
|
|
|
procedure affiche_horloge;
|
|
begin
|
|
if (formClock<>nil) then
|
|
begin
|
|
FormClock.Show;
|
|
formClock.BringToFront;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TFormClock.ButtonGHClick(Sender: TObject);
|
|
begin
|
|
formFicheHoraire.showModal;
|
|
end;
|
|
|
|
end.
|
|
|