Приложение В – Исходный код программы

unit Unit1;

interface

uses

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

Dialogs, Grids, DBGrids, StdCtrls, DBCtrls, Menus, ExtCtrls, XPMan;

type

TForm1 = class(TForm)

DBGrid1: TDBGrid;

DBNavigator1: TDBNavigator;

Bevel1: TBevel;

XPManifest1: TXPManifest;

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

N9: TMenuItem;

N10: TMenuItem;

N11: TMenuItem;

ListBox1: TListBox;

Label1: TLabel;

Label2: TLabel;

procedure N3Click(Sender: TObject);

procedure N5Click(Sender: TObject);

procedure N6Click(Sender: TObject);

procedure N10Click(Sender: TObject);

procedure N9Click(Sender: TObject);

procedure N11Click(Sender: TObject);

procedure FormShow(Sender: TObject);

procedure ListBox1Click(Sender: TObject);

end;

var Form1: TForm1;

implementation

uses Unit2, Unit3, DB, Unit4, Unit5, Unit6, Unit7;

{$R *.dfm}

procedure TForm1.N3Click(Sender: TObject);

begin

if Form3.ShowModal = mrOK then begin

DBGrid1.DataSource.DataSet.Filtered := false;

DBGrid1.DataSource.DataSet.Filtered := true;

end;

end;

procedure TForm1.N5Click(Sender: TObject);

begin

Form4.ShowModal;

end;

procedure TForm1.N6Click(Sender: TObject);

begin

Form5.ShowModal;

end;

procedure TForm1.N10Click(Sender: TObject);

begin

Application.MessageBox('Программный модуль "Учет успеваемости '+ 'студентов". Разработан студентом группы АЛ-ДЛП-901 Алейниковым'+ 'Д.В.','О программе', MB_ICONINFORMATION);

end;

procedure TForm1.N9Click(Sender: TObject);

begin

Form6.ShowModal;

end;

procedure TForm1.N11Click(Sender: TObject);

begin

Form7.ShowModal;

end;

procedure TForm1.FormShow(Sender: TObject);

begin

DataModule2.tbStudent.Sort := 'ФИО';

with DataModule2.tbGruppa do begin

First;

while not eof do begin

ListBox1.Items.Add(FieldByName('НГ').AsString);

Next;

end;

end;

with DataModule2.qFirstDate do begin

Active := true;

First;

Unit2.Filter.fDate := Fields[0].AsDateTime;

Active := false;

end;

Filter.ldate := date();

ListBox1.ItemIndex := 0;

ListBox1Click(nil);

end;

procedure TForm1.ListBox1Click(Sender: TObject);

begin

Filter.Group := ListBox1.Items[ListBox1.ItemIndex];

DBGrid1.DataSource.DataSet.Filtered := false;

DBGrid1.DataSource.DataSet.Filtered := true;

end;

end.

 

unit Unit2;

interface

uses

SysUtils, Classes, DB, ADODB;

type

TDataModule2 = class(TDataModule)

dsUspev: TDataSource;

ADOConnection1: TADOConnection;

tbPredm: TADOTable;

tbGruppa: TADOTable;

tbStudent: TADOTable;

qFirstDate: TADOQuery;

dsStudent: TDataSource;

dsPredm: TDataSource;

qPrilDipl: TADOQuery;

qAvgMark: TADOQuery;

qVed: TADOQuery;

tbUspev: TADOQuery;

tbUspevDSDesigner: TIntegerField;

tbUspevDSDesigner2: TIntegerField;

tbUspevDSDesigner3: TDateTimeField;

tbUspevDSDesigner4: TIntegerField;

tbUspevDSDesigner5: TWideStringField;

tbUspevDSDesigner6: TWideStringField;

tbUspevStringField: TStringField;

tbUspevField: TStringField;

procedure DataModuleCreate(Sender: TObject);

procedure tbUspevFilterRecord(DataSet: TDataSet; var Accept: Boolean);

end;

TFilterRec = record

Group,

FIO,

Subject: String;

fDate,

lDate: TDateTime ;

end;

var DataModule2: TDataModule2;

Filter : TFilterRec;

implementation

{$R *.dfm}

procedure TDataModule2.DataModuleCreate(Sender: TObject);

begin

tbStudent.Sort := 'ФИО';

end;

