Добавил:

Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.

Вуз:

Белорусский государственный университет информатики и радиоэлектроники

Предмет:

[НЕСОРТИРОВАННОЕ]

Файл:

Отчёт(печать с 5 стр).docx

Скачиваний:

Добавлен:

01.05.2025

Размер:

1.17 Mб

Скачать

☆

<<< < Предыдущая 1 2 3 4 5 6 78 / 88

Список используемой литературы

Вирт Н. Алгоритмы и структуры данных. – . М.: Мир, 1989.
Сухарев М. В. Основы Delphi. Профессиональный подход.
Осипов Д. Delphi. Профессиональное программирование, 2006.

Листинг программы

unit Unit1;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,

System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.StdCtrls, Vcl.ExtCtrls,

unit3, unit4, unit6, unit8,

Vcl.Imaging.jpeg, Vcl.Imaging.pngimage, Vcl.Menus;

type

TFrmMain = class(TForm)

SgMain: TStringGrid;

PnlMain: TPanel;

BtnAdd: TButton;

LblRegReply: TLabel;

BtnDelete: TButton;

PnlActions: TPanel;

PnlSort: TPanel;

PnlSearch: TPanel;

LblSearch: TLabel;

EdtSearchNum: TEdit;

EdtSearchName: TEdit;

MainMenu: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

PnlGreeting: TPanel;

LblGreeting: TLabel;

LblHint: TLabel;

PnlStatistics: TPanel;

EdtHoursFrom: TEdit;

EdtMinsFrom: TEdit;

PnlTime: TPanel;

EdtMinsTill: TEdit;

EdtHoursTill: TEdit;

LblShowByTime: TLabel;

BtnShowByTime: TButton;

LblShowByDay: TLabel;

LblShowUnclosed: TLabel;

BtnShowByDay: TButton;

BtnShowUnclosed: TButton;

LblStatistics: TLabel;

LblShowGraph: TLabel;

BtnShowGraph: TButton;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

BtnSearchNum: TButton;

BtnSearchName: TButton;

BtnChange: TButton;

Rg: TRadioGroup;

N3: TMenuItem;

N4: TMenuItem;

procedure FormCreate(Sender: TObject);

procedure BtnAddClick(Sender: TObject);

procedure N1Click(Sender: TObject);

procedure N4Click(Sender: TObject);

procedure PnlGreetingMouseMove(Sender: TObject; Shift: TShiftState;

X, Y: integer);

procedure LblHintMouseMove(Sender: TObject; Shift: TShiftState;

X, Y: integer);

procedure LblGreetingMouseMove(Sender: TObject; Shift: TShiftState;

X, Y: integer);

procedure BtnShowGraphClick(Sender: TObject);

procedure N5Click(Sender: TObject);

