Другое: Обработка типизированных файлов

unit Unit1;

{$mode objfpc}{$H+}

interface

uses

Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids, Menus;

type

{ TForm1 }

TForm1 = class(TForm)

MainMenu1: TMainMenu;

MenuItem1: TMenuItem;

MenuItem2: TMenuItem;

udalit: TMenuItem;

srednee: TMenuItem;

vihod: TMenuItem;

zakrit: TMenuItem;

otkrit: TMenuItem;

sohranit: TMenuItem;

sohranitkak: TMenuItem;

sozdat: TMenuItem;

OpenDialog1: TOpenDialog;

SaveDialog1: TSaveDialog;

StringGrid1: TStringGrid;

procedure otkritClick(Sender: TObject);

procedure sohranitClick(Sender: TObject);

procedure sohranitkakClick(Sender: TObject);

procedure sozdatClick(Sender: TObject);

procedure sredneeClick(Sender: TObject);

procedure udalitClick(Sender: TObject);

procedure vihodClick(Sender: TObject);

procedure zakritClick(Sender: TObject);

private

public

end;

var

Form1: TForm1;

implementation

Type

Stud=record

No:integer;

name:string[20];

gr:string[10];

o1,o2,o3:integer;

end;

Ar=array [1..50] of string;

Ar2=array[1..50] of integer;

var

sf:string;

{$R *.lfm}

Procedure TabForFile; {преобразование таблицы для записи}

Var i:integer;

begin

With Form1.StringGrid1 do begin

ColCount:=6;

RowCount:=20;

FixedRows:=1;

FixedCols:=0;

ColWidths[0]:=25;

ColWidths[1]:=100;

ColWidths[2]:=70;

ColWidths[3]:=33;

ColWidths[4]:=33;

ColWidths[5]:=33;

Width:=25;

For i:=0 to ColCount-1 do

Width:= Width+ColWidths[i];

Cells[0,0]:='№';

Cells[1,0]:='фамилия';

Cells[2,0]:='группа';

Cells[3,0]:='оц1';

Cells[4,0]:='оц2';

Cells[5,0]:='оц3';

Options:=Options+[goEditing];

end; end;

Procedure TabForFile2; {преобразование таблицы для среднего}

Var i:integer;

begin

With Form1.StringGrid1 do begin

ColCount:=2;

RowCount:=20;

FixedRows:=1;

FixedCols:=0;

ColWidths[0]:=80;

ColWidths[1]:=100;

Width:=25;

For i:=0 to ColCount-1 do

Width:= Width+ColWidths[i];

Cells[0,0]:='группа';

Cells[1,0]:='средняя оц';

Options:=Options+[goEditing];

end; end;

procedure SaveToFile; {процедура сохранения в файл}

var i: integer;

f: file of stud;

s: stud;

begin

AssignFile(f,sf);

Rewrite(f);

With Form1.StringGrid1 do

for i:= 1 to RowCount-1 do

if Cells[0,i]<>'' then

begin

s.No:=StrToInt(Cells[0,i]);

s.Name:=Cells[1,i];

s.Gr:=Cells[2,i];

if (cells[3,i]='') or (cells[4,i]='') or (cells[5,i]='') then

begin

ShowMessage('Заполните поля до конца!');

end else

begin

s.o1:=StrToInt(cells[3,i]);

s.o2:=StrToInt(cells[4,i]);

s.o3:=StrToInt(cells[5,i]);

write(f,s);

end;

end;

CloseFile(f);

end;

procedure LoadFromFile; {процедура открытия файла}

var i: integer;

f: file of stud;

s: stud;

begin

AssignFile(f,sf);

Reset(f);

i:=0;

While not EoF(f) do

begin

i:= i+1;

read(f,s);

With Form1.StringGrid1 do

begin

Cells[0,i]:=IntToStr(s.No);

Cells[1,i]:=s.Name;

Cells[2,i]:=s.Gr;

cells[3,i]:=IntToStr(s.o1);

cells[4,i]:=IntToStr(s.o2);

cells[5,i]:=IntToStr(s.o3);

end;

end;

