Delphi11的多线程ⓞ
OLD Coder , 习惯使用Pascal 接下来准备启用多线程，毕竟硬件多核，Timer不太爽了（曾经的桌面，都是Timer——理解为“片”）
突然想写写，不知道还有多少D兄弟们在。
从源码开始
用D11之前用D7，为了兼容现在的“大WEB”（utf8Code，你猜用来写的什么？）只能升级到高版本——的确提供了很多的系功能，比如Mysql、SQLITE等。
用Delphi一切必须从源码开始——不要问为什么！
D7中的 TThread
~ 依然没有Pascal代码块~
TThread = class
private
{$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 Linux
function GetPriority: Integer;
procedure SetPriority(Value: Integer);
function GetPolicy: Integer;
procedure SetPolicy(Value: Integer);
{$ENDIF}
procedure SetSuspended(Value: Boolean);
protected
procedure 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;
public
constructor 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 = class
private type
PSynchronizeRecord = ^TSynchronizeRecord;
TSynchronizeRecord = record
FThread: 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 var
FProcessorCount: Integer;
FOnSynchronize: TOnSynchronizeProc;
private
FThreadID: 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;
protected
procedure 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 type
TSystemTimes = record
IdleTime, UserTime, KernelTime, NiceTime: UInt64;
end;
public
constructor 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 thread
class 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 thread
class 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 counter
class function GetTickCount: Cardinal; static;
// Returns current value in milliseconds of an internal system counter with 64bits
class 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
uses
Winapi.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;
begin
SaveToFileName:=Trim(edtTitle.Text);
if chbxDownAll.Checked then
begin
for I := 0 to scMainTree.Items.Count-1 do
begin
if doFind( 0, scMainTree.Items[I] ) then
begin
if doWownCurrent(reFileName) then
begin
C_FormatPicture_Fix( reFileName,FWorkPath+trim(edtSubDir.Text)+'\',SaveToFileName, 800, 320,0 );
end;
if not chbxDownAll.Checked then
Break;
end;
end;
end
else
begin
//编辑图片
if doWownCurrent(reFileName) then
begin
C_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;
begin
Result:=False;
Try
w:= TWICImage.Create;
if not FileExists(reFilename) then Exit;
w.LoadFromFile(reFilename);
if ( w.Height < DestHeight ) and ( w.Width < DestWidth ) then Exit;
//放缩模糊
//放缩到 DestHeight
nWIF := 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) then
begin
cMode:=1;
result:=true;
end
else
begin
//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) then
begin
cMode:=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] then
begin
j.CompressionQuality := 100;//PressQuality;
j.Compress;
end;
j.SaveToFile ( SavePath+'_M_'+SaveToFileName+'.jpg' );
Result:=True;
Finally
if assigned(w) then FreeAndNil(w);
if assigned(j) then FreeAndNil(j);
if assigned(d) then FreeAndNil(d);
End;
end;
简单裁剪，穷人需要小体积图，懂得点赞。
说明：网络放缩部分参考自网络。
