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