Технология структурного программирования в среде Delphi

Приложение 1

Модуль Unit1.

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Grids, bukva, massiv, unit_def, unit_operation, zapisi;

type

TForm1 = class(TForm)

GroupBox1: TGroupBox;

GroupBox2: TGroupBox;

StringGrid1: TStringGrid;

GroupBox3: TGroupBox;

Label1: TLabel;

Edit1: TEdit;

Button1: TButton;

Edit2: TEdit;

Edit3: TEdit;

Edit4: TEdit;

Edit5: TEdit;

Edit6: TEdit;

Edit7: TEdit;

Button2: TButton;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

Label6: TLabel;

Label7: TLabel;

GroupBox4: TGroupBox;

Button3: TButton;

Button9: TButton;

Memo1: TMemo;

Button10: TButton;

Memo2: TMemo;

Edit8: TEdit;

Edit9: TEdit;

Label8: TLabel;

Label9: TLabel;

GroupBox5: TGroupBox;

Button5: TButton;

Button6: TButton;

GroupBox6: TGroupBox;

Button7: TButton;

Button11: TButton;

Button12: TButton;

OpenDialog1: TOpenDialog;

Button13: TButton;

Button8: TButton;

Button14: TButton;

Button15: TButton;

GroupBox7: TGroupBox;

Button16: TButton;

StringGrid2: TStringGrid;

Label10: TLabel;

procedure FormCreate(Sender: TObject);

procedure Button8Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button6Click(Sender: TObject);

procedure Button14Click(Sender: TObject);

procedure Button13Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure Button7Click(Sender: TObject);

procedure Button11Click(Sender: TObject);

procedure Button12Click(Sender: TObject);

procedure clear_stringgrid;

procedure Button9Click(Sender: TObject);

procedure Button15Click(Sender: TObject);

procedure Button10Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button16Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

y,c,i,j: integer;

G: tgruppa;

RCST:rstudent;

S: tstudent;

St: string;

txt: textfile;

a:arr;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

with StringGrid1 do

begin

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

StringGrid1.cells[1,0]:='Номер зачетной книжки';

StringGrid1.cells[2,0]:='Шифр группы';

StringGrid1.cells[3,0]:='Название дисциплины';

StringGrid1.cells[4,0]:='Дата получения оценки';

StringGrid1.cells[5,0]:='Оценка';

StringGrid1.cells[6,0]:='Фамилия преподавателя';

end;

with StringGrid2 do

begin

StringGrid2.cells[0,0]:='Номер';

StringGrid2.cells[1,0]:='Шифр группы';

StringGrid2.cells[2,0]:='Дисциплина';

StringGrid2.cells[3,0]:='Преподаватель';

end;

end;

procedure TForm1.Button8Click(Sender: TObject);

begin

memo1.clear;

memo2.clear;

end;

procedure TForm1.Button1Click(Sender: TObject);

var j:integer;

begin

if (strtoint(edit1.Text))<=0 then

ShowMessage('Введено неверное количество')

else

begin

StringGrid1.RowCount:=strtoint(edit1.Text)+1;

for j:=1 to (strtoint(edit1.Text)) do

StringGrid1.Cells[0,j]:=inttostr(j);

ShowMessage('Вводите данные студента');

Groupbox1.Enabled:=true;

Groupbox5.Enabled:=true;

Groupbox2.Enabled:=true;

Groupbox6.Enabled:=true;

Groupbox4.Enabled:=true;

Stringgrid1.Enabled:=true;

end;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

if (j<strtoint(edit1.Text)) then

begin

inc(j);

if (StringGrid1.Cells[1,j]='') then

begin

StringGrid1.Cells[1,j]:=edit2.text;

StringGrid1.Cells[2,j]:=edit3.text;

StringGrid1.Cells[3,j]:=Tur(edit4.text);

StringGrid1.Cells[4,j]:=edit5.text;

StringGrid1.Cells[5,j]:=edit6.text;

StringGrid1.Cells[6,j]:=Tur(edit7.text);

end;

end