procedure N7Click(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure SgMainDrawCell(Sender: TObject; ACol, ARow: integer; Rect: TRect;

State: TGridDrawState);

procedure RgClick(Sender: TObject);

procedure BtnChangeClick(Sender: TObject);

procedure BtnDeleteClick(Sender: TObject);

procedure BtnSearchNumClick(Sender: TObject);

procedure BtnSearchNameClick(Sender: TObject);

procedure BtnShowByTimeClick(Sender: TObject);

procedure BtnShowByDayClick(Sender: TObject);

procedure BtnShowUnclosedClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FrmMain: TFrmMain;

IsAdded: Boolean;

implementation

{$R *.dfm}

uses Unit2;

// при нажатии на кнопку 'Добавить'

procedure TFrmMain.BtnAddClick(Sender: TObject);

begin

with FrmReplyReg do

begin

EdtName.Text := '';

EdtStreet.Text := '';

EdtNumber.Text := '';

EdtRoom.Text := '';

EdtPhone.Text := '';

CmbProblem.ItemIndex := 0;

CmbReadyness.ItemIndex := 0;

CmbReadyness.Enabled := false;

EdtStreet.Enabled := true;

EdtNumber.Enabled := true;

EdtRoom.Enabled := true;

BtnAddReply.Visible := true;

BtnChangeReply.Visible := false;

IsAdded := true;

end;

// открываем форму регистрации заявок

FrmReplyReg.ShowModal;

end;

// При нажатии на кнопку 'Изменить'

procedure TFrmMain.BtnChangeClick(Sender: TObject);

var

ReplyAdds: string;

i: integer;

begin

// Заполняем поля в форме редактирования заявок

if SgMain.Row <> 0 then

begin

with FrmReplyReg do

begin

// Имя жильца

EdtName.Text := SgMain.Cells[1, SgMain.Row];

ReplyAdds := SgMain.Cells[2, SgMain.Row];

// Улица

EdtStreet.Text := Copy(ReplyAdds, 1, Pos(',', ReplyAdds) - 1);

ReplyAdds := Copy(ReplyAdds, Pos('.', ReplyAdds) + 1,

Length(ReplyAdds) - Pos('.', ReplyAdds));

// Номер дома

EdtNumber.Text := Copy(ReplyAdds, 1, Pos(',', ReplyAdds) - 1);

ReplyAdds := Copy(ReplyAdds, Pos('.', ReplyAdds) + 1,

Length(ReplyAdds) - Pos('.', ReplyAdds));

// Номер квартиры

EdtRoom.Text := ReplyAdds;

// Телефон

EdtPhone.Text := SgMain.Cells[3, SgMain.Row];

// Неисправность

i := 0;

while i <> CmbProblem.Items.Count - 1 do

begin

if CmbProblem.Items[i] = SgMain.Cells[4, SgMain.Row] then

begin

CmbProblem.ItemIndex := i;

break;

end;

i := i + 1;

end;

// Готовность

if SgMain.Cells[6, SgMain.Row] = 'Не готово' then

CmbReadyness.ItemIndex := 0

else

CmbReadyness.ItemIndex := 1;

CmbReadyness.Enabled := true;

EdtStreet.Enabled := false;

EdtNumber.Enabled := false;

EdtRoom.Enabled := false;

BtnAddReply.Visible := false;

BtnChangeReply.Visible := true;

end;

IsAdded := false;

// открываем форму регистрации заявок

FrmReplyReg.ShowModal;

end;

// процедура изменения номера заявок при удалении заявки

procedure SetNewReplyNumber(Deleted: integer);

var

H: PReply;

begin

H := HeadReply;

while H <> nil do

begin

// у всех заявок, чей номер больше номера удалённой, он уменьшается на 1

if H^.Num > Deleted then

H^.Num := H^.Num - 1;

H := H^.Next;

end;

// номер следующей при добавлении заявки будет на 1 меньше чем должен был

ReplyNumber := ReplyNumber - 1;

end;

// при нажатии на кнопку 'Удалить'

procedure TFrmMain.BtnDeleteClick(Sender: TObject);

// процедура удаления строки из таблицы

procedure GridDeleteRow(RowNumber: integer);

var

i: integer;

begin

with FrmAddresses do

begin

SgAddresses.Row := RowNumber;

// если удаляется последняя строка таблицы

if SgAddresses.Row = SgAddresses.RowCount - 1 then

SgAddresses.RowCount := SgAddresses.RowCount - 1

else

begin

// не последняя

for i := RowNumber to SgAddresses.RowCount - 1 do

SgAddresses.Rows[i] := SgAddresses.Rows[i + 1];

SgAddresses.RowCount := SgAddresses.RowCount - 1;

end;

// процедура удаления адреса из списка адресов

procedure DelAddsFromList;

var

P, Temp: PAddsList;

H: PReply;

DeletingRow: integer;

begin

// проверка, существует ли потенциально этот же удаляемый адрес в списке

H := HeadReply;

while H <> nil do

begin

// если да, то выходим из процедуры, адрес из списка не удаляется

if (H^.Adds^.Street + ', д.' + H^.Adds^.Number + ', кв.' +

H^.Adds^.Room = SgMain.Cells[2, SgMain.Row]) then

Exit;

H := H^.Next;

end;

// если удаляем головной адрес

if HeadAddsList^.Adds^.Street + ', д.' + HeadAddsList^.Adds^.Number +

', кв.' + HeadAddsList^.Adds^.Room = SgMain.Cells[2, SgMain.Row] then

begin

Temp := HeadAddsList;

HeadAddsList := HeadAddsList^.Next;

Dispose(Temp);

DeletingRow := 1;

end

else

begin

// если удаляем произвольный(не головной) адрес

P := HeadAddsList;

DeletingRow := 2;

with P^.Next^.Adds^ do

while Street + ', д.' + Number + ', кв.' + Room <> SgMain.Cells

[2, SgMain.Row] do

begin

P := P^.Next;

DeletingRow := DeletingRow + 1;

end;

Temp := P^.Next;

P^.Next := P^.Next^.Next;

Dispose(Temp);

end;

// удаляем строку из таблицы

GridDeleteRow(DeletingRow);

end;

var

H, Temp: PReply;

RowNum, ColNum: integer;

begin

H := HeadReply;

// если выделена не заглавная строка таблицы

if SgMain.Row <> 0 then

begin

{ если данные первого в списке диска совпадают с данными диска

выделенной строки таблицы, то удаляем первый элемент из списка,

а также очищаем занимаемую им память }

if inttostr(H^.Num) = SgMain.Cells[0, SgMain.Row] then

begin

Temp := HeadReply;

HeadReply := HeadReply^.Next;

Dispose(Temp);

end

else

{ в противном случае ищем совпадения данных текущего диска с данными диска

в выделенной строке таблицы, после чего удаляем этот элемент из списка

и очищаем занимаемую им память }

begin

while inttostr(H^.Next^.Num) <> SgMain.Cells[0, SgMain.Row] do

H := H^.Next;

Temp := H^.Next;

H^.Next := H^.Next^.Next;

Dispose(Temp);

end;

// удаляем адрес из списка

DelAddsFromList;

// присваиваем значение номеру будущей заявки

SetNewReplyNumber(strtoint(SgMain.Cells[0, SgMain.Row]));

// вывод на экран списка

H := HeadReply;

SgMain.RowCount := SgMain.RowCount - 1;

for RowNum := 1 to SgMain.RowCount - 1 do

begin

for ColNum := 0 to 6 do

begin

case ColNum of

SgMain.Cells[ColNum, RowNum] := inttostr(H^.Num);

SgMain.Cells[ColNum, RowNum] := H^.Name;

SgMain.Cells[ColNum, RowNum] := H^.Adds^.Street + ', д.' +

H^.Adds^.Number + ', кв.' + H^.Adds^.Room;

SgMain.Cells[ColNum, RowNum] := H^.Phone;

SgMain.Cells[ColNum, RowNum] := H^.Problem;

SgMain.Cells[ColNum, RowNum] := datetostr(H^.IncomeDate) + ', ' +

timetostr(H^.IncomeTime);

SgMain.Cells[ColNum, RowNum] := H^.Ready;

end;

H := H^.Next;

end;

// процедура печати результата поиска

procedure PrintSearch(Searching: string; T: integer);

var

H, Temp, PrintReply: PReply;

begin

with FrmMain do

begin

// PrintReply - список заявок, которые удовлетворяют условию поиска

PrintReply := nil;

H := HeadReply;

// проходимся по всему списку

while H <> nil do

begin

{ параметр T передаём при вызове процедуры, если он = 1,

то ищем заявки по номеру, иначе по имени.

Comparing - номер заявки /имя жильца из текущего списка,

Searching - номер заявки /имя жильца, которого мы хотим найти }

if T = 1 then

begin

if Searching = inttostr(H^.Num) then

begin

// если PrintReply пустой, то создаём его и добавляем 1ый элемент

if PrintReply = nil then

begin

New(PrintReply);

PrintReply^ := H^;

PrintReply^.Next := nil;

end

else

// если не пустой, то добавляем элемент

begin

Temp := PrintReply;

while Temp^.Next <> nil do

Temp := Temp^.Next;

New(Temp^.Next);

Temp^.Next^ := H^;

Temp^.Next^.Next := nil;

end;

end

else

// если строка Searching является строкой/подстрокой строки Comparing

if Pos(AnsiLowerCase(Searching), AnsiLowerCase(H^.Name)) <> 0 then

begin

// если PrintReply пустой, то создаём его и добавляем 1ый элемент

if PrintReply = nil then

begin

New(PrintReply);

PrintReply^ := H^;

PrintReply^.Next := nil;

end

else

// если не пустой, то добавляем элемент

begin

Temp := PrintReply;

while Temp^.Next <> nil do

Temp := Temp^.Next;

New(Temp^.Next);

Temp^.Next^ := H^;

Temp^.Next^.Next := nil;

end;

// проверяем следующий элемент списка

H := H^.Next;

end;

{ после того, как проверили весь список, если PrintReply пустой,

показать соответствующее сообщение }

if PrintReply = nil then

ShowMessage('По данному запросу заявок не найдено.')

else

begin

{ если PrintReply не пустой, то выводим все его элементы на экран,

последовательно удаляя элементы PrintReply'a для экономии памяти

(повышение эффективности программы) }

SgMain.RowCount := 1;

while PrintReply <> nil do

begin

SgMain.RowCount := SgMain.RowCount + 1;

SgMain.Cells[0, SgMain.RowCount - 1] := inttostr(PrintReply^.Num);

SgMain.Cells[1, SgMain.RowCount - 1] := PrintReply^.Name;

SgMain.Cells[2, SgMain.RowCount - 1] := PrintReply^.Adds^.Street +

', д.' + PrintReply^.Adds^.Number + ', кв.' + PrintReply^.Adds^.Room;

SgMain.Cells[3, SgMain.RowCount - 1] := PrintReply^.Phone;

SgMain.Cells[4, SgMain.RowCount - 1] := PrintReply^.Problem;

SgMain.Cells[5, SgMain.RowCount - 1] :=

datetostr(PrintReply^.IncomeDate) + ', ' +

timetostr(PrintReply^.IncomeTime);

SgMain.Cells[6, SgMain.RowCount - 1] := PrintReply^.Ready;

Temp := PrintReply;

PrintReply := PrintReply^.Next;

Dispose(Temp);

end;

// при нажатии на кнопку поиска по ФИО жильца

procedure TFrmMain.BtnSearchNameClick(Sender: TObject);

begin

PrintSearch(EdtSearchName.Text, 2);

end;

// при нажатии на кнопку поиска по номеру заявки

procedure TFrmMain.BtnSearchNumClick(Sender: TObject);

begin

PrintSearch(EdtSearchNum.Text, 1);

end;

// процедура вывода на экран и в файл заявок, удовлетворяющих условиям поиска

procedure ShowReplies(By: String; NewName: string);

var

H, Temp, PrintReply: PReply;

F: TextFile;

Condition: Boolean;

begin

// если список заявок не пуст

if HeadReply <> nil then

begin

H := HeadReply;

// PrintReply - список печатающихся заявок

PrintReply := nil;

while H <> nil do

begin

// By определяет выводим заявки за день или не готовые

if By = 'ByDay' then

Condition := (H^.IncomeDate = Date)

else

Condition := (H^.Ready = 'Не готово');

// если условие соблюдается, добавляем заявку в список печатающихся заявок

if Condition = true then

begin

if PrintReply = nil then

begin

New(PrintReply);

PrintReply^ := H^;

PrintReply^.Next := nil;

end

else

begin

Temp := PrintReply;

while Temp^.Next <> nil do

Temp := Temp^.Next;

New(Temp^.Next);

Temp^.Next^ := H^;

Temp^.Next^.Next := nil;

end;

H := H^.Next;

end;

// Если существуют заявки по данному запросу

if PrintReply <> nil then

begin

// Запись в файл заявок по данному запросу

AssignFile(F, 'Заявки.txt');

Rewrite(F);

CloseFile(F);

Rename(F, NewName);

Rewrite(F);

writeln(F,

'№ ФИО Адрес Телефон Неисправность Дата и время поступления Готовность');

Temp := PrintReply;

while Temp <> nil do

begin

if Temp^.Next = nil then

write(F, inttostr(Temp^.Num) + ' ' + Temp^.Name + ' ' +

Temp^.Adds^.Street + ', ' + Temp^.Adds^.Number + ', ' +

Temp^.Adds^.Room + ' ' + Temp^.Phone + ' ' + Temp^.Problem +

' ' + datetostr(Temp^.IncomeDate) + ', ' +

timetostr(Temp^.IncomeTime) + ' ' + Temp^.Ready)

else

writeln(F, inttostr(Temp^.Num) + ' ' + Temp^.Name + ' ' +

Temp^.Adds^.Street + ', ' + Temp^.Adds^.Number + ', ' +

Temp^.Adds^.Room + ' ' + Temp^.Phone + ' ' + Temp^.Problem +

' ' + datetostr(Temp^.IncomeDate) + ', ' +

timetostr(Temp^.IncomeTime) + ' ' + Temp^.Ready);

Temp := Temp^.Next;

end;

CloseFile(F);

// Вывод на экран заявок по данному запросу

with FrmMain do

begin

SgMain.RowCount := 1;

while PrintReply <> nil do

begin

SgMain.RowCount := SgMain.RowCount + 1;

SgMain.Cells[0, SgMain.RowCount - 1] := inttostr(PrintReply^.Num);

SgMain.Cells[1, SgMain.RowCount - 1] := PrintReply^.Name;

SgMain.Cells[2, SgMain.RowCount - 1] := PrintReply^.Adds^.Street +

', д.' + PrintReply^.Adds^.Number + ', кв.' +

PrintReply^.Adds^.Room;

SgMain.Cells[3, SgMain.RowCount - 1] := PrintReply^.Phone;

SgMain.Cells[4, SgMain.RowCount - 1] := PrintReply^.Problem;

SgMain.Cells[5, SgMain.RowCount - 1] :=

datetostr(PrintReply^.IncomeDate) + ', ' +

timetostr(PrintReply^.IncomeTime);

SgMain.Cells[6, SgMain.RowCount - 1] := PrintReply^.Ready;

// последовательно очищаем память, занимаемую печатаемым списком

Temp := PrintReply;

PrintReply := PrintReply^.Next;

Dispose(Temp);

end;

end

else

ShowMessage('По данному запросу заявок не найдено.');

end;

// при нажатии на кнопку 'Показать' заявки за день

procedure TFrmMain.BtnShowByDayClick(Sender: TObject);

begin

ShowReplies('ByDay', 'Заявки за ' + datetostr(Date) + ' .txt');

end;

// при нажатии на кнопку 'ok' - показать заявки, входящие во временной диапазон

procedure TFrmMain.BtnShowByTimeClick(Sender: TObject);

var

TimeFrom, TimeTill: TTime;

H, Temp, PrintReply: PReply;

NewName: string;

F: TextFile;

begin

// если поля ввода времени заполнены

if (EdtHoursFrom.Text <> '') and (EdtMinsFrom.Text <> '') and

(EdtHoursTill.Text <> '') and (EdtMinsTill.Text <> '') then

// Если время введено неправильно или в неправильном формате

if (strtoint(EdtHoursFrom.Text) > 23) or (strtoint(EdtMinsFrom.Text) > 59)

or (strtoint(EdtHoursTill.Text) > 23) or (strtoint(EdtMinsTill.Text) > 59)

then

ShowMessage

('Правильно заполните поля в формате hh mm : hh mm, где hh - часы(число находится в диапазоне 0-23), а mm - минуты(число находится в диапазоне 0-59)')

else

begin

// TimeFrom - время 'до', TimeTill - время 'после'

TimeFrom := strtotime(EdtHoursFrom.Text + ':' + EdtMinsFrom.Text + ':00');

TimeTill := strtotime(EdtHoursTill.Text + ':' + EdtMinsTill.Text + ':00');

// если время 'до' > время 'после'

if TimeFrom > TimeTill then

ShowMessage('Время ''до'' больше времени ''после''.')

// если список заявок не пустой

else if HeadReply <> nil then

begin

H := HeadReply;

// PrintReply - список заявок для печати

PrintReply := nil;

while H <> nil do

begin

{ если время заявки находится в указанном диапазоне, то добавляем её

в список для печати }

if (H^.IncomeTime >= TimeFrom) and (H^.IncomeTime <= TimeTill) then

begin

if PrintReply = nil then

begin

New(PrintReply);

PrintReply^ := H^;

PrintReply^.Next := nil;

end

else

begin

Temp := PrintReply;

while Temp^.Next <> nil do

Temp := Temp^.Next;

New(Temp^.Next);

Temp^.Next^ := H^;

Temp^.Next^.Next := nil;

end;

H := H^.Next;

end;

// Если по данному запросу найдены заявки

if PrintReply <> nil then

begin

// Запись в файл заявок по данному запросу

AssignFile(F, 'Заявки.txt');

Rewrite(F);

CloseFile(F);

NewName := 'Заявки с ' + EdtHoursFrom.Text + '.' + EdtMinsFrom.Text +

' по ' + EdtHoursTill.Text + '.' + EdtMinsTill.Text + '.txt';

Rename(F, NewName);

Rewrite(F);

writeln(F,

'№ ФИО Адрес Телефон Неисправность Дата и время поступления Готовность');

Temp := PrintReply;

while Temp <> nil do

begin

if Temp^.Next = nil then

write(F, inttostr(Temp^.Num) + ' ' + Temp^.Name + ' ' +

Temp^.Adds^.Street + ', ' + Temp^.Adds^.Number + ', ' +

Temp^.Adds^.Room + ' ' + Temp^.Phone + ' ' +

Temp^.Problem + ' ' + datetostr(Temp^.IncomeDate) + ', ' +

timetostr(Temp^.IncomeTime) + ' ' + Temp^.Ready)

else

writeln(F, inttostr(Temp^.Num) + ' ' + Temp^.Name + ' ' +

Temp^.Adds^.Street + ', ' + Temp^.Adds^.Number + ', ' +

Temp^.Adds^.Room + ' ' + Temp^.Phone + ' ' +

Temp^.Problem + ' ' + datetostr(Temp^.IncomeDate) + ', ' +

timetostr(Temp^.IncomeTime) + ' ' + Temp^.Ready);

Temp := Temp^.Next;

end;

CloseFile(F);

// Вывод на экран заявок по данному запросу

SgMain.RowCount := 1;

while PrintReply <> nil do

begin

SgMain.RowCount := SgMain.RowCount + 1;

SgMain.Cells[0, SgMain.RowCount - 1] := inttostr(PrintReply^.Num);

SgMain.Cells[1, SgMain.RowCount - 1] := PrintReply^.Name;

SgMain.Cells[2, SgMain.RowCount - 1] := PrintReply^.Adds^.Street +

', д.' + PrintReply^.Adds^.Number + ', кв.' +

PrintReply^.Adds^.Room;

SgMain.Cells[3, SgMain.RowCount - 1] := PrintReply^.Phone;

SgMain.Cells[4, SgMain.RowCount - 1] := PrintReply^.Problem;

SgMain.Cells[5, SgMain.RowCount - 1] :=

datetostr(PrintReply^.IncomeDate) + ', ' +

timetostr(PrintReply^.IncomeTime);

SgMain.Cells[6, SgMain.RowCount - 1] := PrintReply^.Ready;

// последовательно очищаем память, занимаемую печатаемым списком

Temp := PrintReply;

PrintReply := PrintReply^.Next;

Dispose(Temp);

end;

end

else

ShowMessage('По данному запросу заявок не найдено.');

end;

end

else

ShowMessage('Заполните все поля.');

end;

// при нажатии на кнопку 'Показать' график поступления заявок

procedure TFrmMain.BtnShowGraphClick(Sender: TObject);

begin

// открывается форма с графиком

FrmGraph.ShowModal;

end;

// при нажатии на кнопку 'Показать' незакрытые заявки

procedure TFrmMain.BtnShowUnclosedClick(Sender: TObject);

begin

ShowReplies('ByReady', 'Незакрытые заявки.txt');

end;

// при закрытии формы

procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);

