孤独的猫

  博客园 :: 首页 :: 博问 :: 闪存 :: 新随笔 :: 联系 :: 订阅 订阅 :: 管理 ::

      VCL对象不是线程安全的,而且它们的属性和方法必须要从VCL主线程中进行访问或被执行,但有两种VCL对象是例外的情况,它们是线程安全的。一种是任何图形对象,另一种是TThreadList。

     这意味着不必非得在主VCL线程中才能设置一个画布的画笔颜色,或画刷类型,可以在另一个线程的环境中完成一点。对于图形对象,使用Lock和UnLock,而对于ThreadList,则使用LockList和UnLockList,这些方法的行为类似于临界区,在调用它们的时候会阻止其他线程的执行。因为Lock会中断所有线程的执行,所以如果使用不正确的话,应用程序性能会有很大下降。比如:

Form1.Canvas.Lock;
For i := 0 to 10000 do
  begin
    Form1.Canvas.TextOut(20,20,str);
  end;
Form1.Canvas.UnLock;上面这个代码中,Lock后再循环,则循环结构过于拥挤,锁定时间过长。所以应该将Lock与UnLock放在循环里面。

     下面的例子,通过多线程对窗体画布进行画线。点“开始”菜单创建N个线程同时往窗体画线,点“结束”同时终止N个线程。

   {主窗体代码}  
  1. unit Main;  
  2.    
  3. interface  
  4.    
  5. uses  
  6.   Windows, Messages, SysUtils, Variants, Classes,  
  7.   Graphics, Controls, Forms,   Dialogs, Menus;  
  8.    
  9. type  
  10.   TForm2 = class(TForm)  
  11.     MainMenu1: TMainMenu;  
  12.     S1: TMenuItem;  
  13.     T1: TMenuItem;  
  14.     procedure S1Click(Sender: TObject);  
  15.     procedure T1Click(Sender: TObject);  
  16.     procedure FormCreate(Sender: TObject);  
  17.     procedure FormDestroy(Sender: TObject);  
  18.   private  
  19.     { Private declarations }  
  20.   public  
  21.     { Public declarations }  
  22.   end;  
  23.    
  24. var  
  25.   Form2: TForm2;  
  26.   List:TList;  
  27. implementation  
  28.    
  29. uses DrawThread;  
  30.    
  31. {$R *.dfm}  
  32.    
  33. procedure TForm2.FormCreate(Sender: TObject);  
  34. begin  
  35.   List:=TList.Create;  
  36. end;  
  37.    
  38. procedure TForm2.FormDestroy(Sender: TObject);  
  39. begin  
  40.   List.Free;  
  41. end;  
  42. //“开始”菜单   
  43. procedure TForm2.S1Click(Sender: TObject);  
  44. var  
  45.   value:string;  
  46.   i: Integer;  
  47. begin  
  48.   value:=InputBox('提示','请输入需要创建多少线程:','3');  
  49.   try  
  50.     for i := 0 to StrToInt(value) - 1 do  
  51.       List.Add(TDrawThread.create(self));  
  52.   except  
  53.     on e:Exception do  
  54.     ShowMessage(e.Message);  
  55.   end;  
  56. end;  
  57. //“结束”菜单   
  58. procedure TForm2.T1Click(Sender: TObject);  
  59. var  
  60.   I: Integer;  
  61. begin  
  62.   Cursor:=crHourGlass;  
  63.   try  
  64.   for I := List.Count - 1 downto 0 do  
  65.     begin  
  66.       TDrawThread(List[i]).Terminate;  
  67.     end;  
  68.   List.Clear;  
  69.   finally  
  70.     Cursor:=crDefault;  
  71.   end;  
  72.   ShowMessage('线程已终止');  
  73. end;  
  74.    
  75. end.{多线程类}  
  76. unit DrawThread;  
  77.    
  78. interface  
  79.    
  80. uses  
  81.   Classes,Forms;  
  82.    
  83. type  
  84.   TDrawThread = class(TThread)  
  85.   private  
  86.     { Private declarations }  
  87.     FForm:TForm;  
  88.     FWidth,FHeight:Integer;  
  89.   protected  
  90.     procedure Execute; override;  
  91.   public  
  92.     constructor create(AForm:TForm);  
  93.   end;  
  94.    
  95. implementation  
  96.    
  97. uses Main,Types,Windows;  
  98.    
  99. { TDrawThread }  
  100.    
  101. constructor TDrawThread.create(AForm: TForm);  
  102. begin  
  103.   FForm:=AForm;  
  104.   FWidth:=FForm.Width;  
  105.   FHeight:=FForm.Height;  
  106.   Inherited Create(False);  
  107. end;  
  108.    
  109. procedure TDrawThread.Execute;  
  110. var  
  111.   p1,p2:TPoint;  
  112. begin  
  113.   { Place thread code here }  
  114.   FreeOnTerminate:=True;  
  115.   while Not (Terminated or Application.Terminated) do  
  116.   begin  
  117.     Randomize;  
  118.     P1.X:=Random(FWidth);  
  119.     P1.Y:=Random(FHeight);  
  120.     P2.X:=Random(FWidth);  
  121.     P2.Y:=Random(FHeight);  
  122.     FForm.Canvas.Pen.Color:=RGB(Random(256),Random(256),Random(256));  
  123.     with FForm.Canvas do  
  124.     begin  
  125.       Lock;  
  126.       MoveTo(P1.X,P1.Y);  
  127.       LineTo(P2.X,p2.Y);  
  128.       UnLock;    
  129.     end;  
  130.   end;  
  131. end;  
  132.    
  133. end.  

 

运行情况如下(如果想看它慢慢画的话,只要在UnLock后加上Sleep(100)):

posted on 2012-03-06 20:31  孤独的猫  阅读(1807)  评论(0)    收藏  举报