else

Begin

showmessage('Таблица заполнена');

end;

end;

procedure TForm1.Button6Click(Sender: TObject);

begin

Edit2.Clear;

Edit3.Clear;

Edit4.Clear;

Edit5.Clear;

Edit6.Clear;

Edit7.Clear;

end;

procedure TForm1.Button14Click(Sender: TObject);

begin

close;

end;

procedure TForm1.Button13Click(Sender: TObject);

var i,j:integer;

begin

with StringGRid1 do

for i:=1 to RowCount-1 do

for j:=0 to ColCount-1 do

Cells[j, i]:='';

end;

procedure TForm1.Button5Click(Sender: TObject);

var

i,j:integer;

begin

setlength(a,strtoint(edit1.text));

g:=tgruppa.create(strtoint(edit1.text));

begin

with stringgrid1 do

begin

for i:=1 to RowCount-1 do

begin

a[i-1]:=tstudent.create;

a[i-1].nom:=strtoint(cells[1,i]);

a[i-1].grup:=cells[2,i];

a[i-1].predmet:=cells[3,i];

a[i-1].data:=cells[4,i];

a[i-1].ocenka:=strtoint(cells[5,i]);

a[i-1].famp:=cells[6,i];

end;

end;

g.setarr(a);

clear_stringgrid;

g.getarr(a);

with stringgrid1 do

begin

for j:=1 to RowCount-1 do

begin

StringGrid1.Cells[1,j]:=inttostr(a[j-1].nom);

StringGrid1.Cells[2,j]:=a[j-1].grup;

StringGrid1.Cells[3,j]:=a[j-1].predmet;

StringGrid1.Cells[4,j]:=a[j-1].data;

StringGrid1.Cells[5,j]:=inttostr(a[j-1].ocenka);

StringGrid1.Cells[6,j]:=a[j-1].famp;

end;

end;

end;

end;

procedure TForm1.Button7Click(Sender: TObject);

var fi1:textfile; buf:string; i,j: integer;

begin

with OpenDialog1 do

begin

if opendialog1.Execute then

st:=opendialog1.FileName;

assignfile(fi1,st);

reset(fi1);

j:=1;

while not eof(fi1) do

begin

for i:=0 to 7 do begin

readln(fi1,buf);

StringGrid1.Cells[i,j]:=buf;

end;

inc(j);

end;

closefile(fi1)

end;

end;

procedure TForm1.Button11Click(Sender: TObject);

var student: rstudent; el:tstudent; i,j,k: integer; flt: file of rstudent;

begin

j:=1;

k:=0;

i:=0;

assignfile(flt,name);

rewrite(flt);

try

while k<=(length(a)-1) do begin

student.inom := el.nom;

student.igrup := el.grup;

student.ipredmet := el.predmet;

student.idata := el.data;

student.iocenka := el.ocenka;

student.ifamp := el.famp;

student.inom := strtoint(stringgrid1.cells[1,j]);

student.igrup := stringgrid1.cells[2,j];

student.ipredmet := stringgrid1.cells[3,j];

student.idata := stringgrid1.cells[4,j];

student.iocenka := strtoint(stringgrid1.cells[5,j]);

student.ifamp := stringgrid1.cells[6,j];

write(flt,student);

inc(i);

inc(j);

inc(k);

end;

except

ShowMessage('Не задана длина массива');

end;

closefile(flt);

end;

procedure TForm1.Button12Click(Sender: TObject);

var

filegr:file of rstudent;

buf:string;

sstudent: tstudent;

student: rstudent;

t,d: integer;

begin

with OpenDialog1 do

begin

t:=1;

clear_stringgrid;

g:=tgruppa.create(0);

if opendialog1.Execute then

st:=opendialog1.FileName;

if fileExists(st) then begin

assignfile(filegr,st);

reset(filegr);

d:=0;

while not EOF(filegr) do begin

setlength(a,1+d);

read(filegr,student);

a[d]:=tstudent.Create;

a[d].nom := student.inom;

a[d].grup := student.igrup;

