• Delphi线程类()


    View Code
    {*******************************************************}
    { }
    { Delphi Thread Sample }
    { Creation Date 2011.06.29 }
    { Created By: ming }
    { }
    {*******************************************************}
    unit unitWorkThread;

    interface

    uses
    Classes,Windows, Messages, SysUtils, Graphics, StdCtrls;

    type
    TWorkThread
    = class(TThread)
    private
    { Private declarations }
    FEvent: HWND;
    FMsg:
    string;
    FMemo: TMemo;
    FInterval: Cardinal;
    procedure doSyncProc1;
    procedure doSomething;
    procedure syncOutputMsg;
    procedure doOutputMsg(const msg: string);
    procedure _sleep(millisecond:Cardinal);
    protected
    procedure Execute; override;
    public
    constructor Create(Suspend: boolean); overload;
    constructor Create(Suspend: boolean; mmoOutput: TMemo); overload;
    destructor Destroy; override;
    public
    procedure exitThread;
    public
    property Interval:Cardinal read FInterval write FInterval;
    end;

    var
    WorkThread: TWorkThread;

    implementation

    { TWorkThread }

    constructor TWorkThread.Create(Suspend: boolean);
    begin
    inherited Create(Suspend);
    FEvent :
    = CreateEvent(nil,False,False,nil);
    FreeOnTerminate :
    = True;
    FInterval :
    = 100;
    end;

    constructor TWorkThread.Create(Suspend: boolean; mmoOutput: TMemo);
    begin
    inherited Create(Suspend);
    FEvent :
    = CreateEvent(nil,False,False,nil);
    FreeOnTerminate :
    = True;
    FInterval :
    = 100;
    FMemo :
    = mmoOutput;
    doOutputMsg(
    'Thread Create');
    end;

    destructor TWorkThread.Destroy;
    begin
    CloseHandle(FEvent);
    doOutputMsg(
    'Thread Destroy');
    inherited;
    end;

    procedure TWorkThread.doSyncProc1;
    begin

    end;

    procedure TWorkThread.doOutputMsg(const msg: string);
    begin
    FMsg :
    = msg;
    Synchronize(syncOutputMsg);
    end;

    procedure TWorkThread.syncOutputMsg;
    begin
    if Assigned(FMemo) then
    FMemo.Lines.Add(FMsg);
    end;

    procedure TWorkThread.doSomething;
    begin
    //Synchronize(doSyncProc1);
    doOutputMsg(FormatDateTime(
    'HH:NN:SS',now));
    end;

    procedure TWorkThread.Execute;
    begin
    inherited;
    while not Terminated do
    begin
    if WaitForSingleObject(FEvent,FInterval)=WAIT_OBJECT_0 then
    begin
    Break;
    end;
    doSomething;
    //_sleep(FInterval);
    end;
    end;

    procedure TWorkThread.exitThread;
    begin
    if FEvent>0 then
    begin
    SetEvent(FEvent);
    if Suspended then Resume;
    end;
    end;

    procedure TWorkThread._sleep(millisecond: Cardinal);
    begin
    WaitForSingleObject(Self.Handle,millisecond);
    end;

    {=============================================================}
    { Use TWorkThread
    procedure TForm1.btnCreateThreadClick(Sender: TObject);
    begin
    WorkThread := TWorkThread.Create(False,mmoOutput);
    //WorkThread.Interval := 1000;
    if WorkThread.Suspended then
    WorkThread.Resume;
    end;

    procedure TForm1.btnDestroyThreadClick(Sender: TObject);
    begin
    if Assigned(WorkThread) then
    WorkThread.exitThread;
    end;
    }

    end.

  • 相关阅读:
    centos 7遇到的问题
    Exceptions&Files
    关于Transtion属性收藏
    游戏主循环知识积累
    display:inline、block、inline-block的区别
    Sublime text 3快捷键收藏
    业务逻辑详解随记
    探究Struts2运行机制,知识积累
    将博客搬至CSDN
    url随记
  • 原文地址:https://www.cnblogs.com/Jekhn/p/2093068.html
Copyright © 2020-2023  润新知