83
frmStart.ADOBaseOsn.Open; Открываем базу.
end;
end;
end;
ПРОЦЕДУРА ВЫБОР МЕСЯЦА.
Эта процедура позволяет пользователю выбирать месяц обучения и
просматривать успеваемость. Изменение текущего месяца происходит с помощью
выпадающего списка (Combobox) и кнопок прокрутки.
procedure TfrmGlav.MesChange(Sender: TObject);
Потребуются следующие переменные:
n- текущий месяц
с - выбранный месяц
var
n,i:integer
begin;
c:=Mes.ItemIndex+1; В переменную c заносим значение индекса переменной
Mes и прибавляем 1.
Начинаем отображение столбцов через цикл.
for i:=3 to DBGrid1.Columns.Count-1 do
begin
n:=strtoint(copy(DBGrid1.Columns[i].FieldName,4,2)); Получаем в переменную n
имена столбцов (месяцы)
if n<>c then DBGrid1.Columns[i].Visible:=false Сравниваем две полученные
переменные, если условие выполняется то скрываем столбцы.
else
begin
DBGrid1.Columns[i].Visible:=True; Если не выполняется то отображаем.
DBGrid1.Columns[i].Title.Caption:=copy(DBGrid1.Columns[i].FieldName,1,2);
DBGrid1.Columns[i].Width:=20; Устанавливаем ширину столбцов.
end;
end;
end;
Переключение месяца клавишами.
На предыдущий.
Просто вычитаем из индекса месяца 1
procedure TfrmGlav.SpeedButton1Click(Sender: TObject);
begin
if Mes.ItemIndex<11 then
Mes.ItemIndex:=Mes.ItemIndex+1;
MesChange(Mes);
end;
На следующий.
84
Прибавляем 1
procedure TfrmGlav.SpeedButton2Click(Sender: TObject);
begin
if mes.ItemIndex>0 then
Mes.ItemIndex:=Mes.ItemIndex-1;
MesChange(Mes);
end;
ПРОЦЕДУРА ВВОД ОЦЕНКИ.
Позволяет вносить в базу оценки, предупреждая ошибки ввода.
procedure TfrmGlav.DBGrid1DblClick(Sender: TObject);
var
vvocenka,StrMessage:string; Введенная оценка
begin
При двойном клике по ячейке таблицы выдается окно ввода
if InputQuery('Ввод оценки', 'Введите оценку:', vvocenka) then
Если введенный текст не является цифрой от 1 до 5, появляется сообщение об
ошибке.
if (StrToInt(vvocenka) > 5) or (StrToInt(vvocenka)<0) then
begin
StrMessage:='Не правильно введена оценка';
MessageDlg( StrMessage, mterror, [mbOk], 0);
end
else
begin
85
ADOTable1.Edit; Разрешить редактирование базы
Если нет ошибки, то оценка записывается в базу
ADOTable1.FieldValues[copy(DBGrid1.Columns[DBGrid1.SelectedIndex].FieldNam
e,1,10)] := vvocenka;
Если оценка равна 0, то оценка удаляется
if vvocenka = '0' then
ADOTable1.FieldValues[copy(DBGrid1.Columns[DBGrid1.SelectedIndex].FieldName,1,10)]
:= null;
ADOTable1.Post; Происходит сохранение базы
end;
end;
ПРОЦЕДУРА ВСЕ ОЦЕНКИ.
Необходимо применять, когда необходимо отобразить все оценки одновременно.
procedure TfrmGlav.SpeedButton3Click(Sender: TObject);
var i:integer;
begin
for i:=3 to DBGrid1.Columns.Count-1 do
begin
DBGrid1.Columns[i].Visible:=true; Отображаем все столбцы.
DBGrid1.Columns[i].Width:=20; Устанавливаем ширину.
end;
end;
end.
ПРОЦЕДУРА ДОБАВЛЕНИЕ ГРУППЫ.
Выполняет добавление в базу таблицу новой группы.
procedure TfrmStud.SpeedButton2Click(Sender: TObject);
var
s - наименование новой группы.
s:string;
begin
if MessageBox(handle,'Вы действительно хотите добавить новую
группу?','...',MB_ICONQUESTION or MB_YESNO)=mrYes then
Выводится вопросительное сообщение.
86
begin
s:=InputBox('...','Введите номер группы:','');
Номер класса запоминается в переменной s.
if s<>'' then
frmStart.ADOTGroup.AppendRecord([nil,s]); Добавляется запись.
end;
end;
ПРОЦЕДУРА УДАЛЕНИЕ ГРУППЫ.
procedure TfrmStud.SpeedButton1Click(Sender: TObject);
begin
Выводится вопросительное сообщение.
if MessageBox(handle,PChar('Вы действительно хотите удалить группу
"'+grupp.text+'" ?'),'...',MB_ICONQUESTION or MB_YESNO)=mrYes then
begin
frmStart.ADOTGroup.Delete; Удаляется запись.
end;
end;
ПРОЦЕДУРА ДОБАВЛЕНИЕ, УДАЛЕНИЕ ЗАПИСИ.
procedure TfrmStud.SpeedButton4Click(Sender: TObject);
var
StrMessage:string;
begin
if Grupp.text = '' then
begin
87
StrMessage:='Не выбрана группа';
MessageDlg( StrMessage, mterror, [mbOk], 0);
end
else
begin
ADOStud.AppendRecord([nil,nil,Grupp.text,nil]); Добавляется запись
end;
end;
procedure TfrmStud.SpeedButton5Click(Sender: TObject);
begin
ADOStud.Delete();Удаляется запись
end;
ПРОЦЕДУРА ВЫБОР ОТКРЫВАЕМОЙ ТАБЛИЦЫ
procedure TfrmStart.BitBtn1Click(Sender: TObject);
var
_name:string;
st:TStrings;
i:integer;
tab1,tab2:boolean;
begin
if grup.Text='' then exit; Если группа не выбрана выйти
if Cmb_Predm.Text='' then exit; Если предмет не выбран выйти
tab1:=false;
tab2:=tab1;
frmGlav.ADOTable1.Close; Закрыть таблицу предмет
frmTema.ADOTema.Close; и тема занятий
Получим имя таблицы из таблицы «Предметы»
и добавим номер группы
_Name := ADOTPredm.Fields[2].AsString+
Grup.Text;
st := TStringList.Create; Создать класс массив строк получим список таблиц из
базы.
ADOBaseOsn.GetTableNames(st);
В цикле попытаемся найти нужные таблицы в базе
и если находим, то переходим на другую форму
for i:=0 to st.count-1 do
begin
if st[i]=_name then tab1:=true
else if st[i]='Тема занятия '+_name then tab2:=true;
Открываем эту таблицу
if (tab1) and (tab2) then
88
begin
frmGlav.ADOTable1.TableName := _name;
frmGlav.ADOTable1.Open;
frmTema.ADOTema.TableName := 'Тема занятия '+_name;
frmTema.ADOTema.Open;
st.Free;
frmGlav.Show;
frmStart.Hide;
exit;
end;
end;
ПРОЦЕДУРА ВЫВОД ТЕКУЩЕЙ ДАТЫ.
procedure TfrmStart.Timer1Timer(Sender: TObject);
begin
label4.Caption := 'Дата: '+DateToStr(Date)+#10#13+
'Время: '+TimeToStr(Time);
end;
ПРОЦЕДУРА ВЫВОД СООБЩЕНИЯ.
Выводится сообщение для пользователя в верхней части окна.
procedure TfrmTema.Timer1Timer(Sender: TObject);
Устанавливаются конечные параметры (точки финиша).
begin
if dx1<=80 then inc(dx1,2);
if dx2>=90 then dec(dx2,2);
if dx3<=80 then inc(dx3,2);
if (dx1>=80) and (dx2<=90) and (dx3>=80) then
begin
inc(n);
if n=100 then
begin
Устанавливаются начальные параметры (точки отсчета).
dx1:=-420;
dx2:=700;
dx3:=-420;
n:=0;
end;
end;
inc(col);
if col=50 then
begin
canvas.Font.Color := TColor(colors); Установки цвета(Красный)
col:=0;
end;
BitBlt(canvas.Handle,0,0,690,98,Image1.Canvas.Handle,0,0,SRCCOPY);
Установки на обновления компонента Image1.
Само сообщение.
89
TextOut(canvas.Handle,dx1, 8,'Уважемый пользователь ввиду ограниченных
возможностей баз данных ',64);
TextOut(canvas.Handle,dx2,28,'Microsoft Access, просим вводить дату через
нижнее подчеркивание.',65);
TextOut(canvas.Handle,dx3,48,'Надеемся Вас это не затруднит.',30);
end;
ПРОЦЕДУРЫ ДОБАВЛЕНИЕ, УДАЛЕНИЕ ТЕМЫ.
procedure TfrmTema.SpeedButton2Click(Sender: TObject);
begin
ADOTema.Append; Добавляем запись
end;
procedure TfrmTema.SpeedButton3Click(Sender: TObject);
begin
ADOTema.Delete; Удаляем запись.
end;
ПРОЦЕДУРА ДОБАВЛЕНИЕ НОВОГО ПРЕДМЕТА
procedure TFormSpisPredm.SpeedButton4Click(Sender: TObject);
Используемые переменные.
i - переменная цикла.
Istina – логическая переменная для провери существующих предметов.
StrMessage – содежит сообщение
CaptionStr – переменная в которой будет содержаться префикс.
var
StrMessage,CaptionStr:string;
i:integer;
istina : boolean;
begin
CaptionStr:='';Присваиваем пустое значение.
if not InputQuery('Префикс', 'Введите Префикс',CaptionStr) then exit;Сообщение о
просьбе ввести префикс. Он заносится в переменную CaptionStr
istina := false;
ADOTbPred.Prior;Устанавливаем курсор на первую запись.
for i:=1 to ADOTbPred.RecordCount do Запускаем цикл по проверке
существующих предметов.
begin
if CaptionStr = ADOTbPred.Fields.Fields[1].Text then istina := true;Сравниваем с
каждой записью таблицы.
ADOTbPred.Next; Следующая запись
end;
if istina = true then
90
begin
StrMessage:='Префикс уже используется';Если находим выводим сообщение.
MessageDlg( StrMessage, mterror, [mbOk], 0);
end
else
begin
ADOTbPred.Insert;
ADOTbPred.AppendRecord([nil,CaptionStr]);Иначе добавляем запись в талицу.
end;
end;
ПРОЦЕДУРА УДАЛЕНИЕ ПРЕДМЕТА.
procedure TFormSpisPredm.SpeedButton5Click(Sender: TObject);
begin
ADOTbPred.Delete(); Удаляем последнюю запись.
end;
FormTemp: Эта форма очень важна, благодаря которой происходит формирование
сводной ведомости.
Нам понадобятся глобальные переменные
SN,SE,SF: TStringList; Листы предметов без экзаменов и с экзаменами, полный
лист.
SNF,SEF,SFF: TStringList; Листы предметов без экзаменов и с экзаменами,
полный лист полное наименование.
И процедура procedure VivodVExcel;
Начинаем с процедуры выбор текущего семестра.
ПРОЦЕДУРА ВЫБОР ТЕКУЩЕГО СЕМЕСТРА.
procedure TFormTemp.CmbSemChange(Sender: TObject);
var
str:string; Содержит наименование текущего семестра.
index2 : integer; Переменная цикла
begin
SF.Clear;Очищаем переменные
SE.Clear; Очищаем переменные
SN.Clear; Очищаем переменные
SFF.Clear; Очищаем переменные
SEF.Clear; Очищаем переменные
SNF.Clear; Очищаем переменные
Заносим значение из комбобокса в переменную str.
str:=CmbSem.Text;
91
Фильтруем по группе
ADOTblPred.Filtered:=false;
ADOTblPred.Filter:='Группа='+QuotedStr(frmStart.Grup.Text);
ADOTblPred.Filtered:=true;
Открываем цикл по всем записям в таблице
ADOTblPred.First;
for index2:=1 to ADOTblPred.RecordCount do
begin
Заносим значение «Название_табл» в переменную SE (Это массив строк), а также
«Предметы » в переменную SEF и иначе те же данные заносятся в другие переменные
SN и SNF соответственно. Таким образом, мы получим два списка: в одном те предметы,
по которым есть экзамены, а в другом – те, по которым нет. Проходимся по всем
столбцам (Семестрам).
if str = '1 семестр' then
begin
if ADOTblPred.FieldValues['1семестр'] = '0' then
begin
SE.Add(ADOTblPred.FieldValues['Название_табл']);
SEF.Add(ADOTblPred.FieldValues['Предметы']);
end
else
begin
SN.Add(ADOTblPred.FieldValues['Название_табл']);
SNF.Add(ADOTblPred.FieldValues['Предметы']);
end
end;
if str = '2 семестр' then
begin
if ADOTblPred.FieldValues['2семестр'] = '0' then
begin
SE.Add(ADOTblPred.FieldValues['Название_табл']);
SEF.Add(ADOTblPred.FieldValues['Предметы']);
end
else
begin
SN.Add(ADOTblPred.FieldValues['Название_табл']);
SNF.Add(ADOTblPred.FieldValues['Предметы']);
end
end;
if str = '3 семестр' then
begin
if ADOTblPred.FieldValues['3семестр'] = '0' then
begin
SE.Add(ADOTblPred.FieldValues['Название_табл']);
SEF.Add(ADOTblPred.FieldValues['Предметы']);
end
else
begin
SN.Add(ADOTblPred.FieldValues['Название_табл']);
SNF.Add(ADOTblPred.FieldValues['Предметы']);
end
92
end;
if str = '4 семестр' then
begin
if ADOTblPred.FieldValues['4семестр'] = '0' then
begin
SE.Add(ADOTblPred.FieldValues['Название_табл']);
SEF.Add(ADOTblPred.FieldValues['Предметы']);
end
else
begin
SN.Add(ADOTblPred.FieldValues['Название_табл']);
SNF.Add(ADOTblPred.FieldValues['Предметы']);
end
end;
if str = '5 семестр' then
begin
if ADOTblPred.FieldValues['5семестр'] = '0' then
begin
SE.Add(ADOTblPred.FieldValues['Название_табл']);
SEF.Add(ADOTblPred.FieldValues['Предметы']);
end
else
begin
SN.Add(ADOTblPred.FieldValues['Название_табл']);
SNF.Add(ADOTblPred.FieldValues['Предметы']);
end
end;
if str = '6 семестр' then
begin
if ADOTblPred.FieldValues['6семестр'] = '0' then
begin
SE.Add(ADOTblPred.FieldValues['Название_табл']);
SEF.Add(ADOTblPred.FieldValues['Предметы']);
end
else
begin
SN.Add(ADOTblPred.FieldValues['Название_табл']);
SNF.Add(ADOTblPred.FieldValues['Предметы']);
end
end;
if str = '7 семестр' then
begin
if ADOTblPred.FieldValues['7семестр'] = '0' then
begin
SE.Add(ADOTblPred.FieldValues['Название_табл']);
SEF.Add(ADOTblPred.FieldValues['Предметы']);
end
else
begin
SN.Add(ADOTblPred.FieldValues['Название_табл']);