93
SNF.Add(ADOTblPred.FieldValues['Предметы']);
end
end;
if str = '8 семестр' then
begin
if ADOTblPred.FieldValues['8семестр'] = '0' then
begin
SE.Add(ADOTblPred.FieldValues['Название_табл']);
SEF.Add(ADOTblPred.FieldValues['Предметы']);
end
else
begin
SN.Add(ADOTblPred.FieldValues['Название_табл']);
SNF.Add(ADOTblPred.FieldValues['Предметы']);
end
end;
ADOTblPred.Next; // Следующая запись
end;
После завершения склеиваются листы так, чтобы экзаменационные предметы
оказались в конце.
for index2:=0 to SN.Count-1 do
begin
SF.Add(SN.Strings[index2]);
end;
for index2:=0 to SE.Count-1 do
begin
SF.Add(SE.Strings[index2]);
end;
for index2:=0 to SNF.Count-1 do
begin
SFF.Add(SNF.Strings[index2]);
end;
for index2:=0 to SEF.Count-1 do
begin
SFF.Add(SEF.Strings[index2]);
end;
end;
После завершения формирования списка вывода можно посылать данные в Excel
ПРОЦЕДУРА ВЫВОД ОТЧЕТА В EXCEL.
Procedure TFormTemp.VivodVExcel;
var
k,i, i2, i3, index:integer;
indexKPF:integer; Если есть КП то прибавляем это число.
S: TStringList;
tempfam, temppred: string;
94
XLApp,Sheet,Colum:Variant;
begin
indexKPF:=1; Еще не встретили КП
FormTemp.Hide;
Меняем имя формы.
frmGlav.Caption:=' Пожалуйста, подождите, идет обработка….';
Отступаем шесть строк сверху
k:=6;
frmGlav.ADOTable1.First;
Создаем массив строк для вывода.
S:=TStringList.Create;
for i:=1 to frmGlav.ADOTable1.RecordCount do
begin
S.Add(frmGlav.ADOTable1.FieldValues['Отчет']);
frmGlav.ADOTable1.Next; Следующая запись.
end;
XLApp:= CreateOleObject('Excel.Application');
Отключаем реакцию Excel на события, чтобы ускорить вывод информации.
XLApp.Application.EnableEvents := false;
Открываем книгу Excel находящуюся в каталоге ext
XLApp.Workbooks.Open(ExtractFilePath(Application.ExeName)+'ext\'+'Отчетt.xls')
;
Устанавливаем параметры вывода
XLApp.Workbooks[1].WorkSheets[1].Name:='Отчет';
Colum:=XLApp.Workbooks[1].WorkSheets['Отчет'].Columns;
Colum.Columns[1].ColumnWidth:=40;
Colum:=XLApp.Workbooks[1].WorkSheets['Отчет '].Rows;
Colum.Rows[1].Font.Color:=clBlue;
Colum.Rows[1].Font.Size:=14;
Colum.Rows[2].Font.Color:=clBlue;
Colum.Rows[2].Font.Size:=10;
Sheet:=XLApp.Workbooks[1].WorkSheets['Отчет'];
Пишем заглавие
Sheet.Cells[1,3]:='СВОДНАЯ ВЕДОМОСТЬ';
i3:=1+SF.Count;
XLApp.Range[XLApp.Cells[k-1, 1], XLApp.Cells[k-1, i3]].Borders.LineStyle:=1;
Заставляем работать прогресс бар.
frmWait.ProgressBar1.Min:=0;
frmWait.ProgressBar1.Max:=s.Count;
Начинаем заполнение листа фамилиями которые берутся из переменной s
for i2:=0 to s.Count-1 do
begin
tempfam:=s.Strings[i2];
memo2.Lines.Add(tempfam);
frmStart.ADOTPredm.First;
Sheet.Cells[i2+k,1]:=tempfam;
XLApp.Range[XLApp.Cells[k+i2, 1], XLApp.Cells[k+i2, i3]].Borders.LineStyle:=1;
95
frmWait.ProgressBar1.Position:=i2;
for i:=1 to SF.Count do
begin
Подпись столбца и его настройки
Sheet.Cells[k-1,1].HorizontalAlignment := xlCenter;
Sheet.Cells[k-1,1].VerticalAlignment := xlCenter;
Sheet.Cells[k-1,1].Font.Bold:=true;
Sheet.Cells[k-1,1].Font.Size:=10;
Sheet.Cells[k-1,1]:='Фамилия учащегося';
Настройки последующих столбцов
Sheet.Cells[k-1,i+1].HorizontalAlignment := xlCenter;
Sheet.Cells[k-1,i+1].VerticalAlignment := xlCenter;
Sheet.Cells[k-1,i+1].WrapText := True;
Sheet.Cells[k-1,i+1].Orientation := 90;
Sheet.Cells[k-1,i+1].Font.Bold:=true;
Sheet.Cells[k-1,i+1].Font.Size:=10;
Всталяем строки с предметами
Sheet.Cells[k-1,i+1]:=SFF.Strings[i-1];
temppred:=SF.Strings[i-1]+ frmStart.Grup.Text;
memo2.Lines.Add(temppred);
ADOTablePredTemp.TableName:=temppred;
ADOTablePredTemp.Active:=true;
ADOTablePredTemp.Filtered := False;
ADOTablePredTemp.Filter:=''+'Ôàìèëèÿ='+QuotedStr(tempfam);
ADOTablePredTemp.Filtered := True;
ADOTablePredTemp.GetFieldNames(FList);Получаем список полей
Добавляем
for index :=0 to FList.Count-1 do
begin
if (FList.Strings[index] = 'КП') and (i2=0) then
begin
indexKPF:=indexKPF+1;
end;
end;
Вставляем столбец для КП
for index :=0 to FList.Count-1 do
begin
if FList.Strings[index] = 'КП' then
begin
XLApp.Range [XLApp. Cells [k-1,1], XLApp. Cells[k1,
indexKPF+SF.Count]].Borders. LineStyle: = 1;
Sheet.Cells[k-1,indexKPF+SF.Count].HorizontalAlignment := xlCenter;
Sheet.Cells[k-1,indexKPF+SF.Count].VerticalAlignment := xlCenter;
Sheet.Cells[k-1,indexKPF+SF.Count].WrapText := True;
96
Sheet.Cells[k-1,indexKPF+SF.Count].Orientation := 90;
Sheet.Cells[k-1,indexKPF+SF.Count].Font.Bold:=true;
Sheet.Cells[k-1,indexKPF+SF.Count].Font.Size:=10;
Sheet.Cells[k-1,indexKPF+SF.Count]:='Курсовой проект по:
'+SFF.Strings[i-1];
end;
end;
Начинаем заполнение оценками
for index :=0 to FList.Count-1 do
begin
if FList.Strings[index] = 'КП' then
begin
XLApp.Range[XLApp.Cells[k+i2, 1], XLApp.Cells[k+i2, indexKPF+SF.Count]].
Borders.LineStyle:=1;
Sheet.Cells[i2+k,indexKPF+SF.Count]:=ADOTablePredTemp.FieldValues['КП'];
end;
end;
Sheet.Cells[i2+k,i+1]:=ADOTablePredTemp.FieldValues['Èòîã'];
ADOTablePredTemp.Filtered := False;
ADOTablePredTemp.Active:=false;
end;
end;
Закончили заполнение.
Описываем макрос по созданию среднего значения, необходим для организации
диаграммы.
Sheet:=XLApp.Workbooks[1].WorkSheets['Лист2'];
//i2 = 6
for i2:=0 to s.Count-1 do
begin
Sheet.Cells[i2+6,1]:='=Отчет!RC'; Копируем с листа «Отчет» фамилии
Sheet.Cells[i2+6,2]:='=AVERAGE(Отчет!RC:RC[9])'Получаем средние
значения
Sheet.Cells[i2+6,2].NumberFormat := '# ##0,00'; Устанавливаем формат ячейки.
end;
Показываем результаты.
frmWait.Hide;
XLApp.Visible:=true;
FormTemp.Close;
frmGlav.Caption:='Успеваемость';
end;
Очищаем переменные.
procedure TFormTemp.FormCreate(Sender: TObject);
begin
SE:=TStringList.Create;
SN:=TStringList.Create;
97
SF:=TStringList.Create;
SEF:=TStringList.Create;
SNF:=TStringList.Create;
SFF:=TStringList.Create;
FList:=TStringList.Create;
end;
Задержка перед началом вывода, а то форма подвисает.
procedure TFormTemp.SpeedButton3Click(Sender: TObject);
begin
frmWait.Show;
Timer1.Enabled:=true;
end;
procedure TFormTemp.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled:=false;
VivodVExcel;
end;
Конец
end.
frmYchPl. ПРОЦЕДУРА ЗАГРУЗКА ПЛАНА.
procedure TfrmYchPl.LoadPlan;
var
ListItem: TListItem;
index: integer;
begin
Добавляем в ListItem список предметов.
for index:=1 to ADOTbl.RecordCount do
begin
with LVPlan do
begin
ListItem := Items.Add;
ListItem.Caption := ADOTbl.FieldValues['Предметы'];
Устанавливаем отображение так, что бы если в базе стоит 0, то выдавалось
«Есть» а если -1 то пустая клетка.
if ADOTbl.FieldValues['1семестр'] = '0' then ListItem.SubItems.Add('Есть')
else ListItem.SubItems.Add(' ');
if ADOTbl.FieldValues[' 2семестр '] = '0' then ListItem.SubItems.Add(' Есть ')
else ListItem.SubItems.Add(' ');
if ADOTbl.FieldValues[' 3семестр '] = '0' then ListItem.SubItems.Add(' Есть ')
else ListItem.SubItems.Add(' ');
if ADOTbl.FieldValues[‘4семестр '] = '0' then ListItem.SubItems.Add(' Есть ')
else ListItem.SubItems.Add(' ');
if ADOTbl.FieldValues[' 5семестр '] = '0' then ListItem.SubItems.Add(' Есть ')
else ListItem.SubItems.Add(' ');
if ADOTbl.FieldValues[' 6семестр '] = '0' then ListItem.SubItems.Add(' Есть ')
else ListItem.SubItems.Add(' ');
if ADOTbl.FieldValues[' 7семестр '] = '0' then ListItem.SubItems.Add(' Есть ')
else ListItem.SubItems.Add(' ');
if ADOTbl.FieldValues['8 семестр '] = '0' then ListItem.SubItems.Add(' Есть ')
98
else ListItem.SubItems.Add(' ');
end;
ADOTbl.Next; Следующая запись
end;
end;
ПРОЦЕДУРА СОЗДАНИЕ ТАБЛИЦЫ.
procedure TfrmYchPl.CreateTable;
var
commandsql:string;
begin
Команда для создания таблицы
commandsql:='Create table' +' '+ 'new'+CmBGroup.Text;
with ADOQuery1 do begin
with SQL do begin
Clear;
Команды для создания полей
Add(commandsql);
Add('(');
Add('Предметы varchar(50),Название_табл varchar(50)');
Add(',Группа varchar(50)');
Add(',1семестр logical, 2 семестр logical');
Add(',3 семестр logical, 4 семестр logical');
Add(',5 семестр logical, 6 семестр logical');
Add(',7 семестр logical, 8 семестр logical');
Add(')');
end;
ADOQuery1.ExecSQL; Выполнение команд на SQL не смотря на ошибки
end;
end;
ПРОЦЕДУРА УДАЛЕНИЕ ТАБЛИЦЫ.
procedure TfrmYchPl.DeleteTable;
var
commandsql:string;
begin
Команда для удаления таблицы
commandsql:='DELETE FROM' +' '+ 'new'+CmBGroup.Text;
with ADOQuery1 do begin
with SQL do begin
Clear;
Add(commandsql);
end;
ADOQuery1.ExecSQL; Выполнение команд на SQL не смотря на ошибки
end;
end;
procedure TfrmYchPl.FormCreate(Sender: TObject);
var
99
i:integer;
begin
Получаем список таблиц в базе
STBases := TStringList.Create;
frmStart.ADOBaseOsn.GetTableNames(STBases, False);
for i:=1 to ADOTblGroup.RecordCount do
begin
Добавляем запись (Номер группы) в ComboBox
CmBGroup.Items.Add(ADOTblGroup.Fields.Fields[1].Text);
ADOTblGroup.Next; Следующая запись
end;
for i:=1 to ADOTblpred.RecordCount do
begin
Добавляем запись
LVPred.Items.Add.Caption:=ADOTblpred.Fields.Fields[0].Text;
ADOTblpred.Next; Следующая запись
end;
end;