Chronomètre pour le thé

Télécharger le projet
Commenter

Description

Dans la lignée des sources pas très innovantes voici un chronomètre avec une sonnerie. Bon je sais il en existe d'autres sur le site, mais celui-ci crée lui-même le son qu'il produit lorsqu'il sonne (en générant une oscillation périodique en créneaux dans le buffer de la carte son). La bonne nouvelle c'est que le composant TWaveOut (voir http://www.delphifr.com/codes/PROGRAMME-MIX-AUDIO-APPRENTI-DJ_33254.aspx) est créé au runtime donc pas besoin d'installer le package.

Je l'utilise pour faire infuser le thé, et éviter de me retrouver avec un liquide tout noir imbuvable parce que je l'ai oublié :-)

Les paramètres (durée du compte à rebours, position de la fenêtre) sont enregistrés dans un fichier ini.

Source / Exemple : 


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, WaveBase, WaveOut, IniFiles;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    Label2: TLabel;
    SpeedButton1: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure WaveOut1Buffer(Buffer: Pointer; Length: Cardinal;
      BufferQueueLength: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
  public
    FFirstTick,FDeltaSound,FSoundIntensity:Integer;
    FFlash:Boolean;
    WaveOut1: TWaveOut;
  end;

var
  Form1: TForm1;
  GTotalTime:Integer;

const
  GMillisecondsPerDay=3600*1000*24;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  f:TIniFile;
  h1,h2:HRGN;
const
  Rounding=15;
begin
  WaveOut1:=TWaveOut.Create(Self);
  WaveOut1.Bits16:=True;
  WaveOut1.BufferSize:=2048;
  WaveOut1.DeviceID:=-1;
  WaveOut1.OnBuffer:=WaveOut1Buffer;
  h1:=CreateRoundRectRgn(0,0,ClientWidth+1,ClientHeight+1,Rounding,Rounding);
  with SpeedButton1.BoundsRect do
    h2:=CreateRectRgn(Left,Top,Right,Bottom);
  CombineRgn(h1,h1,h2,RGN_OR);
  DeleteObject(h2);
  SetWindowRgn(Handle,h1,False);
  DeleteObject(h1);
  f:=TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini'));
  try
    Left:=f.ReadInteger('Position','X',0);
    Top:=f.ReadInteger('Position','Y',0);
  finally
    f.Destroy;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  t,u:Integer;
begin
  t:=Integer(GetTickCount)-FFirstTick;
  u:=GTotalTime-t;
  if u<6000 then
    WaveOut1.Start;
  if u<0 then begin
    FFlash:=not FFlash;
    if FFlash then
      Label1.Color:=clRed
    else
      Label1.Color:=0;
    u:=0;
  end;
  Label1.Caption:=TimeToStr(u/GMillisecondsPerDay);
  Label2.Caption:='Total time: '+TimeToStr(t/GMillisecondsPerDay);
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key=27 then
    Close;
end;

procedure TForm1.WaveOut1Buffer(Buffer: Pointer; Length: Cardinal;
  BufferQueueLength: Integer);
type
  TSmallintArray=array[0..$FFFFFF] of Smallint;
  PSmallintArray=^TSmallintArray;
var
  p:PSmallintArray;
  i:Integer;

  function Signal(x:Single):Smallint;
  begin
    if Frac(x/3000)<0.8 then
      Result:=0
    else begin
      if Cos(x)>0 then
        Result:=FSoundIntensity
      else
        Result:=-FSoundIntensity;
    end;
  end;

begin
  p:=Buffer;
  Length:=Length div 2;
  for i:=0 to Length-1 do
    p[i]:=Signal(0.3*(i+FDeltaSound));
  FDeltaSound:=FDeltaSound+Integer(Length);
  Inc(FSoundIntensity,5+FSoundIntensity div 20);
  if FSoundIntensity>32000 then
    FSoundIntensity:=32000;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  f:TIniFile;
begin
  f:=TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini'));
  try
    f.WriteInteger('Position','X',Left);
    f.WriteInteger('Position','Y',Top);
  finally
    f.Destroy;
  end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  Perform(WM_SYSCOMMAND,$f012,0);
end;

end.

Conclusion :


Un peu d'indulgence svp, parce que là, j'ai presque l'impression d'avoir posté mon premier programme de calculette :-)
Télécharger le projet

Codes Sources

A voir également

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_Forman)