Форма программы при ведена на рис. 1.67. После того как пользователь установит время сигнала и щелкнет на кнопке ОК, окно программы должно исчезнуть с экрана, а значок программы — появиться на сис темной панели (рис. 1.68). Окно программы должно появиться на экране в установленное время. Появление окна должно сопровождаться звуковым сигналом.

Рис. 1.69. Окно программы


unit Alarm_;
interface
uses
Windows, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms, Dialogs, StdCtrls,
ExtCtrls, ComCtrls,
ShellAPI, // для доступа к Shell_NotifyIcon
DateUtils, MPlayer;
Будильник
Рис. 1.68. Значок программы
Будильник во время ее работы
Рис. 1.67. Форма программы должен находиться
Будильник на системной панели
type
TForml = class(TForm)
Timerl: TTimer;
Labell: TLabel;
Label2: TLabel;
Label3: TLabel;
Labels.- TLabel;
UpDownl: TUpDown;
Label5: TLabel;
UpDown2: TUpDown;
Label6: TLabel;
Shapel: TShape;
Label7: TLabel;
Buttonl: TButton;
Shape2: TShape;
Label8: TLabel;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure TimerITimer(Sender: TObject);
procedure UpDownlClick(Sender: TObject;
Button: TUDBtnType);
procedure UpDown2Click(Sender: TObject;
Button: TUDBtnType);
procedure ButtonlClick(Sender: TObject);
// **** эти объявления вставлены сюда вручную
procedure CreateTraylcon(n: integer; Tip: String);
procedure DeleteTraylcon(n: integer);
procedure SetSound;
// ******************************************
private
I Private declarations }
public
(' Public declarations }
end;
var
Forrnl: TForml;
implementation
/ Имя WAV-файла, который должен находиться
в системном каталоге Media, программа
берет из командной строки. Если параметр
не указан, будильник воспроизводит звук,
который располагается в файле sound.wav,
который должен находиться в том же
каталоге, что и выполняемый файл программы.
I
{$R *.dfm]
var
Hour,Min: word; // время на индикаторе
AlHour, AlMin: word; // будильник установлен на AlHour:AXMin
MediaPlayer : TMediaPlayer;
// компонент MediaPlayer обеспечивает воспроизведение
// звукового сигнала
// начало работы программы
procedure TForml.FormCreate(Sender: TObject);
begin
Hour := HourOf(Now);
Min := MinuteOf(Now) ;
Labell.Caption := IntToStr(Hour) ;
if Min < 10
then Label2.Caption := '0'+IntToStr(Min)
else Label2.Caption := IntToStr(Min!;
7 Зак. 939
// CreateTraylcon (1) ; // поместить картинку на System Tray
SetSound; // загрузить WAV-файл
end;
// завершение работы программы
procedure TForml.FormClose(Sender: TObject; var Action:
TCloseAction);
begin
// удалить картинку с System Tray
DeleteTraylcon(1);
end;
const
WM_MYTRAYNOTIFY = WM_USER + 123;
// помещает картинку на System Tray
procedure TForml.CreateTraylcon(n: integer; Tip: string);
var
nidata: TNotifylconData;
begin
// заполним структуру nidata,
// поля которой определяют значок
// на System Tray
with nidata do
begin
cbSize : = SizeOf(TNotifylconData);
Wnd := Self.Handle; // окно (приложение), которое
// представляет значок
uld := n; // номер значка (одно приложение может
// разместить несколько значков)
uFlags := NIF_ICON or NIF_MESSAGE or NIFJHP; // что
// надо сделать
uCallBackMessage := WM_MYTRAYNOTIFY;
hlcon := Application.Icon.Handle;
//szTip := 'Будильник';
StrPCopy(szTip,Tip); // копируем Ansi-строку
// в nul-terminated-строку
end;
Shell_NotifyIcon(NIM_ADD, Snidata);
end;
// удаляет картинку с System Tray
procedure TForml.DeleteTraylcon(n: integer);
nidata: TNotifylconData;
begin
// заполним структуру nidata,
// поля которой определяют значок
// на System Tray
with nidata do
begin
cbsize := SizeOf(TNotifylconData);
Wnd := Self.Handle; // окно (приложение), которое
// представляет значок
uld := n; // номер значка (одно приложение может
// разместить несколько значков)
end;
Shell_NotifyIcon(NIM_DELETE, @nidata);
end;
// сигнал от таймера
procedure TForml.TimerlTimer(Sender: TObject);
var
cHour,cMin: word;
begin
// получить текущее время
cHour := HourOf(Now);
cMin := MinuteOf(Now) ;
if Timerl.Tag = 0 // окно программы на экране
then begin
I проверим, совпадает ли текущее время
с отображаемым на индикаторе }
if cHour О Hour then
begin
Hour := cHour;
Labell.Caption := IntToStr(Hour) ;
end;
if cMin <> Min then
begin
Min := cMin;
if min <10
then Label2.Caption := '0' + IntToStr(Min)
else Label2.Caption := IntToStr(Min);
end;
// обеспечим мигание двоеточия
if Label3.Visible
then Label3.Visible := False
else Iabel3.Visible := True;
end
else // окно программы скрыто, контролируем
// наступление момента подачи сигнала
if (cHour = AlHour) and (cMin = AlMin)
// сигнал !
then begin
Forral.Show;
Timer1.Tag := 0;
Timerl.Interval := 1000;
try
MediaPlayer.Play; // воспроизвести
// звуковой фрагмент
except
on EMCIDeviceError do;
end;
end; .
end;
// щелчок на UpDovml изменяет
// время сигнала будильника — часы
procedure TForml.UpDownlClick(Sender: TObject;
Button: TUDBtnType);
begin
if UpDownl.Position < 10
then Label4.Caption := '0' +
IntToStr(UpDownl.Position)
else Label4.Caption := IntToStr(UpDownl.Position);
end;
// щелчок на UpDown2 изменяет
// время сигнала будильника — минуты
procedure TForml.UpDown2Click(Sender: TObject;
Button: TUDBtnType);
begin
if UpDown2.Position < 10
then Label5.Caption := '0' + IntToStr(UpDown2.Position)
else Label5.Caption := IntToStr(UpDown2.Position);
end;
// щелчок на кнопке ОК
procedure TForml.ButtonlClick(Sender: TObject);
begin
// установить будильник
AlHour := UpDownl.Position;
AlMin := UpDown2.Position;
Timer1.Tag := 1;
// поместить картинку на System Tray
CreateTraylconU, 'Будильник ' +
Label4.Caption+':'+Label5.Caption);
Forml.Hide;
Timerl.Interval := 3000; // проверять каждые З секунды
end;
// определяет звук будильника
procedure TForml.SetSound;
var
pWinDir: PChar; // указатель на nul-terminated-строку
sWinDir: String[80];
begin
// создадим компонент MediaPlayer
MediaPlayer := TMediaPlayer.Create(Forml) ;
MediaPlayer.ParentWindow := Forml.Handle;
MediaPlayer.Visible := False;
// Стандартные WAV-файлы находятся в каталоге Media,
// но где находится и как называется каталог, в который
// установлен Windows? Выясним это.
// Чтобы получить имя каталога Windows,
// воспользуемся API-функцией GetWindowsDirectory.
// Строка, которая передается в API-функцию,
// должна быть nul-terminated-строкой.
// Получить имя каталога Windows
GetMem(pWinDir,80); // выделить память для строки
GetWindowsDirectory(pWinDir,80); // получить каталог
// Windows
sWinDir := pWindir;
// открыть WAV-файл
if ParamStr(1) = ''
then MediaPlayer.FileName := 'Sound.wav'
else MediaPlayer.FileName := sWinDir + '\media\' +
ParamStr(1);
try
. MediaPlayer.Open;
except
on EMCIDeviceError do;
end;
end;

end.