Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
21
Добавлен:
02.05.2014
Размер:
3 Кб
Скачать
☆
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.2014876 б21Project2.res
  • #
    02.05.20141 Кб21Unit1.~dfm
  • #
    02.05.20143 Кб21Unit1.~pas
  • #
    02.05.20147 Кб21Unit1.dcu
  • #
    02.05.20141 Кб21Unit1.dfm
  • #
    02.05.20143 Кб21Unit1.pas