procedure TDataModule2.tbUspevFilterRecord(DataSet: TDataSet;

var Accept: Boolean);

var

ns : string;

begin

Accept := true;

with Filter do begin

if Group <> '' then

Accept := Accept and (tbStudent.Lookup('НС', tbUspev.FieldByName('НС').AsString, 'НГ') = Group);

if FIO <> '' then

Accept := Accept and (tbUspev.FieldByName('НС').AsString =

tbStudent.Lookup('ФИО',FIO,'НС'));

if Subject <> '' then

Accept := Accept and (tbUspev.FieldByName('КП').AsString =

tbPredm.Lookup('НП',Subject,'КП'));

Accept := Accept and (tbUspev.FieldByName('ДАТАС').AsDateTime >= fDate);

Accept := Accept and (tbUspev.FieldByName('ДАТАС').AsDateTime <= lDate);

end;

end;

end.

 

unit Unit3;

interface

uses

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

Dialogs, StdCtrls, Buttons, ComCtrls;

type

TForm3 = class(TForm)

GroupBox1: TGroupBox;

Edit2: TEdit;

DateTimePicker1: TDateTimePicker;

Edit3: TEdit;

BitBtn1: TBitBtn;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

DateTimePicker2: TDateTimePicker;

Label5: TLabel;

Button1: TButton;

procedure BitBtn1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

FirstDate: TDateTime;

end;

 

var

Form3: TForm3;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm3.BitBtn1Click(Sender: TObject);

begin

with Filter do begin

FIO := Edit2.Text;

Subject := Edit3.Text;

fDate := DateTimePicker1.DateTime;

lDate := DateTimePicker2.DateTime;

end;

end;

procedure TForm3.FormCreate(Sender: TObject);

begin

with DataModule2.qFirstDate do begin

Active := true;

First;

FirstDate := Fields[0].AsDateTime;

Active := false;

end;

DateTimePicker1.DateTime := FirstDate;

DateTimePicker2.DateTime := date();

end;

procedure TForm3.Button1Click(Sender: TObject);

begin

edit2.Clear;

edit3.Clear;

DateTimePicker1.DateTime := FirstDate;

DateTimePicker2.DateTime := date();

end;

end.

 

unit Unit6;

interface

uses

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

Dialogs, StdCtrls, ComObj;

type

TForm6 = class(TForm)

Label1: TLabel;

Button1: TButton;

ComboBox1: TComboBox;

Label2: TLabel;

ComboBox2: TComboBox;

