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.