var

F: TextFile;

i: integer;

begin

// Сохранение списка обслуживаемых адресов

AssignFile(F, 'Adds.txt');

if HeadAdds <> nil then

begin

Rewrite(F);

while HeadAdds <> nil do

begin

writeln(F, HeadAdds^.Street);

if HeadAdds^.Next = nil then

write(F, HeadAdds^.Number)

else

writeln(F, HeadAdds^.Number);

HeadAdds := HeadAdds^.Next;

end;

CloseFile(F);

end

else if FileExists('Adds.txt') then

Erase(F);

// Сохранение списка заявок

AssignFile(F, 'Reply.txt');

if HeadReply <> nil then

begin

Rewrite(F);

while HeadReply <> nil do

begin

writeln(F, HeadReply^.Num);

writeln(F, HeadReply^.Name);

writeln(F, HeadReply^.Adds^.Street);

writeln(F, HeadReply^.Adds^.Number);

writeln(F, HeadReply^.Adds^.Room);

writeln(F, HeadReply^.Phone);

writeln(F, HeadReply^.Problem);

writeln(F, HeadReply^.IncomeDate);

writeln(F, HeadReply^.IncomeTime);

if HeadReply^.Next = nil then

write(F, HeadReply^.Ready)

else

writeln(F, HeadReply^.Ready);

HeadReply := HeadReply^.Next;

end;

CloseFile(F);

end

else if FileExists('Reply.txt') then

Erase(F);

// Сохранение списка адресов

AssignFile(F, 'AddsList.txt');

if HeadAddsList <> nil then

begin

Rewrite(F);

while HeadAddsList <> nil do

begin

writeln(F, HeadAddsList^.Adds^.Street);

writeln(F, HeadAddsList^.Adds^.Number);

writeln(F, HeadAddsList^.Adds^.Room);

if HeadAddsList^.Next = nil then

write(F, inttostr(HeadAddsList^.Owed))

else

writeln(F, inttostr(HeadAddsList^.Owed));

HeadAddsList := HeadAddsList^.Next;

end;

CloseFile(F);

end

else if FileExists('AddsList.txt') then

Erase(F);

// Сохранение списка неисправностей

AssignFile(F, 'Problems.txt');

with FrmReplyReg do

if CmbProblem.Items.Count <> 0 then

begin

Rewrite(F);

for i := 0 to CmbProblem.Items.Count - 1 do

if i <> CmbProblem.Items.Count - 1 then

writeln(F, CmbProblem.Items[i])

else

write(F, CmbProblem.Items[i]);

CloseFile(F);

end

else if FileExists('Problems.txt') then

Erase(F);

end;

// при создании формы

procedure TFrmMain.FormCreate(Sender: TObject);

var

F: TextFile;

H: PServiceAdds;

X: PReply;

P: PAddsList;

begin

SgMain.Cells[0, 0] := '№';

SgMain.Cells[1, 0] := ' ФИО';

SgMain.Cells[2, 0] := ' Адрес';

SgMain.Cells[3, 0] := ' Телефон';

SgMain.Cells[4, 0] := ' Проблема';

SgMain.Cells[5, 0] := ' Дата поступления';

SgMain.Cells[6, 0] := ' Готовность';

// Загрузка списка обслуживаемых адресов

AssignFile(F, 'Adds.txt');

if FileExists('Adds.txt') then

begin

Reset(F);

while not Eof(F) do

begin

if HeadAdds = nil then

begin

New(HeadAdds);

Readln(F, HeadAdds^.Street);

Readln(F, HeadAdds^.Number);

HeadAdds^.Next := nil;

end

else

begin

H := HeadAdds;

while H^.Next <> nil do

H := H^.Next;

New(H^.Next);

Readln(F, H^.Next^.Street);

Readln(F, H^.Next^.Number);

H^.Next^.Next := nil;

end;

CloseFile(F);

end;

// Инициализация номера следующей заявки

ReplyNumber := 1;

// Загрузка списка заявок

AssignFile(F, 'Reply.txt');

if FileExists('Reply.txt') then

begin

Reset(F);

while not Eof(F) do

begin

if HeadReply = nil then

begin

New(HeadReply);

Readln(F, HeadReply^.Num);

Readln(F, HeadReply^.Name);

New(HeadReply^.Adds);

Readln(F, HeadReply^.Adds^.Street);

Readln(F, HeadReply^.Adds^.Number);

Readln(F, HeadReply^.Adds^.Room);

Readln(F, HeadReply^.Phone);

Readln(F, HeadReply^.Problem);

Readln(F, HeadReply^.IncomeDate);

Readln(F, HeadReply^.IncomeTime);

Readln(F, HeadReply^.Ready);

HeadReply^.Next := nil;

ReplyNumber := ReplyNumber + 1;

end

else

begin

X := HeadReply;

while X^.Next <> nil do

X := X^.Next;

New(X^.Next);

Readln(F, X^.Next^.Num);

Readln(F, X^.Next^.Name);

New(X^.Next^.Adds);

Readln(F, X^.Next^.Adds^.Street);

Readln(F, X^.Next^.Adds^.Number);

Readln(F, X^.Next^.Adds^.Room);

Readln(F, X^.Next^.Phone);

Readln(F, X^.Next^.Problem);

Readln(F, X^.Next^.IncomeDate);

Readln(F, X^.Next^.IncomeTime);

Readln(F, X^.Next^.Ready);

X^.Next^.Next := nil;

ReplyNumber := ReplyNumber + 1;

end;

CloseFile(F);

end;

// вывод на экран списка заявок

X := HeadReply;

while X <> nil do

begin

SgMain.RowCount := SgMain.RowCount + 1;

SgMain.Cells[0, SgMain.RowCount - 1] := inttostr(X^.Num);

SgMain.Cells[1, SgMain.RowCount - 1] := X^.Name;

SgMain.Cells[2, SgMain.RowCount - 1] := X^.Adds^.Street + ', д.' +

X^.Adds^.Number + ', кв.' + X^.Adds^.Room;

SgMain.Cells[3, SgMain.RowCount - 1] := X^.Phone;

SgMain.Cells[4, SgMain.RowCount - 1] := X^.Problem;

SgMain.Cells[5, SgMain.RowCount - 1] := datetostr(X^.IncomeDate) + ', ' +

timetostr(X^.IncomeTime);

SgMain.Cells[6, SgMain.RowCount - 1] := X^.Ready;

X := X^.Next;

end;

// загрузка списка адресов

AssignFile(F, 'AddsList.txt');

if FileExists('AddsList.txt') then

begin

Reset(F);

while not Eof(F) do

begin

if HeadAddsList = nil then

begin

New(HeadAddsList);

New(HeadAddsList^.Adds);

Readln(F, HeadAddsList^.Adds^.Street);

Readln(F, HeadAddsList^.Adds^.Number);

Readln(F, HeadAddsList^.Adds^.Room);

Readln(F, HeadAddsList^.Owed);

HeadAddsList^.Next := nil;

end

else

begin

P := HeadAddsList;

while P^.Next <> nil do

P := P^.Next;

New(P^.Next);

New(P^.Next^.Adds);

Readln(F, P^.Next^.Adds^.Street);

Readln(F, P^.Next^.Adds^.Number);

Readln(F, P^.Next^.Adds^.Room);

Readln(F, P^.Next^.Owed);

P^.Next^.Next := nil;

end;

CloseFile(F);

end;

// прячет начальное приветствие при наведении на первую надпись

procedure TFrmMain.LblGreetingMouseMove(Sender: TObject; Shift: TShiftState;

X, Y: integer);

begin

PnlGreeting.Hide;

LblGreeting.Hide;

LblHint.Hide;

end;

// прячет начальное приветствие при наведении на вторую надпись

procedure TFrmMain.LblHintMouseMove(Sender: TObject; Shift: TShiftState;

X, Y: integer);

begin

PnlGreeting.Hide;

LblGreeting.Hide;

LblHint.Hide;

end;

// при нажатии на пункт 'Выйти' в главном меню

procedure TFrmMain.N1Click(Sender: TObject);

begin

// закрывает приложение

FrmMain.Close;

end;

// при нажатии на пункт меню 'Список адресов'

procedure TFrmMain.N4Click(Sender: TObject);

begin

// открывает форму с адресами

FrmAddresses.Show;

end;

// при нажатии на пункт 'Обновить' в меню

procedure TFrmMain.N5Click(Sender: TObject);

var

H: PReply;

begin

// если мы прошли авторизацию

if FrmLogin.Visible = false then

begin

H := HeadReply;

SgMain.RowCount := 1;

// вывод на экран всего списка заявок и очистка полей поиска

while H <> nil do

begin

SgMain.RowCount := SgMain.RowCount + 1;

SgMain.Cells[0, SgMain.RowCount - 1] := inttostr(H^.Num);

SgMain.Cells[1, SgMain.RowCount - 1] := H^.Name;

SgMain.Cells[2, SgMain.RowCount - 1] := H^.Adds^.Street + ', д.' +

H^.Adds^.Number + ', кв.' + H^.Adds^.Room;

SgMain.Cells[3, SgMain.RowCount - 1] := H^.Phone;

SgMain.Cells[4, SgMain.RowCount - 1] := H^.Problem;

SgMain.Cells[5, SgMain.RowCount - 1] := datetostr(H^.IncomeDate) + ', ' +

timetostr(H^.IncomeTime);

SgMain.Cells[6, SgMain.RowCount - 1] := H^.Ready;

H := H^.Next;

end;

EdtSearchNum.Text := '';

EdtSearchName.Text := '';

end;

