Delphi11的多线程ⓞ

OLD Coder , 习惯使用Pascal 接下来准备启用多线程，毕竟硬件多核，Timer不太爽了（曾经的桌面，都是Timer——理解为“片”）

突然想写写，不知道还有多少D兄弟们在。

从源码开始

用D11之前用D7，为了兼容现在的“大WEB”（utf8Code，你猜用来写的什么？）只能升级到高版本——的确提供了很多的系功能，比如Mysql、SQLITE等。
用Delphi一切必须从源码开始——不要问为什么！

在D7这里插入图片描述

D7中的 TThread

~ 依然没有Pascal代码块~

  TThread = classprivate
{$IFDEF MSWINDOWS}FHandle: THandle;FThreadID: THandle;
{$ENDIF}
{$IFDEF LINUX}// ** FThreadID is not THandle in Linux **FThreadID: Cardinal;FCreateSuspendedSem: TSemaphore;FInitialSuspendDone: Boolean;
{$ENDIF}FCreateSuspended: Boolean;FTerminated: Boolean;FSuspended: Boolean;FFreeOnTerminate: Boolean;FFinished: Boolean;FReturnValue: Integer;FOnTerminate: TNotifyEvent;FSynchronize: TSynchronizeRecord;FFatalException: TObject;procedure CallOnTerminate;class procedure Synchronize(ASyncRec: PSynchronizeRecord); overload;
{$IFDEF MSWINDOWS}function GetPriority: TThreadPriority;procedure SetPriority(Value: TThreadPriority);
{$ENDIF}
{$IFDEF LINUX}// ** Priority is an Integer value in Linuxfunction GetPriority: Integer;procedure SetPriority(Value: Integer);function GetPolicy: Integer;procedure SetPolicy(Value: Integer);
{$ENDIF}procedure SetSuspended(Value: Boolean);protectedprocedure CheckThreadError(ErrCode: Integer); overload;procedure CheckThreadError(Success: Boolean); overload;procedure DoTerminate; virtual;procedure Execute; virtual; abstract;procedure Synchronize(Method: TThreadMethod); overload;property ReturnValue: Integer read FReturnValue write FReturnValue;property Terminated: Boolean read FTerminated;publicconstructor Create(CreateSuspended: Boolean);destructor Destroy; override;procedure AfterConstruction; override;procedure Resume;procedure Suspend;procedure Terminate;function WaitFor: LongWord;class procedure Synchronize(AThread: TThread; AMethod: TThreadMethod); overload;class procedure StaticSynchronize(AThread: TThread; AMethod: TThreadMethod);property FatalException: TObject read FFatalException;property FreeOnTerminate: Boolean read FFreeOnTerminate write FFreeOnTerminate;
{$IFDEF MSWINDOWS}property Handle: THandle read FHandle;property Priority: TThreadPriority read GetPriority write SetPriority;
{$ENDIF}
{$IFDEF LINUX}// ** Priority is an Integer **property Priority: Integer read GetPriority write SetPriority;property Policy: Integer read GetPolicy write SetPolicy;
{$ENDIF}property Suspended: Boolean read FSuspended write SetSuspended;
{$IFDEF MSWINDOWS}property ThreadID: THandle read FThreadID;
{$ENDIF}
{$IFDEF LINUX}// ** ThreadId is Cardinal **property ThreadID: Cardinal read FThreadID;
{$ENDIF}property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate;end;

在这里插入图片描述

