设计器

优化

designer/udesignerproject.tsf

@@ -164,9 +164,13 @@ type TProjectManagerForm = class(TVCForm) //
         r := format(%% //工程%s界面库主程序
 uses tslvcl;     //引入界面库
 app := InitializeApplication(); //获得界面管理器
-app.CreateForm(class(%s),fm);   //¹¹ÔìÖ÷´°¿Ú
+app.CreateForm(get_main_wnd(),fm);   //构造主窗口
 fm.show();                     //显示主窗口
 app.run();                    //开始消息循环
+function get_main_wnd(); //获得主窗口,切换主窗口工程会修改该函数
+begin
+    return class(%s);
+end 
 %%,n,n+"main");
         ReWriteString(cprojpath+n+".tsl",r);
         ReWriteString(cprojpath+n+"main.tsf",CreateAForm(n+"main"));
@@ -1011,7 +1015,21 @@ type TProjectView = class(TVCForm) //
             fn := cn.FName ;
             FMainForm := fn;	   
             SaveProjInfo(); 
+            ftxt := format(%% function get_main_wnd(); //获得主窗口,切换主窗口工程会修改该函数
+begin
+    return class(%s);
+end %%,fn);
+            scriptname := FCProjectPath+FExecEntry+".tsl";
+            it := FTslEditer.OpenScriptByFileName(scriptname);
+            if it then 
+            begin 
+                if it.replacemfunc("get_main_wnd",ftxt) then 
+                begin
+                    FTslEditer.SavePageItem(it);
+                end 
+            end 
             o.parent := nil;
+            
         end else 
         if o.caption = "设置为入口脚本" then
         begin

designer/utslcodeeditor.tsf

@@ -1152,6 +1152,25 @@ type TPageEditerItem=class(TPageItem)
     Fscripttype;
     ///////////////////设计器相关//////////////////////////////////////
     public
+    function replacemfunc(fn,txt);
+    begin
+        d := getmfunctioninfo();
+        for i,v in d do 
+        begin
+            if v["name"] = fn then 
+            begin
+                rs := PosToRowCol(FTslParser2.Script,array(v["startpos"]-1,v["endpos"]));
+                p := rs[0];
+                if ifarray(p)then
+                begin
+                    FEditer.ExecuteCommand(FEditer.ecGotoXY,p);
+                    FEditer.ExecuteCommand(FEditer.ecSelGotoXY,rs[1]);
+                    FEditer.ExecuteCommand(FEditer.ecString,txt);
+                end
+                return 1;
+            end 
+        end 
+    end 
     function Addfiled(fld); //添加成员变量
     begin
         if not FTslParser then return 0;
@@ -1512,7 +1531,15 @@ type TPageEditerItem=class(TPageItem)
         end
         return FGetInfoChace;
     end
+    function getmfunctioninfo();
+    begin
+        if not ftslparser2 then 
+            ftslparser2 := new ttslscripparser();
+        ftslparser2.Script :=FEditer.Text;  
+        return  ftslparser2.gettslfunctions();         
+    end 
     private
+    ftslparser2;
     FEnCode;
     FLastFileTime;
     FTslSynText;

designer/utslvcldcomponents.tsf

@@ -1572,7 +1572,6 @@ type TDTimer = class(TDRootComponent)
         return inherited;
         return "¶¨Ê±Æ÷";
     end 
-
     function bitmapinfo();override;
     begin
         return GetTimerBitmapInfo();
@@ -1609,6 +1608,66 @@ type TDTimer = class(TDRootComponent)
         );
     end 
 
+end 
+type TworkerWindow = class(TDVirutalWindow)
+{**
+    @explan(说明) 工作任务控件窗口 %%
+**}
+    public 
+    function Create(AOwner);override;
+    begin
+        inherited;
+        BindComp := new tworkerctl(self);
+    end 
+    function bitmapinfo();override;
+    begin
+        return getworkerbitmapinfo();
+    end 
+end 
+type tdworkerctl = class(TDRootComponent)
+{**
+    @explan(说明) 工作任务控件 %%
+**}
+    function HitTip();override;
+    begin
+        return inherited;
+    end 
+    function bitmapinfo();override;
+    begin
+        return getworkerbitmapinfo();
+    end 
+    function IsContainer();override;
+    begin
+        return false;
+    end 
+    function ComponentClass();override;
+    begin
+        return class(tworkerctl);
+    end 
+    function WndClass();override;
+    begin
+        return Class(TworkerWindow);
+    end 
+    function Create(AOwner);override;
+    begin
+        inherited;
+        DefaultEvent := array(
+        "event":"onmessage",
+        "name":"message",
+        "virtual":true,
+        "param":array("o","d"),
+        "body":
+" 
+    {**
+        @explan(说明) 工作线程 %%
+        @param(d)(any) 数据 %%
+        @param(o)(tworkerctl) 工作线程对象 %%
+    **}
+    inherited;
+"
+        );
+    end 
+
 end 
 //**************FMainMenu********************************
 type TMainMenuWindow = class(TDVirutalWindow)
