var
F:TextFile;
i:integer;
begin
{Файл - 'XD.txt'}
// открываем файл для чтения
AssignFile(F,'XD.txt');
Reset(F);
if IOResult <> 0 then
// ошибка открытия файла!
begin
{$I+}
MessageBox(0,'Ошибка!','Не возможно открыть файл XD.txt!',MB_OK);
exit;
end;
{$I+}
// считываем файл построчно до конца и заполняем массив XDar
i:=1;
while not(SeekEof(F))do
begin
ReadLn(F,XDar[i]);
inc(i);
end;
CloseFile(F); // закрыть файл
{Файл - 'WTK.txt'}
{$I-}
// открываем файл для чтения
AssignFile(F,'WTK.txt');
Reset(F);
if IOResult <> 0 then
// ошибка открытия файла!
begin
{$I+}
MessageBox(0,'Ошибка!','Не возможно открыть файл WTK.txt!',MB_OK);
exit;
end;
{$I+}
// считываем файл построчно до конца и заполняем массив XDar
i:=1;
while not(SeekEof(F))do
begin
ReadLn(F,WTKar[i]);
inc(i);
end;
CloseFile(F); // закрыть файл
{Файл - 'BANK.txt'}
{$I-}
// открываем файл для чтения
AssignFile(F,'BANK.txt');
Reset(F);
if IOResult <> 0 then
// ошибка открытия файла!
begin
{$I+}
MessageBox(0,'Ошибка!','Не возможно открыть файл BANK.txt!',MB_OK);
exit;
end;
{$I+}
// считываем файл построчно до конца и заполняем массив XDar
i:=1;
while not(SeekEof(F))do
begin
ReadLn(F,BANKar[i]);
inc(i);
end;
CloseFile(F); // закрыть файл
end;
{Процедура инициализации таблицы и заполнение ее в соответсвии с массивами}
procedure TForm1.InitGrids;
var i,j:integer;
begin
XDgrid.Cells[0,0]:='Номер договора';
XDgrid.Cells[1,0]:='Дата заключения';
XDgrid.Cells[2,0]:='Дата завершения';
XDgrid.Cells[3,0]:='Тема договора';
XDgrid.Cells[4,0]:='Организация';
XDgrid.Cells[5,0]:='Признак завершения';
XDgrid.Cells[6,0]:='Cтоимость';
WTKgrid.Cells[0,0]:='Фамилия';
WTKgrid.Cells[1,0]:='Имя';
WTKgrid.Cells[2,0]:='Отчество';
WTKgrid.Cells[3,0]:='Год рождения ';
WTKgrid.Cells[4,0]:='Код ХД ';
WTKgrid.Cells[5,0]:='Признак';
WTKgrid.Cells[6,0]:='Сумма вознаграждения ';
WTKgrid.Cells[7,0]:='Домашний адрес ';
WTKgrid.Cells[8,0]:='Номер сбербанка';
WTKgrid.Cells[9,0]:='Расчетный счет ';
BANKgrid.Cells[0,0]:='Номер отделения';
BANKgrid.Cells[1,0]:='Город';
BANKgrid.Cells[2,0]:='Адрес ';
BANKgrid.Cells[3,0]:='Наименование отделения ';
BANKgrid.Cells[4,0]:='Банковский код ';
NDgrid.Cells[0,0]:='Номер договора';
NDgrid.Cells[1,0]:='Дата заключения';
NDgrid.Cells[2,0]:='Дата завершения';
NDgrid.Cells[3,0]:='Тема договора';
NDgrid.Cells[4,0]:='Организация';
NDgrid.Cells[5,0]:= 'Кол-во членов ВТК';
for i:=1 to 10 do
begin
for j:=1 to 7 do
XDgrid.Cells[j-1,i]:=XDar[(i-1)*7+j];
end;
for i:=1 to 15 do
begin
for j:=1 to 10 do
WTKgrid.Cells[j-1,i]:=WTKar[(i-1)*10+j];
end;
for i:=1 to 10 do
begin
for j:=1 to 5 do
BANKgrid.Cells[j-1,i]:=BANKar[(i-1)*5+j];
end;
end;
{Заполним массивы в соответсвии с данными в таблице}
procedure TForm1.FillArrays;
var i:integer;
begin
for i:=0 to 69 do
begin
XDar[i+1]:=XDgrid.Cells[(i mod 7),(i div 7)+1];
end;
for i:=0 to 149 do
begin
WTKar[i+1]:=WTKgrid.Cells[(i mod 10),(i div 10)+1];
end;
for i:=0 to 49 do
begin
BANKar[i+1]:=BANKgrid.Cells[(i mod 5),(i div 5)+1];
end;
end;
{Сохраним данные из массивов в файл}
procedure TForm1.SaveInFiles;
var
F:TextFile; // текстовый файл
i:integer;
begin
{XD.txt}
// открываем файл для записи
AssignFile(F,'XD.txt');
Rewrite(F);
// построчно записываем из массива в файл
for i:=1 to 70 do
WriteLn(F,XDar[i]);
CloseFile(F); // закрыть файл
{WTK.txt}
// открываем файл для записи
AssignFile(F,'WTK.txt');
Rewrite(F);
// построчно записываем из массива в файл
for i:=1 to 150 do
WriteLn(F,WTKar[i]);
CloseFile(F); // закрыть файл
{BANK.txt}
// открываем файл для записи
AssignFile(F,'BANK.txt');
Rewrite(F);
// построчно записываем из массива в файл
for i:=1 to 50 do
WriteLn(F,BANKar[i]);
CloseFile(F); // закрыть файл
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
LoadFromFiles; // загрузка данных из файла в массивы
InitGrids; // инициализация таблицы
FillNDgrid; // заполнить таблицу незавершенных договоров
end;
{Выход}
procedure TForm1.N2Click(Sender: TObject);
begin
Halt;
end;
{Сохранить}
procedure TForm1.N3Click(Sender: TObject);
begin
FillArrays; // сначала заполним массивы в соответсвии с таблицами
SaveInFiles; // теперь сохраним в файл
end;
{Поиск}
procedure TForm1.btnSearchClick(Sender: TObject);
var
myRect: TGridRect;
Grid: TStringGrid;
nCol,i,j:integer;
st:String;
begin
st:=txtSearch.Text; // строка для поиска
// определяем активную закладку
case PageControl1.ActivePageIndex of
0: begin Grid:= XDgrid; nCol:=7; end;
1: begin Grid:=WTKgrid; nCol:=10; end;
2: begin Grid:=BANKgrid; nCol:=5; end;
end;
myRect.Left := 11;
myRect.Top := 11;
myRect.Right := 11;
myRect.Bottom := 11;
Grid.Selection:= myRect;
if(st=' ') or (st='') then exit;
// поиск
for i:=1 to 10 do
for j:=0 to nCol-1 do
if Grid.Cells[j,i]=st then
begin
myRect.Left := j;
myRect.Top := i;
myRect.Right := j;
myRect.Bottom := i;
Grid.Selection := myRect;
exit;
end;
end;
{Заполнить таблицу незавершенных договоров в соответсвии с
XDgrid, WTKgrid, BANKgrid}
procedure TForm1.FillNDgrid;
var i,j,y,n:integer;
code:string;
st:string;
begin
j:=1;
for i:=1 to 10 do
if(XDGrid.Cells[5,i]='незавершен') then
begin
NDgrid.Cells[0,j]:=XDGrid.Cells[0,i];
NDgrid.Cells[1,j]:=XDGrid.Cells[1,i];
NDgrid.Cells[2,j]:=XDGrid.Cells[2,i];
NDgrid.Cells[3,j]:=XDGrid.Cells[3,i];
NDgrid.Cells[4,j]:=XDGrid.Cells[4,i];
// составим код договора
code:= NDgrid.Cells[0,j]+'/'+ NDgrid.Cells[1,j][9]+ NDgrid.Cells[1,j][10];
// найдем сколько человек состоит именно в этом ВТК
n:=0;
for y:=1 to 15 do
if(WTKgrid.Cells[4,y]=code) then inc(n);
str(n,st);
NDgrid.Cells[5,j]:=st;
inc(j);
end;
end;
{Обновить - обновить таблицу незавершенных договоров}
procedure TForm1.N4Click(Sender: TObject);
var i,j:integer;
begin
for i:=1 to 10 do
for j:=0 to 5 do
NDgrid.Cells[j,i]:='';
FillNDgrid;
end;
{Переключение флага редактирования}
procedure TForm1.CheckBox1Click(Sender: TObject);
var opt:TGridOptions;
begin
opt:=XDgrid.Options;
if CheckBox1.Checked=false then
begin
Include(opt,goRowSelect);
Exclude(opt,goEditing);
btnDel.Enabled := true;
end
else
begin
Exclude(opt,goRowSelect);
Include(opt,goEditing);
btnDel.Enabled := false;
end;
XDgrid.Options := opt;
WTKgrid.Options := opt;
BANKgrid.Options := opt;
end;
{Удалить}
procedure TForm1.btnDelClick(Sender: TObject);
var
myRect: TGridRect;
Grid: TStringGrid;
nCol,i,j:integer;
begin
// определяем активную закладку
case PageControl1.ActivePageIndex of
0: begin Grid:= XDgrid; nCol:=7; end;
1: begin Grid:=WTKgrid; nCol:=10; end;
2: begin Grid:=BANKgrid; nCol:=5; end;
end;
if(Grid.Row>0) and (Grid.Row<10) then
for i:=Grid.Row to 10 do
begin
for j:=0 to nCol-1 do
Grid.Cells[j,i]:=Grid.Cells[j,i+1];
end;
end;
{пирамидальная сортировка таблицы NDgrid по возростанию}
procedure TForm1.Sort;
var
l,r:word;
x,n,n1,n2,c,y:integer;
s:string;
sr:SRow;
procedure Sift;
label l3;
var i,j,y:word;
begin
i:=l;j:=2*i;s:=NDgrid.Cells[5,i];SaveRow(sr,i);
while j<=r do
begin
if j<r then
begin
Val(NDgrid.Cells[5,j],n1,c);
Val(NDgrid.Cells[5,j+1],n2,c);
if n1<n2 then j:=j+1;
end;
Val(s,n1,c);
Val(NDgrid.Cells[5,j],n2,c);
if n1>=n2 then goto l3;
for y:=0 to 5 do
NDgrid.Cells[y,i]:=NDgrid.Cells[y,j];
i:=j; j:=2*i;
end;
l3:
for y:=0 to 5 do
begin
NDgrid.Cells[y,i]:=sr[y];
end;
end; // Sift
begin
n:=0;
for y:=1 to 10 do
if (NDgrid.Cells[5,y]<>'') and (NDgrid.Cells[5,y]<>' ') then
inc(n);
l:=(n div 2)+1;r:=n;
while l>1 do
begin
l:=l-1; Sift;
end;
while r>1 do
begin
SaveRow(sr,1);
s:=NDgrid.Cells[5,1];
SweepRows(1,r);
r:=r-1; Sift;
end;
end; // Sort
{пирамидальная сортировка таблицы NDgrid по убыванию}
procedure TForm1.Sort2;
var
l,r:word;
x,n,n1,n2,c,y:integer;
s:string;
sr:SRow;
procedure Sift;
label l3;
var i,j,y:word;
begin
i:=l;j:=2*i;s:=NDgrid.Cells[5,i];SaveRow(sr,i);
while j<=r do
begin
if j<r then
begin
Val(NDgrid.Cells[5,j],n1,c);
Val(NDgrid.Cells[5,j+1],n2,c);
if n1>n2 then j:=j+1;
end;
Val(s,n1,c);
Val(NDgrid.Cells[5,j],n2,c);
if n1<=n2 then goto l3;
for y:=0 to 5 do
NDgrid.Cells[y,i]:=NDgrid.Cells[y,j];
i:=j; j:=2*i;
end;
l3:
for y:=0 to 5 do
begin
NDgrid.Cells[y,i]:=sr[y];
end;
end; // Sift
begin
n:=0;
for y:=1 to 10 do
if (NDgrid.Cells[5,y]<>'') and (NDgrid.Cells[5,y]<>' ') then
inc(n);
l:=(n div 2)+1;r:=n;
while l>1 do
begin
l:=l-1; Sift;
end;
while r>1 do
begin
SaveRow(sr,1);
s:=NDgrid.Cells[5,1];
SweepRows(1,r);
r:=r-1; Sift;
end;
end; // Sort2
{поменять местами строки r1 и r2 в таблице NDgrid}
procedure TForm1.SweepRows(r1,r2:word);
var s: array [0..5] of String[30];
i:integer;
begin
for i:=0 to 5 do
s[i]:=NDgrid.Cells[i,r1];
for i:=0 to 5 do
NDgrid.Cells[i,r1]:=NDgrid.Cells[i,r2];
for i:=0 to 5 do
NDgrid.Cells[i,r2]:=s[i];
end;
{сохранить строку номер r таблицы NDgrid в sr}
procedure TForm1.SaveRow(var sr:SRow;r:word);
var i:integer;
begin
for i:=0 to 5 do
sr[i]:=NDgrid.Cells[i,r];
end;
procedure TForm1.btnSort2Click(Sender: TObject);
begin
Sort;
end;
procedure TForm1.btnSort1Click(Sender: TObject);
begin
Sort2;
end;
end.