a[d].predmet := student.ipredmet;

a[d].data := student.idata;

a[d].ocenka := student.iocenka;

a[d].famp := student.ifamp;

stringgrid1.cells[1,1+d] := inttostr(a[d].nom);

stringgrid1.cells[2,1+d] := a[d].grup;

stringgrid1.cells[3,1+d] := a[d].predmet;

stringgrid1.cells[4,1+d] := a[d].data;

stringgrid1.cells[5,1+d] := inttostr(a[d].ocenka);

stringgrid1.cells[6,1+d] := a[d].famp;

inc(d);

end;

g.setarr(a);

end

else begin

assignfile(filegr,st);

rewrite(filegr);

end;

end;

closefile(filegr);

c:=d;

end;

procedure Tform1.clear_stringgrid;

var i,j: integer;

begin

with StringGrid1 do

for i:=1 to RowCount-1 do

for j:=0 to ColCount-1 do

Cells[j, i]:='';

end;

procedure TForm1.Button9Click(Sender: TObject);

var

b:arr;

s1,s2:string;

i:integer;

begin

memo1.clear;

s1:=edit8.text;

s2:=edit9.text;

g.statement(b,s1,s2);

for i:=0 to high(b) do

begin

s1:=inttostr(b[i].nom)+' '+b[i].grup+' '+b[i].predmet+' '+b[i].data+' '+inttostr(b[i].ocenka)+' '+b[i].famp;

memo1.Lines.Add(s1);

end;

g.setarr(b);

end;

procedure TForm1.Button15Click(Sender: TObject);

begin

edit8.Clear;

edit9.Clear;

end;

procedure TForm1.Button10Click(Sender: TObject);

var

sr:real;

s1,s2:string;

begin

s1:=edit8.text;

s2:=edit9.text;

sr:=g.sredn(a,s1,s2);

memo2.Lines.Add(floattostr(sr));

end;

procedure TForm1.Button3Click(Sender: TObject);

var

i,j:integer;

begin

clear_stringgrid;

g.setarr(a);

g.sort_vstavka(g);

g.getarr(a);

i:=0;

for j:=1 to (length(a)) do begin

stringgrid1.cells[1,j] := inttostr(a[i].nom);

stringgrid1.cells[2,j] := a[i].grup;

stringgrid1.cells[3,j] := a[i].predmet;

stringgrid1.cells[4,j] := a[i].data;

stringgrid1.cells[5,j] := inttostr(a[i].ocenka);

stringgrid1.cells[6,j] := a[i].famp;

inc(i);

end;

end;

procedure TForm1.Button16Click(Sender: TObject);

var

h:arr;

i,j:integer;

s1:string;

flag:boolean;

begin

g.setarr(a);

g.dvoechniki(h,g);

g.getarr(a);

i:=0;

for j:=1 to (length(h)) do

begin

stringgrid2.cells[0,j] := inttostr(h[i].nom);

stringgrid2.cells[1,j] := h[i].grup;

stringgrid2.cells[2,j] := h[i].predmet;

stringgrid2.cells[3,j] := h[i].famp;

inc(i);

end;

end;

end.

Приложение 2

Модуль Unit_def.

unit Unit_Def;

interface

uses sysutils, zapisi;

type

TStudent=class

private

inom : integer;

igrup : string;

ipredmet : string;

idata : string;

iocenka : integer;

ifamp : string;

public

constructor Create;

destructor Destroy(var msg:string);

property nom : integer read inom write inom;

property grup : string read igrup write igrup;

property predmet : string read ipredmet write ipredmet;

property data : string read idata write idata;

property ocenka : integer read iocenka write iocenka;

property famp : string read ifamp write ifamp;

end;

implementation

constructor Tstudent.Create;

begin

inom:=0;

igrup:='';

ipredmet:='';

idata:='';

iocenka:=0;

ifamp:='';

end;

destructor Tstudent.Destroy(var msg:string);

begin

msg:='Объект был удалён!';

end;

end.

Приложение 2