// при нажатии на пункт меню 'Смена пользователя'

procedure TFrmMain.N7Click(Sender: TObject);

begin

FrmLogin.Caption := 'Смена пользователя';

// открывается форма авторизации

FrmLogin.ShowModal;

end;

// прячет начальное приветствие при наведении на красную панель

procedure TFrmMain.PnlGreetingMouseMove(Sender: TObject; Shift: TShiftState;

X, Y: integer);

begin

PnlGreeting.Hide;

LblGreeting.Hide;

LblHint.Hide;

end;

// при нажатии на сортировку

procedure TFrmMain.RgClick(Sender: TObject);

begin

IsAdded := false;

if Rg.ItemIndex = 0 then

// сортируем по дате

FrmReplyReg.SortByDate;

if Rg.ItemIndex = 1 then

// сортируем по неисправности

FrmReplyReg.SortByProblem;

end;

// делает таблицу заявок шире, если элементов более 22, чтобы поместился ScrollBar

procedure TFrmMain.SgMainDrawCell(Sender: TObject; ACol, ARow: integer;

Rect: TRect; State: TGridDrawState);

begin

if (SgMain.RowCount > 22) and (SgMain.Width = 1005) then

SgMain.Width := 1023;

if (SgMain.Width = 1023) and (SgMain.RowCount < 23) then

SgMain.Width := 1005;

end;

end.

unit Unit2;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,

System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Unit1;

type

TFrmLogin = class(TForm)

EdLogin: TEdit;

EdPassWord: TEdit;

BtnOk: TButton;

LblReg1: TLabel;

LblReg2: TLabel;

