Правила форума
Прочтите прежде чем задавать вопрос!
1 таблица банков
2 таблица клиентов
Связь таблиц заключается в том, что у одного банка могут быть несколько клиентов, а у каждого клиента могут быть вклады в разных банках.
Программа еще далека от оптимальной, модернизация ей еще предстоит, но вроде работает без сбоетв, если кто-то обнаружит серьзезный недочет или ошибку прошу сообщить, в дальнейшем планирую оптимизировать макимально эту программу, написать лайт-версию без динамических структур, и на их основе сделать материал для FAQ.
Если будут вопросы по программе, спрашивайте.
Код: (Показать/Скрыть)
{$r-}
uses crt;
const
mb1 = 'Введите имя банка : ';
mb2 = 'Сколько клиентов у данного банка : ';
mb3 = 'Имя клиента : ';
mc1 = 'Ввдите имя клиента : ';
mc2 = 'В скольки банках у данного клиенита есть вкалады : ';
mc3 = 'Имя банка : ';
msgb = 'Выберете банк, для посмотра списка его вкладчиков и нажмите <Enter>,либо';
msgc = 'Выберете клиента, для посмотра списка банков, в которых есть его вклад нажмите <Enter>,либо';
type
TType = string;
PArr = record
p : ^TArr;
size : LongInt;
end;
TArr = array [1..1] of TType;
PStruct = record
s : ^TStruct;
size : LongInt;
end;
TStruct = array [1..1] of record
name : TType;
arr : PArr;
end;
procedure AddEl(var a : PArr; el : TType);
var
newArr : ^TArr;
begin
GetMem(newArr, a.size + sizeof(TType));
if a.p <> nil then begin
move(a.p^[1], newArr^[1], a.size);
FreeMem(a.p, a.size);
end;
inc(a.size, sizeof(TType));
a.p := newArr;
a.p^[a.size div sizeof(TType)] := el;
end;
procedure AddStruct(var struct : PStruct);
var
newStruct : ^TStruct;
begin
GetMem(newStruct, struct.size + sizeof(TStruct));
if struct.s <> nil then begin
move(struct.s^[1], newStruct^[1], struct.size);
FreeMem(struct.s, struct.size);
end;
inc(struct.size, sizeof(TStruct));
struct.s := newStruct;
struct.s := newStruct;
end;
function Find(struct : PStruct; el : TType) : word;
var
fnd : boolean;
n,i : word;
begin
find := 0;
fnd := false;
n := struct.size div sizeof(TStruct);
i := 1;
while (i <= n) and not(fnd) do begin
fnd := (struct.s^[i].name = el);
if not(fnd) then inc(i);
end;
if fnd then
find := i
end;
procedure Show(struct : PStruct; msg : TType);
var
n,i,j,x,y,ch : word;
begin
n := struct.size div sizeof(TStruct);
repeat
clrscr;
for i := 1 to n do writeln(i,'). ',struct.s^[i].name);
writeln('Выберете банк, для посмотра списка его вкладчиков и нажмите <Enter>,либо');
writeln('0 для выхода в основное меню');
x := WhereX; y := WhereY;
repeat
readln(ch);
GotoXY(x,y); ClrEOL;
until ch in [0..n];
if ch <> 0 then begin
clrscr;
for j := 1 to struct.s^[ch].arr.size div sizeof(TType) do
writeln(struct.s^[ch].arr.p^[j]);
end;
writeln('Нажмите любую клавишу'); readln;
until ch = 0;
end;
procedure Work(var main : PStruct; var sub : PStruct; msg1,msg2,msg3 : TType);
var
n,i,id : word;
namem, names : TType;
ch : char;
begin
clrscr;
writeln('Вы уверены что хотите ввести новую структуру [Enter - yes, Esc - no] ?');
repeat ch := readkey until ch in [#13,#27];
if ch = #27 then exit;
clrscr;
write(msg1); readln(namem);
if (Find(main, namem)) <> 0 then exit;
AddStruct(main);
main.s^[main.size div sizeof(TType)].name := namem;
main.s^[main.size div sizeof(TType)].arr.size := 0;
write(msg2); readln(n);
if n > 0 then
for i := 1 to n do begin
write(msg3); readln(names);
AddEl(main.s^[main.size div sizeof(TType)].arr, names);
id := Find(sub, names);
if id = 0 then begin
AddStruct(sub);
sub.s^[sub.size div sizeof(TStruct)].name := names;
sub.s^[sub.size div sizeof(TStruct)].arr.size := 0;
AddEl(sub.s^[sub.size div sizeof(TType)].arr, namem);
end
else AddEl(sub.s^[sub.size div sizeof(TType)].arr, namem);
end;
end;
function Menu(var b : PStruct; var c : PStruct; var q : boolean) : boolean;
var
ch : char;
n,i,id : word;
cname,bname : TType;
begin
clrscr;
writeln('1 -> Добавить банк ');
writeln('2 -> Добавить клиента');
writeln('3 -> Вывести и-ю по банкам');
writeln('4 -> Вывести и-ю по клиентам');
writeln('----------------------------');
writeln('0 -> Выход');
repeat
ch := readkey;
until ch in ['0'..'4'];
case ch of
'1' : Work(b, c, mb1, mb2, mb3);
'2' : Work(c, b, mc1, mc2, mc3);
'3' : Show(b, msgb);
'4' : Show(c, msgc);
'0' : q := true;
end;
end;
var
bank, client : PStruct;
quit : boolean;
begin
clrscr;
bank.size := 0;
client.size := 0;
quit := false;
while not(quit) do menu(bank, client, quit);
FreeMem(bank.s, bank.size);
FreeMem(client.s ,client.size);
end.
.
