Материал: ПЗ
end; end;
n:=0;
m:=0;
s:=0;
end;
end;
end;
Загрузка тем и записей о занятиях аналог левой страницы журнала
procedure TForm_jurnal.update_tems(Sender: TObject);
begin
if FileExists('db\jurnal\' + teacher_j + '_' + predmet_j + '_' +
klass_j + '_' + quarter_j +'_tems.db') then
memo1.Lines.LoadFromFile('db\jurnal\' + teacher_j + '_' + predmet_j + '_' +
klass_j + '_' + quarter_j +'_tems.db');
end;
Рис 33 – Схема расчета среднего бала и добавления в таблицу
Кнопка сохранения всех данных из журнала в файл
procedure TForm_jurnal.Button5Click(Sender: TObject); // Сохранить данные Кнопка
var
f:Text;
i,j:integer;
begin
if (ComboBox2.ItemIndex<0) then begin
ShowMessage ('Нет данных для сохранения таблицы!') ;
Exit;
end;
assignfile(f,'db\jurnal\' + teacher_j + '_' + predmet_j + '_' +
klass_j + '_' + quarter_j +'.db');
Rewrite(f);
for i:=0 to Length(date_arr)-1 do
Write (f,inttostr(date_arr[i,0]) + ' ' + inttostr(date_arr[i,1]) + ' '); // заносим все даты в одну строчку!
WriteLn(f, ''); //Пропуск
WriteLn(f, '');
for j:=0 to Length(marks_arr)-1 do // Заносим все оценки
begin
WriteLn (f,persons_arr[marks_arr[j,0]+1]); // ФИО
WriteLn (f,inttostr(marks_arr[j,1])); // месяц
WriteLn (f,inttostr(marks_arr[j,2])); // день
WriteLn (f,inttostr(marks_arr[j,3])); // оценка
WriteLn(f, '');
end;
CloseFile(f);
memo1.Lines.SaveToFile('db\jurnal\' + teacher_j + '_' + predmet_j + '_' + // Сохраняем темы!!!
klass_j + '_' + quarter_j +'_tems.db');
end;
Рис 34 – Схема сохранения данных
Кнопка сохранения таблицы
Для сохранения таблицы в файл был выбран формат HTML как наиболее универсальный. В отличии от Формата excel таблицы для его сохранения нет необходимости обращаться к внутренним программам компьютера.
procedure TForm_jurnal.MenuItem2Click(Sender: TObject); // сохранить табл
var
s:string;
begin
If Form_jurnal.SaveDialog2.Execute then
s:= Form_jurnal.SaveDialog2.FileName;
Form_jurnal.StrGridToHTML(s, StringGrid1, Label12.caption); end;
procedure TForm_jurnal.StrGridToHTML(const FileName: string; StrGrid: TStringGrid; // Сохраняем таблицу в HTML
const Heading: string = '');
var
Txt: TextFile;
i, ii: integer;
BgColor, TxColor: string;
Begin // Convert TColor to HTML Hex Color
BgColor := 'FFFFFF';
TxColor := '000000'; // Create output file
AssignFile(Txt, FileName);
Rewrite(Txt); // HTML Header Info
WriteLn(Txt, '<HTML>');
WriteLn(Txt, '<HEAD>');
WriteLn(Txt, '<TITLE>' + ExtractFileName(FileName) + '</TITLE>');
WriteLn(Txt, '</HEAD>');
WriteLn(Txt);
WriteLn(Txt, '<BODY TEXT=#' + TxColor + ' BGCOLOR=#CCCCCC>');
WriteLn(Txt, '<H1>' + Heading + '</H1>');
WriteLn(Txt, '<TABLE WIDTH=100% CELLPADDING=2 CELLSPACING=2 ' +
'BGCOLOR=#' + BgColor + ' BORDER=1>'); // Column Descriptions
WriteLn(Txt, ' <TR>');
for i := 0 to StrGrid.ColCount - 1 do
WriteLn(Txt, ' <TH>' + StrGrid.Cells[i, 0] + '</TH>');
WriteLn(Txt, ' </TR>');// Write out the Grid Data
for i := 1 to StrGrid.RowCount - 1 do begin
WriteLn(Txt, ' <TR>');
for ii := 0 to StrGrid.ColCount - 1 do
WriteLn(Txt, ' <TD>' + StrGrid.Cells[ii, i] + '</TD>');
WriteLn(Txt, ' </TR>');
end; // Footer
WriteLn(Txt, '<TABLE>');
WriteLn(Txt, '<P>');
WriteLn(Txt, '</BODY>');
WriteLn(Txt, '</HTML>');
CloseFile(Txt);
end;
Рис 35 – Схема сохранения таблицы в файл HTML
Кнопка добавить дату занятия. Добавляет лишнюю колонку в SG и дату в формате День/Месяц.
procedure TForm_jurnal.Button2Click(Sender: TObject); //КНОПКА Добавить дату занятий
var
i,j,m,d:integer; begin
if (ComboBox4.ItemIndex < 0 ) then begin
ShowMessage ('Выберите месяц!');
Exit; end;
if (ComboBox5.ItemIndex < 0 ) then begin
ShowMessage ('Выберите день!');
Exit; end;
m:=ComboBox4.ItemIndex+1;
d:= strtoint(ComboBox5.Text);
for i:=0 to Length(date_arr)-1 do // Делаем -1 тк вылетает за пределы памяти
begin
if Length(date_arr)>0 then
if date_arr[i,0] = m then
if d = date_arr[i,1] then begin
ShowMessage ('Такая дата уже есть');
Exit;
end;
end;// else
begin
setlength(date_arr,Length(date_arr)+1,2);
date_arr[Length(date_arr)-1,0]:= m; //месяц
date_arr[Length(date_arr)-1,1]:= d; //день
for i:=0 to Length(date_arr)-1 do // Сортировка по месяцу
for j:=0 to Length(date_arr)-2 do
if date_arr[j,0]>date_arr[j+1,0] then
begin
m:= date_arr[j,0];
d:= date_arr[j,1];
date_arr[j,0]:= date_arr[j+1,0];
date_arr[j,1]:= date_arr[j+1,1];
date_arr[j+1,0]:=m;
date_arr[j+1,1]:=d;
end;
for i:=0 to Length(date_arr)-1 do // Сортировка по дню
for j:=0 to Length(date_arr)-2 do
if date_arr[j,0]=date_arr[j+1,0] then
if date_arr[j,1]>date_arr[j+1,1] then
begin
m:= date_arr[j,0];
d:= date_arr[j,1];
date_arr[j,0]:= date_arr[j+1,0];
date_arr[j,1]:= date_arr[j+1,1];
date_arr[j+1,0]:=m;
date_arr[j+1,1]:=d;
end;
Form_jurnal.ComboBox6_update (Sender);
Form_jurnal.ComboBox2_update (Sender);
Form_jurnal.Updategrid_2 (Sender);
Form_jurnal.Updategrid_marks (Sender);
end;
end;
Кнопка Добавить оценку организована по тому же алгоритму что описан выше.
Рис 36 – Схема добавления даты занятия
Кнопка Удаления даты где есть оценки:
procedure TForm_jurnal.Button3Click_2(Sender: TObject); // Удаление Оценок и даты !!!
var
i,j,k,n,n1:integer; begin
k:= ComboBox6.ItemIndex;
n:=0; n1:=0;
for i:=0 to Length(marks_arr)-1 do // Проверка есть ли на этой дате оценки
if marks_arr[i,1] = date_arr[k,0] then
if marks_arr[i,2] = date_arr[k,1] then inc(n); // считаем количество повторений
repeat
inc(n1);
for j:=0 to Length(marks_arr)-1 do // Находим дату
if marks_arr[j,1] = date_arr[k,0] then
if marks_arr[j,2] = date_arr[k,1] then
for i:=j+1 to Length(marks_arr)-1 do
begin
marks_arr[i-1,0] := marks_arr[i,0];
marks_arr[i-1,1] := marks_arr[i,1];
marks_arr[i-1,2] := marks_arr[i,2];
marks_arr[i-1,3] := marks_arr[i,3];
end;
SetLength(marks_arr, Length(marks_arr)-1, 4);
Form_jurnal.ComboBox7_update (Sender);
until n1=n;
for i:=k+1 to Length(date_arr)-1 do // удаление Даты
begin
date_arr[i-1,0] := date_arr[i,0];
date_arr[i-1,1] := date_arr[i,1];
end;
SetLength(date_arr, Length(date_arr)-1, 2);
Form_jurnal.ComboBox6_update (Sender);
Form_jurnal.ComboBox2_update (Sender);
Form_jurnal.Updategrid_2 (Sender);
Form_jurnal.Updategrid_marks (Sender);
end;
Рис 37 – Схема удаления даты и оценок в эту дату
Результат работы программы:
Рис 38 – Главная форма
Рис 39 – Форма Завуч
Рис 40 – Форма закрепить за учителем предмет
Рис 41 – Пример отчета ученика
Рис 42 – Форма учитель
Рис 43 – Форма родители
Рис 44 – Форма журнал (ограничение доступа)
Рис 45 – Форма журнал (полный доступ)
Список использованных источников:
Абрамов, В.Г.; Трифонов, Н.П. и др. Введение в язык Паскаль; Наука - , 1988. - 320 c.
Грогоно, П. Программирование на языке ПАСКАЛЬ; М.: Мир - Москва, 1982. - 384 c.
Павловская, Т.А. Паскаль. Программирование на языке высокого уровня; СПб: Питер - Москва, 2003. - 393 c.
Фаронов, В.В. Turbo Pascal 7.0. Учебное пособие; М.: Нолидж - Москва, 1997. - 566 c.
Листинг программы:
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, unit_main, unit_Zavych, unit_add_teacher, unit_edit_teacher,
unit_teacher_pr, unit_add_kl, unit_edit_kl, unit_person_kl, unit_jurnal,
unit_del_data, unit_danger, unit_teacher, unit_parents,
unit_report, unit_about, unit_tz
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Title:='Электронный журнал';
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TForm_Zavych, Form_Zavych);
Application.CreateForm(TForm_add_teacher, Form_add_teacher);
Application.CreateForm(TForm_edit_teacher, Form_edit_teacher);
Application.CreateForm(TForm_teacher_pr, Form_teacher_pr);
Application.CreateForm(TForm_add_kl, Form_add_kl);
Application.CreateForm(TForm_edit_kl, Form_edit_kl);
Application.CreateForm(TForm_person_kl, Form_person_kl);
Application.CreateForm(TForm_jurnal, Form_jurnal);
Application.CreateForm(TForm_del_data, Form_del_data);
Application.CreateForm(TForm_danger, Form_danger);
Application.CreateForm(TForm_teacher, Form_teacher);
Application.CreateForm(TForm_Parents, Form_Parents);
Application.CreateForm(TForm_report, Form_report);
Application.CreateForm(TForm_about, Form_about);
Application.CreateForm(TForm_TZ, Form_TZ);
Application.Run;
end.
unit unit_main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons,
Menus, ExtCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Button1: TButton;
Image1: TImage;
Label1: TLabel;
MainMenu1: TMainMenu;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure MenuItem3Click(Sender: TObject);
procedure MenuItem4Click(Sender: TObject);
procedure MenuItem5Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
uses
unit_Zavych, unit_teacher, unit_parents, unit_about, unit_tz ;
{$R *.lfm}
{ TForm1 }
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
form_zavych.showmodal;
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
Form_parents.Showmodal;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Form_teacher.Showmodal;
end;
procedure TForm1.FormCreate(Sender: TObject);// Создание каталога папок при включении программы!
begin
// Проверка наличия папки
if DirectoryExists('db') then
// Можно вывести сообщение
else
ForceDirectories(ExtractFilePath(Application.ExeName) + '/db/teach_pr');
CreateDir('db\person_kl');
CreateDir('db\jurnal');
end;
procedure TForm1.MenuItem3Click(Sender: TObject);
begin
Form_about.show;
end;
procedure TForm1.MenuItem4Click(Sender: TObject);
begin
Form_tz.Show;
end;
procedure TForm1.MenuItem5Click(Sender: TObject);
begin
close;
end;
end.
unit unit_Zavych;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
Buttons, Menus;
type
{ TForm_Zavych }
TForm_Zavych = class(TForm)
BitBtn2: TBitBtn;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button9: TButton;
ComboBox1: TComboBox;
ComboBox2: TComboBox;
ComboBox3: TComboBox;
ComboBox4: TComboBox;
ComboBox5: TComboBox;
ComboBox6: TComboBox;
Image1: TImage;
Label1: TLabel;
Label10: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
ListBox1: TListBox;
ListBox2: TListBox;
MainMenu1: TMainMenu;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
procedure BitBtn2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button5Click_1(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button6Click_1(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button7Click_1(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button8Click_1(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure ComboBox5Change(Sender: TObject);
procedure FormClose(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ListBox_teacher (Sender: TObject);
procedure ListBox_kl (Sender: TObject);
procedure ComboBox_teacher (Sender: TObject);
procedure ComboBox_kl (Sender: TObject);
procedure ComboBox_exercises (Sender: TObject);
procedure ComboBox_kl_1(Sender: TObject);
procedure MenuItem2Click(Sender: TObject);
procedure MenuItem3Click(Sender: TObject);
procedure MenuItem5Click(Sender: TObject);
private
public
edit_tchr, edit_kl, teacher_j, predmet_j, klass_j, quarter_j:String;
danger:integer;
end;
var
Form_Zavych: TForm_Zavych;
implementation
uses
unit_add_teacher, unit_edit_teacher, unit_teacher_pr, unit_add_kl, unit_edit_kl, unit_person_kl, unit_jurnal, unit_danger, unit_report, unit_about, unit_tz ;
{$R *.lfm}
{ TForm_Zavych }
procedure TForm_Zavych.Button1Click(Sender: TObject);
begin
// Добавить учителя
Form_add_teacher.showmodal;
end;
procedure TForm_Zavych.ComboBox_kl_1(Sender: TObject); // При открытии заносим в КОМБОБОКС классы !
var
tsr : tsearchrec;
s : string;
begin
ComboBox5.Clear;
if FindFirst('db\person_kl\' + '*.*',faAnyFile,tsr) = 0 then
repeat
s:= tsr.name;