procedure BtnOkClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormShow(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FrmLogin: TFrmLogin;

implementation

{$R *.dfm}

// при нажатии на кнопку 'ok'

procedure TFrmLogin.BtnOkClick(Sender: TObject);

var

F: TextFile;

Log, Pass: string;

begin

AssignFile(F, 'Login.txt');

{ если файл не существует или мы меняем логин и пароль, то данные авторизации

в файле перезаписываются }

if (not(FileExists('Login.txt'))) or (FrmLogin.Caption = 'Смена пользователя')

then

begin

Rewrite(F);

Writeln(F, EdLogin.Text);

Writeln(F, EdPassWord.Text);

CloseFile(F);

FrmLogin.Hide;

FrmMain.Show;

FrmLogin.Close;

end

else

begin

Reset(F);

Readln(F, Log);

Readln(F, Pass);

CloseFile(F);

// если логин и пароль совпадают, входим на главную форму

if (AnsiSameText(EdLogin.Text, Log)) and (EdPassWord.Text = Pass) then

begin

FrmLogin.Hide;

FrmMain.Show;

FrmLogin.Close;

end

else

// иначе остаёмся на этой же форме

begin

LblReg1.Show;

LblReg2.Show;

LblReg1.Caption := 'Неверный логин';

LblReg2.Caption := ' или пароль';

end;

// при закрытии формы

procedure TFrmLogin.FormClose(Sender: TObject; var Action: TCloseAction);

begin

// если мы пытаемся войти в систему а не меняем логи и пароль, то выходим из программы

if FrmMain.Visible = false then

FrmMain.Close;

end;

// при создании формы

procedure TFrmLogin.FormCreate(Sender: TObject);

var

F: TextFile;

begin

AssignFile(F, 'Login.txt');

// устанавливаем видимость надписей

if FileExists('Login.txt') then

begin

Reset(F);

if eof(F) then

begin

LblReg1.Visible := true;

LblReg2.Visible := true;

end;

CloseFile(F);

end

else

begin

LblReg1.Visible := true;

LblReg2.Visible := true;

end;

// при показе формы

procedure TFrmLogin.FormShow(Sender: TObject);

begin

if FrmLogin.Caption = 'Смена пользователя' then

begin

LblReg1.Visible := true;

LblReg2.Visible := true;

LblReg1.Caption := 'Введите новые';

LblReg2.Caption := 'логин и пароль';

end;

end.

unit Unit3;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,

System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Unit4,

Unit5;

type

PReply = ^Reply;

PAdds = ^Adds;

PAddsList = ^AddsList;

Reply = Record

Num: integer;

Name: string;

Adds: PAdds;

Phone: string;

Problem: string;

IncomeDate: TDate;

IncomeTime: TTime;

Ready: string;

Next: PReply;

End;

Adds = Record

Street: string;

Number: string;

Room: string;

End;

AddsList = Record

Adds: PAdds;

Owed: integer;

Next: PAddsList;

End;

TFrmReplyReg = class(TForm)

PnlRegistration: TPanel;

LblName: TLabel;

LblPhone: TLabel;

LblStreet: TLabel;

LblNumber: TLabel;

LblRoom: TLabel;

EdtName: TEdit;

EdtRoom: TEdit;

EdtPhone: TEdit;

EdtStreet: TEdit;

EdtNumber: TEdit;

LblProblem: TLabel;

BtnCheckAdress: TButton;

BtnAddReply: TButton;

PnlCheck: TPanel;

LblCheckAdress: TLabel;

BtnChangeReply: TButton;

CmbReadyness: TComboBox;

LblReadyness: TLabel;

CmbProblem: TComboBox;

BtnAddProblem: TButton;

procedure BtnCheckAdressClick(Sender: TObject);

procedure BtnAddReplyClick(Sender: TObject);

procedure BtnChangeReplyClick(Sender: TObject);

procedure BtnAddProblemClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

procedure SortByProblem;

procedure SortByDate;

{ Public declarations }

end;

var

FrmReplyReg: TFrmReplyReg;

HeadReply: PReply;

ReplyNumber: integer;

HeadAddsList: PAddsList;

implementation

{$R *.dfm}

uses unit1, unit8;

// функция проверки адреса(обслуживает ли данная ЖЭС данный адрес)

function CheckAddress(S, N: string): Boolean;

var

i, j: integer;

begin

if N = 'все' then

Exit

else

begin

Result := false;

repeat

if Pos(S, N) <> 0 then

begin

i := Pos(S, N);

j := i - 1 + Length(S);

if ((i = 1) or (N[i - 1] = ' ') or (N[i - 1] = ',')) and

((j = Length(N)) or (N[j + 1] = ' ') or (N[j + 1] = ',')) then

Result := true

else

begin

if j <> Length(N) then

N := Copy(N, j + 1, Length(N) - j)

else

break;

end;

until (Pos(S, N) = 0) or (Result = true);

end;

// процедура сортировки по неисправности

procedure TFrmReplyReg.SortByProblem;

var

H, N, NHeadReply, Temp: PReply;

RowNum, ColNum: integer;

begin

H := HeadReply;

NHeadReply := nil;

while H <> nil do

begin

// если новый(сортированный) список заявок ещё пуст

if NHeadReply = nil then

begin

New(NHeadReply);

NHeadReply^ := H^;

NHeadReply^.Next := nil;

end

else

begin

N := NHeadReply;

if AnsiLowerCase(H^.Problem) < AnsiLowerCase(N^.Problem) then

begin

Temp := NHeadReply;

New(NHeadReply);

NHeadReply^ := H^;

NHeadReply^.Next := Temp;

end

else

// если очередной элемент старго списка не прошёл условие входа в отсортированный

begin

while N <> nil do

begin

// условие сортировки

if N^.Next = nil then

begin

New(N^.Next);

N^.Next^ := H^;

N^.Next^.Next := nil;

break;

end;

if AnsiLowerCase(H^.Problem) < AnsiLowerCase(N^.Next^.Problem) then

begin

Temp := N^.Next;

New(N^.Next);

N^.Next^ := H^;

N^.Next^.Next := Temp;

break;

end;

N := N^.Next;

end;

H := H^.Next;

end;

{ если прошлись уже по всему текущему списку, значит отсортированный список

готов, неотсортированный список больше не нужен, удаляем его

для экономии памяти(повышение эффективности программы) }

if HeadReply <> nil then

begin

while HeadReply <> nil do

begin

Temp := HeadReply;

HeadReply := HeadReply^.Next;

Dispose(Temp);

end;

HeadReply := NHeadReply;

if IsAdded = true then

FrmMain.SgMain.RowCount := FrmMain.SgMain.RowCount + 1;

// печать отсортированного списка

H := HeadReply;

with FrmMain do

for RowNum := 1 to SgMain.RowCount - 1 do

begin

for ColNum := 0 to 6 do

begin

case ColNum of

SgMain.Cells[ColNum, RowNum] := inttostr(H^.Num);

SgMain.Cells[ColNum, RowNum] := H^.Name;

SgMain.Cells[ColNum, RowNum] := H^.Adds^.Street + ', д.' +

H^.Adds^.Number + ', кв.' + H^.Adds^.Room;

SgMain.Cells[ColNum, RowNum] := H^.Phone;

SgMain.Cells[ColNum, RowNum] := H^.Problem;

SgMain.Cells[ColNum, RowNum] := datetostr(H^.IncomeDate) + ', ' +

timetostr(H^.IncomeTime);

SgMain.Cells[ColNum, RowNum] := H^.Ready;

end;

H := H^.Next;

end;

// процедура сортировки по дате

procedure TFrmReplyReg.SortByDate;

// функция сравнения дат

function DateCompare(OldDate, NewDate: TDate;

OldTime, NewTime: TTime): Boolean;

begin

Result := false;

// условие сравнения

if OldDate < NewDate then

Result := true

else if (OldDate = NewDate) and (OldTime < NewTime) then

Result := true;

end;

var

H, N, NHeadReply, Temp: PReply;

RowNum, ColNum: integer;

begin

H := HeadReply;

NHeadReply := nil;

while H <> nil do

begin

// если новый список заявок ещё пуст

if NHeadReply = nil then

begin

New(NHeadReply);

NHeadReply^ := H^;

NHeadReply^.Next := nil;

end

else

begin

N := NHeadReply;

if DateCompare(H^.IncomeDate, N^.IncomeDate, H^.IncomeTime, N^.IncomeTime)

then

begin

Temp := NHeadReply;

New(NHeadReply);

NHeadReply^ := H^;

NHeadReply^.Next := Temp;

end

else

// если очередной элемент старго списка не прошёл условие входа в отсортированный

begin

while N <> nil do

begin

// условие сортировки

if N^.Next = nil then

begin

New(N^.Next);

N^.Next^ := H^;

N^.Next^.Next := nil;

break;

end;

if DateCompare(H^.IncomeDate, N^.Next^.IncomeDate, H^.IncomeTime,

N^.Next^.IncomeTime) then

begin

Temp := N^.Next;

New(N^.Next);

N^.Next^ := H^;

N^.Next^.Next := Temp;

break;

end;

N := N^.Next;

end;

H := H^.Next;

end;

{ если прошлись уже по всему текущему списку, значит отсортированный список

готов, неотсортированный список больше не нужен, удаляем его

для экономии памяти(повышение эффективности программы) }

if HeadReply <> nil then

begin

while HeadReply <> nil do

begin

Temp := HeadReply;

HeadReply := HeadReply^.Next;

Dispose(Temp);

end;

HeadReply := NHeadReply;

if IsAdded = true then

FrmMain.SgMain.RowCount := FrmMain.SgMain.RowCount + 1;

// печать отсортированного списка

H := HeadReply;

with FrmMain do

for RowNum := 1 to SgMain.RowCount - 1 do

begin

for ColNum := 0 to 6 do

begin

case ColNum of

SgMain.Cells[ColNum, RowNum] := inttostr(H^.Num);

SgMain.Cells[ColNum, RowNum] := H^.Name;

SgMain.Cells[ColNum, RowNum] := H^.Adds^.Street + ', д.' +

H^.Adds^.Number + ', кв.' + H^.Adds^.Room;

SgMain.Cells[ColNum, RowNum] := H^.Phone;

SgMain.Cells[ColNum, RowNum] := H^.Problem;

SgMain.Cells[ColNum, RowNum] := datetostr(H^.IncomeDate) + ', ' +

timetostr(H^.IncomeTime);

SgMain.Cells[ColNum, RowNum] := H^.Ready;

end;

H := H^.Next;

end;

// при нажатии на кнопку '+'

procedure TFrmReplyReg.BtnAddProblemClick(Sender: TObject);

begin

// открытие формы редактирования неисправностей

FrmProblem.ShowModal;

end;

// при нажатии на кнопку 'Добавить'

procedure TFrmReplyReg.BtnAddReplyClick(Sender: TObject);

// Процедура добавления адреса в список адресов

procedure AddsToList(PAddress: PAdds);

var

P, Temp: PAddsList;

RowNum: integer;

begin

// если головного адреса нет, то создаём

if HeadAddsList = nil then

begin

New(HeadAddsList);

New(HeadAddsList^.Adds);

HeadAddsList^.Adds^ := PAddress^;

HeadAddsList^.Owed := 0;

HeadAddsList^.Next := nil;

end

else

begin

// если есть, добавляем в список по условию

P := HeadAddsList;

while P <> nil do

begin

if (PAddress^.Street = P^.Adds^.Street) and

(PAddress^.Number = P^.Adds^.Number) and

(PAddress^.Room = P^.Adds^.Room) then

Exit;

P := P^.Next;

end;

P := HeadAddsList;

if AnsiLowerCase(PAddress^.Street + PAddress^.Number + PAddress^.Room) <

AnsiLowerCase(P^.Adds^.Street + P^.Adds^.Number + P^.Adds^.Room) then

begin

Temp := HeadAddsList;

New(HeadAddsList);

New(HeadAddsList^.Adds);

HeadAddsList^.Adds^ := PAddress^;

HeadAddsList^.Owed := 0;

HeadAddsList^.Next := Temp;

end

else

begin

while P^.Next <> nil do

begin

if AnsiLowerCase(PAddress^.Street + PAddress^.Number + PAddress^.Room)

< AnsiLowerCase(P^.Next^.Adds^.Street + P^.Next^.Adds^.Number +

P^.Next^.Adds^.Room) then

begin

Temp := P^.Next;

New(P^.Next);

New(P^.Next^.Adds);

P^.Next^.Adds^ := PAddress^;

P^.Next^.Owed := 0;

P^.Next^.Next := Temp;

break;

end;

P := P^.Next;

end;

if P^.Next = nil then

begin

New(P^.Next);

New(P^.Next^.Adds);

P^.Next^.Adds^ := PAddress^;

P^.Next^.Owed := 0;

P^.Next^.Next := nil;

end;

// Добавление в таблицу адресов данного

with FrmAddresses do

begin

SgAddresses.RowCount := SgAddresses.RowCount + 1;

P := HeadAddsList;

for RowNum := 1 to SgAddresses.RowCount - 1 do

begin

SgAddresses.Cells[0, RowNum] := P^.Adds^.Street + ', д.' +

P^.Adds^.Number + ', кв.' + P^.Adds^.Room;

if P^.Owed = 0 then

SgAddresses.Cells[1, RowNum] := 'нет'

else

SgAddresses.Cells[1, RowNum] := inttostr(P^.Owed);

P := P^.Next;

end;

var

H: PServiceAdds;

P: PReply;

begin

// Если все поля заполнены

if (EdtName.Text <> '') and (EdtStreet.Text <> '') and (EdtNumber.Text <> '')

and (EdtRoom.Text <> '') and (EdtPhone.Text <> '') and

(CmbProblem.ItemIndex <> -1) then

begin

// если в поле 'Квартира' содержатся запятые или точки

if (Pos(',', EdtRoom.Text) <> 0) or (Pos('.', EdtRoom.Text) <> 0) then

begin

ShowMessage

('В поле ''Квартира'' не должны содержаться запятые или точки.');

Exit;

end;

H := HeadAdds;

// Проверка на вхождение адреса в число обслуживаемых

while H <> nil do

begin

if (AnsiLowerCase(H^.Street) = AnsiLowerCase(EdtStreet.Text)) and

((CheckAddress(EdtNumber.Text, H^.Number) = true) or (H^.Number = 'все'))

then

break;

H := H^.Next;

end;

// Проверка на существование текущей заявки

P := HeadReply;

while P <> nil do

begin

// Если такая заявка уже имеется

if (AnsiLowerCase(EdtStreet.Text) = AnsiLowerCase(P^.Adds^.Street)) and

(AnsiLowerCase(EdtNumber.Text) = AnsiLowerCase(P^.Adds^.Number)) and

(AnsiLowerCase(EdtRoom.Text) = AnsiLowerCase(P^.Adds^.Room)) and

(AnsiLowerCase(CmbProblem.Text) = AnsiLowerCase(P^.Problem)) then

begin

ShowMessage('Данная заявка уже имеется.');

Exit;

end;

// Если данный телефон уже имеется

if (AnsiLowerCase(EdtStreet.Text) <> AnsiLowerCase(P^.Adds^.Street)) and

(AnsiLowerCase(EdtNumber.Text) <> AnsiLowerCase(P^.Adds^.Number)) and

(AnsiLowerCase(EdtRoom.Text) <> AnsiLowerCase(P^.Adds^.Room)) and

(AnsiLowerCase(EdtPhone.Text) = AnsiLowerCase(P^.Phone)) then

begin

ShowMessage('Данный телефон зарегистрирован на другого жителя.');

Exit;

end;

// Если данный адрес уже есть в списке, но зарегистрирован на другое лицо

if (AnsiLowerCase(EdtStreet.Text) = AnsiLowerCase(P^.Adds^.Street)) and

(AnsiLowerCase(EdtNumber.Text) = AnsiLowerCase(P^.Adds^.Number)) and

(AnsiLowerCase(EdtRoom.Text) = AnsiLowerCase(P^.Adds^.Room)) and

((AnsiLowerCase(EdtName.Text) <> AnsiLowerCase(P^.Name)) or

(AnsiLowerCase(EdtPhone.Text) <> AnsiLowerCase(P^.Phone))) then

begin

ShowMessage

('Данный адрес и/или данный телефон относятся к другому жителю.');

Exit;

end;

P := P^.Next;

end;

// Если адрес проверку не прошёл

if H = nil then

begin

ShowMessage('Введённый адрес не обслуживается данной ЖЭС.');

Exit;

end

else

// Если прошёл

begin

// если список не существует

if HeadReply = nil then

begin

// создаём список

New(HeadReply);

with HeadReply^ do

begin

ReplyNumber := 1;

Num := ReplyNumber;

Name := AnsiUpperCase(EdtName.Text[1]) + Copy(EdtName.Text, 2,

Length(EdtName.Text) - 1);

New(Adds);

Adds^.Street := AnsiUpperCase(EdtStreet.Text[1]) +

Copy(EdtStreet.Text, 2, Length(EdtStreet.Text) - 1);

Adds^.Number := EdtNumber.Text;

Adds^.Room := EdtRoom.Text;

Phone := EdtPhone.Text;

Problem := CmbProblem.Text;

IncomeDate := Date;

IncomeTime := Time;

Ready := CmbReadyness.Text;

Next := nil;

ReplyNumber := ReplyNumber + 1;

AddsToList(HeadReply^.Adds);

with FrmMain do

begin

// вывод на экран списка, состоящего из 1 элемента(диска)

SgMain.RowCount := SgMain.RowCount + 1;

SgMain.Cells[0, SgMain.RowCount - 1] := inttostr(Num);

SgMain.Cells[1, SgMain.RowCount - 1] := HeadReply^.Name;

SgMain.Cells[2, SgMain.RowCount - 1] := Adds^.Street + ', д.' +

Adds^.Number + ', кв.' + Adds^.Room;

SgMain.Cells[3, SgMain.RowCount - 1] := Phone;

SgMain.Cells[4, SgMain.RowCount - 1] := Problem;

SgMain.Cells[5, SgMain.RowCount - 1] := datetostr(IncomeDate) + ', '

+ timetostr(IncomeTime);

SgMain.Cells[6, SgMain.RowCount - 1] := Ready;

ShowMessage('Заявка принята.');

end;

end

else

// Если список существует

begin

// Добавляем заявку в список

P := HeadReply;

while P^.Next <> nil do

P := P^.Next;

New(P^.Next);

with P^.Next^ do

begin

Num := ReplyNumber;

P^.Next^.Name := AnsiUpperCase(EdtName.Text[1]) +

Copy(EdtName.Text, 2, Length(EdtName.Text) - 1);

New(Adds);

Adds^.Street := AnsiUpperCase(EdtStreet.Text[1]) +

Copy(EdtStreet.Text, 2, Length(EdtStreet.Text) - 1);

Adds^.Number := EdtNumber.Text;

Adds^.Room := EdtRoom.Text;

Phone := EdtPhone.Text;

Problem := CmbProblem.Text;

IncomeDate := Date;

IncomeTime := Time;

Ready := CmbReadyness.Text;

Next := nil;

ReplyNumber := ReplyNumber + 1;

AddsToList(P^.Next^.Adds);

end;

// Если активирована сортировка по дате

if FrmMain.Rg.ItemIndex = 0 then

begin

SortByDate;

ShowMessage('Заявка принята.');

Exit;

end;

// Если активирована сортировка по неисправности

if FrmMain.Rg.ItemIndex = 1 then

begin

SortByProblem;

ShowMessage('Заявка принята.');

Exit;

end;

with FrmMain, P^.Next^ do

begin

// Если никакая сортировка не активирована, печатаем новую заявку

SgMain.RowCount := SgMain.RowCount + 1;

SgMain.Cells[0, SgMain.RowCount - 1] := inttostr(Num);

SgMain.Cells[1, SgMain.RowCount - 1] := P^.Next^.Name;

SgMain.Cells[2, SgMain.RowCount - 1] := Adds^.Street + ', д.' +

Adds^.Number + ', кв.' + Adds^.Room;

SgMain.Cells[3, SgMain.RowCount - 1] := Phone;

SgMain.Cells[4, SgMain.RowCount - 1] := Problem;

SgMain.Cells[5, SgMain.RowCount - 1] := datetostr(IncomeDate) + ', ' +

timetostr(IncomeTime);

SgMain.Cells[6, SgMain.RowCount - 1] := Ready;

ShowMessage('Заявка принята.');

end;

end

else

ShowMessage('Заполните все поля.');

end;

// При нажатии на кнопку 'Изменить'

procedure TFrmReplyReg.BtnChangeReplyClick(Sender: TObject);

// Процедура корректировки ФИО и телефонов заявок

{ Если ещё какая-нибудь заявка из списка имеет тот же адрес что и изменяемая

и были изменены ФИО и/или телефон, то изменяем и в ней ФИО и/или телефон }

procedure CorrectNamesAndPhones(NameChanged, PhoneChanged: Boolean);

var

P: PReply;

RowNum, ColNum: integer;

begin

with FrmMain do

begin

if HeadReply^.Adds^.Street + ', д.' + HeadReply^.Adds^.Number + ', кв.' +

HeadReply^.Adds^.Room = SgMain.Cells[2, SgMain.Row] then

begin

if NameChanged = true then

HeadReply^.Name := AnsiUpperCase(EdtName.Text[1]) +

Copy(EdtName.Text, 2, Length(EdtName.Text) - 1);

if PhoneChanged = true then

HeadReply^.Phone := EdtPhone.Text;

end;

P := HeadReply;

while P^.Next <> nil do

begin

if P^.Next^.Adds^.Street + ', д.' + P^.Next^.Adds^.Number + ', кв.' +

P^.Next^.Adds^.Room = SgMain.Cells[2, SgMain.Row] then

begin

if NameChanged = true then

P^.Next^.Name := AnsiUpperCase(EdtName.Text[1]) +

Copy(EdtName.Text, 2, Length(EdtName.Text) - 1);

if PhoneChanged = true then

P^.Next^.Phone := EdtPhone.Text;

end;

P := P^.Next;

end;

// Вывод на экран списка заявок

P := HeadReply;

with FrmMain do

for RowNum := 1 to SgMain.RowCount - 1 do

begin

for ColNum := 0 to 6 do

begin

case ColNum of

SgMain.Cells[ColNum, RowNum] := inttostr(P^.Num);

SgMain.Cells[ColNum, RowNum] := P^.Name;

SgMain.Cells[ColNum, RowNum] := P^.Adds^.Street + ', д.' +

P^.Adds^.Number + ', кв.' + P^.Adds^.Room;

SgMain.Cells[ColNum, RowNum] := P^.Phone;

SgMain.Cells[ColNum, RowNum] := P^.Problem;

SgMain.Cells[ColNum, RowNum] := datetostr(P^.IncomeDate) + ', '

+ timetostr(P^.IncomeTime);

SgMain.Cells[ColNum, RowNum] := P^.Ready;

end;

P := P^.Next;

end;

var

P: PReply;

NameChanged, PhoneChanged: Boolean;

begin

// Если все поля заполнены

if (EdtName.Text <> '') and (EdtStreet.Text <> '') and (EdtNumber.Text <> '')

and (EdtRoom.Text <> '') and (EdtPhone.Text <> '') and

(CmbProblem.ItemIndex <> -1) then

begin

// Проверяем изменились ли ФИО и телефон жителя

NameChanged := false;

PhoneChanged := false;

with FrmMain do

begin

if SgMain.Cells[1, SgMain.Row] <> EdtName.Text then

NameChanged := true;

if SgMain.Cells[3, SgMain.Row] <> EdtPhone.Text then

PhoneChanged := true;

end;

// Проверка на существование текущей заявки

P := HeadReply;

while P <> nil do

begin

// Если данная заявка уже имеется

if (P^.Name = EdtName.Text) and (P^.Adds^.Street = EdtStreet.Text) and

(P^.Adds^.Number = EdtNumber.Text) and (P^.Adds^.Room = EdtRoom.Text)

and (P^.Phone = EdtPhone.Text) and (P^.Problem = CmbProblem.Text) and

(P^.Ready = CmbReadyness.Text) then

begin

ShowMessage('Данная заявка уже имеется.');

Exit;

end;

// Если данный телефон используется другим жителем

if (EdtPhone.Text = P^.Phone) and (PhoneChanged = true) then

begin

ShowMessage('Данный телефон зарегистрирован на другого жителя.');

Exit;

end;

P := P^.Next;

end;

P := HeadReply;

// Если изменяем 1ый элемент списка

if inttostr(P^.Num) = FrmMain.SgMain.Cells[0, FrmMain.SgMain.Row] then

begin

// Изменяем поля 1го элемента списка

HeadReply^.Name := AnsiUpperCase(EdtName.Text[1]) +

Copy(EdtName.Text, 2, Length(EdtName.Text) - 1);

HeadReply^.Phone := EdtPhone.Text;

HeadReply^.Problem := CmbProblem.Text;

HeadReply^.Ready := CmbReadyness.Text;

{ Если ещё какая-нибудь заявка из списка имеет тот же адрес что и изменяемая

и были изменены ФИО и/или телефон, то изменяем и в ней ФИО и/или телефон }

CorrectNamesAndPhones(NameChanged, PhoneChanged);

// Если активирована сортировка по неисправности

if FrmMain.Rg.ItemIndex = 1 then

begin

SortByProblem;

ShowMessage('Заявка успешно отредактирована.');

FrmReplyReg.Close;

Exit;

end

else

begin

ShowMessage('Заявка успешно отредактирована.');

FrmReplyReg.Close;

end;

end

else

// Если изменяем не 1ый элемент списка

begin

P := HeadReply;

while inttostr(P^.Next^.Num) <> FrmMain.SgMain.Cells

[0, FrmMain.SgMain.Row] do

P := P^.Next;

with P^.Next^ do

begin

P^.Next^.Name := AnsiUpperCase(EdtName.Text[1]) +

Copy(EdtName.Text, 2, Length(EdtName.Text) - 1);

Phone := EdtPhone.Text;

Problem := CmbProblem.Text;

Ready := CmbReadyness.Text;

end;

{ Если ещё какая-нибудь заявка из списка имеет тот же адрес что и изменяемая

и были изменены ФИО и/или телефон, то изменяем и в ней ФИО и/или телефон }

CorrectNamesAndPhones(NameChanged, PhoneChanged);

// Если активирована сортировка по неисправности

if FrmMain.Rg.ItemIndex = 1 then

begin

SortByProblem;

ShowMessage('Заявка успешно отредактирована.');

FrmReplyReg.Close;

Exit;

end

else

begin

ShowMessage('Заявка успешно отредактирована.');

FrmReplyReg.Close;

end;

end

else

ShowMessage('Заполните все поля.');

end;

// при нажатии на кнопку 'Проверить'

procedure TFrmReplyReg.BtnCheckAdressClick(Sender: TObject);

begin

// открытие формы с адресами, обслуживаемых ЖЭС

FrmServiceAddresses.ShowModal;

end;

// при создании формы

procedure TFrmReplyReg.FormCreate(Sender: TObject);

var

F: TextFile;

NewProblem: string;

begin

// Загрузка неисправностей

AssignFile(F, 'Problems.txt');

if FileExists('Problems.txt') then

begin

Reset(F);

while not Eof(F) do

begin

Readln(F, NewProblem);

CmbProblem.Items.Add(NewProblem);

end;

CmbProblem.ItemIndex := 0;

CloseFile(F);

end;

end.

unit Unit4;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,

System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.StdCtrls, Vcl.ExtCtrls,

Unit7;

type

PServiceAdds = ^ServiceAdds;

ServiceAdds = Record

Street: string;

Number: string;

Next: PServiceAdds;

End;

TFrmServiceAddresses = class(TForm)

SgAdds: TStringGrid;

PnlAddress: TPanel;

BtnAddAddress: TButton;

BtnChangeAddress: TButton;

BtnDeleteAddress: TButton;

LblAddsOperations: TLabel;

procedure FormCreate(Sender: TObject);

procedure BtnAddAddressClick(Sender: TObject);

procedure BtnDeleteAddressClick(Sender: TObject);

procedure BtnChangeAddressClick(Sender: TObject);

procedure SgAddsDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;

State: TGridDrawState);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FrmServiceAddresses: TFrmServiceAddresses;

