begin
// Создать файл с именем из Edit
s:=edit1.Text;
if s='' then ShowMessage ('Нельзя ввести пустое поле!') else
if FileExists('db\person_kl\' + s + '.db') then ShowMessage ('Такой класс уже есть!') else
begin
assignfile(f,'db\person_kl\' + s +'.db');
rewrite(f);
closefile(f);
end;
close;
Form_Zavych.ListBox_kl(Sender);
Form_Zavych.ComboBox_kl(Sender);
Form_Zavych.ComboBox_kl_1(Sender);
end;
end.
unit unit_edit_kl;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
type
{ TForm_edit_kl }
TForm_edit_kl = class(TForm)
Button1: TButton;
Edit1: TEdit;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
public
end;
var
Form_edit_kl: TForm_edit_kl;
implementation
uses
unit_zavych;
{$R *.lfm}
{ TForm_edit_kl }
procedure TForm_edit_kl.Button1Click(Sender: TObject); // Сохранить
var
//f:textfile;
s:string;
begin
s:=edit1.Text;
if s='' then
ShowMessage ('Нельзя ввести пустое поле!')
else
if FileExists('db\person_kl\' + s + '.db') then
ShowMessage ('Такой класс уже есть!')
else
begin
{DeleteFile('db\person_kl\' + Form_zavych.edit_kl + '.db');
assignfile(f,'db\person_kl\' + s +'.db');}
//assignfile (f,'db\person_kl\' + Form_zavych.edit_kl + '.db' );
RenameFile('db\person_kl\' + Form_zavych.edit_kl + '.db' , 'db\person_kl\' + s +'.db');
// rewrite(f);
//closefile(f);
Form_Zavych.ListBox_kl(Sender);
Form_Zavych.ComboBox_kl(Sender);
Form_Zavych.ComboBox_kl_1(Sender);
close;
end;
end;
procedure TForm_edit_kl.FormShow(Sender: TObject);
begin
Edit1.text:=Form_zavych.edit_kl;
end;
end.
unit unit_person_kl;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
type
{ TForm_person_kl }
TForm_person_kl = class(TForm)
Button1: TButton;
Button3: TButton;
Button4: TButton;
Edit1: TEdit;
Label1: TLabel;
Label2: TLabel;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button3Click_1(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
private
public
end;
var
Form_person_kl: TForm_person_kl;
implementation
uses
unit_zavych, unit_danger;
{$R *.lfm}
{ TForm_person_kl }
procedure TForm_person_kl.FormShow(Sender: TObject);
begin
ListBox1.Items.LoadFromFile ('db\person_kl\' + Form_zavych.edit_kl + '.db');
end;
procedure TForm_person_kl.Button1Click(Sender: TObject); // Добавить
var
i,j:integer;
begin
j:=0;
if Edit1.Text='' then
begin
ShowMessage ('Нельзя ввести пустое поле!');
j:=1;
end
else
for i:=0 to ListBox1.Items.Count-1 do
begin
if ListBox1.Items[i] = Edit1.Text then
begin
ShowMessage ('Такой ученик уже есть!');
j:=1;
end
end;
if j<>1 then
ListBox1.Items.addText(Edit1.Text);
end;
procedure TForm_person_kl.Button3Click_1(Sender: TObject); // Удалить
begin
if ListBox1.ItemIndex >= 0 then
ListBox1.Items.Delete(ListBox1.ItemIndex);
end;
procedure TForm_person_kl.Button3Click(Sender: TObject); // Удалить
begin
begin
Form_danger.show ;
Form_Zavych.danger:=6;
end;
end;
procedure TForm_person_kl.Button4Click(Sender: TObject); //Сохранить
begin
ListBox1.Items.SaveToFile('db\person_kl\' + Form_zavych.edit_kl + '.db');
Form_Zavych.ComboBox_kl_1(Sender);
end;
procedure TForm_person_kl.ListBox1Click(Sender: TObject);
begin
if ListBox1.ItemIndex >= 0 then
Edit1.Text:=ListBox1.Items[ListBox1.ItemIndex];
end;
end.
unit unit_report;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Menus, Math;
type
TDynStringArray = array of string;
TDynintArray_array = array of array of integer;
{ TForm_report }
TForm_report = class(TForm)
MainMenu1: TMainMenu;
Memo1: TMemo;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
SaveDialog1: TSaveDialog;
procedure FormClose(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure MenuItem2Click(Sender: TObject);
procedure MenuItem3Click(Sender: TObject);
procedure Search(Sender: TObject);
procedure big(Sender: TObject);
private
public
klass, person:String;
end;
var
Form_report: TForm_report;
files_arr: TDynStringArray;
marks_arr: TDynintArray_array;
implementation
{$R *.lfm}
{uses
unit_parents;}
{ TForm_report }
procedure TForm_report.FormShow(Sender: TObject); // при открытии
begin
Caption:='Отчет ученика: ' + person;
Form_report.Search(Sender); // Поиск всех файлов этого класса!
Form_report.Big(Sender); // Делаем отчет!
end;
procedure TForm_report.FormClose(Sender: TObject);
begin
memo1.Clear;
files_arr:=nil;
marks_arr:=nil;
//Form_parents.Show;
end;
procedure TForm_report.MenuItem2Click(Sender: TObject); //Сохранить как
begin
If Form_report.SaveDialog1.Execute then
Form_report.Memo1.Lines.SaveToFile(Form_report.SaveDialog1.FileName);
end;
procedure TForm_report.MenuItem3Click(Sender: TObject); // Выход
begin
close;
end;
procedure TForm_report.Search(Sender: TObject); // ПОИСК файлов и внесение данных в массив files_arr
var
FindFile: TSearchRec;
Path: String;
begin
Path:='db\jurnal\*_' + klass + '_?.db';
if FindFirst(Path, faAnyFile, FindFile)=0 then // ищем первый файл
begin
setlength(files_arr,Length(files_arr)+1);
files_arr[Length(files_arr)-1] := FindFile.Name;
while FindNext(FindFile)=0 do // ищем второй+ файл
begin
setlength(files_arr,Length(files_arr)+1);
files_arr[Length(files_arr)-1] := FindFile.Name;
end;
FindClose(FindFile); //Освобождаем память
end;
end;
procedure TForm_report.big(Sender: TObject);
var
i,j,sr,k:integer;
sr1:real;
s,m,m1,d:string;
f:textfile;
begin
if Length(files_arr)=0 then begin
memo1.Lines.add('У данного класса отсутствуют какие либо записи в журнале.');
exit;
end;
for i:=0 to Length(files_arr)-1 do
begin
AssignFile (f, 'db\jurnal\' + files_arr[i]);
Reset(f);
While not (EOF (f)) do begin
Readln (f, s);
if s = person then
begin
setlength(marks_arr,Length(marks_arr)+1,3);
Readln (f, s); //день
marks_arr[Length(marks_arr)-1,0] :=strtoint(s);
Readln (f, s); //месяц
marks_arr[Length(marks_arr)-1,1] :=strtoint(s);
Readln (f, s); //оценка
marks_arr[Length(marks_arr)-1,2] :=strtoint(s);
readln(f);
end;
end;
if Length(marks_arr)>0 then begin
s:= files_arr[i];
while pos('_',s)>0 do begin
memo1.Lines.add('Преподаватель:'+ copy(s,1,pos('_',s)-1));
delete(s,1,pos('_',s));
memo1.Lines.add('Предмет:'+ copy(s,1,pos('_',s)-1));
delete(s,1,pos('_',s));
memo1.Lines.add('Класс:'+ copy(s,1,pos('_',s)-1));
delete(s,1,pos('_',s));
memo1.Lines.add('Четверть:'+ copy(s,1,pos('.db',s)-1));
end;
memo1.Lines.add('|День|месяц|оценка|');
for j:=0 to Length(marks_arr)-1 do begin
case marks_arr[j,1] of
1: m := 'янв';
2: m := 'фев';
3: m := 'мар';
4: m := 'апр';
5: m := 'май';
6: m := 'июн';
7: m := 'июл';
8: m := 'авг';
9: m := 'сен';
10: m := 'окт';
11: m := 'ноя';
12: m := 'дек';
end;
case marks_arr[j,2] of
0: m1:='1';
1: m1:='2';
2: m1:='3';
3: m1:='4';
4: m1:='5';
5: m1:='6';
6: m1:='7';
7: m1:='8';
8: m1:='9';
9: m1:='10';
10: m1:='н';
11: m1:='*';
end;
d:= inttostr(marks_arr[j,0]);
memo1.Lines.add('| ' + d + ' | ' + m + ' | ' + m1 + ' |');
end;
sr:=0;
for k:=0 to Length(marks_arr)-1 do
if marks_arr[k,2] < 10 then
sr:= sr+ marks_arr[k,2]+1;
sr1:= SimpleRoundTo((sr/Length(marks_arr)),-2);
memo1.Lines.add('Средний балл: ' + FloatToStr(sr1) + ';');
memo1.Lines.add('');
memo1.Lines.add('');
marks_arr:=nil;
end;
end;
if Memo1.Lines.Count = 0 then begin
memo1.Lines.add('У данного ученика отсутствуют какие либо записи в журнале.');
end;
end;
end.