@@ -3647,6 +3706,7 @@ begin
         class(TDPairSplitter),class(TDPairSplitterSide),
         class(TDPage),class(TDTabSheet),
         class(TDTimer),
+        class(tdworkerctl),
         class(TDImageList),
         class(TDClipBoard),
         class(TDMainMenu),class(TDPopUpMenu),class(TDMenu),

designer/utslvcldesignerresource.tsf

@@ -12,6 +12,7 @@ function GetOpenFileBitmapInfo();
 function GetTrayBitmapInfo();
 function GetImageListBitmapInfo();
 function GetTimerBitmapInfo();
+function getworkerbitmapinfo();
 function geteditcommetbmpinfo();
 function GetSaveFileBitmapInfo();
 function getedituncommetbmpinfo();
@@ -431,6 +432,23 @@ E75F6B92237701200B4A4F07417AD477FE77239FDF2CF3C05A576BFC3590203F4
 A7AFB93CA55249BFFCBBBAE83B447E01A5FB392686E583230000000049454E44A
 E42608200";
 end
+function getworkerbitmapinfo();
+begin
+    return "0502000000060400000074797065000203000000696D670006040000006461746
+100028F01000089504E470D0A1A0A0000000D4948445200000014000000140806
+0000008D891D0D000000017352474200AECE1CE90000000467414D410000B18F0
+BFC6105000000097048597300000EC300000EC301C76FA8640000012449444154
+384FB594CD0B015114C5FDFF3B290B65235B0B0945C34A9405169826A1443EF29
+991897A3AD7DCE9CD7BC3981ABFBA35EFBC7BCFBC53332F2162E63F86A7AB238C
+FE4A248B43AFC2907B310B0F4086FDE99E36ACE5592C7657AA30B80F339885072
+0C3F67843A20C1A55823480D98EB9A5E740431CBFD25DB8AB37FBCB5DD39850C3
+AEB5D34E1C94820935CC19135ACB11F30D5D63BE1ADAF7073D175A732F22E2AA9
+ACC474388A854692406B383F712EC67AAA64FE35ED447439C0085EFEAE63C4943
+44C46D0EFC5AB66679FDD0E0A119AA7044ECF1B7296BEBE38DB49F0D3922E232A
+CA5CB63578960C811119761ADDE5BBA4A04438088EAAFF8D66C7715D110115554
+4D33E4CB817F78F94488A8024DEEC5ACEF7288FDFA8A93980D85780147E8D95FD
+B7EAFA90000000049454E44AE42608200";
+end 
 function geteditcommetbmpinfo();
 begin
     return "0502000000060400000074797065000203000000696D670006040000006461746

designer/utslvclsyntaxparser.tsf

@@ -88,7 +88,7 @@ type tslparser = class(tslparserbase) //
         @explan(说明) 获得class 的基本信息 %%
         @return(array) 包括"name","inherited","uses" 等信息 %%
         **}
-        if not Tokens then array();
+        if not Tokens then return array();
         FCurrentPos := 0;
         while true do
         begin
@@ -169,6 +169,42 @@ type tslparser = class(tslparserbase) //
         end
         return r;
     end