HeadAdds: PServiceAdds;

Correct: Boolean;

implementation

{$R *.dfm}

// при нажатии на кнопку 'Добавить' новый сервисный адрес

procedure TFrmServiceAddresses.BtnAddAddressClick(Sender: TObject);

begin

with FrmNewAddress do

begin

BtnAddNewAddress.Visible := true;

BtnChangeNewAddress.Visible := false;

EdtNewStreet.Text := '';

EdtNewNumber.Text := '';

end;

// открытие формы для добавления нового сервисного адреса

FrmNewAddress.ShowModal;

end;

// удаление строки из таблицы

procedure GridDeleteRow(RowNumber: Integer);

var

i: Integer;

begin

with FrmServiceAddresses do

begin

SgAdds.Row := RowNumber;

// если удаляется последняя строка таблицы

if SgAdds.Row = SgAdds.RowCount - 1 then

SgAdds.RowCount := SgAdds.RowCount - 1

else

begin

// не последняя

for i := RowNumber to SgAdds.RowCount - 1 do

SgAdds.Rows[i] := SgAdds.Rows[i + 1];

SgAdds.RowCount := SgAdds.RowCount - 1;

end;

// При нажатии на кнопку 'Изменить' сервисный адрес

procedure TFrmServiceAddresses.BtnChangeAddressClick(Sender: TObject);

var

H, Temp: PServiceAdds;

i: Integer;

begin

// если выделили не строку с заголовком

if SgAdds.Row <> 0 then

begin

i := SgAdds.Row - 1;

with FrmNewAddress do

begin

BtnAddNewAddress.Visible := false;

BtnChangeNewAddress.Visible := true;

H := HeadAdds;

while i <> 0 do

begin

H := H^.Next;

i := i - 1;

end;

{ вставляем в редактируемые поля формы изменения адреса улицу и дома изменяемого адреса }

EdtNewStreet.Text := H^.Street;

EdtNewNumber.Text := H^.Number;

Correct := false;

// открытие формы редактирования сервисного адреса

FrmNewAddress.ShowModal;

// если изменения были произведены

if Correct = true then

begin

// Если в списке сервисных адресов только один сервисный адрес

if HeadAdds^.Next = nil then

begin

HeadAdds^.Street := EdtNewStreet.Text;

if EdtNewNumber.Text = '' then

HeadAdds^.Number := 'все'

else

HeadAdds^.Number := EdtNewNumber.Text;

SgAdds.Cells[0, SgAdds.Row] := HeadAdds^.Street;

SgAdds.Cells[1, SgAdds.Row] := HeadAdds^.Number;

ShowMessage('Адрес успешно отредактирован.');

end

else

// Если в списке адресов больее одного сервисного адреса

begin

// Извлекаем адрес Temp из списка сервисных адресов HeadAdds

Temp := H;

if Temp = HeadAdds then

HeadAdds := HeadAdds^.Next

else

begin

H := HeadAdds;

while H^.Next <> Temp do

H := H^.Next;

H^.Next := H^.Next^.Next;

end;

Temp^.Street := EdtNewStreet.Text;

if EdtNewNumber.Text = '' then

Temp^.Number := 'все'

else

Temp^.Number := EdtNewNumber.Text;

// Вставляем отредактированный Temp в список адресов HeadAdds

if Temp^.Street < HeadAdds^.Street then

begin

Temp^.Next := HeadAdds;

HeadAdds := Temp;

end

else

begin

