Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
20
Добавлен:
02.05.2014
Размер:
2.64 Кб
Скачать
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus;

type
TForm1 = class(TForm)
ColorDialog1: TColorDialog;
MainMenu1: TMainMenu;
opt1: TMenuItem;
option1: TMenuItem;
add1: TMenuItem;
removethread1: TMenuItem;
add101: TMenuItem;
removeall1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure removethread1Click(Sender: TObject);
procedure add101Click(Sender: TObject);
procedure removeall1Click(Sender: TObject);
procedure add1Click(Sender: TObject);
private
{ Private declarations }
threadlist:tlist;
public
{ Public declarations }
end;
tdrawthread=class(tthread)
private
fcolor:tcolor;
fform:tform;
public
constructor create(aform:tform;acolor:tcolor);
procedure execute;override;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
{drawthread}
constructor tdrawthread.create(aform:tform;acolor:tcolor);
begin
fcolor:=acolor;
fform:=aform;
inherited create(false);
end;

procedure tdrawthread.execute;
var p1,p2:tpoint;

procedure getrandcoords;
var maxX,maxY:integer;
begin
maxX:=fform.ClientWidth;
maxY:=fform.ClientHeight;
p1.X:=random(maxX);
p2.X:=random(maxX) ;
p1.Y:=random(maxY);
p2.Y:=random(maxY) ;
end;
begin
freeonterminate:=true;
while not (terminated or application.Terminated) do
begin
getrandcoords;
with fform.Canvas do
begin
lock;
pen.Color:=fcolor;
moveto(p1.X,p1.Y);
lineto(p2.X,p2.Y);
unlock;
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
threadlist:=tlist.Create;
end;


procedure TForm1.FormDestroy(Sender: TObject);
begin
removeall1click(nil);
threadlist.Free;
end;


procedure TForm1.add1Click(Sender: TObject);
begin
if form1.ColorDialog1.Execute then
threadlist.Add(tdrawthread.create(self,ColorDialog1.Color));
end;


procedure TForm1.removethread1Click(Sender: TObject);
begin
tdrawthread(threadlist[threadlist.Count-1]).Terminate;
threadlist.Delete(threadlist.Count-1);
end;


procedure TForm1.add101Click(Sender: TObject);
var i:integer;
begin
for i:=1 to 3 do
threadlist.Add(tdrawthread.create(self,random(maxint)));
end;


procedure TForm1.removeall1Click(Sender: TObject);
var i:integer;
begin
cursor:=crhourglass;
try
for i:=threadlist.Count-1 downto 0 do
begin
tdrawthread(threadlist[i]).Terminate;
tdrawthread(threadlist[i]).WaitFor;
end;
threadlist.Clear;
finally;
cursor:=crdefault;
end;
end;


initialization
randomize;
end.
Соседние файлы в папке primerdraw
  • #
    02.05.20141.11 Кб20Project2.dof
  • #
    02.05.2014188 б20Project2.dpr
  • #
    02.05.2014876 б20Project2.res
  • #
    02.05.20146.87 Кб20Unit1.dcu
  • #
    02.05.20141.17 Кб20Unit1.dfm
  • #
    02.05.20142.64 Кб20Unit1.pas
  • #
    02.05.20141.12 Кб20Unit1.~dfm
  • #
    02.05.20142.64 Кб20Unit1.~pas