1. Программирование на языке Delphi: учебное пособие/ А.Н. Вальвачев [и др.]. - 2012. - 432 с.

2. Глухова Л.А. Основы алгоритмизации и программирования: Учебное пособие, ч1. - Минск: БГУИР, 2010. - 195 с.

Приложения

Приложение А

unit Unit2;

interface

uses

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

Dialogs, StdCtrls, Buttons;

type

TForm2 = class (TForm)

Button2: TButton;

BitBtn1: TBitBtn;

Button1: TButton;

procedure Button2Click (Sender: TObject);

procedure BitBtn1Click (Sender: TObject);

procedure Button1Click (Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

mesto = record

name: string [10];

procent: real;

oshibki: integer;

time: integer;

end;

filemesto=file of mesto;

var

Form2: TForm2;

m: mesto;

pokaz: boolean = false;

implementation

uses Unit1, Unit4;

{$R *. dfm}

procedure TForm2. Button2Click (Sender: TObject);

begin

Form2. Hide;

form1: =tform1. create (self);

try

if form1. showmodal=mrOK

then;

finally form1. free

end;

form4: =tform4. create (self);

try

if form4. showmodal=mrCancel

then;

finally form4. free

end;

form2. Show;

end;

procedure TForm2. BitBtn1Click (Sender: TObject);

begin

close

end;

procedure TForm2. Button1Click (Sender: TObject);

begin

form2. Hide;

pokaz: =true;

form4: =tform4. Create (self);

try

if form4. ShowModal=mrcancel

then;

finally form4. Free

end;

pokaz: =false;

form2. Show;

end;

end.

unit Unit1; {автор - Булойчик Алексей}

interface

uses

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

Dialogs, StdCtrls, ExtCtrls, ComCtrls, XPMan, jpeg, Buttons;

type

TForm1 = class (TForm)

ListBox1: TListBox;

ListBox2: TListBox;

Label2: TLabel;

Label1: TLabel;

Timer1: TTimer;

Timer2: TTimer;

Image1: TImage;

Edit2: TEdit;

Label3: TLabel;

Label4: TLabel;

Edit3: TEdit;

Button1: TButton;

Button2: TButton;

Panel1: TPanel;

Image2: TImage;

i1: TImage;

i4: TImage;

i3: TImage;

i2: TImage;

Label5: TLabel;

Edit1: TEdit;

procedure Timer1Timer (Sender: TObject);

procedure Timer2Timer (Sender: TObject);

procedure Button1Click (Sender: TObject);

procedure Button1KeyPress (Sender: TObject; var Key: Char);

procedure Button2KeyPress (Sender: TObject; var Key: Char);

procedure ListBox2KeyPress (Sender: TObject; var Key: Char);

procedure Button2Click (Sender: TObject);

procedure FormCreate (Sender: TObject);

procedure FormShow (Sender: TObject);

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

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses Unit3, Unit2, Unit4;

const h=16;

var time,pause,rount,posit,mistake,obshmist,obshtime,slovo: integer;

nul1,nul2: string [2];

{$R *. dfm}

procedure bukva (t: char);

var x,y: word;

begin

case t of

'й': begin x: =61; y: =39 end;

'ц': begin x: =101; y: =39 end;

'у': begin x: =142; y: =39 end;

'к': begin x: =183; y: =39 end;

'е': begin x: =225; y: =39 end;

'н': begin x: =266; y: =39 end;

'г': begin x: =307; y: =39 end;

'ш': begin x: =348; y: =39 end;

'щ': begin x: =389; y: =39 end;

'з': begin x: =430; y: =39 end;

'х': begin x: =471; y: =39 end;

'ъ': begin x: =512; y: =39 end;

'ф': begin x: =82; y: =80 end;

'ы': begin x: =124; y: =80 end;

'в': begin x: =164; y: =80 end;

'а': begin x: =205; y: =80 end;

'п': begin x: =246; y: =80 end;

'р': begin x: =287; y: =80 end;

'о': begin x: =328; y: =80 end;

'л': begin x: =369; y: =80 end;

'д': begin x: =410; y: =80 end;

'ж': begin x: =451; y: =80 end;

'э': begin x: =492; y: =80 end;

'я': begin x: =101; y: =120 end;

'ч': begin x: =142; y: =120 end;

'с': begin x: =183; y: =120 end;

'м': begin x: =225; y: =120 end;

'и': begin x: =266; y: =120 end;

'т': begin x: =306; y: =120 end;

'ь': begin x: =348; y: =120 end;

'б': begin x: =389; y: =120 end;

'ю': begin x: =430; y: =120 end

else x: =1000

end;

with form1 do

begin

i1. left: =x;

i1. Top: =y;

i2. Left: =x+37;

i2. Top: =y;

i3. Left: =x;

i3. Top: =y+37;

i4. Left: =x;

i4. Top: =y;

end;

end;

procedure procend;

begin

obshtime: =obshtime+time;

obshmist: =obshmist+mistake;

m. oshibki: =obshmist;

m. time: =obshtime;

with form1 do

m. procent: = (rount-1) *10+ (slovo*length (ListBox2. Items [0]) +length (Label1. Caption)) / (length (ListBox2. Items [0]) *10);

form1. Close;

end;

procedure newround (r: byte);

type sh=shortstring;

var a: array [1.20] of sh;

s: string [15];

sk: set of byte;

i,n,k: byte;

f: file of sh;

begin

slovo: =0;

pause: =0;

time: =0;

mistake: =0;

nul1: ='00';

nul2: ='00';

with form1 do

begin

Edit2. Text: ='000';

Edit3. Text: ='000';

Edit1. Text: =inttostr (rount);

label1. Left: =750;

label2. Left: =label1. Left;

Listbox1. Clear;

Listbox2. Clear;

Listbox1. Height: =0;

Listbox2. Top: =listbox1. Top;

Listbox2. Height: =10*h;

Label2. Font. Color: =RGB ( ( (750-label1. Left) *255) div 750, ( (label1. Left-50) *255) div 750, ( (label1. Left-50) *60) div 650);

end;

s: ='files/'+inttostr (r);

assign (f,s);

reset (f);

n: =0;

repeat

inc (n);

read (f,a [n]);

until eof (f) =true;

close (f);

sk: = [];

for i: =1 to 10 do

begin

repeat

k: =random (n) +1;

until (k in sk) =false;

include (sk,k);

form1. ListBox2. Items. Add (a [k]);

end;

form1. Label1. Caption: ='';

Form1. Label2. Caption: =form1. ListBox2. Items [0];

bukva (form1. ListBox2. Items [0] [1]);

end;

procedure nextword;

begin

inc (slovo);

posit: =790;

with form1 do

begin

ListBox2. ItemIndex: =1;

if ListBox2. ItemIndex=1

then

begin

ListBox1. Items. Add (form1. ListBox2. Items [0]);

ListBox2. Items. Delete (0);

ListBox1. Height: =ListBox1. Height+h;

ListBox2. Height: =ListBox2. Height-h;

ListBox2. Top: =ListBox2. Top+h;

Label1. Caption: ='';

Label2. Caption: =ListBox2. Items [0];

bukva (ListBox2. Items [0] [1]);

label1. Left: =750;

label2. Left: =label1. Left;

Label2. Font. Color: =RGB ( ( (750-label1. Left) *255) div 750, ( (label1. Left-50) *255) div 750, ( (label1. Left-50) *60) div 650);

end

else

begin

inc (rount);

obshtime: =obshtime+time;

obshmist: =obshmist+mistake;

if rount<=10

then newround (rount)

else procend;

end;

end;

end;

procedure press (var Key: Char);

var s: shortstring;

begin

with form1 do

begin

ListBox2. ItemIndex: =0;

s: =label2. Caption;

if key=s [1]

then

begin

label1. Caption: =Label1. Caption+s [1];

delete (s,1,1);

Label2. Caption: =s;

label2. Left: =label1. Left+label1. Width;

if length (s) =0

then nextword

else bukva (s [1]);

end

else

begin

inc (mistake);

if mistake=10

then nul2: ='0';

if mistake=100

then nul2: ='';

Edit3. Text: =nul2+inttostr (mistake);

end;

end;

end;

procedure TForm1. Timer1Timer (Sender: TObject);

var i: integer;

begin

Label1. Left: =Label1. Left-rount;

Label2. Left: =Label2. Left-rount;

if label2. Left<50

then procend;

if label2. Left<posit

then

begin

Label2. Font. Color: =RGB ( ( (750-label2. Left) *255) div 750, ( (label2. Left-50) *255) div 750, ( (label2. Left-50) *60) div 650);

posit: =label2. Left;

end;

end;

procedure TForm1. Timer2Timer (Sender: TObject);

begin

inc (time);

if time=10

then nul1: ='0';

if time =100

then nul1: ='';

Edit2. Text: =nul1+inttostr (time);

end;

procedure TForm1. Button1Click (Sender: TObject);

begin

if pause<3

then

begin

form3: =Tform3. create (self);

try

if form3. ShowModal = mrOk

then;

finally form3. Free

end;

inc (pause);

end;

end;

procedure TForm1. Button1KeyPress (Sender: TObject; var Key: Char);

begin

press (key);

end;

procedure TForm1. Button2KeyPress (Sender: TObject; var Key: Char);

begin

press (key);

end;

procedure TForm1. ListBox2KeyPress (Sender: TObject; var Key: Char);

begin

press (key);

end;

procedure TForm1. Button2Click (Sender: TObject);

begin

procend;

end;

procedure TForm1. FormCreate (Sender: TObject);

begin

randomize;

obshmist: =0;

obshtime: =0;

rount: =1;

posit: =790;

end;

procedure TForm1. FormShow (Sender: TObject);

begin

newround (rount);

end;

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

begin

procend;

end;

end.

unit Unit3;

interface

uses

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

Dialogs, StdCtrls, Buttons;

type

TForm3 = class (TForm)

Label5: TLabel;

BitBtn1: TBitBtn;

procedure FormActivate (Sender: TObject);

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

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form3: TForm3;

implementation

uses Unit1;

procedure pause;

begin

with Form1 do

begin

Timer1. Enabled: =not Timer1. Enabled;

Timer2. Enabled: =not Timer2. Enabled;

Button1. Enabled: =not Button1. Enabled;

Button2. Enabled: =not Button2. Enabled;

ListBox2. Enabled: =not ListBox2. Enabled;

end;

end;

{$R *. dfm}

procedure TForm3. FormActivate (Sender: TObject);

begin

pause

end;

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

begin

pause

end;

end.

unit Unit4;

interface

uses

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

Dialogs, StdCtrls, Buttons;

type

TForm4 = class (TForm)

L1: TLabel;

L2: TLabel;

L3: TLabel;

L1N: TLabel;

L2N: TLabel;

L3N: TLabel;

L1P: TLabel;

L2P: TLabel;

L3P: TLabel;

Label10: TLabel;

Label11: TLabel;

Label12: TLabel;

Label13: TLabel;

L4N: TLabel;

L4P: TLabel;

L4M: TLabel;

L4T: TLabel;

L1M: TLabel;

L2M: TLabel;

L3M: TLabel;

L1T: TLabel;

L2T: TLabel;

L3T: TLabel;

Edit: TEdit;

BitBtn1: TBitBtn;

procedure FormShow (Sender: TObject);

procedure EditKeyPress (Sender: TObject; var Key: Char);

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

procedure BitBtn1Click (Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form4: TForm4;

implementation

uses Unit2;

{$R *. dfm}

var f: filemesto;

a: array [1.3] of mesto;

i,j,k: byte;

s: string [5];

procedure TForm4. FormShow (Sender: TObject);

var w: boolean;

begin

assignfile (f,'files/records');

reset (f);

for i: =1 to 3 do

read (f,a [i]);

closefile (f);

if pokaz

then

with form4 do

begin

L1N. Caption: =a [1]. name;

L1M. Caption: =inttostr (a [1]. oshibki);

L1T. Caption: =inttostr (a [1]. time) +'с';

str (a [1]. procent: 0: 2,s);

if s [3] <>'. '

then delete (s,5,1);

if s [4] ='. '

then s: ='100';

L1P. Caption: =s+'%';

L2N. Caption: =a [2]. name;

L2M. Caption: =inttostr (a [2]. oshibki);

L2T. Caption: =inttostr (a [2]. time) +'с';

str (a [2]. procent: 0: 2,s);

if s [3] <>'. '

then delete (s,5,1);

if s [4] ='. '

then s: ='100';

L2P. Caption: =s+'%';

L3N. Caption: =a [3]. name;

L3M. Caption: =inttostr (a [3]. oshibki);

L3T. Caption: =inttostr (a [3]. time) +'с';

str (a [3]. procent: 0: 2,s);

if s [3] <>'. '

then delete (s,5,1);

if s [4] ='. '

then s: ='100';

L3P. Caption: =s+'%';

end

else

begin

k: =4;

if (a [3]. procent<m. procent)

then

begin

w: =false;

repeat

dec (k);

if round (a [k-1]. procent*1000) >round (m. procent*1000)

then w: =true

else

if round (a [k-1]. procent*1000) =round (m. procent*1000)

then

begin

if a [k-1]. oshibki<m. oshibki

then w: =true;

if a [k-1]. oshibki=m. oshibki

then

if a [k-1]. time<=m. time

then w: =true;

end;

until (k=1) or w;

for j: =2 downto k do

a [j+1]: =a [j];

a [k]: =m;

if k<>1

then

begin

L1N. Caption: =a [1]. name;

L1M. Caption: =inttostr (a [1]. oshibki);

L1T. Caption: =inttostr (a [1]. time) +'с';

str (a [1]. procent: 0: 2,s);

if s [3] <>'. '

then delete (s,5,1);

if s [4] ='. '

then s: ='100';

L1P. Caption: =s+'%';

end

else

begin

L1N. Visible: =false;

L1M. Caption: =inttostr (m. oshibki);

L1T. Caption: =inttostr (m. time) +'с';

str (m. procent: 0: 2,s);

if s [3] <>'. '

then delete (s,5,1);

if s [4] ='. '

then s: ='100';

L1P. Caption: =s+'%';

Edit. Visible: =true;

edit. Top: =48+64* (k-1);

end;

if k<>2

then

begin

L2N. Caption: =a [2]. name;

L2M. Caption: =inttostr (a [2]. oshibki);

L2T. Caption: =inttostr (a [2]. time) +'с';

str (a [2]. procent: 0: 2,s);

if s [3] <>'. '

then delete (s,5,1);

if s [4] ='. '

then s: ='100';

L2P. Caption: =s+'%';

end

else

begin

L2N. Visible: =false;

L2M. Caption: =inttostr (m. oshibki);

L2T. Caption: =inttostr (m. time) +'с';

str (m. procent: 0: 2,s);

if s [3] <>'. '

then delete (s,5,1);

if s [4] ='. '

then s: ='100';

L2P. Caption: =s+'%';

Edit. Visible: =true;

edit. Top: =48+64* (k-1);

end;

if k<>3

then

begin

L3N. Caption: =a [3]. name;

L3M. Caption: =inttostr (a [3]. oshibki);

L3T. Caption: =inttostr (a [3]. time) +'с';

str (a [3]. procent: 0: 2,s);

if s [3] <>'. '

then delete (s,5,1);

if s [4] ='. '

then s: ='100';

L3P. Caption: =s+'%';

end

else

begin

L3N. Visible: =false;

L3M. Caption: =inttostr (m. oshibki);

L3T. Caption: =inttostr (m. time) +'с';

str (m. procent: 0: 2,s);

if s [3] <>'. '

then delete (s,5,1);

if s [4] ='. '

then s: ='100';

L3P. Caption: =s+'%';

Edit. Visible: =true;

edit. Top: =48+64* (k-1);

end;

end

else

with form4 do

begin

L1N. Caption: =a [1]. name;

L1M. Caption: =inttostr (a [1]. oshibki);

L1T. Caption: =inttostr (a [1]. time) +'с';

str (a [1]. procent: 0: 2,s);

if s [3] <>'. '

then delete (s,5,1);

if s [4] ='. '

then s: ='100';

L1P. Caption: =s+'%';

L2N. Caption: =a [2]. name;

L2M. Caption: =inttostr (a [2]. oshibki);

L2T. Caption: =inttostr (a [2]. time) +'с';

str (a [2]. procent: 0: 2,s);

if s [3] <>'. '

then delete (s,5,1);

if s [4] ='. '

then s: ='100';

L2P. Caption: =s+'%';

L3N. Caption: =a [3]. name;

L3M. Caption: =inttostr (a [3]. oshibki);

L3T. Caption: =inttostr (a [3]. time) +'с';

str (a [3]. procent: 0: 2,s);

if s [3] <>'. '

then delete (s,5,1);

if s [4] ='. '

then s: ='100';

L3P. Caption: =s+'%';

L4N. Visible: =true;

L4P. Visible: =true;

L4M. Visible: =true;

L4T. Visible: =true;

str (m. procent: 0: 2,s);

if s [3] <>'. '

then delete (s,5,1);

if s [4] ='. '

then s: ='100';

L4P. Caption: =s+'%';

L4M. Caption: =inttostr (m. oshibki);

L4T. Caption: =inttostr (m. time) +'с';

end;

end;

end;

procedure TForm4. EditKeyPress (Sender: TObject; var Key: Char);

begin

if key=#13

then

begin

if Edit. Text=''

then Edit. text: ='NoName';

case k of

1:

begin

L1N. Visible: =true;

L1N. Caption: =Edit. Text;

end;

2:

begin

L2N. Visible: =true;

L2N. Caption: =Edit. Text;

end;

3:

begin

L3N. Visible: =true;

L3N. Caption: =Edit. Text;

end;

end;

a [k]. name: =edit. Text;

edit. Visible: =false;

rewrite (f);

for j: =1 to 3 do

write (f,a [j]);

closefile (f);

end;

end;

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

begin

if edit. Visible=true

then

begin

if Edit. Text=''

then Edit. text: ='NoName';

case k of

1:

begin

L1N. Visible: =true;

L1N. Caption: =Edit. Text;

end;

2:

begin

L2N. Visible: =true;

L2N. Caption: =Edit. Text;

end;

3:

begin

L3N. Visible: =true;

L3N. Caption: =Edit. Text;

end;

end;

a [k]. name: =edit. Text;

edit. Visible: =false;

rewrite (f);

for j: =1 to 3 do

write (f,a [j]);

closefile (f);

end;

end;

procedure TForm4. BitBtn1Click (Sender: TObject);

begin

close

end;

end.

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