From d30fed56255970b7a5393c7b6c75930b1f21d53f Mon Sep 17 00:00:00 2001 From: JianjunLiu Date: Fri, 28 Apr 2023 14:19:54 +0800 Subject: [PATCH] =?UTF-8?q?=E8=AE=BE=E8=AE=A1=E5=99=A8?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 浼樺寲 --- designer/udesignerproject.tsf | 20 ++++++++- designer/utslcodeeditor.tsf | 27 ++++++++++++ designer/utslvcldcomponents.tsf | 62 +++++++++++++++++++++++++++- designer/utslvcldesignerresource.tsf | 18 ++++++++ designer/utslvclsyntaxparser.tsf | 43 ++++++++++++++++++- funcext/tvclib/tslvcl.tsf | 57 +++++++++++++++++++++++++ funcext/tvclib/utslmemo.tsf | 1 + funcext/tvclib/uvclthreadworker.tsf | 24 +++++++++-- 8 files changed, 244 insertions(+), 8 deletions(-) diff --git a/designer/udesignerproject.tsf b/designer/udesignerproject.tsf index 6419c84..2502acf 100644 --- a/designer/udesignerproject.tsf +++ b/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 diff --git a/designer/utslcodeeditor.tsf b/designer/utslcodeeditor.tsf index eefe7f8..8099f89 100644 --- a/designer/utslcodeeditor.tsf +++ b/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; diff --git a/designer/utslvcldcomponents.tsf b/designer/utslvcldcomponents.tsf index f1e7276..ca95338 100644 --- a/designer/utslvcldcomponents.tsf +++ b/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), diff --git a/designer/utslvcldesignerresource.tsf b/designer/utslvcldesignerresource.tsf index 4475447..08a8932 100644 --- a/designer/utslvcldesignerresource.tsf +++ b/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 diff --git a/designer/utslvclsyntaxparser.tsf b/designer/utslvclsyntaxparser.tsf index 9b20248..efda20c 100644 --- a/designer/utslvclsyntaxparser.tsf +++ b/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 diff --git a/funcext/tvclib/tslvcl.tsf b/funcext/tvclib/tslvcl.tsf index c382f1a..1e69c11 100644 --- a/funcext/tvclib/tslvcl.tsf +++ b/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 diff --git a/funcext/tvclib/utslmemo.tsf b/funcext/tvclib/utslmemo.tsf index 1896b51..d784dbe 100644 --- a/funcext/tvclib/utslmemo.tsf +++ b/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; diff --git a/funcext/tvclib/uvclthreadworker.tsf b/funcext/tvclib/uvclthreadworker.tsf index a47c206..a6b5a78 100644 --- a/funcext/tvclib/uvclthreadworker.tsf +++ b/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