liujianjun
/
tslediter
3
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity

设计器 

优化
This commit is contained in:
JianjunLiu 2023-04-28 14:19:54 +08:00
parent 08efcf2722
commit d30fed5625
8 changed files with 244 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
designer/udesignerproject.tsf
View File

@ -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

27
designer/utslcodeeditor.tsf
View File

@ -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;

62
designer/utslvcldcomponents.tsf
View File

@ -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),

18
designer/utslvcldesignerresource.tsf
View File

@ -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

43
designer/utslvclsyntaxparser.tsf
View File

@ -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

57
funcext/tvclib/tslvcl.tsf
View File

@ -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

1
funcext/tvclib/utslmemo.tsf
View File

@ -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;

24
funcext/tvclib/uvclthreadworker.tsf
View File

@ -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