D11中的TThread

  TThread = classprivate typePSynchronizeRecord = ^TSynchronizeRecord;TSynchronizeRecord = recordFThread: TObject;FMethod: TThreadMethod;FProcedure: TThreadProcedure;FSynchronizeException: TObject;FExecuteAfterTimestamp: Int64;procedure Init(AThread: TObject; const AMethod: TThreadMethod); overload;procedure Init(AThread: TObject; const AProcedure: TThreadProcedure); overload;end;TOnSynchronizeProc = reference to procedure (AThreadID: TThreadID; var AQueueEvent: Boolean;var AForceQueue: Boolean; var AMethod: TThreadMethod; var AProcedure: TThreadProcedure);private class varFProcessorCount: Integer;FOnSynchronize: TOnSynchronizeProc;privateFThreadID: TThreadID;
{$IF Defined(MSWINDOWS)}FHandle: THandle platform;
{$ELSEIF Defined(POSIX)}FCreateSuspendedMutex: pthread_mutex_t;FInitialSuspendDone: Boolean;FResumeEvent: sem_t;
{$ENDIF POSIX}FStarted: Boolean;FCreateSuspended: Boolean;[HPPGEN('volatile bool FTerminated')]FTerminated: Boolean;FSuspended: Boolean;FFreeOnTerminate: Boolean;[HPPGEN('volatile bool FFinished')]FFinished: Boolean;FReturnValue: Integer;FOnTerminate: TNotifyEvent;FFatalException: TObject;FExternalThread: Boolean;FShutdown: Boolean;class constructor Create;class destructor Destroy;procedure CallOnTerminate;class procedure Synchronize(ASyncRec: PSynchronizeRecord; QueueEvent: Boolean = False;ForceQueue: Boolean = False); overload;class function GetCurrentThread: TThread; static;class function GetIsSingleProcessor: Boolean; static; inline;procedure InternalStart(Force: Boolean);
{$IF Defined(MSWINDOWS)}function GetPriority: TThreadPriority; platform;procedure SetPriority(Value: TThreadPriority); platform;
{$ELSEIF Defined(POSIX)}function GetPriority: Integer; platform;procedure SetPriority(Value: Integer); platform;function GetPolicy: Integer; platform;procedure SetPolicy(Value: Integer); platform;
{$ENDIF POSIX}procedure SetSuspended(Value: Boolean);private class threadvar[Unsafe] FCurrentThread: TThread;protectedprocedure CheckThreadError(ErrCode: Integer); overload;procedure CheckThreadError(Success: Boolean); overload;procedure DoTerminate; virtual;procedure TerminatedSet; virtual;procedure Execute; virtual; abstract;procedure Queue(AMethod: TThreadMethod); overload; inline;procedure Synchronize(AMethod: TThreadMethod); overload; inline;procedure Queue(AThreadProc: TThreadProcedure); overload; inline;procedure Synchronize(AThreadProc: TThreadProcedure); overload; inline;procedure SetFreeOnTerminate(Value: Boolean);procedure ShutdownThread; virtual;class procedure InitializeExternalThreadsList;property ReturnValue: Integer read FReturnValue write FReturnValue;property Terminated: Boolean read FTerminated;public typeTSystemTimes = recordIdleTime, UserTime, KernelTime, NiceTime: UInt64;end;publicconstructor Create; overload;constructor Create(CreateSuspended: Boolean); overload;
{$IF Defined(MSWINDOWS)}constructor Create(CreateSuspended: Boolean; ReservedStackSize: NativeUInt); overload;
{$ENDIF MSWINDOWS}destructor Destroy; override;// CreateAnonymousThread will create an instance of an internally derived TThread that simply will call the// anonymous method of type TProc. This thread is created as suspended, so you should call the Start method// to make the thread run. The thread is also marked as FreeOnTerminate, so you should not touch the returned// instance after calling Start as it could have run and is then freed before another external calls or// operations on the instance are attempted.class function CreateAnonymousThread(const ThreadProc: TProc): TThread; static;procedure AfterConstruction; override;procedure BeforeDestruction; override;// This function is not intended to be used for thread synchronization.procedure Resume; deprecated;// Use Start after creating a suspended thread.procedure Start;// This function is not intended to be used for thread synchronization.procedure Suspend; deprecated;procedure Terminate;function WaitFor: LongWord;
{$IF Defined(POSIX)}// Use Schedule on Posix platform to set both policy and priority. This is useful// when you need to set policy to SCHED_RR or SCHED_FIFO, and priority > 0. They// cannot be set sequentionally using Policy and Priority properties. Setting// policy to SCHED_RR or SCHED_FIFO requires root privileges.procedure Schedule(APolicy, APriority: Integer);
{$ENDIF POSIX}// NOTE: You can only call CheckTerminated and SetReturnValue on an internally created thread.// Calling this from an externally created thread will raise an exception// Use TThread.CheckTerminated to check if the Terminated flag has been set on the current threadclass function CheckTerminated: Boolean; static;// Use TThread.SetReturnValue to set the current thread's return value from code that doesn't have// direct access to the current threadclass procedure SetReturnValue(Value: Integer); static;class procedure Queue(const AThread: TThread; AMethod: TThreadMethod); overload; static;class procedure Queue(const AThread: TThread; AThreadProc: TThreadProcedure); overload; static;class procedure RemoveQueuedEvents(const AThread: TThread; AMethod: TThreadMethod); overload; static;class procedure StaticQueue(const AThread: TThread; AMethod: TThreadMethod); static; deprecated 'From C++ just use Queue now that it is just a static method';class procedure Synchronize(const AThread: TThread; AMethod: TThreadMethod); overload; static;class procedure Synchronize(const AThread: TThread; AThreadProc: TThreadProcedure); overload; static;class procedure StaticSynchronize(const AThread: TThread; AMethod: TThreadMethod); static; deprecated 'From C++ just use Synchronize now that it is just a static method';/// <summary>///    Queue the method to delay its  synchronous execution. Unlike the Queue method, this will queue it even///    if the caller is in the main thread./// </summary>class procedure ForceQueue(const AThread: TThread; const AMethod: TThreadMethod; ADelay: Integer = 0); overload; static;/// <summary>///    Queue the procedure to delay its synchronous execution. Unlike the Queue method, this will queue it even///    if the caller is in the main thread./// </summary>class procedure ForceQueue(const AThread: TThread; const AThreadProc: TThreadProcedure; ADelay: Integer = 0); overload; static;class procedure RemoveQueuedEvents(const AThread: TThread); overload; static;class procedure RemoveQueuedEvents(AMethod: TThreadMethod); overload; static; inline;
{$IFNDEF NEXTGEN}class procedure NameThreadForDebugging(AThreadName: AnsiString; AThreadID: TThreadID = TThreadID(-1)); overload; static; //deprecated 'Use without AnsiString cast';
{$ENDIF !NEXTGEN}class procedure NameThreadForDebugging(AThreadName: string; AThreadID: TThreadID = TThreadID(-1)); overload; static;class procedure SpinWait(Iterations: Integer); static;class procedure Sleep(Timeout: Integer); static;class procedure Yield; static;// Call GetSystemTimes to get the current CPU ticks representing the amount of time the system has// spent Idle, in User's code, in Kernel or System code and Nice. For many systems, such as Windows,// the NiceTime is 0. NOTE: The KernelTime field also include the amount of time the system has been Idle.class function GetSystemTimes(out SystemTimes: TSystemTimes): Boolean; static;// Using the previously acquired SystemTimes structure, calculate the average time that the CPU has been// executing user and kernel code. This is the current CPU load the system is experiencing. The return value// is expressed as a percentage ranging from 0 to 100. NOTE: The passed in PrevSystemTimes record is updated// with the current system time values.class function GetCPUUsage(var PrevSystemTimes: TSystemTimes): Integer; static;// Returns current value in milliseconds of an internal system counterclass function GetTickCount: Cardinal; static;// Returns current value in milliseconds of an internal system counter with 64bitsclass function GetTickCount64: UInt64; static;/// <summary>///    Returns True if after AStartTime the specified ATimeout is passed.///    When ATimeout <= 0, then timeout is inifinite and function always returns False./// </summary>class function IsTimeout(AStartTime: Cardinal; ATimeout: Integer): Boolean; static;property ExternalThread: Boolean read FExternalThread;property FatalException: TObject read FFatalException;property FreeOnTerminate: Boolean read FFreeOnTerminate write SetFreeOnTerminate;property Finished: Boolean read FFinished;
{$IF Defined(MSWINDOWS)}property Handle: THandle read FHandle;property Priority: TThreadPriority read GetPriority write SetPriority;
{$ELSEIF Defined(POSIX)}// ** Priority is an Integer **property Priority: Integer read GetPriority write SetPriority;property Policy: Integer read GetPolicy write SetPolicy;
{$ENDIF POSIX}// Started is set to true once the thread has actually started running after the initial suspend.property Started: Boolean read FStarted;property Suspended: Boolean read FSuspended write SetSuspended;property ThreadID: TThreadID read FThreadID;property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate;/// <summary>///    The currently executing thread. This is the same as TThread.CurrentThread./// </summary>class property Current: TThread read GetCurrentThread;/// <summary>///    The currently executing thread. This is the same as TThread.Current.///    Please use TThread.Current, which is more clear and less redundant./// </summary>class property CurrentThread: TThread read GetCurrentThread;/// <summary>///    The number of processor cores on which this application is running. This will include virtual///    "Hyper-threading" cores on many modern Intel CPUs. It is ultimately based on what the underlying///    operating system reports./// </summary>class property ProcessorCount: Integer read FProcessorCount;/// <summary>///    Simple Boolean property to quickly determine wether running on a single CPU based system./// </summary>class property IsSingleProcessor: Boolean read GetIsSingleProcessor;/// <summary>///    Event handler, which is called before each Synchronize or Queue call./// </summary>class property OnSynchronize: TOnSynchronizeProc read FOnSynchronize write FOnSynchronize;end;

