Chronomètre pour le thé

Soyez le premier à donner votre avis sur cette source.

Vue 6 544 fois - Téléchargée 588 fois

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

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cs_Forman
Messages postés
663
Date d'inscription
samedi 8 juin 2002
Statut
Membre
Dernière intervention
6 avril 2010
1 -
Tu as mal où?
:-S

Ok je sors ------>H
amiga68
Messages postés
55
Date d'inscription
dimanche 23 février 2003
Statut
Membre
Dernière intervention
21 décembre 2009
-
euh, moi, c'est le voisin qui est venu...
J'ai mal maintenant...
C'est malin ton programme...
cs_Forman
Messages postés
663
Date d'inscription
samedi 8 juin 2002
Statut
Membre
Dernière intervention
6 avril 2010
1 -
Génial le coup de la voisine :-)

On a peut-être sans le savoir découvert la fréquence sonore qui attire les voisines en string!
DRJEROME
Messages postés
447
Date d'inscription
jeudi 9 janvier 2003
Statut
Membre
Dernière intervention
5 février 2015
-
Salut

bien joué Mister "T"

:) ;) :~)
Francky23012301
Messages postés
411
Date d'inscription
samedi 6 août 2005
Statut
Membre
Dernière intervention
11 février 2016
1 -
Lancé le truc à 01:33
10 sec apres : la voisine qui descend en string pas contente.
Bon ben j'en ai profité pour lui offrir un thé : Bilan j'ai pas finit la nuit tout seul.

Smpas ton truc formant, sympa.

Je le conseil à tout les étudiants qui sont en résidence universitaire : Va y avoir du laché de strings.
Je le vous le dit les gars : c'est chaud les trucs à Forman

Mdrrrr

Ps : Pour ceux qui ont pas compris. C'est pas un simple chronometre hein.

Pour le code rien à redire sauf que tu as pas renommé les composants :p.

Pour la voisine ca mérite un 10

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.