CloseFile(f);

end;

{ TForm1 }

procedure TForm1.otkritClick(Sender: TObject); //открыть

begin

If StringGrid1.Modified = true then

Case MessageDlg('Текст не сохранен. Сохранить?',mtConfirmation,[mbYes,

mbNo,mbCancel],0) of

mrYes:sozdatClick(self);

mrNo:;

mrCancel:Exit;

end;

StringGrid1.Clean;

TabForFile;

If OpenDialog1.Execute then

Sf:=OpenDialog1.FileName;

LoadFromFile;

Form1.Caption:=sf;

StringGrid1.Modified:=false;

end;

procedure TForm1.sohranitClick(Sender: TObject); //сохранить

begin

If sf='' then

sohranitkakClick(self);

SaveToFile;

Form1.Caption:=sf;

StringGrid1.Modified:=false;

end;

procedure TForm1.sohranitkakClick(Sender: TObject); //сохранить как

begin

If SaveDialog1.Execute then

sf:=SaveDialog1.FileName;

SaveToFile;

Form1.Caption:=sf;

StringGrid1.Modified:=false;

end;

procedure TForm1.sozdatClick(Sender: TObject); //создать

begin

StringGrid1.Clean;

TabForFile;

Form1.Caption:=sf;

StringGrid1.Modified:=false;

end;

procedure TForm1.sredneeClick(Sender: TObject); //среднее

Var a:Ar; b,c:Ar2;

i,n,k:integer;

v:real;

s:stud; f1:file of stud;

begin

Assignfile(f1,sf);

Reset(f1);

n:=1; k:=0;

read(f1,s);

a[n]:=s.gr;

while not eof(f1) do begin

read(f1,s);

for i:=1 to n do

if a[i]=s.gr then k:=k+1 ;

if k=0 then begin n:=n+1; a[n]:=s.gr; end; end;

seek(f1,0);

for i:=1 to n do begin b[i]:=0;c[i]:=0; end;

while not Eof(f1) do begin

read(f1,s) ;

for i:=1 to n do

if s.gr=a[i] then begin b[i]:=b[i]+s.o1+s.o2+s.o3 ; c[i]:=c[i]+3; end;

end;

closefile(f1);

StringGrid1.Clean;

TabForFile2;

for i:=1 to n do begin

Form1.StringGrid1.Cells[0,i]:=a[i];

v:=b[i]/c[i];

Form1.StringGrid1.Cells[1,i]:=floattostr (v);

end;

end;

procedure TForm1.udalitClick(Sender: TObject); //удалить

var q,w:string;f:file of stud;s,b:stud;i,j,k:integer;

begin

Assignfile(f,sf);

Reset(f);

q:=InPutBox('группа','Введите наименование группы','a' ) ;

w:=InPutBox('фамилия','Введите фамилию','a' ) ;

k:=0;i:=0;

While i<=(filesize(f)-2-k) do begin

seek(f,i);

read(f,s);

if (s.name=w) and (s.gr=q) then begin k:=k+1;

for j:=i to filesize(f)-2 do begin

seek(f,j+1);

read(f,b);

seek(f,j);

write(f,b);

end;

end

else i:= i+1;

end;

seek(f,filesize(f)-1-k) ; if (s.name=w) and (s.gr=q) then k:=k+1;

seek(f,filesize(f)-k);

truncate(f); closefile(f);

end;

procedure TForm1.vihodClick(Sender: TObject); //выход

begin

If StringGrid1.Modified = true then

Case MessageDlg('Введенный текст не сохранен. Сохранить?',mtConfirmation,[mbYes,

mbNo,mbCancel],0) of

mrYes:sohranitClick(self);

mrNo:;

mrCancel:Exit;

end;

Form1.Close;

end;

procedure TForm1.zakritClick(Sender: TObject); //закрыть

begin

If StringGrid1.Modified = true then

Case MessageDlg('Введенный текст не сохранен. Сохранить?',mtConfirmation,[mbYes,

mbNo,mbCancel],0) of

mrYes: sohranitClick(self);

mrNo:;

mrCancel:Exit;

end;

end;

end.