47150 (Информационная система начальника жилищно-эксплуатационной службы), страница 3

Kvart. Names[6]:= 'стоимость квартиры';

Kvart. Names[7]:= 'Приват.';

 // –

Scheme:= TVector. Create;

Scheme. Cols:= 4;

Scheme. Names[1]:= 'Кв. 1';

Scheme. Names[2]:= 'Кв. 2';

Scheme. Names[3]:= 'Кв. 3';

Scheme. Names[4]:= 'Кв. 4';

 // –

GK:= TVector. Create;

GK. Cols:= 8;

GK. Names[1]:= 'Номер Квартиры';

GK. Names[2]:= 'Фамилия';

GK. Names[3]:= 'Имя';

GK. Names[4]:= 'Отчество';

GK. Names[5]:= 'Год рождения';

GK. Names[6]:= 'Место работы';

GK. Names[7]:= 'Льготы';

GK. Names[8]:= 'Долг (тыс. руб.)';

 // –

 // 1.5. Таблица А содержит список жильцов – членов семей главных квартиросъемщиков:

 // 1) фамилия,

 // 2) родственное отношение к ГК (мать / отец/муж/жена / дочь/сын),

 // 3) номер квартиры,

 // 4) признак «пенсионер / учащийся / работает / дошкольник».

People:= TVector. Create;

People. Cols:= 4;

People. Names[1]:= 'Фамилия';

People. Names[2]:= 'Родств.отн-ние';

People. Names[3]:= 'Номер квартиры';

People. Names[4]:= 'Признак';

People. Names[5]:= 'Место работы';

People. Names[6]:= 'Льготы';

People. Names[7]:= 'Долг (тыс. руб.)';

 // –

 // 1.6. Таблица С содержит следующие атрибуты квартир (в соответствии с числом комнат):

 // 1) число комнат,

 // 2) месячная квартплата,

 // 3) площадь первой комнаты (кв. м.),

 // 4) площадь второй комнаты (если она есть),

 // 5) площадь третьей комнаты,

 // 6) площадь четвертой комнаты,

 // 7) площадь коридора,

 // 8) площадь кухни,

 // 9) общая площадь туалета и ванной комнаты.

FlatAtr:= TVector. Create;

FlatAtr. Cols:= 9;

FlatAtr. Names[1]:= 'Число комн.';

FlatAtr. Names[2]:= 'Квартплата';

FlatAtr. Names[3]:= 'Пл.ком. №1';

FlatAtr. Names[4]:= 'Пл.ком. №2';

FlatAtr. Names[5]:= 'Пл.ком. №3';

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.