unit Unit1;

interface

uses

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

Dialogs, Grids, StdCtrls, Buttons, Math, Spin, jpeg, ExtCtrls;

const

{Названия факультетов и их количество}

ASpecialnost: array [0.5] of string= ('050501 "Профессиональное обучение (информатика, вычислительная техника, и компьютерные технологии) ',

'050501 "Профессиональное обучение (дизайн)"',

'050706 "Психология и педагогика"',

'050708 "Педагогика и методика начального образования"',

'040101 "Социальная работа"',

'080507 "Менеджмент организации"');

APredmetName: array [0.5,0.2] of string= ( ('Математика','Русский язык','Информатика'),

('Математика','Русский язык','Физика'),

('Математика','Русский язык','Биология'),

('Математика','Русский язык','Обществознание'),

('Русский язык','История','Обществознание'),

('Математика','Русский язык','Обществознание'));

AObrazovanie: array [0.2] of string= ('Неполное среднее (9 классов) ','Полное среднее (11 классов) ','Средне специальное (ПТУ, Техникум) ');

type

TAbiturientRecord=record {Задаем тип хранимых данных в файле: Фамилия, Имя, Отчество, Пол, Дата рождения, Специальность, Оценка 1, Оценка 2, Оценка 3. }

AName: string [30];

AFamilia: string [30];

AOtchestvo: string [30];

ASex: Byte;

ABirsday: TDate;

ASpecialnost: Byte;

AScore1: Byte;

AScore2: Byte;

AScore3: Byte;

AScoreEGE1: Byte;

AScoreEGE2: Byte;

AScoreEGE3: Byte;

AAdres: string [100];

ATelefon: string [30];

AAttestat: Byte;

end;

TForm1 = class (TForm)

StringGrid1: TStringGrid;

btn1: TBitBtn;

btn2: TBitBtn;

btn5: TBitBtn;

cbb1: TComboBox;

lbl1: TLabel;

lbl2: TLabel;

BitBtn1: TBitBtn;

lbl3: TLabel;

Label1: TLabel;

SpinEdit3: TSpinEdit;

SpinEdit1: TSpinEdit;

bvl1: TBevel;

img1: TImage;

procedure btn5Click (Sender: TObject);

procedure FormCreate (Sender: TObject);

procedure cbb1Change (Sender: TObject);

procedure btn1Click (Sender: TObject);

procedure btn2Click (Sender: TObject);

