unit uvclthreadworker;
{**
    @explan(说明)支持工作线程
                注意:工作线程中仅仅支持运算,不支持窗口的操作,
**}
//20210902 添加未初始化之前postmessage的缓存 
interface
uses cstructurelib;
function RunThreadWorkerClient(this); //运行子任务
function RunThreadWorkerHost(); //分发worker消息
type tworkerclient = class(TArray)
{**
    @explan(说明) 工作线程 %%
**}
    function Create(ph);
    begin
        inherited create();
        FConnectHandle := ph;
        uisetthreadworkerdata(ph,0x30,self.handle); //构造  
    end 
    function close(); //请求关闭 0x10
    begin
        uisetthreadworkerdata(FConnectHandle,0x10,0); 
    end 
    function PostMessage(d);
    begin
        uisetthreadworkerdata(FConnectHandle,0x20,d);   
    end 
    function DoOnMessage(d); //执行onmessage 任务
    begin
        if iffuncptr(FOnMessage) then 
        begin 
            try
                return call(FOnMessage,self,d);
            except
                uisetthreadworkerdata(FConnectHandle,0x40,exceptobject.ErrInfo);       
            end;
        end      
    end 
    property ConnectHandle read FConnectHandle;
    property OnMessage read FOnMessage write FOnMessage;
    {**
    			@param(OnMessage)(function[tworkerclient,data]) 消息回调 %%
    		**}
    function destroy();override;
    begin
        FOnMessage := nil;
        inherited;
    end 
    private 
    [weakref] FOnMessage;  //onpost message 
    FConnectHandle; //句柄
end 
type TCustomThreadworker = class()
{**
    @explan(说明) 工作线程宿主 %%
**}
    function Create(s,lib,declaration);
    begin
        if not ifarray(FThreaders) then FThreaders := array();
        FThreader := new tworkerHost();
        FThreaders[inttostr(FThreader.handle)] := FThreader;
        if not (checkok(s,lib,declaration)) then raise "工作线程构造失败!";
        uibeginthreadworker(FScript);
    end  
    function Operator [](idx);
    begin
        	{**
    			@explan(说明)  get数据 %%
    		**}
        return  FThreader[idx];
    end 
    function Operator [1](idx,v);
    begin
        {**
    			@explan(说明)  set数据 %%
    		**}
        FThreader[idx] := v;
    end 
    function Close(); //关闭
    begin
        destroy();
    end 
    function terminate();
    begin
        Close();
    end 
    function PostMessage(d);
    begin
    			{**
    				@expaln(说明) 发送数据给子线程 %%
    				@param(d)(any) 发送数据,基础数据,不能传送对象 %%
    			**}
        FThreader.PostMessage(d);     
    end 
    class function dispatch();
    begin
        if not FThreaders then return ;
        for idx,i in mrows(   FThreaders,1) do 
        begin
            o := FThreaders[i]; 
            try
                oh := o.handle;
            except
                DeleteWorker(i);
                uideleteworkerdata(oh); //删除数据
            end 
            if uifeachthreadworkerdata(oh,msg,data) then 
            begin
                case msg of
                    0x30: //构成成功
                    begin
                        o.ClientReady(data);
                    end 
                    0x10: //请求关闭
                    begin
                        o.close();    
                    end 
                    0x12: //成功关闭
                    begin
                        uideleteworkerdata(oh); //删除数据
                        o.ClientReady(0);
                        DeleteWorker(i);
                        o.destroy();
                    end 
                    0x40: //错误
                    begin
                        o.DoOnError(data);
                    end 
                    0x20 : //传输数据
                    begin
                        o.DoOnMessage(data);
                    end 
                end ;
                break;
            end  
        end 
    end  
    function destroy();override;
    begin
        if FThreader then 
        begin
           FThreader.close();  
        end 
        inherited;
    end 
    property componet read getcomponet  write setcomponet;
    property OnMessage read GetOnMessage write SetOnMessage;
    property OnError read GetOnError write SetOnError;
    property OnStart read GetOnStart Write SetOnStart;
    		{**
    			@param(OnMessage)(function[TThreadWorker,data]) 消息回调 %%
    			@param(OnStart)(function[TThreadWorker]) 子线程启动 %%
    			@param(OnError)(function[TThreadWorker,d]) 子线程启动 %%
    		**}
    protected 
    function Check_TslCode(FScript,err);virtual;
    begin
        return true;
    end 
    private
    class function DeleteWorker(h);
    begin
        if h then  
            reindex( FThreaders,array(h:nil));
    end 
    function checkok(s,libs,declaration);
    begin
        if ifstring(s) then 
        begin
            lib := "";
            if ifarray(libs) and libs then 
            begin
                lib := ","+array2str(libs,",");
            end 
            dc := "";
            if ifstring(declaration) then 
            begin
                dc := declaration;
            end 
            FScript := format( %%
            uses uvclthreadworker%s;
            this := new unit(uvclthreadworker).tworkerclient(%s);
            %s;     
            unit(uvclthreadworker).RunThreadWorkerClient(this);
            %s;
            
            %%,lib,inttostr(FThreader.handle),s,dc);	
            r :=  Check_TslCode(FScript,err);
            if not r then FScript := "";
        end 
        return r;
    end  
    function GetOnMessage();
    begin
        return FThreader.OnMessage;
    end 
    function SetOnMessage(m);
    begin
        FThreader.OnMessage := m;
    end 
    function GetOnError()begin
        return FThreader.OnError ;
    end 
    function SetOnError(e)begin
        FThreader.OnError := e ;     
    end 
    function GetOnStart()begin
        return FThreader.OnStart ;
    end 
    function SetOnStart(e)begin
        FThreader.OnStart := e ;     
    end 
    [weakref]static FThreaders;
    FScript; //脚本
    FThreader;//host对象
    function setcomponet(v);
    begin
        FThreader.componet := v;    
    end 
    function getcomponet();
    begin
        return FThreader.componet;     
    end 
