unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, DateUtils, ComCtrls,
ShellAPI, MPlayer;
type
TForm1 = class(TForm)
Edit1: TEdit;
Timer1: TTimer;
Button1: TButton;
Label1: TLabel;
UpDown1: TUpDown;
UpDown2: TUpDown;
Label3: TLabel;
Label4: TLabel;
Label2: TLabel;
procedure FormCreate(Sender: TObject);
procedure CreateTrayIcon(n: integer; Tip: String);
procedure DeleteTrayIcon(n: integer);
procedure Button1Click(Sender: TObject);
procedure Timer1Tick(Sender: TObject);
procedure SetSound;
procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
procedure UpDown2Click(Sender: TObject; Button: TUDBtnType);
private
{ Private declarations }
public
{ Public declarations }
end;
const
NOTIFY = WM_USER + 123;
var
Form1: TForm1;
AlarmHour, AlarmMin: Word; // время установленное на будильнике
AlarmSet: Boolean; // флаг: установлен ли будильник
MediaPlayer : TMediaPlayer;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Label3.Caption := '00';
Label4.Caption := '00';
Application.Title := 'Будильник';
SetSound;
AlarmSet := false;
end;
procedure TForm1.CreateTrayIcon(n: integer; Tip: string);
var
icondata: TNotifyIconData;
begin
// заполним структуру icondata,
// поля которые определяет значок
// на System Tray
with icondata do
begin
cbSize := SizeOf(TNotifyIconData);
Wnd := Self.Handle; //окно (приложение), которое представляет значок
uId := n; //номер значка
uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP; //что надо сделать
uCallBackMessage := NOTIFY;
hIcon := Application.Icon.Handle;
StrPCopy(szTip,Tip); // строка подсказки
end;
Shell_NotifyIcon(NIM_ADD, @icondata);
end;
// удаляет картинку с System Tray
procedure TForm1.DeleteTrayIcon(n: integer);
var
icondata: TNotifyIconData;
begin
// заполним структуру nidata,
// строка которой определяют значок
// на System Tray
with icondata do
begin
cbSize := SizeOf(TNotifyIconData);
Wnd := Self.Handle;
uId := n;
end;
Shell_NotifyIcon(NIM_DELETE, @icondata);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
// установить будильник
AlarmHour := StrToInt(Label3.Caption);
AlarmMin := StrToInt(Label4.Caption);
AlarmSet := true;
CreateTrayIcon(1,'Будильник '+
Label3.Caption+':'+Label4.Caption); // поместить картинку в System Tray
//c подсказкой о времени срабатывания будильника
Form1.Hide;
end;
procedure TForm1.Timer1Tick(Sender: TObject);
var
curHour,curMin: word;
begin
// получить текущее время
curHour := HourOf(Now);
curMin := MinuteOf(Now);
if AlarmSet // будильник установлен
then begin
// Если наступил установленный момент времени
if (curHour = AlarmHour) and (curMin = AlarmMin)
then begin
Form1.Show;
AlarmSet := false;
try
MediaPlayer.Play; // воспроизвести звуковой фрагмент
except
on EMCIDeviceError do ;
end;
ShowMessage(Edit1.Text); // вывести сообщение
DeleteTrayIcon(1);
end
end
else
// окно программы на экране: мигание двоеточия
Label2.Visible := Not(Label2.Visible);
end;
// определяет звук будильника
procedure TForm1.SetSound;
var
pWinDir: PChar; // указатель на nul terminated строку
begin
// создадим компонент MediaPlayer
MediaPlayer := TMediaPlayer.Create(Form1);
MediaPlayer.ParentWindow := Form1.Handle;
MediaPlayer.Visible := False;
// Cтандартные wav-файлы находятся в каталоге .\Windows\media,
// Получить имя каталога Windows
GetMem(pWinDir,80); // выделить память для строки
GetWindowsDirectory(pWinDir,80); // получить каталог Windows
MediaPlayer.FileName := pWinDir + '\media\chord.wav';
try
MediaPlayer.Open;
except
on EMCIDeviceError do ;
end;
end;
// изменяем время сигнала будильника - часы
procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
if UpDown1.Position > 23
then UpDown1.Position := 0;
if UpDown1.Position < 10
then Label3.Caption := '0' + IntToStr(UpDown1.Position)
else Label3.Caption := IntToStr(UpDown1.Position);
end;
// изменяем время сигнала будильника - минуты
procedure TForm1.UpDown2Click(Sender: TObject; Button: TUDBtnType);
begin
if UpDown2.Position > 59
then UpDown2.Position := 0;
if UpDown2.Position < 10
then Label4.Caption := '0' + IntToStr(UpDown2.Position)
else Label4.Caption := IntToStr(UpDown2.Position);
end;
end.
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.