Модуль Unit_operation.

unit Unit_Operation;

interface

uses SysUtils, unit_def, massiv;

type

Tgruppa=class(tstudent)

private

gruppa:arr;

public

constructor create(n:integer);

procedure add_stud(s: tstudent);

procedure sort_vstavka(var g:tgruppa);

procedure getarr(var a:arr);

procedure setarr(a:arr);

procedure statement(var s : arr; s1,s2:string);

function sredn(s: arr; s1,s2:string):real;

procedure dvoechniki(var s:arr ; var g:tgruppa);

end;

implementation

procedure Tgruppa.getarr(var a:arr);

begin

a:=gruppa;

end;

procedure tgruppa.setarr(a:arr);

var i:integer;

begin

setlength(gruppa,length(a));

for i:=0 to (length(gruppa)-1) do

begin

gruppa[i]:=tstudent.Create;

gruppa[i]:=a[i];

end;

end;

procedure tgruppa.sort_vstavka(var g:tgruppa);

var i,j,k:integer;

flag:boolean;

buf:tstudent;

max:string[50];

begin

for i:=0 to (length(gruppa)-2) do

begin

begin

flag:=false;

for j:=i+1 to ((length(gruppa))-1) do

if g.gruppa[i].predmet>g.gruppa[j].predmet then

begin

max:=g.gruppa[j].predmet;

k:=j;

flag:=true;

end;

if flag=true then

begin

buf:=g.gruppa[i];

g.gruppa[i]:=g.gruppa[k];

g.gruppa[k]:=buf;

end;

end;

end;

end;

function tgruppa.sredn(s: arr; s1,s2:string):real;

var

i,u,m,q:integer;

sr:real;

begin

u:=0;

m:=0;

for i:=0 to high(s) do

if ((s[i].grup)=s1) and ((s[i].predmet)=s2) then

begin

q:=s[i].ocenka;

u:=u+q;

m:=m+1;

end;

sr:=u/m;

result:=sr;

end;

constructor Tgruppa.create(n:integer);

var i:integer;

begin

setlength(gruppa,n);

for i:=0 to (n-1) do

gruppa[i]:=tstudent.Create;

end;

procedure Tgruppa.add_stud(s: tstudent);

begin

setlength(gruppa,length(gruppa)+1);

gruppa[length(gruppa)-1]:=s;

end;

procedure Tgruppa.statement(var s : arr; s1,s2:string);

var

i:integer;

begin

for i:=0 to high(gruppa) do

begin

if ((gruppa[i].grup)=s1) and ((gruppa[i].predmet)=s2) then

begin

setlength(s,length(s)+1);

s[length(s)-1]:=gruppa[i];

end;

end;

end;

procedure Tgruppa.dvoechniki(var s:arr ; var g:tgruppa);

var i:integer;

begin

for i:=0 to (high(gruppa)) do

begin

if (gruppa[i].ocenka=2) and (gruppa[i].nom=gruppa[i].nom) then

begin

setlength(s,length(s)+1);

s[length(s)-1]:=gruppa[i];

end;

end;

end;

end.

Приложение 4

Модуль massiv.

unit massiv;

interface

uses sysutils, unit_def, zapisi;

type

arr=array of tstudent;

rarr=array of rstudent;

implementation

end.

Приложение 5

Модуль zapisi

unit zapisi;

interface

uses sysutils;

type

rstudent=record

inom : integer;

igrup : string[255];

ipredmet : string[255];

idata : string[255];

iocenka : integer;

ifamp : string[255];

end;

implementation

end.

Приложение 3

Модуль bukva

unit bukva;

interface

uses SysUtils;

function Tur(const s:string):string;

implementation

function Tur(const s:string):string;

var

s1,s2:string;

begin

s1:=s;

s1:=ansiuppercase(s1);

s2:=copy(s1,2,length(s1)-1);

s2:=ansilowercase(s2);

insert(s2,s1,2);

s1:=copy(s1,1,length(s));

result:=s1;

end;

end.

Размещено на Allbest.ur