多线程编程(18) - 再从一个小例子出发

前面的例子都是让若干线程做同样的事情, 下面这个例子中的三个线程将分别在三个画板上随机画不同颜色的椭圆.
接下来的很多事情我想要基于这个例子来做.

---

本例效果图:

---

代码文件:

---

unit Unit1;



interface



uses

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

  Dialogs, StdCtrls, ExtCtrls;



type

  TForm1 = class(TForm)

    PaintBox1: TPaintBox;

    PaintBox2: TPaintBox;

    PaintBox3: TPaintBox;

    Button1: TButton;

    procedure Button1Click(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



var

  h1,h2,h3: THandle;



{第一个线程的入口函数: 画红色椭圆}

function ThreadFun1(p: Pointer): Integer; stdcall;

var

  i, x1,y1,x2,y2: Integer;

begin

  Form1.PaintBox1.Canvas.Brush.Color := clRed;

  for i := 0 to 50000 do with Form1.PaintBox1 do

  begin

    x1 := Random(Width); y1 := Random(Height);

    x2 := Random(Width); y2 := Random(Height);

    Canvas.Lock;

    Canvas.Ellipse(x1,y1,x2,y2);

    Canvas.Unlock;

    Sleep(0);

  end;

  Result := 0;

end;



{第二个线程的入口函数: 画绿色椭圆}

function ThreadFun2(p: Pointer): Integer; stdcall;

var

  i, x1,y1,x2,y2: Integer;

begin

  Form1.PaintBox2.Canvas.Brush.Color := clGreen;

  for i := 0 to 50000 do with Form1.PaintBox2 do

  begin

    x1 := Random(Width); y1 := Random(Height);

    x2 := Random(Width); y2 := Random(Height);

    Canvas.Lock;

    Canvas.Ellipse(x1,y1,x2,y2);

    Canvas.Unlock;

    Sleep(0);

  end;

  Result := 0;

end;



{第三个线程的入口函数: 画蓝色椭圆}

function ThreadFun3(p: Pointer): Integer; stdcall;

var

  i, x1,y1,x2,y2: Integer;

begin

  Form1.PaintBox3.Canvas.Brush.Color := clBlue;

  for i := 0 to 50000 do with Form1.PaintBox3 do

  begin

    x1 := Random(Width); y1 := Random(Height);

    x2 := Random(Width); y2 := Random(Height);

    Canvas.Lock;

    Canvas.Ellipse(x1,y1,x2,y2);

    Canvas.Unlock;

    Sleep(0);

  end;

  Result := 0;

end;



procedure TForm1.Button1Click(Sender: TObject);

var

  ID: DWORD;

begin

  h1 := CreateThread(nil, 0, @ThreadFun1, nil, 0, ID);

  h2 := CreateThread(nil, 0, @ThreadFun2, nil, 0, ID);

  h3 := CreateThread(nil, 0, @ThreadFun3, nil, 0, ID);

end;



procedure TForm1.FormDestroy(Sender: TObject);

begin

  CloseHandle(h1);

  CloseHandle(h2);

  CloseHandle(h3);

end;



end.


 
   

窗体文件:

---

object Form1: TForm1

  Left = 0

  Top = 0

  Caption = 'Form1'

  ClientHeight = 206

  ClientWidth = 371

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'Tahoma'

  Font.Style = []

  OldCreateOrder = False

  OnDestroy = FormDestroy

  PixelsPerInch = 96

  TextHeight = 13

  object PaintBox1: TPaintBox

    Left = 8

    Top = 8

    Width = 114

    Height = 153

  end

  object PaintBox2: TPaintBox

    Left = 128

    Top = 8

    Width = 114

    Height = 153

  end

  object PaintBox3: TPaintBox

    Left = 248

    Top = 8

    Width = 114

    Height = 153

  end

  object Button1: TButton

    Left = 288

    Top = 172

    Width = 75

    Height = 25

    Caption = 'Button1'

    TabOrder = 0

    OnClick = Button1Click

  end

end


 
   

可以借助入口函数的参数, 把这个程序简化一下(窗体和运行效果不变):

---

unit Unit1;



interface



uses

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

  Dialogs, StdCtrls, ExtCtrls;



type

  TForm1 = class(TForm)

    PaintBox1: TPaintBox;

    PaintBox2: TPaintBox;

    PaintBox3: TPaintBox;

    Button1: TButton;

    procedure Button1Click(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



var

  h1,h2,h3: THandle;



{线程的入口函数: 不同的线程画不同颜色的椭圆}

function ThreadFun(p: Pointer): Integer; stdcall;

var

  i,x1,y1,x2,y2: Integer;

  paint: TPaintBox;

begin

  case Integer(p) of

    1: begin

      paint := Form1.PaintBox1;

      paint.Canvas.Brush.Color := clRed;

    end;

    2: begin

      paint := Form1.PaintBox2;

      paint.Canvas.Brush.Color := clGreen

    end;

    3: begin

      paint := Form1.PaintBox3;

      paint.Canvas.Brush.Color := clBlue;

    end;

  end;



  for i := 0 to 5000 do with paint do

  begin

    x1 := Random(Width); y1 := Random(Height);

    x2 := Random(Width); y2 := Random(Height);

    Canvas.Lock;

    Canvas.Ellipse(x1,y1,x2,y2);

    Canvas.Unlock;

    Sleep(0);

  end;

  Result := 0;

end;



procedure TForm1.Button1Click(Sender: TObject);

var

  ID: DWORD;

begin

  h1 := CreateThread(nil, 0, @ThreadFun, Ptr(1), 0, ID);

  h2 := CreateThread(nil, 0, @ThreadFun, Ptr(2), 0, ID);

  h3 := CreateThread(nil, 0, @ThreadFun, Ptr(3), 0, ID);

end;



procedure TForm1.FormDestroy(Sender: TObject);

begin

  CloseHandle(h1);

  CloseHandle(h2);

  CloseHandle(h3);

end;



end.


 
   

多用点数组, 再简化一下(窗体与效果一样):

---

unit Unit1;



interface



uses

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

  Dialogs, StdCtrls, ExtCtrls;



type

  TForm1 = class(TForm)

    PaintBox1: TPaintBox;

    PaintBox2: TPaintBox;

    PaintBox3: TPaintBox;

    Button1: TButton;

    procedure Button1Click(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



const

  colors: array[0..2] of TColor = (clRed, clGreen, clBlue);

var

  hArr: array[0..2] of THandle;

  panitArr: array[0..2] of TPaintBox;



function ThreadFun(p: Pointer): Integer; stdcall;

var

  i,n,x1,y1,x2,y2: Integer;

begin

  n := Integer(p);

  panitArr[n].Color := colors[n];



  for i := 0 to 5000 do with panitArr[n] do

  begin

    x1 := Random(Width); y1 := Random(Height);

    x2 := Random(Width); y2 := Random(Height);

    Canvas.Lock;

    Canvas.Ellipse(x1,y1,x2,y2);

    Canvas.Unlock;

    Sleep(0);

  end;

  Result := 0;

end;



procedure TForm1.Button1Click(Sender: TObject);

var

  ID: DWORD;

  i: Integer;

begin

  panitArr[0] := PaintBox1;

  panitArr[1] := PaintBox2;

  panitArr[2] := PaintBox3;

  for i := 0 to Length(hArr) - 1 do

    hArr[i] := CreateThread(nil, 0, @ThreadFun, Ptr(i), 0, ID);

end;



procedure TForm1.FormDestroy(Sender: TObject);

var

  i: Integer;

begin

  for i := 0 to Length(hArr) - 1 do CloseHandle(hArr[i]);

end;



end.