标签:ide ref 方式 sans exit rgba 访问 adl main
unit uFooList;interfaceuses Generics.Collections;type TFooList <T>= class(TList<T>) private procedure FreeAllItems; protected procedure FreeItem(Item: T);virtual; // 子类中需要重载此过程。以确定到底如何释放 Item // 如果是 Item 是指针,就用 Dispose(Item); // 如果是 Item 是TObject ,就用 Item.free; public destructor Destroy;override; procedure ClearAllItems; procedure Lock; // 给本类设计一把锁。 procedure Unlock; end; // 定义加入到 List 的 Item 都由 List 来释放。 // 定义释放规则很重要!只有规则清楚了,才不会乱套。 // 通过这样简单的改造, TList 立马好用 N 倍。implementation{ TFooList<T> }procedure TFooList<T>.ClearAllItems;begin FreeAllItems; Clear;end;destructor TFooList<T>.Destroy;begin FreeAllItems; inherited;end;procedure TFooList<T>.FreeAllItems;var Item: T;begin for Item in self do FreeItem(Item);end;procedure TFooList<T>.FreeItem(Item: T);beginend;procedure TFooList<T>.Lock;begin System.TMonitor.Enter(self);end;procedure TFooList<T>.Unlock;begin System.TMonitor.Exit(self);end;end.unit uFrmMain; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, uCountThread, uFooList;type TCountThreadList = Class(TFooList<TCountThread>) // 定义一个线程 List protected procedure FreeItem(Item: TCountThread); override; // 指定 Item 的释放方式。 end; TNumList = Class(TFooList<Integer>); // 定义一个 Integer List 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 } FNumList: TNumList; FCountThreadList: TCountThreadList; 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 LockCount; procedure UnlockCount; public { Public declarations } end;var FrmMain: TFrmMain;implementation{$R *.dfm}{ TFrmMain }{ TCountThreadList }procedure TCountThreadList.FreeItem(Item: TCountThread);begin inherited; Item.Free;end;procedure TFrmMain.btnWorkClick(Sender: TObject);var s: string; thd: TCountThread;begin btnWork.Enabled := false; FWorkedCount := 0; FBuffIndex := 0; FBuffMaxIndex := FNumList.Count - 1; s := ‘共‘ + IntToStr(FBuffMaxIndex + 1) + ‘个任务,已完成:‘ + IntToStr(FWorkedCount); lblInfo.Caption := s; for thd in FCountThreadList do begin thd.StartThread; end;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);var thd: TCountThread; i: Integer;begin FCountThreadList := TCountThreadList.Create; // 可以看出用了 List 之后,线程数量指定更加灵活。 // 多个线程在一个 List 中,这个 List 可以理解为线程池。 for i := 1 to 3 do begin thd := TCountThread.Create(false); FCountThreadList.Add(thd); thd.OnStatusMsg := self.OnThreadMsg; thd.OnGetNum := self.OnGetNum; thd.OnCounted := self.OnCounted; thd.ThreadName := ‘线程‘ + IntToStr(i); end; FNumList := TNumList.Create; // 构造一组数据用来测试 FNumList.Add(100); FNumList.Add(136); FNumList.Add(306); FNumList.Add(156); FNumList.Add(152); FNumList.Add(106); FNumList.Add(306); FNumList.Add(156); FNumList.Add(655); FNumList.Add(53); FNumList.Add(99); FNumList.Add(157);end;procedure TFrmMain.FormDestroy(Sender: TObject);begin FNumList.Free; FCountThreadList.Free;end;procedure TFrmMain.LockCount;begin System.TMonitor.Enter(btnWork);end;procedure TFrmMain.UnlockCount;begin System.TMonitor.Exit(btnWork);end;procedure TFrmMain.OnCounted(Sender: TCountThread);var s: string;begin LockCount; // 锁不同的对象,宜用不同的锁。 // 每把锁的功能要单一,锁的粒度要最小化。才能提高效率。 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 // 将多个线程访问 FNumList 排队。 FNumList.Lock; try if FBuffIndex > FBuffMaxIndex then begin result := false; end else begin Sender.Num := FNumList[FBuffIndex]; result := true; inc(FBuffIndex); end; finally FNumList.Unlock; end;end;procedure TFrmMain.OnThreadMsg(AMsg: string);begin TThread.Synchronize(nil, procedure begin DispMsg(AMsg); end);end;end.标签:ide ref 方式 sans exit rgba 访问 adl main
原文地址:http://www.cnblogs.com/lackey/p/6336658.html