H := HeadAdds;

while H^.Next <> nil do

if H^.Next^.Street < Temp^.Street then

H := H^.Next

else

break;

Temp^.Next := H^.Next;

H^.Next := Temp;

end;

// Печать изменённого списка адресов

H := HeadAdds;

i := 1;

while H <> nil do

begin

SgAdds.Cells[0, i] := H^.Street;

SgAdds.Cells[1, i] := H^.Number;

H := H^.Next;

i := i + 1;

end;

ShowMessage('Адрес успешно отредактирован.');

end;

// При нажатии на кнопку 'Удалить'

procedure TFrmServiceAddresses.BtnDeleteAddressClick(Sender: TObject);

var

H, Temp: PServiceAdds;

begin

// если выделена не заглавная строка

if SgAdds.Row <> 0 then

begin

// если выделена первая строка, удаляется головной элемент из списка

if (HeadAdds^.Street = SgAdds.Cells[0, SgAdds.Row]) and

(HeadAdds^.Number = SgAdds.Cells[1, SgAdds.Row]) then

begin

Temp := HeadAdds;

HeadAdds := HeadAdds^.Next;

Dispose(Temp);

end

else

begin

H := HeadAdds;

// если выделена произвольная(не первая и не нулевая) строка

while (H^.Next^.Street <> SgAdds.Cells[0, SgAdds.Row]) and

(H^.Next^.Number <> SgAdds.Cells[1, SgAdds.Row]) do

H := H^.Next;

Temp := H^.Next;

H^.Next := H^.Next^.Next;

Dispose(Temp);

end;

// удаление строки из таблицы

GridDeleteRow(SgAdds.Row);

end;

// при создании формы

procedure TFrmServiceAddresses.FormCreate(Sender: TObject);

var

H: PServiceAdds;

begin

SgAdds.Cells[0, 0] := ' Улица';

SgAdds.Cells[1, 0] := ' Дом';

SgAdds.ColWidths[1] := 210;

SgAdds.Width := 415;

// Печать таблицы сервисных адресов

H := HeadAdds;

while H <> nil do

begin

SgAdds.RowCount := SgAdds.RowCount + 1;

SgAdds.Cells[0, SgAdds.RowCount - 1] := H^.Street;

SgAdds.Cells[1, SgAdds.RowCount - 1] := H^.Number;

H := H^.Next;

end;

// делает таблицу сервисных адресов шире, если элементов более 7, чтобы поместился ScrollBar

procedure TFrmServiceAddresses.SgAddsDrawCell(Sender: TObject;

ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);

begin

if (SgAdds.RowCount > 7) and (SgAdds.Width = 415) then

SgAdds.Width := 433;

if (SgAdds.Width = 433) and (SgAdds.RowCount < 8) then

SgAdds.Width := 415;

end;

end.

unit Unit5;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,

System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type

TFrmProblem = class(TForm)

EdtNewProblem: TEdit;

BtnAddNewProblem: TButton;

BtnDelNewProblem: TButton;

procedure BtnAddNewProblemClick(Sender: TObject);

procedure BtnDelNewProblemClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FrmProblem: TFrmProblem;

implementation

{$R *.dfm}

uses unit1, unit2, unit3;

// при нажатии на кнопку 'Добавить'

procedure TFrmProblem.BtnAddNewProblemClick(Sender: TObject);

var

i: integer;

begin

// если введена не пустая строка

if EdtNewProblem.Text <> '' then

with FrmReplyReg do

begin

// проверка на уникальность неисправности

for i := 0 to CmbProblem.Items.Count - 1 do

if CmbProblem.Items[i] = EdtNewProblem.Text then

begin

ShowMessage('Данная неисправность уже имеется.');

Exit;

end;

// добавление новой неисправности в выпадающее меню

CmbProblem.Items.Add(EdtNewProblem.Text);

ShowMessage('Неисправность успешно добавлена.');

if CmbProblem.ItemIndex = -1 then

CmbProblem.ItemIndex := 0;

end;

// при нажатии на кнопку 'Удалить'

procedure TFrmProblem.BtnDelNewProblemClick(Sender: TObject);

var

i: integer;

begin

// если введена не пустая строка

if EdtNewProblem.Text <> '' then

with FrmReplyReg do

for i := 0 to CmbProblem.Items.Count - 1 do

// если текст неисправности = введённому в поле, то она удаляется из выпадающего меню

if CmbProblem.Items[i] = EdtNewProblem.Text then

begin

CmbProblem.Items.Delete(i);

ShowMessage('Неисправность успешно удалена.');

CmbProblem.ItemIndex := 0;

Exit;

end;

// при создании формы

procedure TFrmProblem.FormCreate(Sender: TObject);

begin

// скрывает основную форму, открывает окно логина

FrmMain.Hide;

FrmLogin.ShowModal;

end;

end.

unit Unit6;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,

System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VCLTee.TeEngine, VCLTee.Series,

VCLTee.TeeProcs, VCLTee.Chart, Vcl.ExtCtrls, Vcl.StdCtrls, DateUtils,

VCLTee.tecanvas;

type

TFrmGraph = class(TForm)

PnlGraph: TPanel;

LblReply: TLabel;

CmbDate: TComboBox;

BtnShowGraph: TButton;

Chart1: TChart;

Series1: TBarSeries;

procedure BtnShowGraphClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FrmGraph: TFrmGraph;

implementation

{$R *.dfm}

uses unit3;

// при нажатии на кнопку 'Показать'

procedure TFrmGraph.BtnShowGraphClick(Sender: TObject);

var

H: PReply;

S: string;

i: integer;

Day: array [1 .. 24] of integer;

Week: array [1 .. 7] of integer;

Month: array of integer;

Year: array [1 .. 12] of integer;

begin

// если показываем заявки за день

if CmbDate.ItemIndex = 0 then

begin;

Chart1.Visible := true;

Series1.Clear;

Chart1.LeftAxis.LabelsFont.Size := 8;

Chart1.BottomAxis.LabelsFont.Size := 8;

Chart1.BottomAxis.Maximum := 24.8;

H := HeadReply;

// заполняем массив нулями

// индекс массива - в каком часу поступила заявка

for i := 1 to 24 do

Day[i] := 0;

// проходим по всему списку заявок

while H <> nil do

begin

{ если дата поступления заявки = сегодняшней, то добавляем в массив

в зависимости от времени поступления }

if H^.IncomeDate = Date then

begin

S := Copy(TimeToStr(H^.IncomeTime), 1,

Pos(':', TimeToStr(H^.IncomeTime)) - 1);

Day[strtoint(S)] := Day[strtoint(S)] + 1;

end;

H := H^.Next;

end;

// если кол-во заявок за i-ый час не = 0, отображаем это на графике

for i := 1 to 24 do

begin

if Day[i] <> 0 then

Series1.AddXY(i, Day[i]);

end;

// если показываем заявки за неделю

if CmbDate.ItemIndex = 1 then

begin

Chart1.Visible := true;

Series1.Clear;

Chart1.LeftAxis.LabelsFont.Size := 8;

Chart1.BottomAxis.LabelsFont.Size := 8;

Chart1.BottomAxis.Maximum := 7.8;

H := HeadReply;

// заполняем массив нулями

// индекс массива - в какой день недели поступила заявка

for i := 1 to 7 do

Week[i] := 0;

// проходим по всему списку заявок

while H <> nil do

begin

{ если на этой недели заявка была добавлена в список, то увеличиваем

соответствующее значение в массиве }

if DaysBetween(Date, H^.IncomeDate) <= DayOfTheWeek(Date) - 1 then

Week[DayOfTheWeek(Date) - DaysBetween(Date, H^.IncomeDate)] :=

Week[DayOfTheWeek(Date) - DaysBetween(Date, H^.IncomeDate)] + 1;

H := H^.Next;

end;

// печатаем график

for i := 1 to 7 do

case i of

Series1.AddXY(1, Week[i], 'Понедельник');

Series1.AddXY(2, Week[i], 'Вторник');

Series1.AddXY(3, Week[i], 'Среда');

Series1.AddXY(4, Week[i], 'Четверг');

Series1.AddXY(5, Week[i], 'Пятница');

Series1.AddXY(6, Week[i], 'Суббота');

Series1.AddXY(7, Week[i], 'Воскресенье');

end;

// если показываем заявки за месяц

if CmbDate.ItemIndex = 2 then

begin

Chart1.Visible := true;

Series1.Clear;

Chart1.LeftAxis.LabelsFont.Size := 7;

Chart1.BottomAxis.LabelsFont.Size := 7;

if MonthOf(Date) = 2 then

Chart1.BottomAxis.Maximum := MonthDays[IsLeapYear(YearOf(Date))][2] + 0.8

else

Chart1.BottomAxis.Maximum := MonthDays[IsLeapYear(YearOf(Date))

][MonthOf(Date)] + 0.8;

H := HeadReply;

// устанавливаем длину массива = количеству дней в текущем месяце

SetLength(Month, trunc(Chart1.BottomAxis.Maximum));

// заполняем массив нулями

for i := 0 to Length(Month) - 1 do

Month[i] := 0;

// проходимся по всему списку

while H <> nil do

begin

{ если заявка поступила в текущем месяце, увеличиваем соответствующее

значение в массиве }

if (MonthOf(Date) = MonthOf(H^.IncomeDate)) and

(YearOf(Date) = YearOf(H^.IncomeDate)) then

Month[DayOfTheMonth(H^.IncomeDate) - 1] :=

Month[DayOfTheMonth(H^.IncomeDate) - 1] + 1;

H := H^.Next;

end;

// если кол-во заявок за i-ый день месяца не = 0, отображаем это на графике

for i := 0 to Length(Month) - 1 do

if Month[i] <> 0 then

Series1.AddXY(i + 1, Month[i]);

end;

// если показываем заявки за год

if CmbDate.ItemIndex = 3 then

begin

Chart1.Visible := true;

Series1.Clear;

Chart1.LeftAxis.LabelsFont.Size := 7;

Chart1.BottomAxis.LabelsFont.Size := 7;

Chart1.BottomAxis.Maximum := 12.8;

H := HeadReply;

// заполняем массив нулями

for i := 1 to 12 do

Year[i] := 0;

// проходимся по всему списку

while H <> nil do

begin

{ если заявка была добавлена в этом году, увеличиваем соответствующее

значение в массиве }

if YearOf(Date) = YearOf(H^.IncomeDate) then

Year[MonthOf(H^.IncomeDate)] := Year[MonthOf(H^.IncomeDate)] + 1;

H := H^.Next;

end;

// печатаем график

for i := 1 to 12 do

case i of

Series1.AddXY(1, Year[i], 'Январь');

Series1.AddXY(2, Year[i], 'Февраль');

Series1.AddXY(3, Year[i], 'Март');

Series1.AddXY(4, Year[i], 'Апрель');

Series1.AddXY(5, Year[i], 'Май');

Series1.AddXY(6, Year[i], 'Июнь');

Series1.AddXY(7, Year[i], 'Июль');

Series1.AddXY(8, Year[i], 'Август');

Series1.AddXY(9, Year[i], 'Сентябрь');

10:

Series1.AddXY(10, Year[i], 'Октябрь');

11:

Series1.AddXY(11, Year[i], 'Ноябрь');

12:

Series1.AddXY(12, Year[i], 'Декабрь');

end;

// при создании

procedure TFrmGraph.FormCreate(Sender: TObject);

begin

// не показывает график

Chart1.Visible := false;

end;

end.

unit Unit7;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,

System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type

TFrmNewAddress = class(TForm)

EdtNewStreet: TEdit;

EdtNewNumber: TEdit;

BtnAddNewAddress: TButton;

LblStreet: TLabel;

LblNumber: TLabel;

BtnChangeNewAddress: TButton;

procedure BtnAddNewAddressClick(Sender: TObject);

procedure BtnChangeNewAddressClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FrmNewAddress: TFrmNewAddress;

implementation

{$R *.dfm}

uses unit4;

// При нажатии на кнопку 'Добавить'

procedure TFrmNewAddress.BtnAddNewAddressClick(Sender: TObject);

// Добавление сервисного адреса в список

function AddNewAdds: boolean;

var

H, Temp: PServiceAdds;

begin

Result := false;

H := HeadAdds;

// проверяем сервисный адрес на уникальность

while H <> nil do

begin

if AnsiLowerCase(H^.Street) = AnsiLowerCase(EdtNewStreet.Text) then

begin

ShowMessage('Данный адрес уже имеется в списке.');

Exit;

end;

H := H^.Next;

end;

// если список сервисных адресов пуст, то создаём его

if HeadAdds = nil then

begin

New(HeadAdds);

HeadAdds^.Street := AnsiUpperCase(EdtNewStreet.Text[1]) +

Copy(EdtNewStreet.Text, 2, Length(EdtNewStreet.Text) - 1);

if EdtNewNumber.Text = '' then

HeadAdds^.Number := 'все'

else

HeadAdds^.Number := EdtNewNumber.Text;

HeadAdds^.Next := nil;

end

else

begin

// добавляем адрес в список сервисных адресов

if EdtNewStreet.Text < HeadAdds^.Street then

begin

New(H);

H^.Street := AnsiUpperCase(EdtNewStreet.Text[1]) +

Copy(EdtNewStreet.Text, 2, Length(EdtNewStreet.Text) - 1);

if EdtNewNumber.Text = '' then

H^.Number := 'все'

else

H^.Number := EdtNewNumber.Text;

H^.Next := HeadAdds;

HeadAdds := H;

end

else

begin

H := HeadAdds;

while H^.Next <> nil do

begin

if EdtNewStreet.Text < H^.Next^.Street then

begin

New(Temp);

Temp^.Street := AnsiUpperCase(EdtNewStreet.Text[1]) +

Copy(EdtNewStreet.Text, 2, Length(EdtNewStreet.Text) - 1);

if EdtNewNumber.Text = '' then

Temp^.Number := 'все'

else

Temp^.Number := EdtNewNumber.Text;

Temp^.Next := H^.Next;

H^.Next := Temp;

Result := true;

Exit;

end

else

H := H^.Next;

end;

New(H^.Next);

H^.Next^.Street := AnsiUpperCase(EdtNewStreet.Text[1]) +

Copy(EdtNewStreet.Text, 2, Length(EdtNewStreet.Text) - 1);

if EdtNewNumber.Text = '' then

H^.Next^.Number := 'все'

else

H^.Next^.Number := EdtNewNumber.Text;

H^.Next^.Next := nil;

end;

Result := true;

end;

// Добавление сервисного адреса в таблицу

procedure PrintNewAdds;

var

i: integer;

H: PServiceAdds;

begin

with FrmServiceAddresses do

begin

SgAdds.RowCount := SgAdds.RowCount + 1;

H := HeadAdds;

for i := 1 to SgAdds.RowCount - 1 do

begin

SgAdds.Cells[0, i] := H^.Street;

SgAdds.Cells[1, i] := H^.Number;

H := H^.Next;

end;

begin

// если поле 'Улица' заполнено, оба поля не содержат точек и запятых

if EdtNewStreet.Text <> '' then

begin

if (Pos(',', EdtNewStreet.Text) <> 0) or (Pos('.', EdtNewStreet.Text) <> 0)

or (Pos(',', EdtNewNumber.Text) <> 0) or (Pos('.', EdtNewNumber.Text) <> 0)

then

begin

ShowMessage

('В полях ''Улица'' и ''Дом'' не должны содержаться запятые или точки.');

Exit;

end;

// если сервисный адрес добавляется в список, то он добавляется в таблицу

if AddNewAdds = true then

begin

PrintNewAdds;

ShowMessage('Адрес успешно добавлен в список.');

end;

end

else

ShowMessage('Заполните необходимые поля.');

end;

// Функция проверки наличия сервисного адреса в списке

function CheckAdds: boolean;

var

H: PServiceAdds;

i: integer;

begin

Result := false;

i := FrmServiceAddresses.SgAdds.Row - 1;

H := HeadAdds;

while H <> nil do

begin

if (H^.Street = FrmNewAddress.EdtNewStreet.Text) and (i <> 0) then

begin

Result := true;

Exit;

end;

H := H^.Next;

i := i - 1;

end;

// При нажатии на кнопку 'Изменить'

procedure TFrmNewAddress.BtnChangeNewAddressClick(Sender: TObject);

begin

{ если поле 'Улица' заполнено, оба поля не содержат точек и запятых и данного сервисного

адреса нет в списке, то указываем, что Correct = true, то есть сервисный адрес будет

изменён }

if EdtNewStreet.Text <> '' then

begin

if (Pos(',', EdtNewStreet.Text) <> 0) or (Pos('.', EdtNewStreet.Text) <> 0)

or (Pos(',', EdtNewNumber.Text) <> 0) or (Pos('.', EdtNewNumber.Text) <> 0)

then

begin

ShowMessage

('В полях ''Улица'' и ''Дом'' не должны содержаться запятые или точки.');

Exit;

end;

if CheckAdds = true then

ShowMessage

('Данная улица уже имеется в списке либо никаких изменений не было произведено.')

else

begin

Correct := true;

FrmNewAddress.Close;

end;

end

else

ShowMessage('Заполните необходимые поля.');

end;

end.

unit Unit8;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,

System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.StdCtrls, Vcl.ExtCtrls,

unit9;

type

TFrmAddresses = class(TForm)

SgAddresses: TStringGrid;

PnlOweChange: TPanel;

BtnOweChange: TButton;

procedure FormCreate(Sender: TObject);

procedure SgAddressesDrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

procedure BtnOweChangeClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FrmAddresses: TFrmAddresses;

implementation

{$R *.dfm}

uses unit1, unit3;

procedure TFrmAddresses.BtnOweChangeClick(Sender: TObject);

begin

if SgAddresses.Row <> 0 then

FrmOweChange.ShowModal;

end;

// при создании формы

procedure TFrmAddresses.FormCreate(Sender: TObject);

var

P: PAddsList;

begin

SgAddresses.ColWidths[1] := 150;

SgAddresses.Cells[0, 0] := ' Адрес';

SgAddresses.Cells[1, 0] := ' Задолженность';

// вывод на экран списка адресов жильцов

P := HeadAddsList;

while P <> nil do

begin

with FrmAddresses do

begin

SgAddresses.RowCount := SgAddresses.RowCount + 1;

SgAddresses.Cells[0, SgAddresses.RowCount - 1] := P^.Adds^.Street + ', д.'

+ P^.Adds^.Number + ', кв.' + P^.Adds^.Room;

if P^.Owed <> 0 then

SgAddresses.Cells[1, SgAddresses.RowCount - 1] := inttostr(P^.Owed)

else

SgAddresses.Cells[1, SgAddresses.RowCount - 1] := 'нет';

end;

P := P^.Next;

end;

// делает таблицу адресов шире, если элементов более 11, чтобы поместился ScrollBar

procedure TFrmAddresses.SgAddressesDrawCell(Sender: TObject;

ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);

begin

if (SgAddresses.RowCount > 11) and (SgAddresses.Width = 406) then

begin

FrmAddresses.Width := 430;

SgAddresses.Width := 424;

end;

if (SgAddresses.Width = 424) and (SgAddresses.RowCount < 12) then

begin

FrmAddresses.Width := 412;

SgAddresses.Width := 406;

end;

end.

unit Unit9;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,

System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type

TFrmOweChange = class(TForm)

LblAddress: TLabel;

LblAddressChange: TLabel;

LblOwe: TLabel;

EdtOweChange: TEdit;

BtnChangeOwe: TButton;

procedure FormShow(Sender: TObject);

procedure BtnChangeOweClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FrmOweChange: TFrmOweChange;

implementation

{$R *.dfm}

uses unit8, unit3;

// при нажатии на кнопку 'Редактировать' задолженность

procedure TFrmOweChange.BtnChangeOweClick(Sender: TObject);

var

P: PAddsList;

AddsNumber: integer;

S: string;

begin

with FrmAddresses do

begin

// смена задолженности в таблице

S := EdtOweChange.Text;

if S <> '' then

while S[1] = '0' do

begin

S := Copy(S, 2, Length(S) - 1);

if S = '' then

break;

end;

if S = '' then

SgAddresses.Cells[1, SgAddresses.Row] := 'нет'

else

SgAddresses.Cells[1, SgAddresses.Row] := S;

// выбираем элемент списка адресов, чьё поле задолженности будем менять

P := HeadAddsList;

AddsNumber := SgAddresses.Row;

while AddsNumber <> 1 do

begin

P := P^.Next;

AddsNumber := AddsNumber - 1;

end;

// меняем поле задолженности

if S = '' then

P^.Owed := 0

else

P^.Owed := strtoint(S);

ShowMessage('Задолженность успешно отредактирована.');

FrmOweChange.Close;

end;

// при показе формы

procedure TFrmOweChange.FormShow(Sender: TObject);

begin

with FrmAddresses do

begin

// инициализация текста полей ввода

LblAddressChange.Caption := SgAddresses.Cells[0, SgAddresses.Row];

if SgAddresses.Cells[1, SgAddresses.Row] <> 'нет' then

EdtOweChange.Text := SgAddresses.Cells[1, SgAddresses.Row]

else

EdtOweChange.Text := '';

end;

end.

<<< < Предыдущая 1 2 3 4 5 6 78 / 88

Соседние файлы в предмете [НЕСОРТИРОВАННОЕ]

#
01.05.20252.23 Mб1Отчёт полугот.docx
#
11.05.2015646.14 Кб10Отчет ПСОД 1.doc
#
11.05.2015106.57 Кб11Отчет №6 печать.docx
#
01.05.2025617.2 Кб1Отчёт(печать с 4 стр).docx
#
01.05.20251.11 Mб1Отчёт(печать с 5 стр).docx
#
01.05.20251.17 Mб1Отчёт(печать с 5 стр).docx
#
18.08.2019988.71 Кб3Отчет_ИниСП_Лаб_№1.docx
#
25.09.2019540.16 Кб5Отчетик.doc
#
01.03.202581.92 Кб1ОУИС+Задание+(патентная+информация+и+поиск).doc
#
11.05.20151.62 Mб20ОУИС.pdf
#
21.09.2019294.4 Кб3Оформление отчетов по практике.doc