慢慢开始，我的需求很简单，从Timer改为Thread
第一步、启动线程优雅的执行耗时功能
第二部、启动线程池，让低配的硬件发光发热。
第三步、“论旧举杯先下泪，伤离临水更登楼。”

先去研究下这两段代码

无具体内容附送一段刚D11图片处理的代码：

1、引用单元

interface
usesWinapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Mask, Vcl.ExtCtrls,IdTCPConnection, IdTCPClient, IdHTTP, IdBaseComponent, IdComponent,IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL,HtmlParserEx, Vcl.ComCtrls,Winapi.Wincodec;

implementation
uses IdURI,Winapi.UrlMon,Jpeg,inifiles,RegularExpressions,Masks;

2、调用过程

procedure TForm1.Button1Click(Sender: TObject);
var I:Integer;s:String;SaveToFileName,sTitle,reFileName :String;
beginSaveToFileName:=Trim(edtTitle.Text);if chbxDownAll.Checked thenbeginfor I := 0 to scMainTree.Items.Count-1 dobeginif doFind( 0, scMainTree.Items[I] ) thenbeginif doWownCurrent(reFileName) thenbeginC_FormatPicture_Fix( reFileName,FWorkPath+trim(edtSubDir.Text)+'\',SaveToFileName, 800, 320,0 );end;if not chbxDownAll.Checked thenBreak;end;end;endelsebegin//编辑图片if doWownCurrent(reFileName) thenbeginC_FormatPicture_Fix( reFileName,FWorkPath+trim(edtSubDir.Text)+'\',SaveToFileName, 800, 320,100 );btnFindClick(nil);end;end;
end;

调试代码

3、实现单元引用

4、代码

// 优先缩放到固定高度，不满足缩放到宽度
function TForm1.C_FormatPicture_Fix(reFileName: String;SavePath:String;SaveToFileName:String;DestWidth,DestHeight:integer;ACompressionQuality:word): Boolean;
var w: TWICImage;nWIF: IWICImagingFactory;nWIS: IWICBitmapScaler;j: TJPEGImage;d:TBitmap;cmode:Integer;
beginResult:=False;Tryw:= TWICImage.Create;if not FileExists(reFilename) then Exit;w.LoadFromFile(reFilename);if ( w.Height < DestHeight ) and ( w.Width < DestWidth ) then Exit;//放缩模糊//放缩到 DestHeightnWIF := w.ImagingFactory;nWIF.CreateBitmapScaler(nWIS);nWIS.Initialize(w.Handle, round( w.Width*DestHeight / w.Height ), DestHeight , WICBitmapInterpolationModeFant);w.Handle := IWICBitmap(nWIS);  nWIS := nil;  nWIF := nil;//高度满足if (w.width >= DestWidth) thenbegincMode:=1;result:=true;endelsebegin//w.LoadFromFile(reFilename); 放缩到宽度nWIS := nil;  nWIF := nil;nWIF := w.ImagingFactory;nWIF.CreateBitmapScaler(nWIS);nWIS.Initialize(w.Handle, DestWidth, round( w.Height*DestWidth / w.Width ) , WICBitmapInterpolationModeFant);w.Handle := IWICBitmap(nWIS);  nWIS := nil;  nWIF := nil;if (w.Height > DestHeight) thenbegincMode:=2;Result:=true;end;end;if not Result then Exit;Result:=False;//Result:=True; cMode:=1;//w.SaveToFile(ExtractFilePath(refilename)+'_TTTTT_'+ExtractFileName(refilename)+'.jpg');j:= TJPEGImage.Create;j.Assign(w);d:= TBitmap.Create;d.Width:=DestWidth;d.Height:=DestHeight;if cMode=1 then//固定宽度d.Canvas.CopyRect(Rect(0,0,DestWidth,DestHeight),j.Canvas,Rect(  round( (j.Width-DestWidth) / 2)  , 0, DestWidth,DestHeight))else //固定高度d.Canvas.CopyRect(Rect(0,0,DestWidth,DestHeight),j.Canvas,Rect(  0  ,round( (j.Height-DestHeight) / 2),DestWidth,DestHeight));j.Assign(d);if ACompressionQuality in [1..100] thenbeginj.CompressionQuality := 100;//PressQuality;j.Compress;end;j.SaveToFile ( SavePath+'_M_'+SaveToFileName+'.jpg' );Result:=True;Finallyif assigned(w) then FreeAndNil(w);if assigned(j) then FreeAndNil(j);if assigned(d) then FreeAndNil(d);End;
end;