procedure FormShow(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure ComboBox2Select(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

procedure UpdateCombo;

end;

var

Form6: TForm6;

implementation

uses Unit2, DB, ADODB;

{$R *.dfm}

procedure TForm6.UpdateCombo;

begin

DataModule2.tbStudent.Filtered := false;

DataModule2.tbStudent.Filter := 'НГ = ' + ComboBox2.Text;

DataModule2.tbStudent.Filtered := true;

ComboBox1.Clear;

with DataModule2.tbStudent do begin

First;

while not (eof) do begin

ComboBox1.Items.Add(FieldByName('ФИО').AsString);

Next;

end;

end;

ComboBox1.ItemIndex := 0;

end;

procedure TForm6.FormShow(Sender: TObject);

begin

ComboBox2.Clear;

with DataModule2.tbGruppa do begin

First;

while not (eof) do begin

ComboBox2.Items.Add(FieldByName('НГ').AsString);

Next;

end;

end;

ComboBox2.ItemIndex := 0;

UpdateCombo;

end;

procedure TForm6.Button1Click(Sender: TObject);

var XL, Sheet: variant;

i: integer;

begin

XL := CreateOleObject('Excel.Application');

XL.WorkBooks.Add;

Sheet := XL.WorkBooks[1].WorkSheets[1];

Sheet.Columns[1].ColumnWidth := 10;

Sheet.Columns[2].ColumnWidth := 40;

Sheet.Columns[3].ColumnWidth := 40;

Sheet.Cells[3, 1] := 'Дисциплина';

Sheet.Cells[3, 2] := 'Количество часов';

Sheet.Cells[3, 3] := 'Оценка';

Sheet.Range['A1:C1'].Merge;

Sheet.Range['A1:C1'].Style.HorizontalAlignment := -4108;

Sheet.Range['A1:C1'].Font.Bold := true;

Sheet.Range['A1:C1'].Value := 'Приложение к диплому';

Sheet.Range['A2:C2'].Merge;

Sheet.Range['A2:C2'].Value := ComboBox1.Text;

with DataModule2.qPrilDipl do begin

Parameters.ParamByName('ФИО').Value := ComboBox1.Text;

Active := true;

First;

for i:= 4 to RecordCount+4-1 do begin

Sheet.Cells[i, 1] := Fields[0].AsString;

Sheet.Cells[i, 2] := Fields[1].AsString;

Sheet.Cells[i, 3] := inttostr(round(Fields[2].AsFloat));

Next;

end;

Active := false;

end;

XL.Visible := true;

end;

procedure TForm6.ComboBox2Select(Sender: TObject);

begin

UpdateCombo;

end;

procedure TForm6.FormClose(Sender: TObject; var Action: TCloseAction);

begin

DataModule2.tbStudent.Filtered := false;

end;

end.

 

unit Unit7;

interface

uses

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

Dialogs, StdCtrls, ComObj, ExcelXP;

type

TForm7 = class(TForm)

Label1: TLabel;

ComboBox1: TComboBox;

Button1: TButton;

procedure FormShow(Sender: TObject);

procedure Button1Click(Sender: TObject);

end;

var

Form7: TForm7;

implementation

uses Unit2, DB, ADODB;

{$R *.dfm}

procedure TForm7.FormShow(Sender: TObject);

begin

ComboBox1.Clear;

with DataModule2.tbGruppa do begin

First;

while not (eof) do begin

ComboBox1.Items.Add(FieldByName('НГ').AsString);

Next;

end;

end;

ComboBox1.ItemIndex := 0;

end;

procedure TForm7.Button1Click(Sender: TObject);

var XL, Sheet, x: variant;

i, j: integer;

a: array of integer;

begin

XL := CreateOleObject('Excel.Application');

XL.WorkBooks.Add;

 

Sheet := XL.WorkBooks[1].WorkSheets[1];

Sheet.Columns[1].ColumnWidth := 10;

Sheet.Columns[2].ColumnWidth := 40;

Sheet.Columns[3].ColumnWidth := 40;

Sheet.Cells[4, 1] := 'Фамилия';

Sheet.Columns[1].ColumnWidth := 33.43 ;

Sheet.Cells[3, 2] := 'дисциплины';

Sheet.Range['A1:C1'].Merge;

Sheet.Range['A1:C1'].Style.HorizontalAlignment := -4108;

Sheet.Range['A1:C1'].Font.Bold := true;

Sheet.Range['A1:C1'].Value := 'Ведомость успеваемости';

Sheet.Range['A2:C2'].Merge;

Sheet.Range['A2:C2'].Value := ComboBox1.Text;

i := 0;

with DataModule2.tbStudent do begin

Filter := 'НГ=' + ComboBox1.Text;

Filtered := true;

First;

SetLength(a, RecordCount);

while not eof do begin

Sheet.Cells[i+5, 1] := FieldByName('ФИО').AsString;

a[i] := FieldByName('НС').AsInteger;

inc(i);

Next;

end;

Filtered := false;

end;

i:=1;

with DataModule2.tbPredm do begin

First;

while not eof do begin

inc(i);

Sheet.Cells[4, i] := FieldByName('НП').AsString;

Sheet.Columns[i].ColumnWidth := 10.43 ;

with DataModule2.qVed do begin

Parameters.ParamByName('subject').Value :=

DataModule2.tbPredm.FieldByName('КП').Value;

Parameters.ParamByName('group').Value := ComboBox1.Text;

Active := true;

First;

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

x := Lookup('НC',a[j],'ОЦЕНКА');

if not(VarIsNull(x)) then

Sheet.Cells[j+5,i] := round(double(x))

else

Sheet.Cells[j+5,i] := '-';

end;

Active := false;

end;

Next;

end;

end;

inc(i);

Sheet.Cells[4, i] := 'Средний балл';

Sheet.Columns[i].ColumnWidth := 23.43 ;

for j:= 5 to length(a)+4 do begin

Sheet.cells[j,i].FormulaR1C1 := '=round(AVERAGE(RC[-5]:RC[-1]),1)';

end;

XL.Visible := true;

end;

end.