Года 3 тому пользовался Delphi. Возникла необходимость (скорее желание) поработать с объектом TThread. Работать с ним показалось сложным, потому был создан компонент для простого добавления на окно при разработке (на основе TComponent). Никакого серьёзного разбора сей проблемы перед началом создания такого компонента не проводилось.
То что было сделано:
- Код: Выделить всё
Unit UKTRWProcMem;
{ license: GNU GPL }
{------------------------------------------------------------------------------}
interface
{------------------------------------------------------------------------------}
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, UKTElse, UKTGraph, Contnrs, PsAPI, TlHelp32;
{------------------------------------------------------------------------------}
type
//...
KTSimpleThread = class(TThread)
private
_Proc : TNotifyEvent;
_Cycle : Boolean;
_Synchronic : Boolean;
protected
procedure Run;
procedure Execute; override;
public
constructor Create;
published
property DoThis: TNotifyEvent read _Proc write _Proc;
property Cycle: Boolean read _Cycle write _Cycle;
property Synchronic: Boolean read _Synchronic write _Synchronic;
end;
KTSynchronicThread = class(TComponent)
private
_Thread: KTSimpleThread;
protected
function GetDoThis: TNotifyEvent;
procedure SetDoThis(S: TNotifyEvent);
function GetCycle: Boolean;
procedure SetCycle(S: Boolean);
function GetSuspend: Boolean;
procedure SetSuspend(S: Boolean);
function GetPriority: TThreadPriority;
procedure SetPriority(S: TThreadPriority);
function GetSynchronic: Boolean;
procedure SetSynchronic(S: Boolean);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Thread: KTSimpleThread read _Thread;
published
property DoThis: TNotifyEvent read GetDoThis write SetDoThis;
property Cycle: Boolean read GetCycle write SetCycle;
property Suspend: Boolean read GetSuspend write SetSuspend;
property Priority: TThreadPriority read GetPriority write SetPriority;
property Synchronic: Boolean read GetSynchronic write SetSynchronic;
end;
//...
procedure Register;
{------------------------------------------------------------------------------}
implementation
{------------------------------------------------------------------------------}
{$R *.res}
//...
procedure Register;
begin
RegisterComponents('avi9526', [KTSynchronicThread]);
end;
//...
{------------------------------------------------------------------------------}
constructor KTSimpleThread.Create;
begin
inherited Create(True);
end;
{------------------------------------------------------------------------------}
procedure KTSimpleThread.Execute;
begin
repeat
if _Synchronic
then
Synchronize(Run)
else
Run;
until NOT Cycle;
end;
{------------------------------------------------------------------------------}
procedure KTSimpleThread.Run;
begin
if Assigned(_Proc)
then
_Proc(Self);
end;
{------------------------------------------------------------------------------}
//...
{------------------------------------------------------------------------------}
constructor KTSynchronicThread.Create(AOwner: TComponent);
begin
_Thread := KTSimpleThread.Create;
inherited;
Suspend := True;
_Thread._Synchronic := True;
end;
{------------------------------------------------------------------------------}
destructor KTSynchronicThread.Destroy;
begin
inherited;
Cycle := False;
_Thread.Terminate;
_Thread.Destroy;
end;
{------------------------------------------------------------------------------}
function KTSynchronicThread.GetDoThis: TNotifyEvent;
begin
Result := _Thread._Proc;
end;
{------------------------------------------------------------------------------}
procedure KTSynchronicThread.SetDoThis(S: TNotifyEvent);
begin
_Thread.DoThis := S;
end;
{------------------------------------------------------------------------------}
function KTSynchronicThread.GetCycle: Boolean;
begin
Result := _Thread.Cycle;
end;
{------------------------------------------------------------------------------}
procedure KTSynchronicThread.SetCycle(S: Boolean);
begin
_Thread.Cycle := S;
end;
{------------------------------------------------------------------------------}
function KTSynchronicThread.GetSuspend: Boolean;
begin
Result := _Thread.Suspended;
end;
{------------------------------------------------------------------------------}
procedure KTSynchronicThread.SetSuspend(S: Boolean);
begin
if _Thread.Suspended <> S
then
if (S) OR (Assigned(_Thread._Proc))
then
_Thread.Suspended := S;
end;
{------------------------------------------------------------------------------}
function KTSynchronicThread.GetPriority: TThreadPriority;
begin
Result := _Thread.Priority;
end;
{------------------------------------------------------------------------------}
procedure KTSynchronicThread.SetPriority(S: TThreadPriority);
begin
if _Thread.Priority <> S
then
_Thread.Priority := S;
end;
{------------------------------------------------------------------------------}
function KTSynchronicThread.GetSynchronic: Boolean;
begin
Result := _Thread.Synchronic;
end;
{------------------------------------------------------------------------------}
procedure KTSynchronicThread.SetSynchronic(S: Boolean);
begin
if _Thread.Synchronic <> S
then
_Thread.Synchronic := S;
end;
{------------------------------------------------------------------------------}
//...
end.
Вопросы:
Сегодня решил продолжить работу с этим делом под Linux с FPC и Lazarus от чего решил таки посоветоваться, дабы избежать изобретения велосипеда с квадратными колесами)
1) создание такого компонента имеет смысл?
2) есть какие-то готовые решения подобного плана?
3) это безопасно с точки зрения зависания программы/системы?