+    function gettslfunctions();
+    begin
+        funcsinfo := array();
+        if not Tokens then return funcsinfo;
+        FCurrentPos := 0;
+        funcsinfo := array();
+        while true do
+        begin
+            ctoken(tk,tp,pos,row);
+            if ifnil(tk)then break;
+            if tk="type" and tp <> TT_STR then
+            begin
+                tr := parserclass(0);
+            end
+            if (tk="function" or tk="procedure") and tp <> TT_STR then 
+            begin
+                bpos();
+                bfpos := CurrentPos;
+                lenf := length(funcsinfo);
+                tfn := parserfunction();
+                funcsinfo[lenf]["name"]:= tfn;
+                funcsinfo[lenf]["startpos"]:= getTokenPos(bfpos);
+                //echo ">>cretfpos===",self.CurrentPos,"====",length(Tokens);
+                len := length(Tokens)-1;
+                if (len>CurrentPos) then 
+                begin
+                    funcsinfo[lenf]["endpos"]:= getTokenPos(self.CurrentPos)-1;
+                end else 
+                begin
+                    funcsinfo[lenf]["endpos"]:= getTokenPos(len)+2;    
+                end                 
+                funcsinfo[lenf]["row"]:= row;            
+            end 
+        end
+        return funcsinfo;
+    end 
     function parserclass(fi);
     begin
         {**
@@ -545,7 +581,10 @@ type tslparser = class(tslparserbase) //
                     begin
                         bpos(n);
                         return;
-                    end
+                    end else 
+                    begin
+                        n--; //·ÖºÅ°üÀ¨½øÀ´
+                    end 
                 end
                 return array(pos+3);
             end else

funcext/tvclib/tslvcl.tsf

@@ -4699,6 +4699,63 @@ type TThreadWorker  =class(TCustomThreadworker)
     begin
         return CheckTslCode(FScript,err);
     end 	
+end 
+type tworkerctl =class(tcomponent) //¹¤×÷Ï̷߳â×°
+    function create(AOwner);
+    begin
+        inherited;
+    end 
+    function terminate();
+    begin
+        if fworker then fworker.terminate();
+        fworker := nil;
+    end 
+    function start();
+    begin
+        if csDesigning in ComponentState then return 0;
+        if fworker then return true;
+        if ifstring(FScript) and FScript then 
+        begin
+            fworker := new TThreadWorker(FScript,nil,nil);
+            fworker.componet := self(true);
+            fworker.OnMessage := FOnMessage;
+            fworker.onerror := FOnError;
+        end     
+    end 
+    function PostMessage(d);
+    begin
+        if fworker then return fworker.PostMessage(d);
+    end 
+    function isstarted();
+    begin
+        return fworker?true:false;
+    end 
+    published
+    property script:text read FScript write Setscript;
+    property OnMessage:eventhandler read fOnMessage write setOnMessage;
+    property onerror:eventhandler read FOnError write setOnError;
+    private 
+    fworker;
+    FScript;
+    [weakref]FOnError;
+    [weakref]FOnMessage;
+    function setOnMessage(f);
+    begin
+        fOnMessage := f;
+        if fworker then fworker.OnMessage := f;    
+    end 
+    function setOnError(f);
+    begin
+        FOnError := f;
+        if fworker then fworker.FOnError := f; 
+    end 
+    function Setscript(s);
+    begin
+        if s <> FScript and ifstring(s) and s then 
+        begin
+            FScript := s;    
+        end 
+    end 
 end 	
 	//×¢²á±í²Ù×÷Àà
 type TRegKey = class

funcext/tvclib/utslmemo.tsf

@@ -4044,6 +4044,7 @@ type TSynCustomMemo = class(TCustomMemo)
         y := (CaretY-GetYpos())*GetYScrollDelta();
         x := (CaretX-GetXpos())*GetXScrollDelta();
     end
+    published
     property Highlighter:thighlighter read FHighlighter write SetHighlighter; //语法高亮
     property Completion read FCompletion write SetCompletion; //自动完成
     property TabChar read FTabChar write SetTabChar; 

funcext/tvclib/uvclthreadworker.tsf

@@ -102,7 +102,6 @@ type TCustomThreadworker = class()
             try
                 oh := o.handle;
             except
-                echo ">>>>>>>>>>>>>";
                 DeleteWorker(i);
                 uideleteworkerdata(oh); //删除数据
             end 
@@ -145,6 +144,7 @@ type TCustomThreadworker = class()
         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;
@@ -214,6 +214,14 @@ type TCustomThreadworker = class()
     [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();
@@ -286,6 +294,7 @@ type tworkerHost = class(TArray)
     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 
@@ -301,7 +310,9 @@ type tworkerHost = class(TArray)
             if iffuncptr(FOnStart) then 
             begin 
                 try
-                    call(FOnStart,self);                                     
+                    if Fcomponet then o := Fcomponet;
+                    else o:= self;
+                    call(FOnStart,o);                                     
                 except
                 
                 end;
@@ -339,7 +350,9 @@ type tworkerHost = class(TArray)
         if iffuncptr(FOnError) then 
         begin 
             try
-                return call(FOnError,self,d);
+                if Fcomponet then o := Fcomponet;
+                else o:= self;
+                return call(FOnError,o,d);
             except
             end;
         end      
@@ -349,7 +362,9 @@ type tworkerHost = class(TArray)
         if iffuncptr(FOnMessage) then 
         begin 
             try
-                return call(FOnMessage,self,d);
+                if Fcomponet then o := Fcomponet;
+                else o:= self;
+                return call(FOnMessage,o,d);
             except
             end;
         end      
@@ -368,6 +383,7 @@ type tworkerHost = class(TArray)
     FOnMessage;  //onpost message 
     FOnError;
     FOnStart;
+    Fcomponet;
     autoref
     FConnectHandle; //句柄 
 end