procedure StringGrid1MouseDown (Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure BitBtn1Click (Sender: TObject);

procedure StringGrid1DrawCell (Sender: TObject; ACol, ARow: Integer;

ARect: TRect; State: TGridDrawState);

procedure SpinEdit1Change (Sender: TObject);

procedure SpinEdit3Change (Sender: TObject);

private

{ Private declarations }

public

procedure SortTable; {сортировка данных по сумме баллов}

procedure RefreshTable; {обновление данных в таблице}

{ Public declarations }

end;

var

Form1: TForm1;

F: file of TAbiturientRecord; {Глобальная файловая переменная, для работы с базой данных абитуриентов}

FRecord: TAbiturientRecord; {Глобальная переменная, которая хранит текущую запись из списка абитуриентов}

FFileName: String; {Глобальная переменная, содержит путь к файлу и его имя}

FilePosition: Integer; {Глобальная переменная, содержит индекс записи}

FTableRecords: array of TAbiturientRecord; {Массив в котором будет храниться все записи нашей базы данных абитуриентов для быстрой обработки хи программой}

FRecordIndexs: array of Integer; {Массив в котором будет храниться порядковый номер записи в файле}

FTempIndexs: array of TPoint; {Массив в котором будет храниться порядковый номер записей отображаемых в таблице}

FEdit: Boolean; {Флаг (переменная) отвечающий за редактирование либо новвый ввод записи в базу данных об абитуриентах}

SelectROW: Integer; {переменная в которой будет храниться выделенный индекс строки таблицы}

implementation

uses Unit2, Unit3;

{$R *. dfm}

procedure TForm1. SortTable; {Сортировка данных по Сумме баллов методом пузырька, абитуриенты с наиболее высокой суммой постепенно перемещаются в начало таблицы}

var i,TempIndex: Integer;

a: Boolean;

Temp: TAbiturientRecord;

begin

if Length (FTableRecords) >1 then

begin

a: =True;

while a do

begin

a: =False;

for i: =0 to Length (FTableRecords) - 2 do

if (FTableRecords [i]. AScore1+FTableRecords [i]. AScore2+FTableRecords [i]. AScore3) < (FTableRecords [i+1]. AScore1+FTableRecords [i+1]. AScore2+FTableRecords [i+1]. AScore3) then

begin

Temp: =FTableRecords [i];

FTableRecords [i]: =FTableRecords [i+1];

FTableRecords [i+1]: =Temp;

TempIndex: =FRecordIndexs [i];

FRecordIndexs [i]: =FRecordIndexs [i+1];

FRecordIndexs [i+1]: =TempIndex;

a: =True;

end;

end;

end;

end;

procedure TForm1. RefreshTable; {Обновление информации в таблице абитуриентов, прописываем название столбцов в таблице и заполняем строки с учётом выбранного факультета}

var i,a,b,c: Integer;

begin

btn2. Enabled: =FEdit;

SortTable;

SetLength (FTempIndexs,0);

StringGrid1. Cells [0,0]: ='№ п/п';

StringGrid1. Cells [1,0]: ='Фио абитуриента';

StringGrid1. Cells [2,0]: ='Пол';

StringGrid1. Cells [3,0]: ='Дата рождения';

StringGrid1. Cells [4,0]: ='Специальность (факультет) ';

StringGrid1. Cells [5,0]: =APredmetName [cbb1. ItemIndex,0];

StringGrid1. Cells [6,0]: =APredmetName [cbb1. ItemIndex,1];

StringGrid1. Cells [7,0]: =APredmetName [cbb1. ItemIndex,2];

StringGrid1. Cells [8,0]: ='Сумма балов';

StringGrid1. Cells [9,0]: ='ЕГЭ '+APredmetName [cbb1. ItemIndex,0];

StringGrid1. Cells [10,0]: ='ЕГЭ '+APredmetName [cbb1. ItemIndex,1];

StringGrid1. Cells [11,0]: ='ЕГЭ '+APredmetName [cbb1. ItemIndex,2];

StringGrid1. Cells [12,0]: ='Телефон';

StringGrid1. Cells [13,0]: ='Домашний адрес';

StringGrid1. Cells [14,0]: ='Имеющееся образование';

a: =0;

c: =0;

if Length (FTableRecords) >0 then

for i: =0 to Length (FTableRecords) - 1 do

if FTableRecords [i]. ASpecialnost=cbb1. ItemIndex then

begin

inc (a);

StringGrid1. Cells [0,a]: =IntToStr (a) +'. ';

StringGrid1. Cells [1,a]: =FTableRecords [i]. AName+' '+FTableRecords [i]. AFamilia+' '+FTableRecords [i]. AOtchestvo;

if FTableRecords [i]. ASex=0 then StringGrid1. Cells [2,a]: ='М' else StringGrid1. Cells [2,a]: ='Ж';

StringGrid1. Cells [3,a]: =DateToStr (FTableRecords [i]. ABirsday);

StringGrid1. Cells [4,a]: =ASpecialnost [FTableRecords [i]. ASpecialnost];

StringGrid1. Cells [5,a]: =IntToStr (FTableRecords [i]. AScore1);

StringGrid1. Cells [6,a]: =IntToStr (FTableRecords [i]. AScore2);

StringGrid1. Cells [7,a]: =IntToStr (FTableRecords [i]. AScore3);

StringGrid1. Cells [8,a]: =FloatToStr (FTableRecords [i]. AScore1+FTableRecords [i]. AScore2+FTableRecords [i]. AScore3);

StringGrid1. Cells [9,a]: =IntToStr (FTableRecords [i]. AScoreEGE1);

StringGrid1. Cells [10,a]: =IntToStr (FTableRecords [i]. AScoreEGE2);

StringGrid1. Cells [11,a]: =IntToStr (FTableRecords [i]. AScoreEGE3);

StringGrid1. Cells [12,a]: =FTableRecords [i]. ATelefon;

StringGrid1. Cells [13,a]: =FTableRecords [i]. AAdres;

StringGrid1. Cells [14,a]: =AObrazovanie [FTableRecords [i]. AAttestat];

if ( (FTableRecords [i]. AScore1+FTableRecords [i]. AScore2+FTableRecords [i]. AScore3) >=SpinEdit3. Value) and ( (FTableRecords [i]. AScoreEGE1+FTableRecords [i]. AScoreEGE2+FTableRecords [i]. AScoreEGE3) >=SpinEdit1. Value) then

b: =1 else b: =0;

if b=1 then inc (c);

SetLength (FTempIndexs,a);

FTempIndexs [a-1]: =Point (i,b);

end;

if a=0 then

begin

StringGrid1. RowCount: =2;

for i: =0 to StringGrid1. ColCount-1 do StringGrid1. Cells [i,1]: ='';

end else StringGrid1. RowCount: =a+1;

lbl2. Caption: ='Всего абитуриентов поступающих на выбранный факультет: '+Inttostr (a) +' из них прошли на бюджет: '+Inttostr (c);

end;

procedure TForm1. btn5Click (Sender: TObject);

begin

Close; {Закрываем приложение}

end;

procedure TForm1. FormCreate (Sender: TObject); {Действия при создании формы}

var i: Integer;

begin

form3: =Tform3. Create (Self); {Создаем и отображаем титульный экран с названием курсовой работы}

Form3. Showmodal;

Form3. Free;

{устанавливаем значения глобальным переменным}

FFileName: ='AbiturientsBase. dat';

AssignFile (F,FFileName);

FilePosition: =-1;

FEdit: =False;

SelectROW: =-1;

if not FileExists (FFileName) then {Проверяем существование файла с базой данных}

begin

{Выводим предупреждение и создаем чистую базу}

Showmessage ('Файла с базой данных абитуриентов не существует, Будет создана чистая база');

try

Rewrite (F,FFileName);

except

CloseFile (F);

Halt; {В случае ошибки создания закрываем файл и прекращаем работу программы}

end;

end else Reset (F);

SetLength (FTableRecords,FileSize (F)); {Создание Массива который будет хранить все записи об абитуриентах}

SetLength (FRecordIndexs,FileSize (F)); {Создание Массива который будет порядковый номер записи в файле об абитуриентах}

if Length (FTableRecords) >0 then {Заполнение массива данными из файла с базой данных}

begin

for i: =0 to Length (FTableRecords) - 1 do

begin

Seek (F, i);

read (F,FTableRecords [i]);

FRecordIndexs [i]: =i;

end;

end;

CloseFile (F);

for i: =0 to 5 do cbb1. Items. Add (ASpecialnost [i]); {Заполняем список факультетов}

cbb1. ItemIndex: =0; {выбираем первый факультет из списка}

RefreshTable; {Заполняем таблицу}

end;

procedure TForm1. cbb1Change (Sender: TObject);

begin

RefreshTable; {Обновляем таблицу с учетом вновь выбранного факультета}

end;

procedure TForm1. btn1Click (Sender: TObject);

begin

FEdit: =False; {Меняем атрибут редактирования записи в состояние Неактивен, т. к мы будем обавлять новую запись, а не редактировать старую}

Form2: =TForm2. Create (Self); {Создаем форму для добавления новой записи}

form2. Showmodal; {показываем форму}

Form2. Free; {уничтожаем после её закрытия}

RefreshTable; {Обновляем таблицу с абитуриентами}

end;

procedure TForm1. btn2Click (Sender: TObject);

begin

if FilePosition<>-1 then {если индекс редактируемой записи существует, то меняем атрибут редактирования на активно и создаем форму редактирования и показываем её,

а потом уничтожаем и обновляем таблицу абитуриентов}

begin

FEdit: =True;

Form2: =TForm2. Create (Self);

form2. Showmodal;

Form2. Free;

RefreshTable;

end;

FilePosition: =-1;

FEdit: =False;

end;

procedure TForm1. StringGrid1MouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var a,b: Integer;

begin

SelectROW: =-1;

StringGrid1. MouseToCell (X,Y,A,B);

if (B>0) and (Length (FTempIndexs) >B-1) then {получаем индекс строки в таблице, если он существует, то присваеваем его глобальной переменной FilePosition, делаем доступной кнопку редактировать}

begin

FilePosition: =FTempIndexs [B-1]. X;

btn2. Enabled: =True;

SelectROW: =B;

end else btn2. Enabled: =False;

StringGrid1. Repaint;

end;

procedure TForm1. BitBtn1Click (Sender: TObject);

begin

if FileExists (FFileName) then {Проверяем существование файла с базой данных}

begin

Erase (f); {удаляем файл, потом создаем новый, закрываем файл и запускаем процедуру FormCreate (Self), которая происходит при запуске программы, чтобы обновить все переменные и тд}

Rewrite (f);

CloseFile (f);

FormCreate (Self);

ShowMessage ('База абитуриентов очищена! '); {выводим сообщение, что база очищена }

end;

end;

procedure TForm1. StringGrid1DrawCell (Sender: TObject; ACol, ARow: Integer; ARect: TRect; State: TGridDrawState); {отрисовываем таблицу вручную, чтобы}

begin

case ARow of {в зависимости от номера строки выбираем нужный нам цвет, серый, белый}

0: StringGrid1. Canvas. Brush. Color: =clBtnFace;

else StringGrid1. Canvas. Brush. Color: =clWhite;

end;

if (Length (FTempIndexs) >=ARow) and (ARow>0) then {отрисовываем поступивших на Бюджет, зеленым}

if FTempIndexs [ARow-1]. Y=1 then StringGrid1. Canvas. Brush. Color: =$0000BF00;

if (ARow=SelectROW) and (SelectROW>0) then StringGrid1. Canvas. Brush. Color: =$00FFCCCC;

StringGrid1. Canvas. FillRect (Arect); {закрашиваем ячейку таблицы в ранее определенный цвет}

if (Acol=0) or (Acol=1) or (Acol=4) or (Acol=13) or (Acol=14) then {выводим текст в таблицу, в зависимости от столбца либо по центру либо слева на право}

StringGrid1. Canvas. TextOut (ARect. Left+1,ARect. Top+ ( ( (ARect. Bottom-ARect. Top) - StringGrid1. Canvas. TextHeight (StringGrid1. Cells [Acol,ARow])) div 2),StringGrid1. Cells [Acol,ARow]) else

StringGrid1. Canvas. TextOut (ARect. Left+ ( ( (ARect. Right-ARect. Left) - StringGrid1. Canvas. TextWidth (StringGrid1. Cells [Acol,ARow])) div 2),ARect. Top+ ( ( (ARect. Bottom-ARect. Top) - StringGrid1. Canvas. TextHeight (StringGrid1. Cells [Acol,ARow])) div 2),StringGrid1. Cells [Acol,ARow]);

if Arow=0 then StringGrid1. Canvas. Brush. Color: =clblack

else StringGrid1. Canvas. Brush. Color: =clGray;

StringGrid1. Canvas. FrameRect (Rect (ARect. Left-1,ARect. Top-1,ARect. Right+1,ARect. Bottom+1)); {очерчиваем прямоугольник, каждой ячейки}

end;

procedure TForm1. SpinEdit1Change (Sender: TObject);

begin

if SpinEdit1. Text<>'' then

RefreshTable; {Обновляем таблицу с учетом проходного бала по ЕГЭ}

end;

procedure TForm1. SpinEdit3Change (Sender: TObject);

begin

if SpinEdit3. Text<>'' then

RefreshTable; {Обновляем таблицу с учетом проходного бала по внутренним экзаменам}

end;

end.

unit Unit2;

interface

uses

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

Dialogs, StdCtrls, Buttons, ExtCtrls, Spin, ComCtrls;

type

TForm2 = class (TForm)

btn5: TBitBtn;

btn1: TBitBtn;

btn2: TBitBtn;

pgc1: TPageControl;

ts1: TTabSheet;

ts2: TTabSheet;

ts3: TTabSheet;

lbl1: TLabel;

lbl2: TLabel;

bvl2: TBevel;

bvl3: TBevel;

LabeledEdit1: TLabeledEdit;

LabeledEdit2: TLabeledEdit;

LabeledEdit3: TLabeledEdit;

dtp1: TDateTimePicker;

cbb1: TComboBox;

lbl3: TLabel;

Label2: TLabel;

Label3: TLabel;

se1: TSpinEdit;

SpinEdit1: TSpinEdit;

SpinEdit2: TSpinEdit;

bvl1: TBevel;

Label4: TLabel;

Label5: TLabel;

Label6: TLabel;

SpinEdit3: TSpinEdit;

SpinEdit4: TSpinEdit;

SpinEdit5: TSpinEdit;

Bevel1: TBevel;

Label1: TLabel;

ComboBox1: TComboBox;

LabeledEdit4: TLabeledEdit;

LabeledEdit5: TLabeledEdit;

Bevel2: TBevel;

ComboBox2: TComboBox;

Label7: TLabel;

Bevel3: TBevel;

procedure btn5Click (Sender: TObject);

procedure FormCreate (Sender: TObject);

procedure btn2Click (Sender: TObject);

procedure btn1Click (Sender: TObject);

private

procedure LoadRecord;

{ Private declarations }

public

{ Public declarations }

end;

var

Form2: TForm2;

implementation

uses

Unit1;

{$R *. dfm}

procedure TForm2. LoadRecord; {Отображение в визуальные компоненты редактируемой записи}

begin

FRecord: =FTableRecords [FilePosition];

LabeledEdit1. Text: =FRecord. AName;

LabeledEdit2. Text: =FRecord. AFamilia;

LabeledEdit3. Text: =FRecord. AOtchestvo;

dtp1. DateTime: =FRecord. ABirsday;

ComboBox1. ItemIndex: =FRecord. ASpecialnost;

cbb1. ItemIndex: =FRecord. ASex;

se1. Value: =FRecord. AScore1;

SpinEdit1. Value: =FRecord. AScore2;

SpinEdit2. Value: =FRecord. AScore3;

SpinEdit3. Value: =FRecord. AScoreEGE1;

SpinEdit4. Value: =FRecord. AScoreEGE2;

SpinEdit5. Value: =FRecord. AScoreEGE3;

LabeledEdit4. Text: =FRecord. AAdres;

LabeledEdit5. Text: =FRecord. ATelefon;

ComboBox2. ItemIndex: =FRecord. AAttestat;

end;

procedure TForm2. btn5Click (Sender: TObject);

begin

Form2. Close; {закрыть форму}

end;

procedure TForm2. FormCreate (Sender: TObject); {действия при создании формы}

var i: Integer;

begin

for i: =0 to 5 do ComboBox1. Items. Add (ASpecialnost [i]); {Заполняем список факультетов}

ComboBox1. ItemIndex: =0;

Label3. Caption: =APredmetName [cbb1. ItemIndex,0] +' письменно';

Label2. Caption: =APredmetName [cbb1. ItemIndex,1] +' письменно';

lbl3. Caption: =APredmetName [cbb1. ItemIndex,2] +' письменно';

Label4. Caption: ='Оценка ЕГЭ ('+APredmetName [cbb1. ItemIndex,0] +') ';

Label5. Caption: ='Оценка ЕГЭ ('+APredmetName [cbb1. ItemIndex,1] +') ';

Label6. Caption: ='Оценка ЕГЭ ('+APredmetName [cbb1. ItemIndex,2] +') ';

if FEdit then LoadRecord else btn2Click (nil); {если редактируем запись, то отображаем редактируемые данные в визуалььные компоненты,

если просто добавляем нового абитуриента, то очищаем компоненты и готовимся к вводу данных}

end;

procedure TForm2. btn2Click (Sender: TObject); {очищаем визуальные компоненты от введённых данных}

begin

LabeledEdit1. Text: ='';

LabeledEdit2. Text: ='';

LabeledEdit3. Text: ='';

dtp1. DateTime: =Date;

ComboBox1. ItemIndex: =0;

cbb1. ItemIndex: =0;

se1. Value: =0;

SpinEdit1. Value: =0;

SpinEdit2. Value: =0;

SpinEdit3. Value: =0;

SpinEdit4. Value: =0;

SpinEdit5. Value: =0;

LabeledEdit4. Text: ='';

LabeledEdit5. Text: ='';

ComboBox2. ItemIndex: =0;

end;

procedure TForm2. btn1Click (Sender: TObject);

begin

{Заполняем временную переменную введенными данными из компонентов}

FRecord. AName: =LabeledEdit1. Text;

FRecord. AFamilia: =LabeledEdit2. Text;

FRecord. AOtchestvo: =LabeledEdit3. Text;

FRecord. ABirsday: =dtp1. DateTime;

FRecord. ASpecialnost: =ComboBox1. ItemIndex;

FRecord. ASex: =cbb1. ItemIndex;

FRecord. AScore1: =se1. Value;

FRecord. AScore2: =SpinEdit1. Value;

FRecord. AScore3: =SpinEdit2. Value;

FRecord. AScoreEGE1: =SpinEdit3. Value;

FRecord. AScoreEGE2: =SpinEdit4. Value;

FRecord. AScoreEGE3: =SpinEdit5. Value;

FRecord. AAdres: =LabeledEdit4. Text;

FRecord. ATelefon: =LabeledEdit5. Text;

FRecord. AAttestat: =ComboBox2. ItemIndex;

if Fedit then {если Атрибут редактирования активен то записываем данные в файл с учетом ранее запомненного индекса из таблицы абитуриентов}

begin

Reset (F);

Seek (F,FRecordIndexs [FilePosition]);

Write (F,FRecord);

CloseFile (F);

FTableRecords [FilePosition]: =FRecord;

ShowMessage ('Изменения записаны! ');

Exit; {прерываем процедуру, т. к при редактироании записи остальное не имеет смысла}

end;

{если создаем новую запись, добавляем абитуриента, то расширяем массив данных в памяти и запоминаем его индекс}

SetLength (FTableRecords,Length (FTableRecords) +1);

FTableRecords [Length (FTableRecords) - 1]: =FRecord;

SetLength (FRecordIndexs,Length (FRecordIndexs) +1);

FRecordIndexs [Length (FTableRecords) - 1]: =Length (FTableRecords) - 1;

if FileExists (FFileName) then {Проверяем существование файла с базой данных, если существует, то записываем данные в конец файла}

begin

Reset (F);

Seek (F,FileSize (f));

Write (F,FRecord);

CloseFile (F);

end else

begin

ShowMessage ('Файл с базой данных не найден, запись не произведена! '); {если база с абитуриентами не найдена, то просто выходим и оповещаем пользователя}

Exit;

end;

btn2Click (nil); {очищаем компоненты для нового ввода данных}

end;

end.

unit Unit3;

interface

uses

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

Dialogs, StdCtrls, Buttons, jpeg, ExtCtrls;

type

TForm3 = class (TForm)

btn1: TBitBtn;

lbl1: TLabel;

lbl2: TLabel;

lbl3: TLabel;

lbl5: TLabel;

lbl6: TLabel;

img1: TImage;

procedure btn1Click (Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form3: TForm3;

implementation

uses Unit1;

{$R *. dfm}

procedure TForm3. btn1Click (Sender: TObject);

begin

Close;

end;

end.

Размещено на Allbest.ru