unit Unit1;

interface

uses

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

Dialogs, StdCtrls, ComCtrls, Menus, Grids, TabNotBk, XPMan, ExtCtrls;

type

TType = (TypeString, TypeInteger);

TStringGridX = class (TStringGrid)

public

procedure MoveRow (FromIndex, ToIndex: Longint);

end;

TStudent = record

ID: integer;

FSTU: string [20];

NUMBER: integer;

YCHASTIE: boolean;

end;

TResults= record

ID: integer;

NAME: string [20];

RESULT: string [3];

end;

TMark = record

ID: integer;

StudentID: integer;

ResultsID: integer;

Mark: integer;

end;

TForm1 = class (TForm)

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

Panel1: TPanel;

GroupBox1: TGroupBox;

Button15: TButton;

Button14: TButton;

Button1: TButton;

RadioGroup1: TRadioGroup;

TabbedNotebook1: TTabbedNotebook;

StringGrid1: TStringGrid;

StringGrid2: TStringGrid;

StringGrid3: TStringGrid;

GroupBox2: TGroupBox;

Button3: TButton;

Button2: TButton;

StringGrid4: TStringGrid;

RadioGroup2: TRadioGroup;

GroupBox3: TGroupBox;

Button4: TButton;

XPManifest1: TXPManifest;

procedure Button4Click (Sender: TObject);

procedure N3Click (Sender: TObject);

procedure FormCreate (Sender: TObject);

procedure N2Click (Sender: TObject);

procedure N5Click (Sender: TObject);

procedure Button15Click (Sender: TObject);

procedure Button14Click (Sender: TObject);

procedure Button1Click (Sender: TObject);

