begin process at 2010 02 10 06:59:52
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Divers

 > CHRONOMÈTRE POUR LE THÉ

CHRONOMÈTRE POUR LE THÉ


 Information sur la source

Note :
9 / 10 - par 3 personnes
9,00 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :Divers Classé sous :chronomètre, son, wave Niveau :Débutant Date de création :23/07/2008 Vu / téléchargé :3 056 / 210

Auteur : Forman

Ecrire un message privé
Commentaire sur cette source (9)
Ajouter un commentaire et/ou une note

 Description

Cliquez pour voir la capture en taille normale
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

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

 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Sources du même auteur

Source avec Zip TRADUCTION DE DOKAN EN DELPHI: UN DRIVER "USER-MODE" POUR DI...
Source avec Zip Source avec une capture TASK MANAGER EN MODE TEXTE (ÉMULATION MODE 03H)
Source avec Zip UTILITAIRE POUR LANCER UN PROGRAMME DEPUIS UN AUTRE COMPTE (...
Source avec Zip Source avec une capture DÉMONSTRATION DE LA GESTION DES OBJETS EN MÉMOIRE PAR DELPHI...
Source avec Zip COMPOSANT RUNONCE: AUTORISER UN SEUL LANCEMENT D'UNE APPLICA...

 Sources de la même categorie

Source avec Zip Source avec une capture LOGICIEL DE DIAGNOSTIC AUTOMOBILE KWP2000 par Oniria
Source avec Zip Source avec une capture RÉGLE TRANSPARENTE POUR MESURER UN OBJET ECRAN par dubois77
Source avec Zip Source avec une capture LE BOOK DU PAUVRE par dubois77
Source avec Zip Source avec une capture CAHIER 90 PAGES par dubois77
Source avec Zip Source avec une capture TABLEAU DE BOUTONS DYNAMIQUES (AGENDA) par dubois77

 Sources en rapport avec celle ci

Source avec Zip Source avec une capture DECOMPTEUR AVEC ENREGISTREMENT DES OPTIONS par michaelminelli1
Source avec Zip Source avec une capture JOYEUX NOUVEL AN À TOUS ! par Bacterius
Source avec Zip Source avec une capture ENTRÉES SORTIES WAVE ET MIDI par barbichette
Source avec Zip Source avec une capture GESTIONNAIRE DE CONTACTS par HAFTARIFOUAD
Source avec Zip EDITEUR DE LISTES DE SONS ( SIMPLE MAIS BIEN ) par Bacterius

Commentaires et avis

Commentaire de cantador le 23/07/2008 21:44:29 8/10

indulgence ?
Mais c'est génial.. Un bon thé et en musique..
enfin, j'ai lancé le programme..
j'avais mis le son sur mes enceintes et à fond..
On a frappé à ma porte..
ils ont cru à un attentat !
heureusement, ouf, j'ai trouvé la croix..

Bravo quand même l'originalité..

Commentaire de Forman le 23/07/2008 22:10:30

"On a frappé à ma porte.. " ... lol!

Désolé, j'aurais dû prévenir que le son va crescendo     :-)
Peut-être que je devrais ajouter la possibilité de limiter le volume, mais je n'avais pas trop envie de surcharger l'interface.

Commentaire de Caribensila le 23/07/2008 23:46:46 9/10

De ma copine Yang à Forman :
« Dans les 3 premières minutes, c'est la théine qui diffuse dans l'eau ( 80° ! ). Ensuite, ce sont les tanins qui diffusent et donnent le goût amer, mais aussi les parfums.
Cependant les tanins neutralisent l'effet de la théine et rendent donc le thé moins excitant. »

Ma copine suggère donc un TrackBar  (excitation-parfum) et un choix de type de thé (noir, vert, blanc, etc.) plutôt que le temps d'infusion en dur. Ce serait appréciée en Chine, paraît-il.
De plus, elle n'aime pas le bip-bip. Quelque chose de plus harmonieux pour cet instant aurait été préférable, dit-elle.

Raffinée la chinetoque!  lol

Moi, perso, j'ai rien à redire. Mais je ne  mets que 9 à cause du bip-bip agressif (quand t'es un peu paumé dans le codage de tes pointeurs, ça énerve une théière qui menace de faire exploser la baraque).

Commentaire de Forman le 24/07/2008 00:59:01

Lol elle est vraiment exigeante!

Si j'ai le temps j'en ferai une autre version. L'agressivité du son était désirée, parce que sinon je suis trop tenté de me dire "non c'est bon je peux attendre un peu et y aller plus tard", au moins là il est difficile de l'ignorer.

Commentaire de Francky23012301 le 24/07/2008 01:39:21 10/10

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

Commentaire de DRJEROME le 24/07/2008 12:39:37

Salut

bien joué Mister "T"  

:)  ;) :~)

Commentaire de Forman le 24/07/2008 12:51:36

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!

Commentaire de amiga68 le 03/11/2008 13:05:34

euh, moi, c'est le voisin qui est venu...
J'ai mal maintenant...
C'est malin ton programme...

Commentaire de Forman le 05/11/2008 14:01:06

Tu as mal où?
:-S

Ok je sors ------>H

 Ajouter un commentaire


Discussions en rapport avec ce code source dans le forum

Comment créer un chronomètre [ par Alysum ] Un chrono en min + secondes qui sera remise a zero a chaque pressions sur un bouton.HS: ya un bug sur le forum, je fais une recherche, ke clique sur u chronomètre [ par oudoudou ] Comment faire un chronomètre qui un fois déclenché s'arrète lorsqu'un son est détecté par mo microphonne? Conversion mp3 > Wave [ par CorO ] Bonjour tout le monde :) ,Je voudrais savoir si vous connaissiez un composant ou un quelquonque moyen de transormer des MP3 en Wave sous Delphi 6.Mici Lire un fichier wave [ par olator ] J'ai programmer un puissance4 et je désire que mon prog joue un son wave (enregistrer sur le disque dur) lorsque le joueur gagne. Comment fait on pour wave paradox [ par bilou2000 ] BonjourJ?ai deux soucis : 1er je possede une bdd paradox avec des champs binaires devant contenir du son (wave, mp3)je n?arrive pas à y enregistrer le son wave et octave [ par bilou2000 ] bonjour.j'ai des sons waves et je voudrai soit augmenter d'un octave (plus aigu) soit diminuer d'un octave (plus grave) comment peut t'on faire.Merci. Pb périphérique Wave [ par LeFrettchen ] Bonjour.Je viens de programmer un petit logiciel tout b&#234;te pour lire les fichiers de type wav.Je l'ai test&#233; sous win98, il fonctionne impecc faire un double chronomètre [ par tequilasurlaterre ] bonjours a tous Voila ! je cherche a faire un crono utiliser par les boxeurs.je m'explique.. il faut deux chauses &nbsp;&nbsp;&nbsp; 1) il faut que s Wave en MP3 [ par f6dqm1 ] Bonjour à tousLe sujet n'est pas nouveau. On y trouve des tas de références mais ce n'est pour ça qu'on y arrive !!Je suis l'auteur du programme d'app Wave vizualization and recordind [ par Chaser_DS ] Hi. I am from Russia, and I small speak English. I have a question. Sample - It is a test audio visualization and audio recording test (link on sour


Nos sponsors


Sondage...

Comparez les prix

CalendriCode

Février 2010
LMMJVSD
1234567
891011121314
15161718192021
22232425262728

Consulter la suite du CalendriCode

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,718 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales