пояснительная записка
.docend;
//Form1.AlarmButton.Glyph.LoadFromFile('0.bmp');
Form1.AlarmButton.Caption:= 'Выкл';
end
else
begin
// Form1.AlarmButton.Glyph.LoadFromFile('1.bmp');
Form1.AlarmButton.Caption:= 'Вкл';
Form1.Timer1.Enabled:= False;
Alarm.Destroy;
end;
end;
// ПРОЦЕДУРА СЧИТЫВАЕТ ДАННЫЕ (ВРЕМЯ И СООБЩЕНИЕ)
procedure TForm1.GetAlarm;
begin
Alarm.MsgText:= Form1.Edit1.Text;
Alarm.AlarmTime:= StrToTime(Form1.MaskEdit1.Text);
end;
// ЗДЕСЬ ТАЙМЕР ВЫПОЛНЯЕТ ПРОЦЕДУРЫ ПРОВЕРКИ НАСТОЯЩЕГО ВРЕМЕНИ И ТОГО ЧТО УСТАНОВЛЕНО У НАС
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Alarm.CheckTime;
if Alarm.Handl then
begin
Form1.AlarmButton.Down:= False;
Form1.AlarmButton.Caption:= 'Включить';
Form1.Timer1.Enabled:= False;
end;
end;
// ЗАПИСЫВАЕМ ВРЕМЯ И СООБЩЕНИЕ ВЗАВИСИМОСТИ ОТ ВЫБРАННОГО ВРЕМЕНИ В СПИСКЕ ДЕЛ
procedure TForm1.ListBox1Click(Sender: TObject);
var
n: integer;
s: string;
begin
n:= Form1.ListBox1.ItemIndex;
s:= copy(Form1.ListBox1.Items[n], 0, 2)+ ':' + copy(Form1.ListBox1.Items[n], 6, 2);
Form1.MaskEdit1.Text:= s;
s:= copy(form1.ListBox1.Items[n], 10, length(form1.ListBox1.Items[n]) - 8);
Form1.Edit1.Text:= s;
end;
//**********************************************
// ТРЕЙ *
//**********************************************
// ОТЛАВЛИМАЕМ МИНИМИЗАЦИЮ ПРИЛОЖЕНИЯ
procedure TForm1.ControlWindow(var MSG: TMessage);
begin
if MSG.WParam = SC_MINIMIZE then
begin
ic(1, application.Icon); // добавляем значок в трей
ShowWindow(handle, SW_HIDE); // скрываем программу
ShowWindow(Application.Handle, SW_HIDE); // скрываем кнопку в TAskBar
end
else inherited;
end;
// РЕАКЦИЯ НАЖАТИЙ КНОПОК НА ЗНАЧКЕ В ТРЕЕ
procedure TForm1.IconMouse(var Msg: Tmessage);
var
p: TPoint;
begin
GetCursorPos(p); // ЗАПОМИНАЕМ КООРДИНАТЫ МЫШИ
Case Msg.LParam of // ПРОВЕРЯЕМ КАКАЯ КНОПКА БЫЛА НАЖАТА
WM_LBUTTONUP,WM_LBUTTONDBLCLK:
begin
// тут опишем другие процедур при необходимости
end;
WM_RBUTTONUP:
begin
SetForegroundWindow(Handle); // ВОССТАНВЛИВАЕМ ПРОГРАММУ В КАЧСТВЕ ПЕРВВОГО ОКНА
PopupMenu2.Popup(p.X, p.Y); // ПОКАЗЫВАЕМ POPUPMENU
PostMessage(Handle, WM_NULL, 0, 0);
END;
END;
end;
// Для работы со значками в трее используется функция Shell_NotifyIcon, объявленная в модуле ShellApi. процедура работы со знаком в трее: n - номер операции
// ( 1 - добавить, 2 - удалить, 3 - заменить) и Icon - сама иконка
procedure TForm1.Ic(n: integer; Icon: TIcon);
var
nim: TNotifyIconData;
begin
with nim do
begin
cbSize:= SizeOf(nim);
Wnd:= Form1.Handle;
uID:= 1;
uFlags:= NIF_ICON or NIF_MESSAGE or NIF_TIP;
hIcon:= Icon.Handle;
uCallbackMessage:= wm_user + 1;
szTip:= 'Программа "Ежедневник"';
end;
case n of
1: Shell_NotifyIcon(Nim_add, @nim);
2: Shell_NotifyIcon(Nim_Delete, @Nim);
3: Shell_NotifyIcon(Nim_Modify, @Nim);
end;
end;
procedure TForm1.OnMinimizeProc(sender: TObject);
begin
PostMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
end;
// КОНТЕКСТОВОЕ МЕНЮ ФОРМЫ: "ЕЖЕДНЕВНИК", ДЕЛАЕТ ФОРМУ ВИДИМОЙ
procedure TForm1.PopEGClick(Sender: TObject);
begin
ic(2,Application.Icon); // УДАЛЯЕМ ЗНАЧОК ИЗ ТРЕЯ
ShowWindow(Application.Handle, SW_SHOW); // ВОССТАНАВЛИВАЕМ КНОПКУПРОГРАММЫ
ShowWindow(Handle, SW_SHOW); // ВОССТАНАВЛИВАЕМ ОКНО ПРГРАММЫ
end;
// КОНТЕКСТОВОЕ МЕНЮ ФОРМЫ: "ДОБАВИТЬ/РЕДАКТИРОВАТЬ ДАТУ"
procedure TForm1.PopAddDateClick(Sender: TObject);
begin
Form2.ShowModal;
end;
// КОНТЕКСТОВОЕ МЕНЮ ФОРМЫ "ВКЛ/ВЫКЛ БУДИЛЬНИК"
procedure TForm1.PopOnAlarmClick(Sender: TObject);
begin
if not Timer1.Enabled then
begin
AlarmButton.Down:= true;
AlarmButtonClick(nil);
end
else
begin
AlarmButton.Down:= False;
AlarmButtonClick(nil);
end;
end;
// КОНТЕКСТОВОЕ МЕНЮ ФОРМЫ "ВЫХОД"
procedure TForm1.PopExitClick(Sender: TObject);
begin
Form1.Close;
end;
end.
-
Модуль Unit2
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Grids, StdCtrls, ComCtrls, ExtCtrls;
type
TForm2 = class(TForm)
StringGrid1: TStringGrid;
Panel1: TPanel;
Label1: TLabel;
DateTimePicker1: TDateTimePicker;
AddButton: TButton;
EditDBButton: TButton;
SaveDbButton: TButton;
Button1: TButton;
ListBox1: TListBox;
Label2: TLabel;
DeletRecButton: TButton;
procedure FormCreate(Sender: TObject);
procedure AddButtonClick(Sender: TObject);
procedure EditDBButtonClick(Sender: TObject);
procedure DateTimePicker1Change(Sender: TObject);
procedure SaveDbButtonClick(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure DeletRecButtonClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
procedure DaysDate;
end;
var
Form2: TForm2;
n: integer;
implementation
uses MyUnit, Unit1;
{$R *.dfm}
//*************************************************
// ПРОЦЕДУРЫ ГЛАВНОЙ ФОРМЫ *
//*************************************************
// СОЗДАНИЕ ФОРМЫ: ИНИЦИАЛИЗАЦИЯ ДАННЫХ
procedure TForm2.FormCreate(Sender: TObject);
var
i, // цикл
c: integer; // часы
s: string; // минуты
begin
Form2.StringGrid1.ColWidths[1]:= 200; // ЗАДАЕМ ДЛИНУ
Form2.StringGrid1.Width:= Form2.StringGrid1.ColWidths[0] +
form2.StringGrid1.ColWidths[1]; // ОПРЕДЕЛЯЕМ ОБЩУЮ ДЛИНУ ТАБЛИЦЫ
c:= 0; // ноль часов
s:= '00'; // ноль минут
// разбиваем день с интервалом 30 мин.
// записываем время в первую ячейку
Form2.StringGrid1.Cells[0,0]:= '0' + IntToStr(c) + ' : ' + s;
// записываем время в остальные ячейки
for i:= 1 to 48 do
begin
if i mod 2 = 0 then
s:= '30'
else
begin
s:= '00';
inc(c);
end;
if c < 10 then
Form2.StringGrid1.Cells[0,i]:= '0' + IntToStr(c) + ' : ' + s
else Form2.StringGrid1.Cells[0,i]:= IntToStr(c) + ' : ' + s
end;
end;
// ПИШЕМ ВСЕ ДАТЫ В LISTBOX
procedure TForm2.DaysDate;
var
i: integer;
begin
ListBox1.Items.Clear;
seek(TypFile.FFile, 0);
for i:= 0 to typFile.NumberRec - 1 do
begin
read(typFile.ffile, EG);
ListBox1.Items.Add(eg.Date);
end;
ListBox1.Sorted:= true;
end;
// ФОРМИРУЕМ СПИСОК ДАТ
procedure TForm2.FormShow(Sender: TObject);
begin
ListBox1.Items.Clear;
DaysDate;
end;
// ПРИ НАЖАТИИ НА LISTBOX ПЕРЕДАЕМ ДАТУ В КАЛЕНДАРЬ
procedure TForm2.ListBox1Click(Sender: TObject);
Var
n: integer;
begin
n:= ListBox1.ItemIndex;
DateTimePicker1.Date:= StrToDate(ListBox1.Items[n]);
end;
// ПРИ ВЫБОРЕ ДАТЫ ОЧИЩАЕМ СЕТКУ
procedure TForm2.DateTimePicker1Change(Sender: TObject);
var
i: integer;
begin
for i:= 0 to 49 do
StringGrid1.Cells[1,i]:= '';
end;
//*********************************************
// КНОПКИ УПРАВЛЕНИЯ *
//*********************************************
// КНОПКА <ДОБАВИТЬ ЗАПИСЬ>
procedure TForm2.AddButtonClick(Sender: TObject);
var
i: integer;
begin
TypFile.FindRec(datetostr(DateTimePicker1.Date));
if TypFile.DableDate then
begin
MessageDlg('Такая дату уже есть в списке!!!' + #13+
' Для редактирования нажмите кнопку <Редактировать>',
mtInformation, [mbOk], 0);
exit;
end;
EG.Date:= DateToStr(DateTimePicker1.Date); // ЗАПИСЫВАЕМ ДАТУ
for i:= 0 to 49 do
begin
eg.clock[i]:= StringGrid1.Cells[0,i]; // ЗАПИСЫВАЕМ ПОЛЯ СЕТКИ
eg.work[i]:= StringGrid1.Cells[1,i];
end;
TypFile.AddRec(eg);
DaysDate; // список дат
end;
// КНОПКА <РЕДАКТИРОВАТЬ ЗАПИСЬ>
procedure TForm2.EditDBButtonClick(Sender: TObject);
var
i: integer;
begin
TypFile.PNum:= TypFile.FindRec(DateToStr(DateTimePicker1.Date));
EG:= TypFile.ReadRec(TypFile.PNum);
for i:= 0 to 49 do
begin
StringGrid1.Cells[0,i]:= EG.clock[i];
StringGrid1.Cells[1,i]:= eg.work[i];
end;
end;
// КНОПКА <СОХРАНИТЬ ЗАПИСЬ>
procedure TForm2.SaveDbButtonClick(Sender: TObject);
var
i: integer;
begin
EG.Date:= DateToStr(DateTimePicker1.Date); // ЗАПИСЫВАЕМ ДАТУ
for i:= 0 to 49 do
begin
eg.clock[i]:= StringGrid1.Cells[0,i]; // ЗАПИСЫВАЕМ ПОЛЯ СЕТКИ
eg.work[i]:= StringGrid1.Cells[1,i];
end;
TypFile.ModifyNextRec(EG, TypFile.PNum);
end;
// КНОПКА <УДАЛИТЬ ВСЕ ЗАПИСИ>
procedure TForm2.Button1Click(Sender: TObject);
var
a: integer;
begin
a:= messageDlg('ВЫ ХОТИТЕ ОЧИСТИТЬ СПИСОК ДАТ?', mtInformation,
[mbYes, mbNo], 0);
if a = mrYes then
begin
ListBox1.Items.Clear;
TypFile.DeleteDb;
end;
end;
// КНОПКА <УДАЛИТЬ ЗАПИСЬ>
procedure TForm2.DeletRecButtonClick(Sender: TObject);
var
a: integer;
begin
a:= messageDlg('ВЫ ХОТИТЕ УДАЛИТЬ ДАТУ ' + DateToStr(DateTimePicker1.Date) + '?', mtInformation,
[mbYes, mbNo], 0);
if a = mrYes then
begin
a:= TypFile.FindRec(DateToStr(DateTimePicker1.Date));
if TypFile.DableDate then
if a <> TypFile.NumberRec - 1 then
TypFile.DeleteRec(a)
else
begin
seek(TypFile.FFile, a);
truncate(TypFile.FFile);
TypFile.NumberRec:= FileSize(TypFile.FFile);
end;
end;
DaysDate; // список дат
end;
// ЗАКРЫВАЕМ ФОРМУ - ОБНОВЛЯЕМ СПИСОК ЗАПЛАНИРОВАННЫХ ДЕЛ
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
var
i: integer;
begin
i:= TypFile.FindRec(DateToStr(Form1.DateTimePicker1.Date));
Form1.ListBox1.Items.Clear;
Form1.PlanDay(i);
end;
end.
-
Модуль Unit3
unit Unit3;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, MyUnit;
type
TForm3 = class(TForm)
ComboBox1: TComboBox;
BitBtn1: TBitBtn;
Label1: TLabel;
procedure FormShow(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
end;
var
Form3: TForm3;
x: string;
implementation
uses Unit1;
{$R *.dfm}
procedure TForm3.FormShow(Sender: TObject);
var
i: integer;
begin
seek(PhoneFile.FPhoneFile, 0);
for i:= 0 to PhoneFile.NumberRec - 1 do
begin
read(PhoneFile.FPhoneFile, Phone);
ComboBox1.Items.Add(Phone.Name);
end;
end;
procedure TForm3.ComboBox1Change(Sender: TObject);
begin
x:= ComboBox1.Text;
end;
procedure TForm3.BitBtn1Click(Sender: TObject);
var
a: integer;
begin
a:= PhoneFile.FindName(x);
if a <> PhoneFile.NumberRec - 1 then
PhoneFile.DeleteRec(a)
else
begin
seek(PhoneFile.FPhoneFile, a);
truncate(PhoneFile.FPhoneFile);
PhoneFile.NumberRec:= FileSize(PhoneFile.FPhoneFile);
end;
form3.Close;
Form1.StringGrid1.RowCount:= Form1.StringGrid1.RowCount - 1;
Form1.PhoneDbButtonClick(nil);
end;
end.
-
Модуль Unit4
unit Unit4;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls;
type
TForm4 = class(TForm)
MonthCalendar1: TMonthCalendar;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form4: TForm4;
implementation
{$R *.dfm}
end.
-
Модуль MyUnit
unit MyUnit;
interface
uses Controls, Dialogs, grids, SysUtils, MMSystem;
type
TEgRec = record
Date: string[10]; // дата
clock: array [0..49] of string[8]; // время
work: array [0..49] of string[100] // событие
end;
TPhoneRec = record
Name: string[30]; // ФАМИЛИЯ
Tel: string[10]; // ТЕЛЕФОН
Address: string[30]; // АДРЕС
Org: string[15]; // ОРГАНИЗАЦИЯ
comment: string[20]; // КОМЕНТАРИИ
end;
// БАЗОВЫЙ КЛАСС
TTypFile = class
private
CurNum: integer; // текущее положение записи
public
NumberRec: integer; // номер записи в файле
DbOpen: boolean; // признак отрытия файла
FFile: File of TEgRec;
DableDate: boolean;
constructor Create;
Destructor Destroy; override;
procedure CloseDB; virtual;
function OpenDb(const DBName: string): boolean; virtual;
function CreateDb(const DBname: string): boolean; virtual;
procedure AddRec(const Rec: TEGRec); overload;
procedure ModifyNextRec(const Rec: TEGRec; N: integer); overload;
function ReadRec(const RecNo: integer): TEGRec; overload;
function FindRec(d: string): integer;
procedure DeleteDb;
procedure DeleteRec(n: integer); overload;
function NextWeek(CurDate: TDate): TDate;
procedure CheckDay(var Y,M,D: word);
procedure SetCurNum(n: integer);
function GetCurNum: integer;
property PNum: integer read GetCurNum write SetCurNum;
end;
// КЛАСС НАСЛЕДНИК
TPhoneFile = class(TTypFile)
private
public
FPhoneFile: file of TPhoneRec;
constructor create;
Destructor Destroy; override;
procedure CloseDB; override;
function OpenDb(const DBName: string): boolean; override;
function CreateDb(const DBname: string): boolean; override;
procedure AddRec(const Rec: TPhoneRec); overload;
procedure ModifyNextRec(const Rec: TPhoneRec; N: integer); overload;
function ReadRec: TPhoneRec; overload;
function FindName(s: string): integer;
procedure DeleteRec(n: integer); overload;
end;
// КЛАСС БУДИЛЬНИК
TAlarm = class
private
handled: Boolean;
public
MsgText: string; // ТЕКСТ СООБЩЕНИЯ
AlarmTime: TDateTime; // ВРЕМЯ СИГНАЛА
constructor Create;
Destructor Destroy; override;
Function GetAlarmStr: String;
procedure CheckTime;
function GetHandle: boolean;
property Handl: boolean read GetHandle;
end;
var
TypFile: TTypFile;
EG: TEgRec;
PhoneFile: TPhoneFile;
Phone: TPhoneRec;
Alarm: TAlarm;
implementation
{ TTypFile }
//***********************************************
// БАЗОВЫЙ КЛАСС *
//***********************************************
// СОЗДАЕМ ФАЙЛ БАЗЫ ДАННЫХ
function TTypFile.CreateDb(const DBname: string): boolean;
begin
AssignFile(FFile, Dbname); // ПРИВЯЗЫВАЕМ К ФАЙЛУ ИМЯ
try
Rewrite(FFile); // СОЗДАЕМ ФАЙЛ С ЭТИМ ИМЕНЕМ
DbOpen:= true; // ОТМЕЧАЕМ ЧТО ФАЙЛ ОТКРЫТ
except
DbOpen:= False; // ФАЙЛ НЕ ОТКРЫТ
end;
NumberRec:= 0; // КОЛ-ВО СТРОК РАВНО НУЛЮ
Result:= DbOpen; // РЕЗУЛЬТАТ СОЗДАНИЯ ФАЙЛА
end;
// ОТКРЫВАЕМ ФАЙЛ.
function TTypFile.OpenDb(const DBName: string): boolean;
begin
AssignFile(FFile, DbName);
{$I-}
Reset(FFile); // открываем базу
{$I+}
if IOResult <> 0 then
begin
NumberRec:= 0;
DbOpen:= False;
end
else
begin
NumberRec:= FileSize(FFile); // кол-во записей
DbOpen:= True;
end;
Result:= DbOpen;
end;
// ДОБАВИТЬ ЗАПИСЬ В ФАЙЛ
procedure TTypFile.AddRec(const Rec: TEGRec);
begin
ModifyNextRec(Rec, NumberRec); // переместиться на последнею запись и добавить запись
NumberRec := FileSize(FFile); // новое кол. записей
end;
// ИЗМЕНИТЬ ЗАПИЬ ПОД НОМЕРОМ N
procedure TTypFile.ModifyNextRec(const Rec: TEGRec; N: integer);
begin
Seek(FFile, n); // переместиться на n - запись
Write(FFile, rec);
end;
// ЧИТАТЬ ЗАПИСЬ ПОД НОМЕРОМ RecNo
function TTypFile.ReadRec(const RecNo: integer): TEGRec;
begin
Seek(FFile, RecNo);
read(FFile, result);
end;
// ЗАКРЫВАЕМ ФАЙЛ
procedure TTypFile.CloseDB;
begin
if DbOpen then
CloseFile(FFile);
end;
// КОНСТРУКТОР
constructor TTypFile.Create;
begin
if not OpenDb('BD.txt') then
CreateDB('BD.txt');
end;
// ОСБОЖДАЕМ ПАМЯТЬ
destructor TTypFile.Destroy;
begin
inherited Destroy;
end;
// ПРОЦЕДУРА ПОИСКА ДАТЫ
function TTypFile.FindRec(d: string): integer;
var
i: integer;
begin
Seek(FFile, 0);
DableDate:= false;
for i:= 0 to NumberRec - 1 do
begin
Read(FFile, EG);
if D = EG.Date then
begin
result:= i;
dableDate:= true;
exit;
end;
end;
end;
// ПРОЦЕДУРА УДАЛЕНИЯ ВСЕХ ЗАПИСЕЙ
procedure TTypFile.DeleteDb;
begin
Seek(FFile, 0);
Truncate(FFile);
NumberRec:= FileSize(FFile);
end;
// ПРОЦЕДУРА УДАЛЕНИЯ N ЗАПИСИ
procedure TTypFile.DeleteRec(n: integer);
begin
seek(FFile, NumberRec - 1);
read(FFile, EG);
Seek(FFile, n);
write(FFile, eg);
seek(FFile, NumberRec-1);
truncate(FFile);
NumberRec:= FileSize(FFile);
end;
// ПРОЦЕДУРА ЗАПИСЫВАЕТ НОМЕР ЗАПИСИ
procedure TTypFile.SetCurNum(n: integer);
begin
CurNum:= n;
end;
// ПРОЦЕДУРА ЧТЕНИЯ НОМЕРА ЗАПИСИ
function TTypFile.GetCurNum: integer;
begin
result:= CurNum;
end;
// ПРОЦЕДУРА ИЩЕТ НАЧАЛО СЛЕДУЮЩЕЙ НЕДЕЛИ
function TTypFile.NextWeek(CurDate: TDate): TDate;
var
Y,M,D: word; // ГОД МЕСЯЦ ДЕНЬ
i: integer;
begin
i:= DayOfWeek(CurDate); //
DecodeDate(CurDate, Y, M, D);
case i of
1: D:= D + 1; // ВОСКРЕСЕНИЕ
2: D:= D + 7; // ПОНЕДЕЛЬНИК
3: D:= D + 6; // ВТОРНИК
4: D:= D + 5; // СРЕДА
5: D:= D + 4; // ЧЕТВЕРГ
6: D:= D + 3; // ПЯТНИЦА
7: D:= D + 2; // СУББОТА
end;
CheckDay(Y,M,D);
result:= EncodeDate(Y,M,D);
end;
// ПРОВЕРЯЕМ ДАТУ НА ПЕРЕПОЛНЕНИЕ
procedure TTypFile.CheckDay(var Y, M, D: word);
begin
// 30 ДНЕВНЫЕ МЕСЕЦА
if (M = 4) or (M = 6) or (m = 9) or (m = 11) then
if d > 30 then
begin
d:= d mod 30;
m:= m + 1;
end;
// 31 ДНЕВНЫЕ МЕСЕЦА
if (M = 1) OR (M = 3) OR (M = 5) OR (M = 7) OR (M = 8) OR (M = 10) OR (M = 12) then
if d > 31 then
begin
d:= d mod 31;
m:= m + 1;
end;
// ФЕВРАЛЬ МЕСЯЦ
if m = 2 then
begin
if y mod 4 <> 0 then // не высокосный год
if d > 28 then
begin
d:= d mod 28;
m:= m + 1;
end;
if y mod 4 = 0 then // высокосный год
if d > 29 then
begin
d:= d mod 29;
m:= m + 1;
end;
end;
if m > 12 then
begin
y:= y + 1;
m:= 1;
end;
end;
{ TPhoneFile }
//***************************************************
// КЛАСС НАСЛЕДНИК *
//***************************************************
// СОЗДАЕМ ИЛИ ОТРЫВАЕМ ФАЙЛ
constructor TPhoneFile.create;
begin
if not OpenDb('PhoneDb.txt') then
CreateDB('PhoneDb.txt');
end;
// ОСВОБОЖДЕНИЕ ПАМЯТИ
destructor TPhoneFile.Destroy;
begin
inherited Destroy;
end;
// СОЗДАНИЕ ФАЙЛА БАЗЫ ДАННЫХ ТЕЛЕФОНОВ
function TPhoneFile.CreateDb(const DBname: string): boolean;
begin
AssignFile(FPhoneFile, Dbname); // ПРИВЯЗЫВАЕМ К ФАЙЛУ ИМЯ
try
Rewrite(FPhoneFile); // СОЗДАЕМ ФАЙЛ С ЭТИМ ИМЕНЕМ
DbOpen:= true; // ОТМЕЧАЕМ ЧТО ФАЙЛ ОТКРЫТ
except
DbOpen:= False; // ФАЙЛ НЕ ОТКРЫТ
end;
NumberRec:= 0; // КОЛ-ВО СТРОК РАВНО НУЛЮ
Result:= DbOpen; // РЕЗУЛЬТАТ СОЗДАНИЯ ФАЙЛА
end;
// ОТКРЫТИЕ ФАЙЛА БАЗЫ ДАННЫХ
function TPhoneFile.OpenDb(const DBName: string): boolean;
begin
AssignFile(FPhoneFile, DbName);
{$I-}
Reset(FPhoneFile); // открываем базу
{$I+}
if IOResult <> 0 then
begin
NumberRec:= 0;
DbOpen:= False;
end
else
begin
NumberRec:= FileSize(FPhoneFile); // кол-во записей
DbOpen:= True;
end;
Result:= DbOpen;
end;
// ЗАКРЫВАЕМ ФАЙЛ
procedure TPhoneFile.CloseDB;
begin
if DbOpen then
CloseFile(FPhoneFile);
end;
// ДОБАВИТЬ ЗАПИСЬ
procedure TPhoneFile.AddRec(const Rec: TPhoneRec);
begin
ModifyNextRec(Rec, NumberRec); // переместиться на последнею запись и добавить запись
NumberRec := FileSize(FPhoneFile); // новое кол. записей
end;
// ИЗМЕНИТЬ ЗАПИЬ ПОД НОМЕРОМ N
procedure TPhoneFile.ModifyNextRec(const Rec: TPhoneRec; N: integer);
begin
Seek(FPhoneFile, n); // переместиться на n - запись
Write(FPhoneFile, rec);
end;
// ПРОЦЕДУРА ЧТЕНИЯ ДАННЫХ
function TPhoneFile.ReadRec: TPhoneRec;
begin
read(FphoneFile, result);
end;
// ИЩЕМ ИМЯ
function TPhoneFile.FindName(s: string): integer;
var
i: integer;
begin
Seek(FPhoneFile, 0);
for i:= 0 to NumberRec - 1 do
begin
Read(FPhoneFile, phone);
if s = phone.Name then
begin
result:= i;
exit;
end;
end;
end;
// УДАЛЯЕМ ЗАПИСЬ
procedure TPhoneFile.DeleteRec(n: integer);
begin
seek(FPhoneFile, NumberRec - 1);
read(FPhoneFile, Phone);
Seek(FPhoneFile, n);
write(FPhoneFile, Phone);
seek(FPhoneFile, NumberRec-1);
truncate(FPhoneFile);
NumberRec:= FileSize(FPhoneFile);
end;
{ TAlarm }
//*******************************************
// КЛАСС: БУДИЛЬНИК *
//*******************************************
// ПРОЦЕДУРА ПРОВЕРКИ ВРЕМЕНИ ВКЛ. СИГНАЛА
procedure TAlarm.CheckTime;
var
H1,M1,S1,MS1: word;
H2,M2,S2,MS2: word;
Match: boolean;
begin
DecodeTime(Time, H1, M1, S1, MS1); // ДЕКОДИРУЕМ ТЕКУЩЕЕ ВРЕМЯ
DecodeTime(AlarmTime, H2, M2, S2, MS2); // РАСКОДИРОВАТЬ ТЕКУЩЕЕ ВРЕМЯ БУДИЛЬНИКА
// ПРОВЕРЯЕМ ТЕКУЩЕЕ ВРЕМЯ И ВРЕМЯ БУДИЛЬНИКА
if (H1 = H2) AND (M1 = M2) then
match:= true
else
match:= false;
// ЕСЛИ ВРЕМЯ СОВПОДАЕТ (MATH = TRUE), ТО ВЫПОЛНЯЕМ АЛГОРИТМ ОПИСАННЫЙ НИЖЕ
if match then
begin
if not handled then
begin
handled := true; // ДЛЯ ИЗБЕЖАНИЯ ПОВТОРНЫХ ВКЛ. ИСПОЛЬЗУЕМ ФЛАГ <HANDLED>
SndPlaySound(PChar('1.wav'), SND_SYNC);
MessageDlg(GetAlarmStr, mtWarning, [mbOk], 0);
end;
end
else
Handled:= False;
end;
// ФУНКЦИЯ ФОРМИРУЕТ ТЕКСТ СООБЩЕНИЯ
constructor TAlarm.Create;
begin
handled:= False;
end;
// ОСВОБОЖДАЕМ ПАМЯТЬ
destructor TAlarm.Destroy;
begin
inherited Destroy;
end;
// ФОРМИРУЕМ СТРОКУ СООБЩЕНИЯ
function TAlarm.GetAlarmStr: String;
begin
result:= FormatDateTime('hh:mm ', AlarmTime) + MsgText
end;
// ЧИТАЕМ СОСТОЯНИЕ <HANDLE>
function TAlarm.GetHandle: boolean;
begin
result:= handled;
end;
end.
Заключение
В результате выполнения курсовой работы была разработана прикладная программа «Ежедневник». Она помогает пользователю рационально планировать свой распорядок дня, а также хранить наиболее важные номера телефонов. Программа имеет удобный и простой интерфейс. Разработанная программа выполнена в соответствии с требованиями технического задания.
Список использованных источников
1 Тонкий Л. В. Системное программное обеспечение. Программа учебной дисциплины и методические указания к выполнению курсовой работы [текст] РГАТА. – Рыбинск, 2006. – 23 с.
2 Гофман В. Delphi 7. Полное руководство [текст] Питер. – Санкт-Петербург, 2002. – 340 с.