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

2023-02-03 07:16:48

多线程编程(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.

posted on 2009-02-19 21:17 万一阅读(11985) 评论(18) 编辑收藏

码农公寓

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

相关文章