Бывалый
Профиль
Группа: Участник
Сообщений: 159
Регистрация: 29.4.2006
Репутация: нет
Всего: 0
|
| Код | unit Dialog;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Con-trols, StdCtrls,
Buttons,DB, ExtCtrls, Dialogs;
type
TfrmDialog = class(TForm)
OKBtn: TButton;
CancelBtn: TButton;
pKvart: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
eNomer: TEdit;
eCost: TEdit;
chPrivat: TCheckBox;
pGK: TPanel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
eFam: TEdit;
eName: TEdit;
cbDisc: TCheckBox;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
eMiddle: TEdit;
eBorn: TEdit;
eEmpl: TEdit;
eCredit: TEdit;
pAttr: TPanel;
Label15: TLabel;
Label16: TLabel;
Label17: TLabel;
Label18: TLabel;
Label19: TLabel;
Label20: TLabel;
Label21: TLabel;
eRooms: TEdit;
eRent: TEdit;
eS1: TEdit;
eS2: TEdit;
eS3: TEdit;
eSCorr: TEdit;
Label22: TLabel;
Label23: TLabel;
eS4: TEdit;
eSKitch: TEdit;
eSSan: TEdit;
pShema: TPanel;
Label24: TLabel;
Label25: TLabel;
Label26: TLabel;
eX: TEdit;
eY: TEdit;
eV: TEdit;
eGNomer: TEdit;
Label27: TLabel;
procedure Show(i: Integer; mes: string);
procedure CancelBtnClick(Sender: TObject);
procedure OKBtnClick(Sender: TObject);
private
{ Private declarations }
public
NewNode, Change: TNode;
X,Y,V: Byte;
end;
var
frmDialog, frmNew: TfrmDialog;
index: Integer;
implementation
{$R *.dfm}
procedure TfrmDialog.Show(i: Integer; mes: string);
begin
pKvart.Visible:=false;
pGK.Visible:=false;
pAttr.Visible:=false;
pShema.Visible:=false;
case i of
0: begin
CancelBtn.Top:=pKvart.Height+10;
pKvart.Visible:=true;
end;
1: begin
CancelBtn.Top:=pShema.Height+10;
pShema.Visible:=true;
end;
2: begin
CancelBtn.Top:=pGK.Height+10;
pGK.Visible:=true;
end;
3: begin
CancelBtn.Top:=pAttr.Height+10;
pAttr.Visible:=true;
end;
end;
OKBtn.Caption:=mes;
Caption:=mes+'...';
OKBtn.Top:=CancelBtn.Top;
Height:=OKBtn.Top+OKBtn.Height+30;
index:=i;
self.ShowModal;
end;
procedure TfrmDialog.CancelBtnClick(Sender: TObject);
begin
Visible:=false;
NewNode:=nil;
end;
procedure TfrmDialog.OKBtnClick(Sender: TObject);
var
kvart: TKvartira;
gk: TGK;
attr: TAttribute;
begin
NewNode:= nil;
try
case index of
0: begin
kvart:=TKvartira.Create(StrToInt(eNomer.Text),
StrToInt(eCost.Text),
chPrivat.Checked);
NewNode:=kvart;
end;
1: begin
X:=StrToInt(eX.Text)-1;
Y:=StrToInt(eY.Text)-1;
V:=StrToInt(eV.Text);
end;
2: begin
gk:=TGK.Create(eFam.Text, eName.Text,
eMiddle.Text,eEmpl.Text,
StrToInt(eBorn.Text),
cbDisc.Checked,
StrToInt(eCredit.Text),
StrToInt(eGNomer.Text));
NewNode:=gk;
end;
3: begin
attr:=TAttribute.Create(StrToInt(eRooms.Text),
StrToInt(eRent.Text),
StrToInt(eS1.Text),
StrToInt(eS2.Text),
StrToInt(eS3.Text),
StrToInt(eS4.Text),
StrToInt(eSCorr.Text),
StrToInt(eSKitch.Text),
StrToInt(eSSan.Text));
NewNode:=attr;
end;
end;
if Caption='Изменить...' then begin
frmNew := TfrmDialog.Create(self);
frmNew.Show(index,'Новое значение');
if frmNew.NewNode<>nil then Change:=frmNew.NewNode;
end;
Visible:=false;
except
ShowMessage('Неверные данные');
end;
end;
end.
unit DB;
interface
uses Classes, SysUtils, IniFiles;
type
{Элемент двусвязного кольцевого списка}
TNode = class
private
//следующий элемент
pNext: TNode;
//предыдущий элемент
pPrev: TNode;
//количество элементов в списке
Size: longWord;
//устанавливает количество элементов в списке
procedure setNewSize;
public
//возвращает следующий элемент
function next: TNode;
//возвращает предыдущий элемент
function prev: TNode;
//вставляет новый элемент в список после себя
function insert(Node: TNode): TNode;
//удаляет себя из списка
function remove: TNode;
//возвращает количество элементов в списке
function getSize: longWord;
//сравнивает текущий элемент с Node
function equal(Node: TNode): boolean; virtual; abstract;
//конструктор
constructor Create;
//деструктор
destructor Destroy; virtual;
end;
{Квартира}
TKvartira = class(TNode)
//номер квартиры
Nomer:word;
//стоимость квартиры
Cost:longWord;
//признак "приватизирована/не приватизирована"
Privat:boolean;
//сравнивает текущий элемент с Node
function equal(Node: TNode): boolean; override;
//конструктор
constructor Create(nomer: word;
cost:longword;
privat:boolean);
end;
{Главный квартиросъёмщик}
TGK = class(TNode)
//фамилия
Family:String[50];
//имя
Name:String[50];
//отчество
MiddleName:String[50];
//год рождения
BornYear:word;
//место работы (наименование предприятия)
Emploer:String[50];
//признак "имеет льготы по оплате жилья/не имеет"
HasDiscount:boolean;
//долг по квартплате (тыс. руб.)
Credit:longWord;
//номер квартиры
Nomer:word;
//сравнивает текущий элемент с Node
function equal(Node: TNode): boolean; override;
//конструктор
constructor Create(fam,name,middle,empl:String;
born:word;
disc:boolean;
credit:longword;
nomer:word);
end;
{Родственные отношения}
TRelation = 0..5;//(mother, father, husband, wife, daughter, sun);
{Занятия}
TOccupation = 0..3;//(pensioner, study, work, kinder);
{Вид списка}
TSpisok = 0..4;//(Kvartira, GK, Liver, Attribute);
{Атрибуты квартиры}
TAttribute = class(TNode)
//число комнат
Rooms: byte;
//месячная квартплата
Rent: longWord;
//площади комнат
SquareRoom: array [1..4] of word;
//площадь коридора
SquareCorridor: word;
//площадь кухни
SquareKitchen: word;
//общая площадь туалете и ванной комнаты
SquareSan: word;
//сравнивает текущий элемент с Node
function equal(Node: TNode): boolean; override;
constructor Create(rooms:byte;
rent:longWord;
s1,s2,s3,s4,sCorr,sKitch,sSan:word);
end;
TShema = array [0..20,0..6] of byte;
{База данных}
TBase = class
//Схема расположения квартир по подъездам и эта-жам
Shema: TShema;
//Список главных квартиросъёмщиков
P: TNode;
//Аттрибуты квартир
C: TNode;
//Список квартир
KVART: TNode;
//Количество подъездов и этажей
K,M: Word;
//Номер этажа
function getAttr(Kvartira: TKvartira;attr: byte): word;
//Число комнат
function getRooms(Kvartira: TKvartira):byte;
//Жилая площадь (кв. м.)
function getLiveSquare(Kvartira: TKvartira):word;
//Общая площадь (кв. м.)
function getAllSquare(Kvartira: TKvartira):word;
//сортирует список методом пузырька
procedure sort(Order: boolean);
//ищет элемент и возвращает на него ссылку
function find(Spisok: TNode; Node: TNode):TNode;
//Сохранение базы данных на диске
procedure saveDB(FileName: String);
//Создание новой базы данных
constructor Create(K, M: byte);overload;
//Создание базы данных из файла на диске
constructor Create(FileName: String);overload;
end;
implementation
function BoolToStr(x: boolean):String;
begin
result := 'нет';
if x then result := 'да';
end;
function StrToBool(x: String):boolean;
begin
result := false;
if x='да' then result := true;
end;
{Создание новой базы данных}
constructor TBase.Create(K, M: byte);
var
i, j: byte;
begin
for i:=0 to 20 do
for j:=0 to 6 do Shema[i,j] := 0;
self.K := K;
self.M := M;
P := nil;
C := nil;
KVART := nil;
end;
{Создание базы данных из файла на диске}
constructor TBase.Create(FileName:String);
var
newKvartira: TKvartira;
newGK: TGK;
newAttribute: TAttribute;
fileShema: file of TShema;
i, j: Integer;
iniFile: TIniFile;
sl:TStringList;
current: String;
begin
K:=2; M:=3;
sl := TStringList.Create;
KVART := nil;
iniFile := TIniFile.Create(FileName+'.KVART');
sl.Clear;
iniFile.ReadSections(sl);
j := sl.Count;
for i:=1 to j do begin
current := sl.Strings[i-1];
newKvartira := TKvartira.Create(
StrToInt(IniFile.ReadString(current,'Nomer','*')),
StrToInt(IniFile.ReadString(current,'Cost','*')),
StrToBool(IniFile.ReadString(current,'Privat','*'))
);
if KVART=nil then KVART:=TKvartira(newKvartira.remove)
else KVART.insert(newKvartira);
end;
iniFile.Free;
P := nil;
iniFile := TIniFile.Create(FileName+'.P');
sl.Clear;
iniFile.ReadSections(sl);
j := sl.Count;
for i:=1 to j do begin
current := sl.Strings[i-1];
newGK := TGK.Create(
IniFile.ReadString(current,'Family','*'),
IniFile.ReadString(current,'Name','*'),
IniFile.ReadString(current,'MiddleName','*'),
IniFile.ReadString(current,'Emploer','*'),
StrToInt(IniFile.ReadString(current,'BornYear','*')),
StrToBool(IniFile.ReadString(current,'HasDiscount','*')),
StrToInt(IniFile.ReadString(current,'Credit','*')),
StrToInt(IniFile.ReadString(current,'Nomer','0'))
);
if P=nil then P:=TGK(newGK.remove)
else P.insert(newGK);
end;
iniFile.Free;
C := nil;
iniFile := TIniFile.Create(FileName+'.C');
sl.Clear;
iniFile.ReadSections(sl);
j := sl.Count;
for i:=1 to j do begin
current := sl.Strings[i-1];
newAttribute := TAttribute.Create(
StrToInt(IniFile.ReadString(current,'Rooms','*')),
StrToInt(IniFile.ReadString(current,'Rent','*')),
StrToInt(IniFile.ReadString(current,'s1','*')),
StrToInt(IniFile.ReadString(current,'s2','*')),
StrToInt(IniFile.ReadString(current,'s3','*')),
StrToInt(IniFile.ReadString(current,'s4','*')),
StrToInt(IniFile.ReadString(current,'SquareCorridor','*')),
StrToInt(IniFile.ReadString(current,'SquareKitchen','*')),
StrToInt(IniFile.ReadString(current,'SquareSan','*'))
);
if C=nil then C:=TAttribute(newAttribute.remove)
else C.insert(newAttribute);
end;
iniFile.Free;
AssignFile(fileShema, FileName+'.Shema');
Reset(fileShema);
if (not EOF(fileShema)) then begin
Read(fileShema,Shema);
Close(fileShema);
end;
end;
{Сохранение базы данных на диске}
procedure TBase.saveDB(FileName: String);
var
fileShema: file of TShema;
i: byte;
z: Integer;
iniFile: TIniFile;
ini: file;
begin
Assign(ini,FileName+'.KVART');
ReWrite(ini);
Close(ini);
iniFile := TIniFile.Create(FileName+'.KVART');
if KVART<>nil then
for z:=1 to KVART.Size do begin
ini-File.WriteString(IntToStr(z),'Nomer',IntToStr(TKvartira(KVART).Nomer));
ini-File.WriteString(IntToStr(z),'Cost',IntToStr(TKvartira(KVART).Cost));
ini-File.WriteString(IntToStr(z),'Privat',BoolToStr(TKvartira(KVART).Privat));
KVART := KVART.next;
end;
iniFile.Free;
Assign(ini,FileName+'.P');
ReWrite(ini);
Close(ini);
iniFile := TIniFile.Create(FileName+'.P');
if P<>nil then
for z:=1 to P.Size do begin
ini-File.WriteString(IntToStr(z),'Nomer',IntToStr(TGK(P).Nomer));
iniFile.WriteString(IntToStr(z),'Family',TGK(P).Family);
iniFile.WriteString(IntToStr(z),'Name',TGK(P).Name);
ini-File.WriteString(IntToStr(z),'MiddleName',TGK(P).MiddleName);
iniFile.WriteString(IntToStr(z),'Emploer',TGK(P).Emploer);
ini-File.WriteString(IntToStr(z),'BornYear',IntToStr(TGK(P).BornYear));
ini-File.WriteString(IntToStr(z),'Credit',IntToStr(TGK(P).Credit));
ini-File.WriteString(IntToStr(z),'HasDiscount',BoolToStr(TGK(P).HasDiscount));
P := P.next;
end;
iniFile.Free;
Assign(ini,FileName+'.C');
ReWrite(ini);
Close(ini);
iniFile := TIniFile.Create(FileName+'.C');
if C<>nil then
for z:=1 to C.Size do begin
ini-File.WriteString(IntToStr(z),'Rooms',IntToStr(TAttribute©.Rooms));
ini-File.WriteString(IntToStr(z),'Rent',IntToStr(TAttribute©.Rent));
ini-File.WriteString(IntToStr(z),'SquareCorridor',IntToStr(TAttribute©.SquareCorridor));
ini-File.WriteString(IntToStr(z),'SquareKitchen',IntToStr(TAttribute©.SquareKitchen));
ini-File.WriteString(IntToStr(z),'SquareSan',IntToStr(TAttribute©.SquareSan));
for i:=1 to 4 do
ini-File.WriteString(IntToStr(z),'s'+IntToStr(i),IntToStr(TAttribute©.SquareRoom[i]));
C := C.next;
end;
iniFile.Free;
Assign(ini,FileName+'.Shema');
ReWrite(ini);
Close(ini);
AssignFile(fileShema, FileName+'.Shema');
Rewrite(fileShema);
Write(fileShema, Shema);
Close(fileShema);
end;
{Номер подъезда, этажа, квартиры на этаже}
function TBase.getAttr(Kvartira: TKvartira;attr: byte): word;
var
i,j,l,num,n,floor,pod: word;
begin
num:=0;
for i:=1 to K do
for j:=1 to M do
for l:=1 to 3 do begin
Inc(num);
if num=Kvartira.Nomer then begin
pod:=i;
floor:=j;
n:=l;
end;
end;
case attr of
0: result:=pod;
1: result:=floor;
2: result:=n;
end;
end;
{Число комнат}
function TBase.getRooms(Kvartira: TKvartira):byte;
var
i, //Подъезд
j: word; //Номер квартиры на этаже
begin
i:=getAttr(Kvartira,0);
j:=getAttr(Kvartira,2);
Dec(i);
Dec(j);
try
result := Shema[j,i];
except
result := 0;
end;
end;
{Жилая площадь (кв. м.)}
function TBase.getLiveSquare(Kvartira: TKvartira):word;
var
i: longWord;
begin
i:=0;
result := 0;
if C<>nil then begin
while (i < C.Size) and
(TAttribute©.Rooms <> getRooms(Kvartira)) do begin
Inc(i);
C := C.next;
end;
if TAttribute©.Rooms = getRooms(Kvartira) then
for i:=1 to 4 do result := result + TAttrib-ute©.SquareRoom[i];
end;
end;
{Общая площадь (кв. м.)}
function TBase.getAllSquare(Kvartira: TKvartira):word;
begin
result := getLiveSquare(Kvartira);
if C<>nil then
if TAttribute©.Rooms = getRooms(Kvartira) then
result := result + TAttribute©.SquareCorridor
+ TAttribute©.SquareKitchen
+ TAttribute©.SquareSan;
end;
{Пузырьковая сортировка}
procedure TBase.sort(Order: boolean);
var
i, j: word;
t,cur: TNode;
flag: boolean;
begin
try
P:=P.next;
for i:=1 to P.Size-1 do begin
flag:=true;
cur:=P.prev;
for j:=P.Size-1 downto i do begin
if Order then begin
if TGK(cur.prev).Emploer>TGK(cur).Emploer then be-gin
flag:=false;
t:=cur.prev.remove;
cur.insert(t);
cur:=cur.next;
end;
end else
if TGK(cur.prev).Emploer<TGK(cur).Emploer then be-gin
flag:=false;
t:=cur.prev.remove;
cur.insert(t);
cur:=cur.next;
end;
cur:=cur.prev;
end;
if flag then break;
end;
except end;
end;
//ищет элемент и возвращает на него ссылку
function TBase.find(Spisok: TNode; Node: TNode):TNode;
var
i: word;
begin
result:=nil;
for i:=0 to Spisok.Size do begin
if Spisok.equal(Node) then result:=Spisok;
Spisok:=Spisok.next;
end;
end;
{******************************************************************************}
{Создание двухсвязного кольцевого списка,
все ссылки указывают на себя}
constructor TNode.Create();
begin
Size := 1;
pNext:=self;
pPrev:=self;
end;
{Возвращает следующий элемент}
function TNode.next():TNode;
begin
result := pNext;
end;
{Возвращает предыдущий элемент}
function TNode.prev():TNode;
begin
result := pPrev;
end;
{Вставляет элемент Node в список после текущего
и возвращает указатель на него}
function TNode.insert(Node: TNode):TNode;
var
tmp: TNode;
begin
tmp := pNext;
Node.pNext := tmp;
Node.pPrev := self;
pNext := Node;
tmp.pPrev := Node;
Inc(Size);
setNewSize;
result := Node;
end;
{Удаляет текущий элемент из списка,
устанавливает все ссылки на себя и
возвращает себя}
function TNode.remove: TNode;
begin
if (pPrev<>nil) and (pNext<>nil) then begin
Dec(Size);
setNewSize;
pPrev.pNext := pNext;
pNext.pPrev := pPrev;
end;
Size := 1;
pNext := self;
pPrev := pNext;
result := self;
end;
{Устанавливает количество элементов в списке}
procedure TNode.setNewSize;
var
Node: TNode;
begin
Node := pNext;
while Node.Size<>Size do begin
Node.Size := Size;
Node := Node.pNext;
end;
end;
{Возвращает количество элементов в списке}
function TNode.getSize: longWord;
begin
result := Size;
end;
{Уничтожает память, отведённую под текущий элемент}
destructor TNode.Destroy;
begin
remove;
inherited Destroy;
end;
{***********************************************************}
//сравнивает текущий элемент с Node
function TAttribute.equal(Node: TNode): boolean;
var
attr: TAttribute;
begin
attr:=TAttribute(Node);
result:=true;
if attr.Rooms<>Rooms then result:=false;
if attr.Rent<>Rent then result:=false;
if attr.SquareRoom[1]<>SquareRoom[1] then result:=false;
if attr.SquareRoom[2]<>SquareRoom[2] then result:=false;
if attr.SquareRoom[3]<>SquareRoom[3] then result:=false;
if attr.SquareRoom[4]<>SquareRoom[4] then result:=false;
if attr.SquareCorridor<>SquareCorridor then result:=false;
if attr.SquareKitchen<>SquareKitchen then result:=false;
if attr.SquareSan<>SquareSan then result:=false;
end;
//сравнивает текущий элемент с Node
function TGK.equal(Node: TNode): boolean;
var
gk: TGK;
begin
gk:=TGK(Node);
result:=true;
if gk.Nomer<>Nomer then result:=false;
if gk.Family<>Family then result:=false;
if gk.Name<>Name then result:=false;
if gk.MiddleName<>MiddleName then result:=false;
if gk.BornYear<>BornYear then result:=false;
if gk.Emploer<>Emploer then result:=false;
if gk.HasDiscount<>HasDiscount then result:=false;
if gk.Credit<>Credit then result:=false;
end;
//сравнивает текущий элемент с Node
function TKvartira.equal(Node: TNode): boolean;
var
kvart: TKvartira;
begin
kvart:=TKvartira(Node);
result:=true;
if kvart.Nomer<>Nomer then result:=false;
if kvart.Cost<>Cost then result:=false;
if kvart.Privat<>Privat then result:=false;
end;
constructor TKvartira.Create(nomer: word;
cost:longword;
privat:boolean);
begin
self.Nomer:=nomer;
self.Cost:=cost;
self.Privat:=privat;
inherited Create;
end;
constructor TGK.Create(fam,name,middle,empl:String;
born:word;
disc:boolean;
credit:longword;
nomer:word);
begin
Family:=fam;
self.Name:=name;
self.MiddleName:=middle;
self.BornYear:=born;
self.Emploer:=empl;
self.HasDiscount:=disc;
self.Credit:=credit;
self.Nomer:=Nomer;
inherited Create;
end;
constructor TAttribute.Create(rooms:byte;
rent:longWord;
s1,s2,s3,s4,sCorr,sKitch,sSan:word);
begin
self.Rooms:=rooms;
self.Rent:=rent;
self.SquareRoom[1]:=s1;
self.SquareRoom[2]:=s2;
self.SquareRoom[3]:=s3;
self.SquareRoom[4]:=s4;
self.SquareCorridor:=sCorr;
self.SquareKitchen:=sKitch;
self.SquareSan:=sSan;
inherited Create;
end;
end.
|
Помогите,а?? --------------------
[color=purple][/color]Died.Of course, System.StackOverflow |
Список, Замена сортировки и структуры 
Загрузка ...
