Курсовая работа: Информационная система начальника жилищно-эксплуатационной службы
FlatAtr. Names[6]:= 'Пл.ком. №4';
FlatAtr. Names[7]:= 'Пл.коридора';
FlatAtr. Names[8]:= 'Пл.кухни';
FlatAtr. Names[9]:= 'Пл.туалета';
//
PageControl1Change(Sender);
FSGVector[1]:= StringGrid1;
FSGVector[2]:= StringGrid2;
FSGVector[3]:= StringGrid3;
FSGVector[4]:= StringGrid4;
FSGVector[5]:= StringGrid5;
end;
procedure TInputForm. ReadVec (var Vec: TVector);
var
x, i, j: integer;
St: String;
begin
Readln (Ft, x); Vec. Cols:= x;
for i:=1 to Vec. Cols do
begin Readln (Ft, St); Vec. Names[i]:= St; end;
Readln (Ft, x); Vec. Size:= x;
for i:=1 to Vec. Size do
begin
for j:=1 to Vec. Cols do
begin Readln (Ft, St); Vec.X [i, j]:= St; end;
end;
Vec. SortId:= 1;
Vec. SortMode:= 1;
end;
procedure TInputForm. WriteVec (Vec: TVector);
var i, j: integer;
begin
Writeln (Ft, Vec. Cols);
for i:=1 to Vec. Cols do
Writeln (Ft, Vec. Names[i]);
Writeln (Ft, Vec. Size);
for i:=1 to Vec. Size do
begin
for j:=1 to Vec. Cols do
Writeln (Ft, Vec.X [i, j]);
end;
end;
// Чтение данных из файла
procedure TInputForm. LoadButtonClick (Sender: TObject);
begin
OpenDialog1. Title:= 'Открыть из файла'; // Изменение заголовка окна диалога
if not OpenDialog1. Execute then exit;
// Выполнение стандартного диалога выбора имени файла
FileNameT:= OpenDialog1. FileName; // Возвращение имени дискового файла
AssignFile (Ft, FileNameT); // Связывание файловой переменной Fz с именем файла
Reset(Ft); // Открытие существующего файла
ReadVec(Kvart); // Чтение вектора из файла
ReadVec(Scheme);
ReadVec(GK);
ReadVec(People);
ReadVec(FlatAtr);
PageControl1Change(Sender);
CloseFile(Ft);
end;
procedure TInputForm. SaveButtonClick (Sender: TObject);
// Сохраниение данных в файле
begin
if not SaveDialog1. Execute then exit;
// Выполнение стандартного диалога выбора имени файла
begin
FileNameT:= SaveDialog1. FileName; // Возвращение имени дискового файла
AssignFile (Ft, FileNameT); // Связывание файловой переменной Fz с именем файла
{$I-}
Rewrite(Ft); // Открытие нового файла
{$I+}
if not((IOResult = 0) and (FileNameT <> «)) then
begin
Application. MessageBox ('Не возможно открыть файл!', 'Ошибка', MB_OK);
exit;
end;
end;
WriteVec(Kvart); // Запись в файл
WriteVec(Scheme);
WriteVec(GK);
WriteVec(People);
WriteVec(FlatAtr);
CloseFile(Ft); // Закрытие файла
end;
// Процедура заполнения объекта StringGrid данными из Вектора Vec
procedure TInputForm. FillStringGrid (SG: TStringGrid; Vec: TVector);
var i, j: integer;
begin
Sg. ColCount:= Vec. Cols+1;
if Vec. Size=0
then Sg. RowCount:=2
else Sg. RowCount:=Vec. Size+1;
for i:=1 to Vec. Cols do
Sg. Cells [i, 0]:= Vec. Names[i];
for i:=1 to Vec. Size do
begin
Sg. Cells [0, i]:= IntToStr(i);
for j:=1 to Vec. Cols do
Sg. Cells [j, i]:= Vec.X [i, j];
end;
Sg. ColWidths[0]:= 25;
end;
procedure TInputForm. PageControl1Change (Sender: TObject);
begin
case PageControl1. ActivePageIndex of
0: FillStringGrid (StringGrid1, Kvart);
1: FillStringGrid (StringGrid2, Scheme);
2: FillStringGrid (StringGrid3, GK);
3: FillStringGrid (StringGrid4, People);
4: FillStringGrid (StringGrid5, FlatAtr);
end;
end;
procedure TInputForm. AddBtnClick (Sender: TObject);
var
SG: TStringGrid;
Vec: TVector;
begin
Sg:= FSGVector [PageControl1. ActivePageIndex+1];
Vec:= GetVec;
Vec. Add;
FillStringGrid (SG, Vec);
end;
procedure TInputForm.SGDblClick (Sender: TObject);
var
NRooms, NKv, NKvart, NPod, NFloor: integer;
porch: array [0..MaxN] of integer;
SG: TStringGrid;
Vec: TVector;
i, j, x, k, l: integer;
InputString: String;
begin
Sg:= TStringGrid(Sender);
i:= Sg. Selection. Left;
j:= Sg. Selection. Top;
Vec:= GetVec;
if (i<1) then exit; // За пределами редактирования
// Установим особые параметры для таблицы КВАРТ – StringGrid1
if (Sg. Name = 'StringGrid1') and (i in [2,3,4,5]) then
begin
Application. MessageBox (
'Это поле заполняется автоматически по номеру квартиры и не редактируется!'
'Ошибка', MB_OK);
exit;
end;
InputString:= InputBox ('', 'Введите значение', Vec.X [j, i]);
if InputString=''
then exit;
SG. Cells [i, j]:= InputString;
Vec.X [j, i]:= InputString;
// Заполним при необходимости остальные поля для таблицы КВАРТ – StringGrid1
if (Sg. Name = 'StringGrid1') and (i = 1) then
begin
NKvart:= Vec.X [j, i];
porch[0]:= 0; x:= 0;
for i:=1 to Scheme. Size do
begin
porch[i]:= 2;
if Scheme.X [i, 3]=''
then porch[i]:= 2
else if Scheme.X [i, 4]=''
then porch[i]:= 3 else porch[i]:=4;
if NKvart <= x + (porch[i]*M) then
begin
NPod:= i; // Определили номер подъезда
NFloor:= (NKvart-x) div M +1; // Определили номер этажа
NKv:= (NKvart-x) mod M; // Определили номер кв. на этаже
if NKv=0
then NKv:= M;
NRooms:= Scheme.X [i, NKv]; // Определили кол-во комнат
// Запишем количество комнат в квартире
SG. Cells [2, j]:= IntToStr(NRooms); Vec.X [j, 2]:= NRooms;
// Запишем номер этажа
SG. Cells [3, j]:= IntToStr(NFloor); Vec.X [j, 3]:= NFloor;
for k:=1 to FlatAtr. Size do
begin
if FlatAtr.X [i, 1]= NRooms then // совпадает количество комнат
begin
//x – атр. 4 = сумма площадей всех комнат, взятых из таблицы С,
x:= 0;
for l:=1 to NRooms do
try
x:= x + StrToInt (FlatAtr.X [k, 2+l]);
except
end;
// Запишем жилую площадь
Vec.X [j, 4]:= x; SG. Cells [4, j]:= Vec.X [j, 4];
x:= x + StrToInt (FlatAtr.X [i, 7])+StrToInt (FlatAtr.X [i, 8])+
StrToInt (FlatAtr.X [i, 9]);
// Запишем общую площадь
SG. Cells [5, j]:= IntToStr(x); Vec.X [j, 5]:= x;
break;
end;
end;
InputString:= 'Квартира №'+IntToStr(NKvart)+
' находится в подъезде №'+IntToStr(NPod)+
' на этаже '+IntToStr(NFloor)+
' ('+IntToStr(NRooms)+' комната(ы)).';
Application. MessageBox (PChar(InputString), '', MB_OK);
exit;
end;
x:= x + porch[i]*M;
end;
Application. MessageBox ('Указанная квартира не найдена по схеме дома',
'Ошибка', MB_OK);
SG. Cells [2, j]:= «; Vec.X [j, 2]:= «;
SG. Cells [3, j]:= «; Vec.X [j, 3]:= «;
end;
if (j>Vec. Size) then // Кликнули за пределами области данных
begin
Vec. Add; FillStringGrid (SG, Vec);
end;
end;
function TInputForm. GetVec: TVector;
begin
case PageControl1. ActivePageIndex of
0: result:= Kvart;
1: result:= Scheme;
2: result:= GK;
3: result:= People;
4: result:= FlatAtr;
else result:= Kvart;
end;
end;
procedure TInputForm. DelBtnClick (Sender: TObject);
var
SG: TStringGrid;
Vec: TVector;
i: integer;
begin
Sg:= FSGVector [PageControl1. ActivePageIndex+1];
i:= Sg. Selection. Top; // удаляемая строка
Vec:= GetVec;
Vec. Delete(i);
FillStringGrid (SG, Vec);
end;
procedure TInputForm. SortBtnClick (Sender: TObject);
var
SG: TStringGrid;
Vec: TVector;
i: integer;
begin
Sg:= FSGVector [PageControl1. ActivePageIndex+1];
i:= Sg. Selection. Left; // Будем сортировать этот столбец
Vec:= GetVec;
if (i<1) then exit; // За пределами редактирования
Vec. SortId:= i; // установим сортируемый столбец
Vec. Sort;
FillStringGrid (SG, Vec);
end;
procedure TInputForm.KSpinEditChange (Sender: TObject);
begin
KPod:= KSpinEdit. Value;
end;
procedure TInputForm.MSpinEditChange (Sender: TObject);
begin
M:= MSpinEdit. Value;
end;
procedure TInputForm.SGKeyPress (Sender: TObject; var Key: Char);
begin
if Key =#13 then // Если нажата клавиша Enter то…
SGDblClick(Sender);
end;
procedure TInputForm. FormDestroy (Sender: TObject);
begin
People. Destroy;
GK. Destroy;
Scheme. Destroy;
FlatAtr. Destroy;
Kvart. Destroy;
end;
procedure TInputForm. CopyBtnClick (Sender: TObject);
var
SG: TStringGrid;
Vec: TVector;
i: integer;
begin
Sg:= FSGVector [PageControl1. ActivePageIndex+1];
i:= Sg. Selection.top; // Будем копировать эту строку
Vec:= GetVec;
Vec. AddCopy(i);
FillStringGrid (SG, Vec);
end;
procedure TInputForm. FindBtnClick (Sender: TObject);
var
SG: TStringGrid;
Vec: TVector;
res,
Row, Col: integer;
InputString: String;
begin
Sg:= FSGVector [PageControl1. ActivePageIndex+1];
Col:= Sg. Selection. Left;
Row:= Sg. Selection. Top;
Vec:= GetVec;
if (Col<1) then exit; // За пределами редактирования
InputString:= InputBox ('', 'Введите значение для поиска', «);
if InputString=''
then exit;
res:= Vec. Find (Col, Row, InputString);
if res=0 then
begin
Application. MessageBox ('Указанное значение не найдено!', 'Ошибка', MB_OK);
exit;
end;
Sg. Row:= res;
end;
procedure TInputForm.FButtonClick (Sender: TObject);
var
NKvart, NPod: integer;
fl, i, k, x, p: integer;
St, FIO: String;
begin
//
ReportForm. ListBox1. Items. Clear;
ReportForm. ListBox1. Items. Add (
' Cписок всех жильцов дома, проживающих в квартирах, '+
'в которых ГК имеет льготы по квартплате');
for k:=1 to People. Size do
begin
NKvart:= People.x [k, 3]; // Номер квартиры
fl:= 0;
for i:=1 to GK. Size do
begin
if Gk.X [i, 1]=NKvart then
begin fl:= 1; break; end;
end;
if (fl=0) or ((fl=1) and (Gk.X [i, 7]<>'да'))
then continue; // У ГК нет льгот;
FIO:= People.X [k, 1];
x:= 0; NPod:= 0;
for i:=1 to Scheme. Size do
begin
if Scheme.X [i, 3]=''
then p:= 2
else if Scheme.X [i, 4]=''
then p:= 3 else p:=4;
if NKvart <= x + (p*M) then
begin NPod:= i; break; end;
end;
for i:=1 to Kvart. Size do
if Kvart.X [i, 1]= NKvart then
begin // получили искомую строку квартиры
St:= FIO+' кв. №'+IntToStr(NKvart)+' подъезд №'+IntToStr(NPod)+' – '+
IntToStr (Kvart.X [i, 2])+' комн. ';
if Kvart.X [i, 7]='да'
then St:= St + ' – кв-ра приватизирована '
else St:= St + ' – кв-ра не приватизирована ';
// списка: Фамилия жильца, номер квартиры, подъезд, число комнат, признак
// приватизации.
ReportForm. ListBox1. Items. Add(St);
end;
end;
ReportForm. ShowModal;
end;
end.
unit Unit2;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ComCtrls, ExtCtrls;
type
TReportForm = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
OKBtn: TButton;
CancelBtn: TButton;
ListBox1: TListBox;
private
{Private declarations}
public
{Public declarations}
end;
var
ReportForm: TReportForm;
implementation
{$R *.DFM}
end.
unit MyTypes;
interface
uses Sysutils, Contnrs;
const MaxN = 100;
type
TVarType = Variant; //TVarRec;
TVarMas = array [1..MaxN] of TVarType;
TVector = class (TInterfacedObject)
private
{Private declarations}
FArr: array [1..MaxN] of TVarMas; //source data
FNum: integer; //number of items
FCols: integer; //number of columns
FNames: array [1..MaxN] of String[MaxN]; //names of columns
function GetSize: Integer;
procedure SetSize (value: Integer);
function GetCols: Integer;
procedure SetCols (value: Integer);
procedure SetX (Index1, Index2: integer; value: TVarType);
function GetX (Index1, Index2: integer): TVarType;
procedure SetName (Index: integer; value: String);
function GetName (Index: integer): String;
public
SortId: integer; // Текущий сортируемый столбец
SortMode: integer; // Текущий режим сортировки
constructor Create;
property X [Index1, Index2: Integer]: TVarType read GetX write SetX;
property Names [Index: Integer]: String read GetName write SetName;
property Size: Integer read GetSize write SetSize;
property Cols: Integer read GetCols write SetCols;
procedure Sort (xMode: integer = 0);
procedure Add();
procedure AddCopy (Index: integer);
procedure Delete (Index: integer);
function Find (Col, Row: integer; Value: Variant): integer;
end;
implementation
constructor TVector. Create;
begin
FNum:= 0; SortId:= 0; SortMode:= 1;
end;
function TVector. GetSize: Integer;
begin result:= FNum; end;
procedure TVector. SetSize (value: Integer);
begin FNum:= value; end;
function TVector. GetCols: Integer;
begin result:= FCols; end;
procedure TVector. SetCols (value: Integer);
begin FCols:= value; end;
procedure TVector. SetX (Index1, Index2: integer; value: TVarType);
begin
FArr[Index1] [Index2]:= value;
end;
function TVector. GetX (Index1, Index2: integer): TVarType;
begin
result:= FArr[Index1] [Index2];
end;
function TVector. GetName (Index: integer): String;
begin
result:= FNames[Index];
end;
procedure TVector. SetName (Index: integer; value: String);
begin
FNames[Index]:= Value;
end;
procedure TVector. Add();
begin
FNum:= FNum + 1;
end;
procedure TVector. AddCopy (Index: integer);
begin
FNum:= FNum + 1;
FArr[FNum]:= FArr[Index];
end;
procedure TVector. Delete (Index: integer);
var i: integer;
begin
if FNum=0 then exit; // Вроде как нечего удалять
for i:=Index+1 to FNum do // Перенесем строки
FArr [I-1]:= FArr[I];
FNum:= FNum -1; // уменьшаем количество
end;
// Процедура сортировки вектора данных по индексу SortId с режимом xMode
// xMode = 1 – по возрастанию
// xMode = 2 – по убыванию
// xMode = 0 – использовать текущий режим SortMode и затем поменять его
procedure TVector. Sort (xMode: integer = 0);
procedure QSort (l, r: Integer);
function Less (var x, y: Variant): boolean;
begin
if (X < Y) and (SortMode=1) // по возрастанию
then Less:=true
else Less:=false;
end;
var
i, j, x: integer;
y: TVarMas; //Variant;
begin
i:= l; j:= r; x:= (l+r) DIV 2;
repeat
while Less (FArr[i] [SortId], FArr[x] [SortId]) do i:= i + 1;
while Less (FArr[x] [SortId], FArr[j] [SortId]) do j:= j – 1;
if i <= j then
begin
y:= FArr[i];
FArr[i]:= FArr[j];
FArr[j]:= y;
i:= i + 1; j:= j – 1;
end;
until i > j;
if l < j then QSort (l, j);
if i < r then QSort (i, r);
end;
begin {QuickSort};
if xMode<>0
then SortMode:= xMode;
QSort (1, Size);
if xMode=0 then // Поменяем режим сортировки
begin
if SortMode = 1
then SortMode:=2 else SortMode:=1;
end;
end;
// Процедура поиска значения Value в столбце Col с позиции Row
// возвращает индекс найденой строки или 0 если ничего не найдено
function TVector. Find (Col, Row: integer; Value: Variant): integer;
var i: integer;
begin
result:= 0;
for i:=Row to FNum do
if FArr[I] [Col] = Value then
begin result:= i; exit; end;
end;
end.