procedure StringGrid1MouseUp (Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure StringGrid2MouseUp (Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure StringGrid3MouseUp (Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure Button3Click (Sender: TObject);

procedure StringGrid4MouseUp (Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure Button2Click (Sender: TObject);

private

function BinaryFind (aStart: integer; aVal: string; aCol: integer;

Tabl: TStringGrid): integer;

procedure SortDelayString (tabl: TStringGrid; aCol: integer; SorType: TType);

{ Private declarations }

public

procedure SortString (tabl: TStringGrid; aCol: integer; SorType: TType);

end;

var

Form1: TForm1;

StudentFile: file of TStudent;

ResultsFile: file of TResults;

MarksFile: file of TMark;

cIndex: integer = 1;

cCount: integer = 0;

FindCount: integer = 0;

implementation

uses

Unit6;

{$R *. dfm}

procedure TStringGridX. MoveRow (FromIndex, ToIndex: Integer);

begin

inherited;

end;

procedure TForm1. Button14Click (Sender: TObject);

var

RowIndex: integer;

begin

Form6. Caption: = 'Изменение данных';

case TabbedNotebook1. PageIndex of

0: begin

RowIndex: = StringGrid1. Row;

with form6 do

begin

LabeledEdit1. EditLabel. Caption: = 'Идентификатор';

LabeledEdit2. EditLabel. Caption: = 'Фамилия';

LabeledEdit3. EditLabel. Caption: = 'Номер по журналу';

LabeledEdit4. EditLabel. Caption: = 'Участие в НИР';

LabeledEdit1. Text: = StringGrid1. Cells [0, RowIndex];

LabeledEdit2. Text: = StringGrid1. Cells [1, RowIndex];

LabeledEdit3. Text: = StringGrid1. Cells [2, RowIndex];

LabeledEdit4. Text: = StringGrid1. Cells [3, RowIndex];

LabeledEdit4. Visible: = true;

if Form6. ShowModal = mrOk then

with StringGrid1, Form6 do

begin

Cells [0, RowIndex]: = LabeledEdit1. Text;

Cells [1, RowIndex]: = LabeledEdit2. Text;

Cells [2, RowIndex]: = LabeledEdit3. Text;

Cells [3, RowIndex]: = LabeledEdit4. Text;

end;

end;

end;

1: begin

RowIndex: = StringGrid2. Row;

with form6 do

begin

LabeledEdit1. EditLabel. Caption: = 'Идентификатор';

LabeledEdit2. EditLabel. Caption: = 'Предмет';

LabeledEdit3. EditLabel. Caption: = 'Процент сдачи';

LabeledEdit4. Visible: = false;

LabeledEdit1. Text: = StringGrid2. Cells [0, RowIndex];

LabeledEdit2. Text: = StringGrid2. Cells [1, RowIndex];

LabeledEdit3. Text: = StringGrid2. Cells [2, RowIndex];

LabeledEdit4. Visible: = false;

end;

if Form6. ShowModal = mrOk then

with StringGrid2, Form6 do

begin

Cells [0, RowIndex]: = LabeledEdit1. Text;

Cells [1, RowIndex]: = LabeledEdit2. Text;

Cells [2, RowIndex]: = LabeledEdit3. Text;

end;

end;

2: begin

RowIndex: = StringGrid3. Row;

with form6 do

begin

LabeledEdit1. EditLabel. Caption: = 'Идентификатор записи';

LabeledEdit2. EditLabel. Caption: = 'Идентификатор студента';

LabeledEdit3. EditLabel. Caption: = 'Идентификатор предмета';

LabeledEdit4. EditLabel. Caption: = 'Оценка';

LabeledEdit4. Visible: = true;

LabeledEdit1. Text: = StringGrid3. Cells [0, RowIndex];

LabeledEdit2. Text: = StringGrid3. Cells [1, RowIndex];

LabeledEdit3. Text: = StringGrid3. Cells [2, RowIndex];

LabeledEdit4. Text: = StringGrid3. Cells [3, RowIndex];

end;

if Form6. ShowModal = mrOk then

with StringGrid3, Form6 do

begin

Cells [0, RowIndex]: = LabeledEdit1. Text;

Cells [1, RowIndex]: = LabeledEdit2. Text;

Cells [2, RowIndex]: = LabeledEdit3. Text;

Cells [3, RowIndex]: = LabeledEdit4. Text;

end;

end;

end;

end;

procedure TForm1. Button15Click (Sender: TObject);

var

i, j: integer;

begin

Form6. Caption: = 'Добавление данных';

Form6. LabeledEdit1. Text: = '';

Form6. LabeledEdit2. Text: = '';

Form6. LabeledEdit3. Text: = '';

Form6. LabeledEdit4. Text: = '';

case TabbedNotebook1. PageIndex of

0: begin

with form6 do

begin

LabeledEdit1. EditLabel. Caption: = 'Идентификатор';

LabeledEdit2. EditLabel. Caption: = 'Фамилия';

LabeledEdit3. EditLabel. Caption: = 'Номер по журналу';

LabeledEdit4. EditLabel. Caption: = 'Участие в НИР';

LabeledEdit4. Visible: = true;

end;

i: = 0;

while StringGrid1. Cells [0, i] <> '' do

begin

inc (i);

if i > StringGrid1. RowCount then

begin

StringGrid1. RowCount: = StringGrid1. RowCount + 1;

i: = StringGrid1. RowCount;

break;

end;

end;

if Form6. ShowModal = mrOk then

with StringGrid1, Form6 do

begin

Cells [0, i]: = LabeledEdit1. Text;

Cells [1, i]: = LabeledEdit2. Text;

Cells [2, i]: = LabeledEdit3. Text;

Cells [3, i]: = LabeledEdit4. Text;

end;

end;

1: begin

form6. LabeledEdit1. EditLabel. Caption: = 'Идентификатор';

form6. LabeledEdit2. EditLabel. Caption: = 'Предмет';

form6. LabeledEdit3. EditLabel. Caption: = 'Процент сдачи';

form6. LabeledEdit4. Visible: = false;

i: = 0;

while StringGrid2. Cells [0, i] <> '' do

begin

inc (i);

if i > StringGrid2. RowCount then

begin

StringGrid2. RowCount: = StringGrid2. RowCount + 1;

i: = StringGrid2. RowCount;

break;

end;

end;

if Form6. ShowModal = mrOk then

with StringGrid2, Form6 do

begin

Cells [0, i]: = LabeledEdit1. Text;

Cells [1, i]: = LabeledEdit2. Text;

Cells [2, i]: = LabeledEdit3. Text;

end;

end;

2: begin

form6. LabeledEdit1. EditLabel. Caption: = 'Идентификатор записи';

form6. LabeledEdit2. EditLabel. Caption: = 'Идентификатор студента';

form6. LabeledEdit3. EditLabel. Caption: = 'Идентификатор предмета';

form6. LabeledEdit4. EditLabel. Caption: = 'Оценка';

form6. LabeledEdit4. Visible: = true;

i: = 0;

while StringGrid3. Cells [0, i] <> '' do

begin

inc (i);

if i > StringGrid3. RowCount then

begin

StringGrid3. RowCount: = StringGrid3. RowCount + 1;

i: = StringGrid3. RowCount;

break;

end;

end;

if Form6. ShowModal = mrOk then

with StringGrid3, Form6 do

begin

Cells [0, i]: = LabeledEdit1. Text;

Cells [1, i]: = LabeledEdit2. Text;

Cells [2, i]: = LabeledEdit3. Text;

Cells [3, i]: = LabeledEdit4. Text;

end;

end;

end;

end;

procedure GridDeleteRow (RowNumber: Integer; Grid: TstringGrid);

var

i: Integer;

begin

Grid. Row: = RowNumber;

if (Grid. Row = Grid. RowCount - 1) then

{ On the last row}

Grid. RowCount: = Grid. RowCount - 1

else

begin

{ Not the last row}

for i: = RowNumber to Grid. RowCount - 1 do

Grid. Rows [i]: = Grid. Rows [i + 1];

Grid. RowCount: = Grid. RowCount - 1;

end;

end;

procedure TForm1. Button1Click (Sender: TObject);

var

a: TStrings;

b: array of TStrings;

i, j: integer;

flag: boolean;

begin

flag: = false;

case TabbedNotebook1. PageIndex of

0: if StringGrid1. Cells [0, 1] = '' then

flag: = true;

1: if StringGrid2. Cells [0, 1] = '' then

flag: = true;

2: if StringGrid3. Cells [0, 1] = '' then

flag: = true;

end;

if flag then

MessageDlg ('Все записи удалены', mtInformation, [mbOk], 0)

else

if (MessageDlg ('Удалить запись? ', mtConfirmation, [mbOk, mbCancel], 0) = mrOk) then

case TabbedNotebook1. PageIndex of

0: GridDeleteRow (StringGrid1. Row, StringGrid1);

1: GridDeleteRow (StringGrid2. Row, StringGrid3);

2: GridDeleteRow (StringGrid3. Row, StringGrid3);

end;

end;

procedure TForm1. SortDelayString;

var

j, n, i: integer;

flag: integer;

res: boolean;

count: integer;

buf: array [1.50] of string;

begin

// FindCount: = 0;

try

n: = 0;

for I: = 1 to tabl. RowCount do

if Tabl. Cells [aCol, i] <> '' then

inc (n);

cCount: = n;

// for j: = 1 to n - 1 do

j: = cIndex;

begin

i: = j;

repeat

flag: = 0;

case SorType of

TypeString: res: = (Tabl. Cells [aCol, i] > Tabl. Cells [aCol, i + 1]);

TypeInteger: res: = (strtoint (Tabl. Cells [aCol, i]) > strtoint (Tabl. Cells [aCol, i + 1]));

end;

if res then

begin

TStringGridX (Tabl). MoveRow (i, i+1);

flag: = 1;

dec (i);

inc (FindCount, 1);

end;

until (flag = 0) or (i = 0);

end;

except

MessageDlg ('Неверные данные! ', mtWarning, [mbOk], 0);

end;

inc (cIndex);

if cIndex > cCount - 1 then

begin

cIndex: = 1;

if FindCount > 0 then

MessageDlg ('Сортировка закончена! Шагов: ' + inttostr (FindCount), mtWarning, [mbOk], 0);

end;

end;

procedure TForm1. Button2Click (Sender: TObject);

var

ARow: integer;

begin

ARow: = RadioGroup1. ItemIndex;

case TabbedNotebook1. PageIndex of

0: begin

if ARow in [1, 3] then

SortDelayString (StringGrid1, aRow, TypeString);

if Arow in [0, 2] then

SortDelayString (StringGrid1, aRow, TypeInteger);

end;

1: begin

if Arow = 1 then

SortDelayString (StringGrid2, aRow, TypeString);

if Arow in [0, 2] then

SortDelayString (StringGrid2, aRow, TypeInteger);

end;

2: begin

SortDelayString (StringGrid3, aRow, TypeInteger);

end;

3: begin

if (ARow = 0) then

SortDelayString (StringGrid4, aRow, TypeInteger);

if (ARow = 1) then

SortDelayString (StringGrid4, aRow, TypeString);

end;

end;

end;

procedure TForm1. Button3Click (Sender: TObject);

var

ARow: integer;

begin

ARow: = RadioGroup1. ItemIndex;

case TabbedNotebook1. PageIndex of

0: begin

if ARow in [1, 3] then

SortString (StringGrid1, aRow, TypeString);

if Arow in [0, 2] then

SortString (StringGrid1, aRow, TypeInteger);

end;

1: begin

if Arow = 1 then

SortString (StringGrid2, aRow, TypeString);

if Arow in [0, 2] then

SortString (StringGrid2, aRow, TypeInteger);

end;

2: begin

SortString (StringGrid3, aRow, TypeInteger);

end;

3: begin

if (ARow = 0) then

SortString (StringGrid3, aRow, TypeInteger);

if (ARow = 1) then

SortString (StringGrid3, aRow, TypeString);

end;

end;

end;

procedure TForm1. Button4Click (Sender: TObject);

var

s: string;

r, k, old, cnt, i: integer;

stId: string;

begin

for i: = 1 to stringgrid4. rowcount do

StringGrid4. Rows [i]. Clear;

// StringGrid4. Cells [0, 1]: = '';

// StringGrid4. Cells [1, 1]: = '';

r: = 0;

k: = 0;

old: = 0;

s: = IntToStr (5 - RadioGroup2. ItemIndex);

cnt: = 1;

while r >= 0 do

begin

r: = BinaryFind (k, s, 3, StringGrid3);

k: = r;

if r >= 0 then

begin

stId: = StringGrid3. Cells [1, r];

StringGrid4. Rows [cnt]. Add (stId);

r: = BinaryFind (1, stId, 0, StringGrid1);

if r >= 0 then

StringGrid4. Rows [cnt]. Append (StringGrid1. Cells [1, r])

else

StringGrid4. Rows [cnt]. Append ('Фамилия отсутствует');

inc (cnt, 1);

r: = 0;

end;

end;

end;

procedure TForm1. FormCreate (Sender: TObject);

begin

with StringGrid1 do

begin

Cells [0, 0]: = 'Идентификатор';

Cells [1, 0]: = 'Фамилия';

Cells [2, 0]: = 'Номер по журналу';

Cells [3, 0]: = 'Участие в НИР';

end;

with StringGrid2 do

begin

Cells [0, 0]: = 'Идентификатор';

Cells [1, 0]: = 'Предмет';

Cells [2, 0]: = 'Процент сдачи';

end;

with StringGrid3 do

begin

Cells [0, 0]: = 'Идентификатор записи';

Cells [1, 0]: = 'Идентификатор студента';

Cells [2, 0]: = 'Идентификатор предмета';

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

end;

with StringGrid4 do

begin

Cells [0, 0]: = 'Идентификатор';

Cells [1, 0]: = 'Фамилия';

end;

end;

procedure TForm1. N2Click (Sender: TObject);

var

i, j: integer;

StudentRecord: TStudent;

ResultRecord: TResults;

MarkRecord: TMark;

begin

try

case TabbedNotebook1. PageIndex of

0: begin

AssignFile (StudentFile, 'students. std');

Reset (StudentFile);

i: = 0;

j: = 1; repeat

with StudentRecord, StringGrid1 do

begin

Read (StudentFile, StudentRecord);

Cells [0, j]: = IntToStr (ID);

Cells [1, j]: = FSTU;

Cells [2, j]: = IntToStr (NUMBER);

if YCHASTIE then

Cells [3, j]: = 'Да'

else

Cells [3, j]: = 'Нет';

inc (j);

end;

until Eof (StudentFile);

CloseFile (StudentFile);

end;

1: begin

AssignFile (ResultsFile, 'results. rsl');

Reset (ResultsFile);

i: = 0;

j: = 1;

repeat

with ResultRecord, StringGrid2 do

begin

Read (ResultsFile, ResultRecord);

Cells [0, j]: = IntToStr (ID);

Cells [1, j]: = ResultRecord. NAME;

Cells [2, j]: = RESULT;

inc (j);

end;

until Eof (ResultsFile);

CloseFile (ResultsFile);

end;

2: begin

AssignFile (MarksFile, 'mark. mrk');

Reset (MarksFile);

i: = 0;

j: = 1;

repeat

with MarkRecord, StringGrid3 do

begin

Read (MarksFile, MarkRecord);

Cells [0, j]: = IntToStr (ID);

Cells [1, j]: = IntToStr (StudentID);

Cells [2, j]: = IntToStr (ResultsID);

Cells [3, j]: = IntToStr (Mark);

inc (j);

end;

until Eof (MarksFile);

CloseFile (MarksFile);

end;

end;

except

MessageDlg ('Неверное содержимое файла! ', mtWarning, [mbOk], 0);

end;

end;

procedure TForm1. N3Click (Sender: TObject);

var

j: integer;

StudentRecord: TStudent;

ResultRecord: TResults;

MarkRecord: TMark;

begin

try

case TabbedNotebook1. PageIndex of

0: begin

AssignFile (StudentFile, 'students. std');

Rewrite (StudentFile);

for J: = 1 to StringGrid1. RowCount - 1 do

if StringGrid1. Cells [0, j] <> '' then

with StudentRecord, StringGrid1 do

begin

ID: = StrToIntDef (Cells [0, j], - 1);

FSTU: = Cells [1, j];

NUMBER: = StrToIntDef (Cells [2, j], - 1);

YCHASTIE: = ( (Cells [3, j]) = 'Да') or ( (Cells [3, j]) = 'ДА') or

( (Cells [3, j]) = 'да');

Write (StudentFile, StudentRecord);

end;

CloseFile (StudentFile);

end;

1: begin

AssignFile (ResultsFile, 'results. rsl');

Rewrite (ResultsFile);

for J: = 1 to StringGrid2. RowCount - 1 do

if StringGrid2. Cells [0, j] <> '' then

with ResultRecord, StringGrid2 do

begin

ID: = StrToIntDef (Cells [0, j], - 1);

ResultRecord. NAME: = Cells [1, j];

RESULT: = Cells [2, j];

Write (ResultsFile, ResultRecord);

end;

CloseFile (ResultsFile);

end;

2: begin

AssignFile (MarksFile, 'mark. mrk');

Rewrite (MarksFile);

for J: = 1 to StringGrid1. RowCount - 1 do

if StringGrid3. Cells [0, j] <> '' then

with MarkRecord, StringGrid3 do

begin

ID: = StrToIntDef (Cells [0, j], - 1);

StudentID: = StrToIntDef (Cells [1, j], - 1);

ResultsID: = StrToIntDef (Cells [2, j], - 1);

Mark: = StrToIntDef (Cells [3, j], - 1);

Write (MarksFile, MarkRecord);

end;

CloseFile (MarksFile);

end;

end;

except

MessageDlg ('Неверные данные! ', mtWarning, [mbOk], 0);

end;

end;

procedure TForm1. N5Click (Sender: TObject);

begin

Close

end;

procedure TForm1. SortString;

var

j, n, i: integer;

flag: integer;

res: boolean;

buf: array [1.50] of string;

begin

FindCount: = 0;

try

n: = 0;

for I: = 1 to tabl. RowCount do

if Tabl. Cells [aCol, i] <> '' then

inc (n);

for j: = 1 to n - 1 do

begin

i: = j;

repeat

flag: = 0;

case SorType of

TypeString: res: = (Tabl. Cells [aCol, i] > Tabl. Cells [aCol, i + 1]);

TypeInteger: res: = (strtoint (Tabl. Cells [aCol, i]) > strtoint (Tabl. Cells [aCol, i + 1]));

end;

if res then

begin

TStringGridX (Tabl). MoveRow (i, i+1);

flag: = 1;

dec (i);

inc (FindCount, 1);

end;

until (flag = 0) or (i = 0);

end;

if FindCount > 0 then

MessageDlg ('Сортировка закончена! Шагов: ' + inttostr (FindCount), mtWarning, [mbOk], 0);

except

MessageDlg ('Неверные данные! ', mtWarning, [mbOk], 0);

end;

FindCount: = 0;

end;

procedure TForm1. StringGrid1MouseUp (Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var

Coord: TGridCoord;

ARow, Acol: integer;

begin

Coord: = StringGrid1. MouseCoord (x, y);

ACol: = Coord. Y;

ARow: = Coord. X;

if (Acol >= 0) and (ARow >= 0) then

begin

if (ACol = 0) then

begin

if Arow in [1, 3] then

SortString (StringGrid1, aRow, TypeString);

if Arow in [0, 2] then

SortString (StringGrid1, aRow, TypeInteger);

end;

end;

end;

procedure TForm1. StringGrid2MouseUp (Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var

Coord: TGridCoord;

ARow, Acol: integer;

begin

Coord: = StringGrid2. MouseCoord (x, y);

ACol: = Coord. Y;

ARow: = Coord. X;

if (Acol >= 0) and (ARow >= 0) then

begin

if (ACol = 0) then

begin

if Arow = 1 then

SortString (StringGrid2, aRow, TypeString);

if Arow in [0, 2] then

SortString (StringGrid2, aRow, TypeInteger);

end;

end;

end;

procedure TForm1. StringGrid3MouseUp (Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var

Coord: TGridCoord;

ARow, Acol: integer;

begin

Coord: = StringGrid3. MouseCoord (x, y);

ACol: = Coord. Y;

ARow: = Coord. X;

if (Acol >= 0) and (ARow >= 0) then

begin

if (ACol = 0) then

SortString (StringGrid3, aRow, TypeInteger);

end;

end;

procedure TForm1. StringGrid4MouseUp (Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var

Coord: TGridCoord;

ARow, Acol: integer;

begin

Coord: = StringGrid4. MouseCoord (x, y);

ACol: = Coord. Y;

ARow: = Coord. X;

if (Acol >= 0) and (ARow >= 0) then

begin

if (ARow = 0) then

SortString (StringGrid4, aRow, TypeInteger);

if (ARow = 1) then

SortString (StringGrid4, aRow, TypeString);

end;

end;

function TForm1. BinaryFind (aStart: integer; aVal: string; aCol: integer; Tabl: TStringGrid): integer;

var

q, p, i, flag: integer;

v: string;

begin

q: = aStart + 1; // начало диапазона

p: = 0; // конец диапазона;

result: = - 1;

for i: = 1 to tabl. RowCount - 1 do

if Tabl. Cells [0, i] <> '' then

inc (p);

// q: = 1; // Start;

{ if (p = 0) then

exit; }

repeat

if p < q then

begin

flag: = 1;

result: = - 1;

end

else

begin

i: = trunc ( (q + p) /2);

v: = Tabl. Cells [aCol, i];

if (aVal < Tabl. Cells [aCol, i]) then

p: = i - 1

else if True then

if (aVal > Tabl. Cells [aCol, i]) then

q: = q + 1

else

begin

flag: = 1;

result: = i;

end;

end;

until flag = 1;

end;

end.

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