close

Вход

Забыли?

вход по аккаунту

?

лаб№1

код для вставкиСкачать
Федеральное агентство по образованию
Рязанский Государственный Радиотехнический Университет
Отчёт по лабораторной работе № 1
Создание многопоточных программ в среде Delphi и исследование свойств потоков
Выполнили: ст. гр. 842 Бакин С.С. Золотов И.В.
Проверил: Засорин С.В.
Рязань 2011
1.1 Пример 1. Создание приложения с двумя потоками.
Исходный код программы:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls, StdCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Button1: TButton;
Button2: TButton;
TrackBar1: TTrackBar;
TrackBar2: TTrackBar;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure TrackBar2Change(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
count1,count2:integer;
Threadid1,Threadid2:dword;
HThread1,HThread2:THandle;
implementation
{$R *.dfm}
procedure Execute1;
var
I, Total, Avg: integer;
begin
while True do
begin
Total:=0;
for i:=1 to 10 do inc(Total, Random(Maxint));
Avg:=Avg Div 10; inc(Count1);
end;
end;
procedure Execute2;
var
I, Total, Avg: integer;
begin
while True do
begin
Total:=0;
for i:=1 to 10 do inc(Total, Random(Maxint));
Avg:=Avg Div 10; inc(Count2);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
HThread1:=CreateThread(nil,0,@Execute1,nil,0,Threadid1);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
HThread2:=CreateThread(nil,0,@Execute2,nil,0,Threadid2);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
form1.Edit1.Text:=intTostr(Count1); Count1:=0;
form1.Edit2.Text:=intToStr(Count2); Count2:=0;
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
SetThreadPriority(HThread1,TrackBar1.Position);
end;
procedure TForm1.TrackBar2Change(Sender: TObject);
begin
SetThreadPriority(HThread2,TrackBar2.Position);
end;
end.
При задании потокам одинакового приоритета результаты суммирования в потоках одинаковы(рис.1.1), при задании разных приоритетов результаты больше у потока с бóльшим приоритетом(рис1.2).
Рис.1.1 Выполнение программы с приоритетами потоков 0 и 0
Рис.1.2 Выполнение программы с приоритетами потоков 0 и 1
1.2. Пример 2. Создание многопоточного приложения средствами класса TThread.
Исходный код программы:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Thrd, ExtCtrls, ComCtrls, StdCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
TrackBar1: TTrackBar;
TrackBar2: TTrackBar;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
private
{ Private declarations }
public
Thread1,Thread2:TSimpleThread;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Thread1:=TSimpleThread.Create(False);
Thread1.Priority:=tpLowest;
Thread2:=TSimpleThread.Create(False);
Thread2.Priority:= tpLowest;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Edit1.Text:=IntToStr(Thread1.Count ); Thread1.Count:=0;
Edit2.Text:=IntToStr(Thread2.Count );Thread2. Count:=0;
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
Var
I: Integer;
Priority: TThreadPriority;
begin
Priority:=tpLowest;
for I:= 0 to (Sender as ttrackBar).Position - 1 do
inc(Priority);
if Sender = TrackBar1
then Thread1.Priority:=Priority else Thread2.Priority:=Priority;
end;
end.
unit Thrd;
interface
uses
Classes;
type
TSimpleThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
public
Count:integer;
end;
implementation
{ TSimpleThread }
procedure TSimpleThread.Execute;
var
I, Total, Avg: integer;
begin
while True do
begin
Total:=0;
for i:=1 to 10 do inc(Total, Random(Maxint));
Avg:=Avg Div 10; inc(Count);
end;
end;
end.
Результаты аналогичны ранее полученым , представлены на следующих рисунках 2.1 и 2.2 .
Рис.2.1 Выполнение потоков с нулевыми приоритетами
Рис.2.2 выполнение потоков с приоритетами 1 и 0
1.3. Пример 3. Создание приложения, наглядно показывающего результаты изменения приоритетов потоков.
Исходный код программы:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls, Movethds;
type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
PaintBox2: TPaintBox;
PaintBox3: TPaintBox;
TrackBar1: TTrackBar;
TrackBar2: TTrackBar;
TrackBar3: TTrackBar;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
procedure FormCreate(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
private
public
Thread1, Thread2, Thread3:TMoveThread;
end;
var
Form1: TForm1;
car,bigcar:TBitmap;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
if Thread1.Suspended=true then Thread1.Resume;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if Thread2.Suspended=true then Thread2.Resume;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if Thread3.Suspended=true then Thread3.Resume;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
if Thread1.Suspended =false then Thread1.Suspend;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
if Thread2.Suspended =false then Thread2.Suspend;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
if Thread3.Suspended =false then Thread3.Suspend;
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
Button1.Click;
Button2.Click;
Button3.Click;
end;
procedure TForm1.Button8Click(Sender: TObject);
begin
Button4.Click;
Button5.Click;
Button6.Click;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
car:=TBitMap.Create; // Создается объект BitMap
car.LoadFromFile('car.bmp'); //В него загружается//изображение
bigcar:=TBitMap.Create;
bigcar.LoadFromFile('bigcar.bmp');
thread1:=TMoveThread.Create(car,bigcar,PaintBox1);//Создается поток
Thread1.Priority:=tpLowest; //Устанавливается небольшой
//приоритет у потока, чтобы поток был управляемым и не
//забирал все ресурсы.
Thread2:=TMoveThread.Create(car,bigcar,PaintBox2);//Создается поток
Thread2.Priority:=tpLowest;
thread3:=TMoveThread.Create(car,bigcar,PaintBox3);//Создается поток
Thread3.Priority:=tpLowest;
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
var
i:integer;
priority:TThreadPriority;
begin
priority:=tpLowest;
for i:=0 to ((sender as ttrackbar).position -1) do inc(priority);
if sender=trackbar1 then thread1.priority:=priority
else if sender=trackbar3 then thread3.priority:=priority
else thread2.Priority:=priority;
end;
end.
unit Movethds;
interface
uses
Classes, Graphics, ExtCtrls;
type
TMoveThread = class(TThread)
private
FBox:TPaintBox;
b0,b1:tbitmap;
i:integer;
procedure DoVisualSwap;
procedure DoVisual;
protected
procedure Execute; override;
public
constructor create(a,b:tBitmap;c:Tpaintbox);
destructor destroy;override;
end;
implementation
constructor TMoveThread.Create(a,b:tbitmap; c:TPaintBox);
begin
b0:=a;b1:=b;Fbox:=c; i:=0;
inherited Create(False);
end;
destructor TMoveThread.Destroy;
begin
b0.free;
b1.free;
inherited Destroy;
end;
procedure TMoveThread.DoVisualSwap;{Двигает картинку вправо}
begin
with FBox do
begin
canvas.Draw(i,0,b0);
inc(i);
end;
end;
procedure TMoveThread.DoVisual; { Двигает картинку влево }
begin
with FBox do
begin
canvas.Draw(i,0,b1);
dec(i);
end;
end;
{ TMoveThread }
procedure TMoveThread.Execute;
begin
while true do
begin
while i<=(fbox.Width+b0.Width) do Synchronize(DoVisualSwap);
while i>=(0-b0.Width) do Synchronize(DoVisual);
end;
end;
end.
Результаты представлены на рисунку 3.
Рис.3 Выполнение программы
2. Клавиатурный тренажёр.
Исходный код программы:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls;
type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
RadioGroup1: TRadioGroup;
Button1: TButton;
Button2: TButton;
Label4: TLabel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
RadioGroup2: TRadioGroup;
Label5: TLabel;
TrackBar1: TTrackBar;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
procedure Button1KeyPress(Sender: TObject; var Key: Char);
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
count1, count2, count3: integer;
m, mistakes: word;
ThreadId1, ThreadId2, ThreadId3: dword;
HThread1, HThread2, HThread3: THandle;
implementation
{$R *.dfm}
procedure Execute1;
var
i, total, avg: integer;
begin
while true do
begin
total := 0;
for i := 1 to 10 do inc(total, random(maxint));
avg := total div 10;
inc(count1);
end;
end;
procedure Execute2;
var
i, total, avg: integer;
begin
while true do
begin
total := 0;
for i := 1 to 10 do inc(total, random(maxint));
avg := total div 10;
inc(count2);
end;
end;
procedure Execute3;
var
i, total, avg: integer;
begin
while true do
begin
total := 0;
for i := 1 to 10 do inc(total, random(maxint));
avg := total div 10;
inc(count3);
end;
end;
procedure proc(Label0: TLabel; count: integer);
begin
//условие новой игры
if (Label0.Top > Form1.GroupBox1.Height) or (Label0.Caption = '.') then
begin
//выбор языка и образование символа
if Form1.RadioGroup2.ItemIndex = 0 then Label0.Caption := char(160+random(15))
else Label0.Caption := char(97+random(26));
Label0.Top := 24;
// inc(mistakes);
Form1.Label4.Caption := 'Количество ошибок: '+inttostr(mistakes);
end;
Label0.Top := Label0.Top + (count div 1000000 * m);//скорость движения
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
HThread1 := CreateThread(nil, 0, @Execute1, nil, 0, ThreadId1);
if RadioGroup1.ItemIndex > 0 then HThread2 := CreateThread(nil, 0, @Execute2, nil, 0, ThreadId2);
if RadioGroup1.ItemIndex = 2 then HThread3 := CreateThread(nil, 0, @Execute3, nil, 0, ThreadId3);
RadioGroup1.Enabled := false;
RadioGroup2.Enabled := false;
proc(Label1,count1);
if RadioGroup1.ItemIndex > 0 then proc(Label2,count2);
if RadioGroup1.ItemIndex = 2 then proc(Label3,count3);
mistakes := 0;
Label4.Caption := 'Игра началась....';
Timer1.Enabled:=true;
end;
procedure TForm1.Button2Click(Sender: TObject);//завершение потоков
begin
TerminateThread(HThread1,0);
if RadioGroup1.ItemIndex > 0 then TerminateThread(HThread2,0);
if RadioGroup1.ItemIndex = 2 then TerminateThread(HThread3,0);
RadioGroup1.Enabled := true;
RadioGroup2.Enabled := true;
Timer1.Enabled:=false;
Label4.Caption := 'Выберете параметры игры';
end;
procedure TForm1.RadioGroup1Click(Sender: TObject);//выключение меток
begin
if RadioGroup1.ItemIndex > 0 then Label2.Visible := true else Label2.Visible := false;
if RadioGroup1.ItemIndex = 2 then Label3.Visible := true else Label3.Visible := false;
end;
procedure TForm1.Button1KeyPress(Sender: TObject; var Key: Char);
begin
if Label1.Caption = Key then //сравнение символа на экране с введенным
begin //символом с клавиатуры
Label1.Top := GroupBox1.Height + 24;
count1:=0;
end
else if (RadioGroup1.ItemIndex > 0) and (Label2.Caption = Key) then begin
Label2.Top := GroupBox1.Height + 24;
end
else if (RadioGroup1.ItemIndex = 2) and (Label3.Caption = Key) then begin
Label3.Top := GroupBox1.Height + 24;
end
else begin
inc(mistakes);
Form1.Label4.Caption := 'Количество ошибок: '+inttostr(mistakes);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
m := 1;
Timer1.Enabled:=false;
end;
procedure TForm1.FormResize(Sender: TObject);//движение букв относительно окна
begin
Label1.Left := GroupBox1.Width div 4;
Label2.Left := GroupBox1.Width div 2;
Label3.Left := GroupBox1.Width div 4 * 3;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
proc(Label1,count1);
if RadioGroup1.ItemIndex > 0 then proc(Label2,count2);
if RadioGroup1.ItemIndex = 2 then proc(Label3,count3);
count1 := 0; count2 := 0; count3 := 0;
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
m := TrackBar1.Position;
end;
end.
Результаты показаны на рисунках 2.1 и 2.2
Рис.2.1 Программа до запуска
Рис.2.2 Выполнение программы
3. Черепашка
Исходный код программы:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, Menus, ExtCtrls, SyncObjs;
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Label3: TLabel;
Timer1: TTimer;
Button3: TButton;
N4: TMenuItem;
procedure Edit1Change(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Dr;
procedure StringGrid1Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure StringGrid1ContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
procedure StringGrid1DblClick(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure N4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
ThreadId1, ThreadId2: dword;
HThread1, HThread2: THandle;
turtle1, turtle2, finish1, finish2: byte;
m,n,t,k: byte;
was: array[0..39,0..39] of word;
bmp1, bmp2, bmp3: TBitMap;
preg: array[0..39,0..39] of boolean;
finish, success: boolean;
exitcode: cardinal;
implementation
{$R *.dfm}
procedure Execute1;
var a,b,i,j: word;
begin
for i := 0 to m-1 do
for j := 0 to n-1 do
if preg[i,j] then was[i,j]:= m*n+2 //обозначение преграды
else was[i,j] := m*n+1;//нет преграды
was[turtle1,turtle2] := 0; //обозначим черепашку
was[finish1,finish2] := m*n;
finish := false; success := false;
t := 0;
while not finish and not success do
begin
finish := true;
for i := 0 to m-1 do
begin
for j := 0 to n-1 do
begin
if was[i,j] = t then //санчала ищем положение черепашки
begin
a := i; b := j;
for k := 1 to 4 do //движение возможно в 4 стороны
begin
if k = 1 then dec(a)
else if k = 2 then inc(a,2)
else if k = 3 then begin dec(a); dec(b); end
else inc(b,2);
// если меньше размера поля и (пустая клетка или финиш)
if (a < m) and (b < n) and ((was[a,b] = m*n+1) or (was[a,b] = m*n)) then
begin
finish := false;
if was[a,b] = m*n then success := true;//если дошли до финиша
was[a,b] := t + 1;
end;
end;
end;
end;
end;
inc(t);
end;
end;
procedure Execute2; //установка произвольных данных
var i,j: byte;
begin
turtle1 := random(m); turtle2 := random(n);
repeat // условие не совпадения черепашки с финишом
finish1 := random(m); finish2 := random(n);
until (finish1 <> turtle1) or (finish2 <> turtle2);
for i := 0 to m-1 do
for j := 0 to n-1 do
//рандомное расставление преград
if (random(12) < 4) and not ((turtle1 = i) and (turtle2 = j)) and
not ((finish1 = i) and (finish2 = j)) then preg[i,j] := true
else preg[i,j] := false;
end;
procedure TForm1.Edit1Change(Sender: TObject);//для двух Edit
begin
try
//если поле задано верно
if (strtoint((sender as TEdit).Text) <= 40) and (strtoint((sender as TEdit).Text) >= 1) then
begin
StringGrid1.ColCount := strtoint(Edit1.Text);
StringGrid1.RowCount := strtoint(Edit2.Text);
m := StringGrid1.ColCount; n := StringGrid1.RowCount;
end
else (sender as TEdit).Text := '40';// по умолчанию
except
(sender as TEdit).Text := '40';//при возникновении ошибки или неправильный ввод
end;
end;
procedure TForm1.N2Click(Sender: TObject);//установка черепашки
begin
turtle1 := StringGrid1.Col; turtle2 := StringGrid1.Row;
Dr;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize; Edit1Change(Edit1);
turtle1 := 0; turtle2 := 0; finish1 := 39; finish2 :=39;
m := 40; n := 40;
bmp1 := TBitMap.Create; bmp1.LoadFromFile('turtle.bmp');
bmp2 := TBitMap.Create; bmp2.LoadFromFile('pregrada.bmp');
bmp3 := TBitMap.Create; bmp3.LoadFromFile('finish.bmp');
end;
procedure TForm1.Button1Click(Sender: TObject);
var a, b: byte;
begin
Label3.Caption := 'Поиск пути...';
Dr;
HThread1 := CreateThread(nil, 0, @Execute1, nil, 0, ThreadId1);
repeat GetExitCodeThread(HThread1,exitcode) until exitcode <> still_active;
if success then
begin
a := finish1; b := finish2; //поиск начинаем с финиша
for k := t-1 downto 1 do
begin
dec(a); //проверка слева
if was[a,b] = k then
begin StringGrid1.Canvas.TextOut(a*13+2,b*13,IntToStr(k)); continue; end;
inc(a,2);//проверка справа
if was[a,b] = k then
begin StringGrid1.Canvas.TextOut(a*13+2,b*13,IntToStr(k)); continue; end;
dec(a); dec(b);//проверка сверху
if was[a,b] = k then
begin StringGrid1.Canvas.TextOut(a*13+2,b*13,IntToStr(k)); continue; end;
inc(b,2); //проверка снизу
if was[a,b] = k then
begin StringGrid1.Canvas.TextOut(a*13+2,b*13,IntToStr(k)); continue; end;
end;
Label3.Caption := 'Путь найден!';
end
else Label3.Caption := 'Путь не найден.';
end;
procedure TForm1.Dr; //прорисовка
var i, j: integer;
begin
StringGrid1.Refresh;
StringGrid1.Canvas.Draw(turtle1*13,turtle2*13,bmp1);
StringGrid1.Canvas.Draw(finish1*13,finish2*13,bmp3);
for i := 0 to 39 do
for j := 0 to 39 do
if preg[i,j] then StringGrid1.Canvas.Draw(i*13,j*13,bmp2);
end;
procedure TForm1.StringGrid1Click(Sender: TObject);
begin
Dr;
end;
procedure TForm1.N1Click(Sender: TObject);//установка преград в ручную
begin
preg[StringGrid1.Col,StringGrid1.Row] := not preg[StringGrid1.Col,StringGrid1.Row];
Dr;
end;
procedure TForm1.N3Click(Sender: TObject);//установка финиша
begin
finish1 := StringGrid1.Col;
finish2 := StringGrid1.Row;
Dr;
end;
procedure TForm1.N4Click(Sender: TObject);
var
i,j:integer;
begin
StringGrid1.Refresh;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := false;
Dr;
end;
procedure TForm1.StringGrid1ContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
//для случая установки мышкой
begin
StringGrid1.Col := (Mouse.CursorPos.X-Form1.Left-StringGrid1.Left-5) div 13;
StringGrid1.Row := (Mouse.CursorPos.Y-Form1.Top-StringGrid1.Top-24) div 13;
end;
procedure TForm1.StringGrid1DblClick(Sender: TObject);
begin
N1.Click;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
StringGrid1.SetFocus;
HThread2 := CreateThread(nil, 0, @Execute2, nil, 0, ThreadId2);
repeat GetExitCodeThread(HThread2,exitcode) until exitcode <> still_active;
Dr;
end;
end.
Результаты представлены на рисунках 3.1 и 3.2
Рис.3.1 Программа до запуска
Рис.3.2 Программа запущена
Документ
Категория
Рефераты
Просмотров
35
Размер файла
280 Кб
Теги
лабораторная работа, лаб, лаба, лабораторная
1/--страниц
Пожаловаться на содержимое документа