PascalDelphi / Многие готовые лабы за 1&2 сем. от Колесниковой М.Д. / PrDlg / UnitDialog

unit UnitDialog;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Grids;

type
TForm1 = class(TForm)
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Button1: TButton;
Button2: TButton;
Memo1: TMemo;
Button3: TButton;
Button4: TButton;
StringGrid1: TStringGrid;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Label1: TLabel;
Label2: TLabel;
Button9: TButton;
Label3: TLabel;
Button10: TButton;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure Button10Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

type zap=record
name:string[10];
fio:string[20];
nompok:integer;
izd:string[15];
cena:integer
end;//zap

var
Form1: TForm1;

st,r:string;
rzap:zap;
i:integer;
f1:TextFile;
f2:File of zap;
implementation

function DobProb(k:integer;var s:string):string;
//Добавление пробелов
begin
while length(s) < k do s:=s+' ';
DobProb:=s
end;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
with OpenDialog1 do
begin
if not Execute then Exit;
Memo1.Lines.LoadFromFile(FileName)
end
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
with SaveDialog1 do
begin
if not Execute then Exit;
Memo1.Lines.SaveToFile(FileName)
end
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
close
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
Memo1.Lines.Clear
end;

procedure TForm1.Button5Click(Sender: TObject);
//Создание типизированного файла
begin
if not OpenDialog1.Execute then Exit;
AssignFile(f1,OpenDialog1.FileName);
if not SaveDialog1.Execute then Exit;
AssignFile(f2,SaveDialog1.FileName);
reset(f1); rewrite(f2);
while not SeekEof(f1) do
begin
readln(f1,st);
rzap.name:=copy(st,1,10);
rzap.fio:=copy(st,12,20);
r:=copy(st,33,3); rzap.nompok:=StrToInt(r);
rzap.izd:=copy(st,37,15);
r:=copy(st,53,4); rzap.cena:=StrToInt(r);
write(f2,rzap)
end;
CloseFile(f1); CloseFile(f2);
end;

procedure TForm1.Button6Click(Sender: TObject);
//Вывод в таблицу
var i:integer;
begin
if not OpenDialog1.Execute then Exit;
OpenDialog1.FilterIndex:=2;
AssignFile(f2,OpenDialog1.FileName);
reset(f2);
i:=0;
with StringGrid1 do
begin
cells[0,0]:='Наименование';
cells[1,0]:='ФИО';
cells[2,0]:='Номер';
cells[3,0]:='Издательство';
cells[4,0]:='Цена';
end;
while not Eof(f2) do
begin
read(f2,rzap); inc(i);
with StringGrid1 do
begin
cells[0,i]:=rzap.name;
cells[1,i]:=rzap.fio;
cells[2,i]:=IntToStr(rzap.nompok);
cells[3,i]:=rzap.izd;
cells[4,i]:=IntToStr(rzap.cena);
end;
end;
CloseFile(f2)
end;

procedure TForm1.Button7Click(Sender: TObject);
//Очистка таблицы
var i,j:integer;
begin
with StringGrid1 do
for i:=1 to RowCount-1 do
for j:=0 to ColCount do cells[j,i]:='';
end;

procedure TForm1.Button8Click(Sender: TObject);
//Добавление к файлу
var k:integer;// Место вставляемого элемента(его номер на 1 меньше)
kd:integer;// Кол-во добавляемых записей
k1,kk,i,j:integer;
stroka:string;
begin
if not OpenDialog1.Execute then Exit;
OpenDialog1.FilterIndex:=2;
AssignFile(f2,OpenDialog1.FileName);
reset(f2);
kk:=FileSize(f2);
kd:=StrToInt(Edit1.Text);// Кол-во добавляемых записей
k:=StrToInt(Edit2.Text);// Место вставляемого элемента
if k <> 1 then k1:=k-1 else k1:=k;
for i:=kk downto k1 do
begin seek(f2,i-1); read(f2,rzap);
seek(f2,i+kd-1); write(f2,rzap);
end;
seek(f2,k-1); j:=0;
for i:=1 to kd do
begin
stroka:= Memo1.Lines[j]; rzap.name:=DobProb(10,stroka);
stroka:= Memo1.Lines[j+1]; rzap.fio:=DobProb(20,stroka);
rzap.nompok:=StrToInt( Memo1.Lines[j+2]);
stroka:= Memo1.Lines[j+3]; rzap.izd:=DobProb(15,stroka);
rzap.cena:=StrToInt( Memo1.Lines[j+4]);
write(f2,rzap); inc(j,5);
end;
CloseFile(f2);
end;

procedure TForm1.Button9Click(Sender: TObject);
//Удаление записей
var vizd:string;
kk,i,j:integer;
begin
st:=Edit3.Text; vizd:=DobProb(15,st);
if not OpenDialog1.Execute then Exit;
OpenDialog1.FilterIndex:=2;
AssignFile(f2,OpenDialog1.FileName);
reset(f2);
kk:=FileSize(f2);
repeat
repeat
read(f2,rzap);
if vizd = rzap.izd then
begin j:= FilePos(f2);
if Eof(f2) then Seek(f2,kk-1) //удаляем последнюю запись
else //сдвиг записей в сторону начала файла
for i:=FilePos(f2) to kk-1 do
begin
Seek(f2,i); read(f2,rzap);//читать i-ю запись
Seek(f2,i-1); write(f2,rzap);//писать ее на место (i-1)-ой
end;//конец сдвига
Truncate(f2); dec(kk)
end
until Eof(f2);
Seek(f2,j)
until Eof(f2);
CloseFile(f2);
end;

procedure TForm1.Button10Click(Sender: TObject);
//Сортировка по ФИО автора
var z1,z2:zap;
kk,i:integer;
flag:boolean;
begin
if not OpenDialog1.Execute then Exit;
OpenDialog1.FilterIndex:=2;
AssignFile(f2,OpenDialog1.FileName);
reset(f2);
kk:=FileSize(f2);
repeat
flag:=true;
for i:=0 to kk-2 do
begin
Seek(f2,i); read(f2,z1); read(f2,z2);
if z1.fio > z2.fio then
begin
Seek(f2,i); write(f2,z2); write(f2,z1);
flag:=false;
end;
end
until flag;
CloseFile(f2);
end;

end.