end 
implementation
function RunThreadWorkerHost();
begin
    class(TCustomThreadworker).dispatch();  
end 
function RunThreadWorkerClient(this);
begin 
{**
    @explan(说明) 工作线程主循环 %%
**}
    h := this.handle;
    ph := this.ConnectHandle;
    while true do 
    begin
        if uifeachthreadworkerdata(h,msg,d) then 
        begin
            case msg of
                0x11 : //关闭 
                begin
                    uisetthreadworkerdata(ph,0x12,0); //关闭完成
                    uideleteworkerdata(h); //删除消息
                    return;
                end                  
                0x20 :  //post
                begin
                    this.DoOnMessage(d);
                end 
            end ;
            sleep(1);
        end else
        begin
            sleep(10);
        end 
        tslprocessmessages(false); //20230428添加tsl消息分发
    end 
end
type TArray = class
    function create();
    begin
        FData := array();   
        fobj := new tcbytearray(4);
        FHandle := fobj._getptr_() ;
    end 
    function Operator [](idx);
    begin
        return FData[idx];
    end 
    function Operator [1](idx,v);
    begin
        FData[idx] := v;
    end 
    function destroy();virtual;
    begin
        FData := array();
        fobj := nil;
    end 
    property handle read FHandle ;
    private 
    FData;
    FHandle;
    fobj;
end 

type tworkerHost = class(TArray)
    function Create();
    begin 
        inherited;
        FConnectHandle := 0;
        FCatcheData := array();
    end
    property OnMessage read FOnMessage write FOnMessage; 
    property OnStart read FOnStart write FOnStart;
    property OnError read FOnError write FOnError;
    property componet read Fcomponet write Fcomponet;
    function close(); //关闭命令 0x10
    begin
        if FConnectHandle then 
        begin   
            uisetthreadworkerdata(FConnectHandle,0x11,0); 
        end 
    end         
    function ClientReady(h); //任务句柄改变
    begin
        FConnectHandle := h;   
        if h then 
        begin
            if iffuncptr(FOnStart) then 
            begin 
                try
                    if Fcomponet then o := Fcomponet;
                    else o:= self;
                    call(FOnStart,o);                                     
                except
                
                end;
            end 
            if FCatcheData then 
            begin
                for i,v in FCatcheData do 
                begin
                    uisetthreadworkerdata(FConnectHandle,0x20,v); 
                end 
                FCatcheData := array();
            end 
        end  
    end 
    function PostMessage(d); //发送数据
    begin 
        if FConnectHandle then 
        begin
            if FCatcheData then 
            begin
                for i,v in FCatcheData do 
                begin
                    uisetthreadworkerdata(FConnectHandle,0x20,v); 
                end 
                FCatcheData := array();
            end 
            uisetthreadworkerdata(FConnectHandle,0x20,d);   
        end else
        begin
            FCatcheData[length(FCatcheData)] := d;    
        end 
    end
    function DoOnError(d);//处理错误
    begin
        if iffuncptr(FOnError) then 
        begin 
            try
                if Fcomponet then o := Fcomponet;
                else o:= self;
                return call(FOnError,o,d);
            except
            end;
        end      
    end 
    function DoOnMessage(d); //处理数据
    begin
        if iffuncptr(FOnMessage) then 
        begin 
            try
                if Fcomponet then o := Fcomponet;
                else o:= self;
                return call(FOnMessage,o,d);
            except
            end;
        end      
    end 
    function destroy();override;
    begin
        FOnMessage := nil;
        FOnError := nil;
        OnStart := nil;
        FCatcheData := array();
        inherited;
    end 
    private 
    FCatcheData; //构造数据
    weakref
    FOnMessage;  //onpost message 
    FOnError;
    FOnStart;
    Fcomponet;
    autoref
    FConnectHandle; //句柄 
end 
function iffuncptr(fn);
begin
    //return datatype(fn)=7;
    return ifobj(fn);
end 
initialization
end.