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

设计器

Browse Source 
优化
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
Download Patch File Download Diff File Expand all files Collapse all files
designer/udesignerproject.tsf
+19 -1
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
designer/utslcodeeditor.tsf
+27
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;
designer/utslvcldcomponents.tsf
+61 -1
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),
designer/utslvcldesignerresource.tsf
+18
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
designer/utslvclsyntaxparser.tsf
+41 -2
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