zoukankan      html  css  js  c++  java
  • delphi 线程教学第五节:多个线程同时执行相同的任务

    转载自:https://www.cnblogs.com/lackey/p/6306368.html

    第五节:多个线程同时执行相同的任务
     
    1.锁
     
    设,有一个房间 X ,X为全局变量,它有两个函数  X.Lock 与 X.UnLock;
    有如下代码:
     
    X.Lock;  
       访问资源 P;
    X.Unlock;
    

      

     
    现在有A,B两个线程时空都要执行此段代码。
    当线程A执行了 X.Lock 之后,在没有执行完  X.Unlock 之前,第二个线程B此时也来执行 X.Lock ,
    线程B就会阻塞在 X.Lock 这句代码上。我们可以认为,此时,线程A进入房间,其它线程不准再进入房间。
    只能在外面等,直到线程A执行完 X.Unlock 后,线程A退出了房间,此时线程B才可以进入。
    线程B进入了房间后,其它线程此时同样不准再进入。
     
    即:多个线程用本段代码“访问资源P”的操作是排队执行的。
     
    2.  TMonitor
     
    在 delphi XE2 及以后的版本中,提供了一个方便的锁功能。TMonitor。
    它是一个Record, TMonitor.Enter(X); 与 TMoniter.Exit(X); 等效于上面 lock 与 unlock;
    X 可以是任何一个 TObject 实例。
     
    本例源码下载(delphi XE8版本):FooMuliThread.zip
     
    unit uCountThread; 
    interface 
    uses
      uFooThread; 
    type
      TCountThread = class;
      TOnGetNum = function(Sender: TCountThread): boolean of object; //获取 Num 事件。
      TOnCounted = procedure(Sender: TCountThread) of object;
      TCountThread = class(TFooThread)
      private
        procedure Count;
        procedure DoOnCounted;
        function DoOnGetNum: boolean;
      public
        procedure StartThread; override;
      public
        Num: integer;
        Total: integer;
        OnCounted: TOnCounted;
        OnGetNum: TOnGetNum;
        ThreadName: string;
      end;
     
    implementation
     
    { TCountThread }
     
    procedure TCountThread.Count;
    var
      i: integer;
    begin
     
      // 注意多线程不适合打断点调试。
      // 因为一旦在 IDE 中断后,状态全乱了。
      // 可以写 Log 或用脑袋想,哈哈。
     
      if DoOnGetNum then // 获取参数 Num
      begin
        Total := 0;
        if Num > 0 then
          for i := 1 to Num do
          begin
            Total := Total + i;
            sleep(5); //嫌慢就删掉此句。
          end;
        DoOnCounted; // 引发 OnCounted 事件,告知调用者。
        ExecProcInThread(Count); // 上节说到在线程时空里执行本句。
      end;
     
    end;
     
    procedure TCountThread.DoOnCounted;
    begin
      if Assigned(OnCounted) then
        OnCounted(self);
    end;
     
    function TCountThread.DoOnGetNum: boolean;
    begin
      result := false;
      if Assigned(OnGetNum) then
        result := OnGetNum(self);
    end;
     
    procedure TCountThread.StartThread;
    begin
      inherited;
      ExecProcInThread(Count); // 把 Count 过程塞到线程中运行。
    end;
     
    end.
     
    unit uFrmMain;
    interface
    uses
      Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Graphics,
      Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, uCountThread;
     
    type
      TFrmMain = class(TForm)
        memMsg: TMemo;
        edtNum: TEdit;
        btnWork: TButton;
        lblInfo: TLabel;
        procedure FormCreate(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
        procedure btnWorkClick(Sender: TObject);
        procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
      private
        { Private declarations }
        FCo1, FCo2, FCo3: TCountThread; // 定义了3个线程实例
        // 以后章节将讲解采用 List 容器来装线程实例。
        FBuff: TStringList;
        FBuffIndex: integer;
        FBuffMaxIndex: integer;
        FWorkedCount: integer;
        procedure DispMsg(AMsg: string);
        procedure OnThreadMsg(AMsg: string);
     
        function OnGetNum(Sender: TCountThread): Boolean;
        procedure OnCounted(Sender: TCountThread);
     
        procedure LockBuffer;
        procedure UnlockBuffer;
     
        procedure LockCount;
        procedure UnlockCount;
     
      public
        { Public declarations }
      end;
     
    var
      FrmMain: TFrmMain;
     
    implementation
     
    {$R *.dfm}
    { TFrmMain }
     
    procedure TFrmMain.btnWorkClick(Sender: TObject);
    var
      s: string;
    begin
     
      btnWork.Enabled := false;
      FWorkedCount := 0;
      FBuffIndex := 0;
      FBuffMaxIndex := FBuff.Count - 1;
     
      s := '共' + IntToStr(FBuffMaxIndex + 1) + '个任务,已完成:' + IntToStr(FWorkedCount);
      lblInfo.Caption := s;
     
      FCo1.StartThread;
      FCo2.StartThread;
      FCo3.StartThread;
     
    end;
     
    procedure TFrmMain.DispMsg(AMsg: string);
    begin
      memMsg.Lines.Add(AMsg);
    end;
     
    procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    begin
      // 防止计算期间退出
      LockCount; // 请思考,这里为什么要用 LockCount;
      CanClose := btnWork.Enabled;
      if not btnWork.Enabled then
        DispMsg('正在计算,不准退出!');
      UnlockCount;
    end;
     
    procedure TFrmMain.FormCreate(Sender: TObject);
    begin
     
      FCo1 := TCountThread.Create(false);
      FCo1.OnStatusMsg := self.OnThreadMsg;
      FCo1.OnGetNum := self.OnGetNum;
      FCo1.OnCounted := self.OnCounted;
      FCo1.ThreadName := '线程1';
     
      FCo2 := TCountThread.Create(false);
      FCo2.OnStatusMsg := self.OnThreadMsg;
      FCo2.OnGetNum := self.OnGetNum;
      FCo2.OnCounted := self.OnCounted;
      FCo2.ThreadName := '线程2';
     
      FCo3 := TCountThread.Create(false);
      FCo3.OnStatusMsg := self.OnThreadMsg;
      FCo3.OnGetNum := self.OnGetNum;
      FCo3.OnCounted := self.OnCounted;
      FCo3.ThreadName := '线程3';
     
      FBuff := TStringList.Create;
     
      // 构造一组数据用来测试
     
      FBuff.Add('100');
      FBuff.Add('136');
      FBuff.Add('306');
      FBuff.Add('156');
      FBuff.Add('152');
      FBuff.Add('106');
      FBuff.Add('306');
      FBuff.Add('156');
      FBuff.Add('655');
      FBuff.Add('53');
      FBuff.Add('99');
      FBuff.Add('157');
     
    end;
     
    procedure TFrmMain.FormDestroy(Sender: TObject);
    begin
      FCo1.Free;
      FCo2.Free;
      FCo3.Free;
    end;
     
    procedure TFrmMain.LockBuffer;
    begin
      System.TMonitor.Enter(FBuff);
      // System 是单元名。因为 TMonitor 在 Forms 中也有一个相同的名字。
      // 同名的类与函数,就要在前面加单元名称以示区别。
    end;
     
    procedure TFrmMain.LockCount;
    begin
      // 任意一个 TObject 就行,所以我用了 btnWork
      System.TMonitor.Enter(btnWork);
    end;
     
    procedure TFrmMain.OnCounted(Sender: TCountThread);
    var
      s: string;
    begin
     
      LockCount; // 此处亦可以用 LockBuffer
      // 但是,锁不同的对象,宜用不同的锁。
      // 每把锁的功能要单一,锁的粒度要最小化。才能提高效率。
     
      s := Sender.ThreadName + ':' + IntToStr(Sender.Num) + '累加和为:';
      s := s + IntToStr(Sender.Total);
      OnThreadMsg(s);
     
      inc(FWorkedCount);
     
      s := '共' + IntToStr(FBuffMaxIndex + 1) + '个任务,已完成:' + IntToStr(FWorkedCount);
     
      TThread.Synchronize(nil,
        procedure
        begin
          lblInfo.Caption := s;
        end);
     
      if FWorkedCount >= FBuffMaxIndex + 1 then
      begin
        TThread.Synchronize(nil,
          procedure
          begin
            DispMsg('已计算完成');
            btnWork.Enabled := true; // 恢复按钮状态。
          end);
      end;
     
      UnlockCount;
     
    end;
     
    function TFrmMain.OnGetNum(Sender: TCountThread): Boolean;
    begin
      LockBuffer; // 将多个线程访问 FBuff 排队。
      try
        if FBuffIndex > FBuffMaxIndex then
        begin
          result := false;
        end
        else
        begin
          Sender.Num := StrToInt(FBuff[FBuffIndex]);
          result := true;
          inc(FBuffIndex);
        end;
      finally
        UnlockBuffer;
      end;
    end;
     
    procedure TFrmMain.OnThreadMsg(AMsg: string);
    begin
      TThread.Synchronize(nil,
        procedure
        begin
          DispMsg(AMsg);
        end);
    end;
     
    procedure TFrmMain.UnlockBuffer;
    begin
      System.TMonitor.Exit(FBuff);
    end;
     
    procedure TFrmMain.UnlockCount;
    begin
      System.TMonitor.Exit(btnWork);
    end;
     
    end.
    

    下一节,我们将学习 List 与泛型。为以后设计其它的更高级与灵活的线程做准备。

  • 相关阅读:
    Digital Video Stabilization and Rolling Shutter Correction using Gyroscope 论文笔记
    Distortion-Free Wide-Angle Portraits on Camera Phones 论文笔记
    Panorama Stitching on Mobile
    Natural Image Stitching with the Global Similarity Prior 论文笔记 (三)
    Natural Image Stitching with the Global Similarity Prior 论文笔记(二)
    Natural Image Stitching with the Global Similarity Prior 论文笔记(一)
    ADCensus Stereo Matching 笔记
    Efficient Large-Scale Stereo Matching论文解析
    Setting up caffe on Ubuntu
    Kubernetes配置Secret访问Harbor私有镜像仓库
  • 原文地址:https://www.cnblogs.com/approx/p/11852171.html
Copyright © 2011-2022 走看看