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

跟新

Browse Source
This commit is contained in:
liujianjun
2025-07-22 17:28:43 +08:00
parent e4d6b23680
commit db909b5520
36 changed files with 2389 additions and 1094 deletions
Download Patch File Download Diff File Expand all files Collapse all files
designer/ctl_mgr/t_compile_config.tfm
+33 -33
View File
@@ -10,12 +10,12 @@ object ed_script:t_compile_config
topbottomspacing=10
>
height=560
height=562
left=638
minmaxbox=false
onclose=compile_config_close
top=208
width=484
width=488
wssizebox=true
object panel1:tpanel
autosize=true
@@ -31,7 +31,7 @@ object ed_script:t_compile_config
height=25
left=10
top=10
width=448
width=452
wsdlgmodalframe=false
object lb_input:tlabel
left=2
@@ -74,7 +74,7 @@ object ed_script:t_compile_config
left=10
parentcolor=true
top=45
width=448
width=452
object lb_ype:tlabel
left=6
top=21
@@ -121,13 +121,12 @@ object ed_script:t_compile_config
top=44
width=324
end
object bt_output:tbtn
object bt_outputname:tbtn
autosize=true
caption=".."
enabled=false
height=21
left=408
onclick=bt_output_clk
onclick=bt_outputname_clk
top=44
width=28
end
@@ -148,12 +147,13 @@ object ed_script:t_compile_config
top=67
width=324
end
object bt_outputname:tbtn
object bt_output:tbtn
autosize=true
caption=".."
enabled=false
height=21
left=408
onclick=bt_outputname_clk
onclick=bt_output_clk
top=67
width=28
end
@@ -169,23 +169,23 @@ object ed_script:t_compile_config
leftrightspacing=2
topbottomspacing=2
>
height=71
height=73
left=10
parentcolor=true
top=149
width=448
width=452
object label1:tlabel
left=6
top=21
width=58
height=21
height=23
autosize=true
caption="函数目录"
end
object ed_f_dirs:tedit
autosize=true
caption="edit1"
height=21
height=23
left=66
top=21
width=312
@@ -193,7 +193,7 @@ object ed_script:t_compile_config
object bt_f_dir:tbtn
autosize=true
caption=".."
height=21
height=23
left=380
onclick=bt_f_dir_clk
top=21
@@ -201,7 +201,7 @@ object ed_script:t_compile_config
end
object label2:tlabel
left=6
top=44
top=46
width=58
height=21
autosize=true
@@ -212,7 +212,7 @@ object ed_script:t_compile_config
caption="edit2"
height=21
left=66
top=44
top=46
width=312
end
object bt_s_dir:tbtn
@@ -221,7 +221,7 @@ object ed_script:t_compile_config
height=21
left=380
onclick=bt_s_dir_clk
top=44
top=46
width=28
end
end
@@ -239,8 +239,8 @@ object ed_script:t_compile_config
height=139
left=10
parentcolor=true
top=230
width=448
top=232
width=452
object lb_s_type:tlabel
left=6
top=21
@@ -256,10 +256,10 @@ object ed_script:t_compile_config
left=94
text="*.tfm,*.ini"
top=21
width=318
width=322
end
object label7:tlabel
left=414
left=418
top=21
width=28
height=20
@@ -281,13 +281,13 @@ object ed_script:t_compile_config
height=21
left=94
top=43
width=318
width=322
end
object bt_i_s:tbtn
autosize=true
caption=".."
height=21
left=414
left=418
onclick=bt_i_s_clk
top=43
width=28
@@ -307,13 +307,13 @@ object ed_script:t_compile_config
height=21
left=94
top=66
width=318
width=322
end
object bt_i_f:tbtn
autosize=true
caption=".."
height=21
left=414
left=418
onclick=bt_i_f_clk
top=66
width=28
@@ -333,13 +333,13 @@ object ed_script:t_compile_config
height=21
left=94
top=89
width=318
width=322
end
object bt_tsgadd:tbtn
autosize=true
caption=".."
height=21
left=414
left=418
onclick=bt_tsgadd_clk
top=89
width=28
@@ -359,13 +359,13 @@ object ed_script:t_compile_config
height=21
left=94
top=112
width=318
width=322
end
object bt_d_f:tbtn
autosize=true
caption=".."
height=21
left=414
left=418
onclick=bt_d_f_clk
top=112
width=28
@@ -385,8 +385,8 @@ object ed_script:t_compile_config
height=97
left=10
parentcolor=true
top=379
width=448
top=381
width=452
object label9:tlabel
left=6
top=21
@@ -521,8 +521,8 @@ object ed_script:t_compile_config
>
height=25
left=10
top=486
width=448
top=488
width=452
wsdlgmodalframe=false
object bt_cmd:tbtn
autosize=true
designer/ctl_mgr/t_compile_config.tsf
+14 -9
View File
@@ -95,7 +95,7 @@ type t_compile_config=class(tdcreateform)
function bt_tsgadd_clk(o;e);virtual;
begin
tp := array("tsg库":"*.tsg");
if show_dir_list(s_to_array(ed_tsg.text,true),tp)then
if show_dir_list(s_to_array(ed_tsg.text,true),tp,"tsg库目录")then
begin
ed_tsg.text := array_to_s(dir_list.get_dirs(),true);
end
@@ -183,6 +183,7 @@ type t_compile_config=class(tdcreateform)
function bt_outputname_clk(o;e);virtual;
begin
f_op.filter := array(get_type():"*"+get_type());
f_op.Caption := "输出文件名";
if f_op.OpenDlg()then
begin
ed_output.text :=relative_path( f_op.filename);
@@ -201,6 +202,7 @@ type t_compile_config=class(tdcreateform)
function bt_script_clk(o;e);virtual;
begin
f_op.filter := array("tsl脚本":"*.tsf;*.tsl");
f_op.Caption := "入口脚本";
if f_op.OpenDlg()then
begin
e_script.text := relative_path( f_op.filename);
@@ -210,6 +212,7 @@ type t_compile_config=class(tdcreateform)
function bt_ico_clk(o;e);virtual;
begin
f_op.filter := array("ico图标":"*.ico");
f_op.Caption := "图标文件";
if f_op.OpenDlg()then
begin
ed_ico.text := relative_path( f_op.filename);
@@ -217,28 +220,28 @@ type t_compile_config=class(tdcreateform)
end
function bt_d_f_clk(o;e);virtual;
begin
if show_m_editor(s_to_array(ed_exclude_f.text))then
if show_m_editor(s_to_array(ed_exclude_f.text),"排除函数")then
begin
ed_exclude_f.text := array_to_s(m_list_editor.get_data());
end
end
function bt_i_f_clk(o;e);virtual;
begin
if show_m_editor(s_to_array(ed_include_f.text))then
if show_m_editor(s_to_array(ed_include_f.text),"指定函数")then
begin
ed_include_f.text := array_to_s(m_list_editor.get_data());
end
end
function bt_i_s_clk(o;e);virtual;
begin
if show_m_editor(s_to_array(ed_include_s.text))then
if show_m_editor(s_to_array(ed_include_s.text),"指定资源")then
begin
ed_include_s.text := array_to_s(m_list_editor.get_data());
end
end
function bt_output_clk(o;e);
begin
if show_m_editor(s_to_array(ed_out_f.text))then
if show_m_editor(s_to_array(ed_out_f.text),"输出函数")then
begin
ed_out_f.text := array_to_s(m_list_editor.get_data());
end
@@ -246,14 +249,14 @@ type t_compile_config=class(tdcreateform)
function bt_s_dir_clk(o;e);
begin
if show_dir_list(s_to_array(ed_s_dirs.text,true))then
if show_dir_list(s_to_array(ed_s_dirs.text,true),nil,"资源目录")then
begin
ed_s_dirs.text := array_to_s(dir_list.get_dirs(),true);
end
end
function bt_f_dir_clk(o;e);
begin
if show_dir_list(s_to_array(ed_f_dirs.text,true))then
if show_dir_list(s_to_array(ed_f_dirs.text,true),nil,"函数目录")then
begin
ed_f_dirs.text := array_to_s(dir_list.get_dirs(),true);
end
@@ -274,19 +277,21 @@ type t_compile_config=class(tdcreateform)
invoke(self,v["name"],nil);
end
end
function show_dir_list(data,filetype);
function show_dir_list(data,filetype,cp);
begin
dir_list.Left := Left-20;
dir_list.top := top+50;
dir_list.set_dirs(data);
dir_list.fopentype := filetype;
if ifstring(cp) then dir_list.Caption := cp;
return dir_list.ShowModal();
end
function show_m_editor(data);
function show_m_editor(data,cp);
begin
m_list_editor.Left := Left-20;
m_list_editor.top := top+50;
m_list_editor.set_data(data);
if ifstring(cp) then m_list_editor.Caption := cp;
return m_list_editor.ShowModal();
end
function enabled_script_input(f);
designer/ctl_mgr/t_editor_color_mgr.tfm
+2
View File
@@ -35,6 +35,7 @@ object ditor_color_mgr:t_editor_color_mgr
onselchanged=colorcombobox1_onselchanged
top=18
width=132
parentfont=false
end
object listbox1:tlistbox
caption="listbox1"
@@ -55,6 +56,7 @@ object ditor_color_mgr:t_editor_color_mgr
onselchanged=colorcombobox2_onselchanged
top=18
width=177
parentfont=false
end
object openfileadlg1:topenfileadlg
left=314
designer/udesignerproject.tsf
+32 -44
View File
@@ -4,7 +4,7 @@ interface
@param(说明) 设计器工程相关工具,包括历史工程,工程目录管理,代码编辑器 %%
@date(20220518)
**}
uses utslvclauxiliary,tslvcl,utslmemo,UTslSynMemo,UVCPropertyTypesPersistence,UtslCodeEditor,utslvclsyntaxparser;
uses utslvclauxiliary,utslvcldcomponents,tslvcl,utslmemo,UTslSynMemo,UVCPropertyTypesPersistence,UtslCodeEditor,utslvclsyntaxparser;
function SetWndPostWithMouse(wnd,lft);
type TProjectManagerForm = class(TVCForm) //工程管理 TCustomControl
function Create(AOwner);override;
@@ -175,7 +175,7 @@ end
%%,n,n+"main");
ReWriteString(cprojpath+n+".tsl",r);
ReWriteString(cprojpath+n+"main.tsf",CreateAForm(n+"main"));
ReWriteString(cprojpath+n+format("%smain.tfm",n),CreateAtfm(n+"main",n+"main"));
ReWriteString(cprojpath+n+"main.tfm",CreateAtfm(n+"main",n+"main"));
//ReWriteString(cprojpath+"resource.tfm"+fio+format("%smain.tfm",n),CreateAtfm(n+"main",n+"main"));
//写入缓存
FProjectCoder.AddProject(n,f);
@@ -352,6 +352,8 @@ type TProjectView = class(TVCForm) //
FInput.visible := false;
FInput.parent := self;
FTslEditer := new TTslEditer(AOwner);
FTslEditer.ParentFont := false;
FTslEditer.dbclkcreate := false;
FTslEditer.Notification(FTslEditer,"change_editor_keys");
FTslEditer.FExecuteEditer.cannotadd := true;
FTslEditer.FExecuteEditer.onsaveclk := function(o,e)
@@ -402,11 +404,12 @@ type TProjectView = class(TVCForm) //
begin
app := initializeapplication();
app.font := array("width":ginfo["fontsize"],"height" :ginfo["fontsize"]*2);
FTslEditer.font := array("width":ginfo["fontsize"],"height" :ginfo["fontsize"]*2);
NotifyComponent(self,ginfo);
end
end
FTslEditer.Parent := AOwner;
//FTslEditer.Parent := AOwner;
FTmfParser := new TTmfParser();
FTslParser := new ttslscripparser();
FTreeTool := new TToolBar(self);
@@ -553,6 +556,11 @@ type TProjectView = class(TVCForm) //
if fopenbuzy then return ;
ftree.setsel(nd);
end
function getall_class_tsf();//列表
begin
ls := FTree.get_leaf_nodes();
return ls;
end
function OpenTreeNode(); //打开当前节点
begin
if not FCProjectPath then return Messageboxa("工程没打开","提示",0,self);
@@ -895,8 +903,11 @@ type TProjectView = class(TVCForm) //
function ShowEditor(); //显示函数编辑
begin
FTslEditer.Show(SW_SHOWNOACTIVATE); //
//FTslEditer.Show(SW_SHOWNOACTIVATE); //
FTslEditer.Show(); //
_wapi.bringWindowToTop(FTslEditer.Handle);
it := FTslEditer.GetCurrentEditer();
if it then return it.SetFocus();
end
function hiddeneditor(rc);//隐藏
begin
@@ -965,9 +976,10 @@ type TProjectView = class(TVCForm) //
return r;
end
end
function GoToAFunction(n); //跳转到函数
function GoToAFunction(n,fn); //跳转到函数
begin
fn := FCurrentOpend.gettsfname();
if not fn then
fn := FCurrentOpend.gettsfname();
r := FTslEditer.GoToFunction(fn,n);
saveformcode(fn);
ShowEditor();
@@ -1037,9 +1049,13 @@ type TProjectView = class(TVCForm) //
//FTfmComponets := array();
//FTmfParser.GetAllSubObjects(nil,FTfmComponets);
FDesigner.LoadTreeNode(FTmfParser,inh,FCurrentOpend);
xx := FTslEditer.OpenAndGotoFileByName(FCurrentOpend.gettsfname());
FDesigner.LoadTreeNode(FTmfParser,inh,FCurrentOpend);
FDesigner.EditerCodeChanged(FCurrentOpend);
end else //缺少tfm文件
begin
xx := FTslEditer.OpenAndGotoFileByName(FCurrentOpend.gettsfname());
ShowEditor();
end
fopenbuzy := false;
end else
@@ -1330,7 +1346,7 @@ end
%%,n,nd.Fname,us);
ReWriteString(ph,r);
FTmfParser.ScriptPath := nd.gettmfname();
r := FTmfParser.inheritedcoy(n+"1",n,nd.Fname);
r := FTmfParser.inheritedcopy(n+"1",n,nd.Fname);
ReWriteString(tfm,r);
//ReWriteString((FCProjectPath+"resource.tfm"+fio+n+".tfm"),r);
end else
@@ -2206,7 +2222,7 @@ BD141CA912494F502D48D224F45050274A21E03806FF2C7CA7516022D7D000000
function GoToFunction(fn,n);
begin
it := OpenAndGotoFileByName(fn);
if it then it.GotoFunction(n);
if it then return it.GotoFunction(n);
end
function AddFunction(n,fn,finfo); //添加函数
begin
@@ -2429,6 +2445,12 @@ type TFileTree = class(TTreeCtl)
end
fprojectpath;
fio;
function get_leaf_nodes();
begin
leafs := array();
GetNodeLeafs(FPNode,leafs);
return leafs;
end
function GetInfo(dir,files); //获得信息
begin
leafs := array();
@@ -3117,6 +3139,7 @@ end
////////////////////////////////////////////////////////////////
function move_tfm_to_tsf(dir);
begin
if not(FileList("",dir+iofileseparator()+"resource.tfm"+iofileseparator()+"*.tfm")) then return ;
tsfs := array();
tfms := array();
find_tsf_tfm(dir,tsfs,tfms);
@@ -3248,41 +3271,6 @@ function LegalFolderName(n); //Ŀ¼
begin
return ifstring(n) and n and (1=ParseRegExpr("^[A-Za-z_]\\w{2,}$",n,v,vp,vl)) and (lowercase(n)<>"con");
end
function createtslfunction(f);//构造函数
begin
n := f["name"];
p := f["param"];
b := f["body"];
ps := "";
if ifarray(p)then
begin
len := length(p);
for i := 0 to len-1 do
begin
v := p[i];
if ifstring(v)then ps += v;
if i<len-1 then ps += ";";
end
end
hs := nil;
vt := "";
if f["virtual"] then vt := "virtual;";
if ifstring(n) and ifstring(b)then
begin
//hs := "\r\nfunction "+n+"("+ps+");"+vt+"\r\n\tbegin\r\n"+b+"\r\n\tend\r\n";
bs := str2array(b,"\r\n");
bs2 := "";
for i,v in bs do
begin
if not v then continue;
bs2 += " "+v+"\r\n";
end
hs := "\r\n\ function "+n+"("+ps+");"+vt+"\r\n\ begin\r\n"+bs2+"\r\n\ end\r\n";
end
//hs := "\r\n\tfunction "+n+"("+ps+");"+vt+"\r\n\tbegin\r\n"+b+"\r\n\tend\r\n";
return hs;
end
function SetWndPostWithMouse(wnd,lft);
begin
{**
designer/utslcodeeditor.tsf
+134 -30
View File
@@ -1229,12 +1229,23 @@ type TPageEditerItem=class(TPageItem)
p := crec[0];
if ifarray(p)then
begin
tpl := FEditer.TopLine;
cxy := FEditer.CaretY;
FEditer.ExecuteCommand(FEditer.ecGotoXY,p);
FEditer.ExecuteCommand(FEditer.ecString,fld+";\r\n ");
if p[1]<cxy then
begin
FEditer.TopLine := tpl+1;
FEditer.CaretY := cxy+1;
end else
begin
FEditer.TopLine := tpl;
FEditer.CaretY := cxy;
end
end
end
end
function getuses();
function getuses();//获取uses
begin
if not FTslParser then return 0;
d := GetClassInfo();
@@ -1262,8 +1273,19 @@ type TPageEditerItem=class(TPageItem)
p := rec[0];
if ifarray(p) then
begin
FEditer.ExecuteCommand(FEditer.ecGotoXY,rec[0]);
FEditer.ExecuteCommand(FEditer.ecString,adus);
tpl := FEditer.TopLine;
cxy := FEditer.CaretY;
FEditer.ExecuteCommand(FEditer.ecGotoXY,rec[0]);
FEditer.ExecuteCommand(FEditer.ecString,adus);
if p[1]<cxy then
begin
FEditer.TopLine := tpl+1;
FEditer.CaretY := cxy+1;
end else
begin
FEditer.TopLine := tpl;
FEditer.CaretXY := cxy;
end
end
end
end
@@ -1305,11 +1327,23 @@ type TPageEditerItem=class(TPageItem)
if v["name"]=nfld then
begin
frec := GetInfoRowCol2(v);
tpl := FEditer.TopLine;
cxy := FEditer.CaretY;
if ifarray(frec[0])and ifarray(frec[1])then
begin
FEditer.ExecuteCommand(FEditer.ecGotoXY,frec[0]);
FEditer.ExecuteCommand(FEditer.ecSelGotoXY,frec[1]);
FEditer.SelText := nn?(nn+";"):"";
if cxy>=frec[1,1] then //删除
begin
cn := frec[1,1]-frec[0,1];
FEditer.TopLine := tpl-cn;
FEditer.CaretY := cxy-cn;
end else
begin
FEditer.TopLine := tpl;
FEditer.CaretY := cxy;
end
end
wek := v["dstatic"];
if wek then
@@ -1332,12 +1366,11 @@ type TPageEditerItem=class(TPageItem)
FEditer.ExecuteCommand(FEditer.ecSelGotoXY,frec[1]);
FEditer.SelText := nn?(nn+";"):"";
end
end
end
end
end
end
function GoToFunction(fn);
function GoToFunction(fn);//定位到函数
begin
if not(ifstring(fn))then return false;
nfld := lowercase(fn);
@@ -1355,6 +1388,7 @@ type TPageEditerItem=class(TPageItem)
return true;
end
end
return d["inherited",0];
end
function AddFunction(fn,finfo); //添加函数
begin
@@ -1429,6 +1463,7 @@ type TPageEditerItem=class(TPageItem)
if cp then cp.PrePareCompletion(t);
RepreComple := false;
end
//////////转码/////////////////////////
function ToUnicode_big();
begin
if FEnCode="UCS2-big" then return;
@@ -1497,6 +1532,7 @@ type TPageEditerItem=class(TPageItem)
FEnCode := "ANSI";
end
end
///////////////////////////////
function SetLoadScript(s); //保存文件
begin
if not ifstring(s)then return;
@@ -1576,8 +1612,7 @@ type TPageEditerItem=class(TPageItem)
end
function getmfunctioninfo();
begin
if not ftslparser2 then
ftslparser2 := new ttslscripparser();
if not ftslparser2 then ftslparser2 := new ttslscripparser();
ftslparser2.Script :=FEditer.Text;
return ftslparser2.gettslfunctions();
end
@@ -1799,6 +1834,7 @@ type TEditer=class(TCustomcontrol) //
function Create(AOwner);override;
begin
inherited;
fdbclkcreate := true;
if not Fhightercolor then
Fhightercolor := new thighlitcolor(self);
FOpenHistory := new TMyarrayb();
@@ -1980,7 +2016,7 @@ type TEditer=class(TCustomcontrol) //
DoControlAlign();
end
/////////////////////
FStatus.Items := array(("text":"","width":0.85),("text":"","width":0.16));
FStatus.Items := array(("text":"","width":0.7),("text":"","width":0.31));
/////////////////////////////////////////
//FInfoShowWnd.Caption := "信息:";
////构造节点////////////////////////////////////////////////////
@@ -2041,6 +2077,7 @@ type TEditer=class(TCustomcontrol) //
sz := editorglobalinfo["fontsize"];
sz2 := sz*2;
app.font := array("width":sz,"height":sz2);
self.font := array("width":sz,"height":sz2);
if not(r) or (ifarray( r ) and r["imgsize"]<>editorglobalinfo["imgsize"]) then NotifyComponent(fsyssizemgr,editorglobalinfo);
end
end
@@ -3407,6 +3444,7 @@ type TEditer=class(TCustomcontrol) //
end
function CreateAFile(); //构造文件
begin
if not fdbclkcreate then return ;
if FTslCacheDir then
begin
idx := 0;
@@ -3885,6 +3923,7 @@ type TEditer=class(TCustomcontrol) //
end
published //property 位置
FHistoryDir;
property dbclkcreate read fdbclkcreate write fdbclkcreate;
property hltcolor read gethclor write sethclor;
function showhltcolor();
begin
@@ -3982,13 +4021,15 @@ type TEditer=class(TCustomcontrol) //
fs := data["target"];
finder := finder_set_info(data,ed.Text);
idx := 0;
rsult := finder.replace_all(r);
rsult := finder.replace_all(r);
if rsult then
begin
FFindListWnd.ffindstr := fs;
idx := length(rsult);
ed.ExecuteCommand(ed.ecSelectAll);
ed.SelText := r;
lastidx := -1;
sct := integer((FFindListWnd.Width-10)/(FFindListWnd.font.Width))-17;
for i,v in rsult do
begin
if i=0 then
@@ -3997,12 +4038,11 @@ type TEditer=class(TCustomcontrol) //
if rdx=lastidx then continue;
lastidx := rdx;
if not ifstring(v[3]) then continue;
scap := format(" %d:(第%d行) ",i,rdx)+limitstringlength(v[3]);
scap := format(" %d:(第%d行) ",i,rdx)+ limitstringlength(v[3],sct);
FFindListWnd.AppendItem(array("caption":scap,"file":it.OrigScriptPath,"line":rdx));
end
end
end
function Find_InFiles(d,o,rep,ct);
begin
@@ -4133,8 +4173,13 @@ type TEditer=class(TCustomcontrol) //
lastidx := -1;
if rsult then
begin
if not fnoshow then
begin
FFindListWnd.ffindstr := fs;
end
rt := length(rsult);
iits := 0;
sct := integer((FFindListWnd.Width-10)/(FFindListWnd.font.Width))-17;
for i,v in rsult do
begin
if i=0 and (not fnoshow) then
@@ -4145,7 +4190,7 @@ type TEditer=class(TCustomcontrol) //
if rdx=lastidx then continue;
lastidx := rdx;
if not ifstring(v[3]) then continue;
scap := format(" %d:(第%d行) ",i,rdx)+limitstringlength(v[3]);
scap := format(" %d:(第%d行) ",i,rdx)+ limitstringlength(v[3],sct);
FFindListWnd.AppendItem(array("caption":scap,"file":it.OrigScriptPath,"line":rdx));
iits++;
if iits>80 then
@@ -4313,6 +4358,7 @@ type TEditer=class(TCustomcontrol) //
FGoBackB; // := new TMyarrayB();
FRebackFlag;
FPageEditer;
fdbclkcreate;
fcoolbar;
ftoolbara;
ftoolbarb;
@@ -5281,15 +5327,18 @@ type TFindListWnd=class(TListBox) //
function Create(AOwner);
begin
inherited;
//font := array("width":11,"height":22);
//ParentFont := false;
{onnotification := function(o,e)begin
ms := e.message;
if ifarray(ms) and ms[0] ="font" then
begin
font := ms[1];
end
end }
ffindstr := "";
ownerdraw := true;
ondrawlist := thisfunction(findbox_drawlist); //绘制
end
function FontChanged(o);override;
begin
ft := font;
if ft then
begin
if ownerdraw then ItemHeight := font.Height+4;
return inherited;
end
end
function CheckListItem(s);override;
begin
@@ -5302,6 +5351,62 @@ type TFindListWnd=class(TListBox) //
if not ifstring(r)then return "";
return r;
end
ffindstr; //查找的串
fignorcase;//忽略大小写
function findbox_drawlist(sender:tlistbox; evnt:tlistdrawevent; cvs:tcanvas; idx:integer; ARect:array of integer);
begin
ft := cvs.font;
w := ft.Width;
s := GetItemText(idx);
if not s then return ;
rc := ARect;
if pos("find:",s)=1 then
begin
ft.Color := 0xf0a000;
return cvs.DrawText(s,rc);
end
if ffindstr then
begin
x := 0;
ls := length(s);
ct := integer((rc[2]-rc[0])/w)-3;
if ct>1 and ct<ls then
begin
if bytetype(s,ct)=1 then
begin
s := s[1:(ct-1)]+"...";
end else s := s[1:ct]+"...";
end
p := 1;
ss := str2array(lowercase(s),lowercase(ffindstr));
lenf := length(ffindstr);
lenss := length(ss)-1;
for i,v in ss do
begin
if v then
begin
ft.Color := 0;
lenv := length(v);
rc[2] := lenv*w+x;
cvs.DrawText(s[p:(p+lenv-1)],rc);
x := rc[2];
rc[0] := x;
p+=lenv;
end
if x>ARect[2] then break;
if lenss>i then
begin
ft.Color := 244;
rc[2] := lenf*w+x;
cvs.DrawText(s[p:(p+lenf-1)],rc);
p+=lenf;
x := rc[2];
if x>ARect[2] then break;
rc[0] := x;
end
end
end
end
end
type TFindWnd=class(TPage)
type TFindBtn=class(TBtn)
@@ -5775,8 +5880,6 @@ type TGoToLineWnd=class(TVCForm) //
function Create(AOwner);override;
begin
inherited;
//ParentFont := false;
//font := array("width":10,"height":20);
wssizebox := false;
minmaxbox := false;
WsDlgModalFrame := true;
@@ -5815,9 +5918,6 @@ type TGoToLineWnd=class(TVCForm) //
childsizing := array("layout":1,"leftrightspacing":5,"topbottomspacing":10,"verticalspacing":5,"controlsperline":3);
autosize := true;
end
function DoControlAlign();override;
begin
end
function ShowGoto();
begin
show();
@@ -5937,6 +6037,7 @@ type tsyssizemgr = class(TVCForm)
pal.Parent := self;
childsizing := array("layout":1,"controlsperline":2);
pal.childsizing := array("layout":1,"controlsperline":2,"topbottomspacing":3);
fpal2 := pal;
autosize := true;
fok.onclick := thisfunction(okclk);
fcancel.onclick := thisfunction(cancelclk);
@@ -5948,6 +6049,7 @@ type tsyssizemgr = class(TVCForm)
ft := font;
e.Height := ft.Height+5;
e.Width := ft.Width*7;
if fpal2 then e.Width :=fpal2.Width;
end
function okclk(o,e);
begin
@@ -5982,7 +6084,8 @@ type tsyssizemgr = class(TVCForm)
setinfo(editorglobalinfo?:array());
center_popup_wnd(self);
return ShowModal();
end
end
fpal2;
fsysimg;
fsysfont;
end
@@ -6062,10 +6165,11 @@ function gettslexe();
begin
return static gettslexefullpath();
end
function limitstringlength(s);
function limitstringlength(s,n);
begin
return trim(s);
len := length(s);
n := 150;
if not(n>30) then n := 150;
if len>n then
begin
if bytetype(s,n)=1 then
designer/utslcodeformat.tsf
+3
View File
@@ -133,6 +133,9 @@ type TFormatParser = class
"%%","(*","//","#!",
"<?tslx>",
"?>",
"...",
":>",":<",":<>", ":==",":>=",":<=",
"::>","::<","::<>", "::==","::>=","::<=",
//"0x","0O","0b",
);
TslSyn2 := array("div=","union2=","intersect=","outersect=","minus=","end.",);
designer/utslsynmemo.tsf
+11 -6
View File
@@ -1013,9 +1013,7 @@ type TTslSynHighLighter = class(TSynHighLighter)
end
tvi := s[idx];
if tvi=" " or tvi="\t" then
begin
begin
SetTToken(tokens,const ccs,idx-1,array("%%"));
return ParserTokenLines(s,idx+1,e,ccs,tokens);
end
@@ -1023,7 +1021,7 @@ type TTslSynHighLighter = class(TSynHighLighter)
end
end else
begin
SetTToken(tokens,"%",idx-1);
SetTToken(tokens,"%",idx-1);
idx--;
end
end
@@ -1053,6 +1051,13 @@ type TTslSynHighLighter = class(TSynHighLighter)
SetTToken(tokens,"<",idx);
end
end else
if vi="." and (idx<e-2) and s[idx+1]="." and s[idx+2]="." then //////////加入处理 ...
begin
if ttk then
SetTToken(tokens,ttk,idx-1);
SetTToken(tokens,"...",idx+2);
idx+=2;
end else
if pos(vi,"`~@#$^&*)+-;,.?:[]|\\=><%/") then
begin
if ttk then
@@ -1248,8 +1253,8 @@ type TTslSynHighLighter = class(TSynHighLighter)
end
function GetLineTokens(idx);override;
begin
if idx<FSatesCount then
return FTokens[idx];
if idx<FSatesCount then return FTokens[idx];
return nil;
end
private
function FindRightChar(c,s,b,e,zy); //查找封闭的字符
designer/utslvcldcomponents.tsf
+620 -445
View File
File diff suppressed because it is too large Load Diff
designer/utslvcldebuger.tsf
+5
View File
@@ -2717,6 +2717,11 @@ type tdbgvalueshowgrid=class(TDrawGrid)
end
end
PopupMenu := mu;
onfontchanged := function()begin
ft := font;
if not ft then return ;
ItemHeight := ft.Height+4;
end
end
function DoDrawSubItem(o,e);override;
begin
designer/utslvcldesigner.tsf
+117 -35
View File
@@ -41,6 +41,7 @@ type TVclDesigner = class(tvcform)
FStopMenu;
FProjectsManager;
FProjectManager;
FTslParser;//解析器
//***************************
function WrapProjectTo(); //打包当前
begin
@@ -116,7 +117,7 @@ type TVclDesigner = class(tvcform)
height := (integer(mx*32/twidth)+1)*32+60+30{+24}+5;
end
function TreeNode2tfmsub(lib,node,itemnames,nd);//tmf文件字符串
function TreeNode2tfmsub(lib,node,itemnames,nd,bshow);//tmf文件字符串
begin
if not(node) then
begin
@@ -128,7 +129,7 @@ type TVclDesigner = class(tvcform)
if not tr then return ;
it := tr.RootItem;
node := (it.items)[0];
ifnit := true;
ifnit := true;
end
if not ifarray(itemnames) then itemnames := array();
if not ifarray(lib) then lib := array();
@@ -145,7 +146,7 @@ type TVclDesigner = class(tvcform)
begin
tcname := tc.name;
tcclassname := tc.dclassname;
if not(tcclassname and tcname and ifstring(tcname) and ifstring(tcclassname)) then raise "错误!";
if not(tcclassname and tcname and ifstring(tcname) and ifstring(tcclassname)) then return " ";//raise "错误!"$" "$tcname$" "$tcclassname$"<<<<";
oorinh := (tc.isinherited)?"inherited ":"object ";
ihp := "";
if tc.isinherited then
@@ -153,8 +154,9 @@ type TVclDesigner = class(tvcform)
if ifstring(tc.inheritedparent) then
begin
ihp := "("+tc.inheritedparent+")";
bshow := true;
end
end
end else bshow := true;
r+= oorinh + tcname +":"+tcclassname+ihp+"\r\n";
itemnames[length(itemnames)] := array(tcname,tcclassname);
cr := tc.GetChangedPublish();
@@ -163,10 +165,18 @@ type TVclDesigner = class(tvcform)
if not(v and ifstring(i) and ifstring(v) ) then continue; //严格判断
r+=tab;
r+= i + "=" + v +"\r\n";
bshow := true;
end
for i := 0 to node.ItemCount-1 do
begin
r += tablelines( TreeNode2tfmsub(lib,(node.items)[i],itemnames),tab);
ibshow := false;
rri := TreeNode2tfmsub(lib,(node.items)[i],itemnames,nil,ibshow);
if ibshow then
begin
rr := tablelines( rri,tab);
r += rr;
bshow := true;
end
end
r += "end";
end
@@ -469,12 +479,12 @@ type TVclDesigner = class(tvcform)
begin
Foh := o.height;
_send_(WM_USER,123,123,1);
e.skip := true;
return ;
end
SC_MINIMIZE:
begin
e.skip := true;
return ;
//e.skip := true;
end
SC_DEFAULT:
begin
@@ -487,6 +497,8 @@ type TVclDesigner = class(tvcform)
end
SC_RESTORE:
begin
Foh := o.height;
_send_(WM_USER,123,123,1);
end
end;
@@ -503,7 +515,7 @@ type TVclDesigner = class(tvcform)
begin
if e.wparam = 123 and e.lparam=123 then
begin
if o.height>Foh then
if {o.height>Foh}true then
begin
o.height := Foh; //gtk 逻辑正确但是设置无效
end
@@ -911,8 +923,46 @@ type TVclDesigner = class(tvcform)
end
end else
begin
FProjectManager.GoToAFunction(dv);
return ;
inh := FProjectManager.GoToAFunction(dv);
if not ifstring(inh) then return ;
////////////////父类中查找////////////////////////////////////////////
flg := true;
fs := FProjectManager.getall_class_tsf();
while flg and inh do //循环查找父类
begin
fn := 0;
for i,v in fs do //查找父类文件
begin
if v.fname=inh and v.FType<>"tsl" then
begin
fn := v.gettsfname();
break;
end
end
if not fn then break;//没找到文件退出
FTslParser.ScriptPath := fn;
ci := FTslParser.GetClassInfo();
for i,vf in ci["funcs"] do //对比函数名
begin
if dv=vf then
begin
flg := false;
break;
end
end
if flg then //没找到函数,继续找上一级父类
begin
inh := ci["inherited",0] ;
end else //找到函数,提示跳转
begin
if messageboxa("函数:"$dv$"在父类:"$inh$"中,是否打开","打开提示!",1,self)=IDOK then
begin
return FProjectManager.GoToAFunction(dv,v.gettsfname());
end
end
end
//////////////////////////////////////////////////////////////////
end
end
end
@@ -969,6 +1019,7 @@ type TVclDesigner = class(tvcform)
{**
@explan(说明) 组件被点击 %%
**}
uses utslvclevent;
nd := o._tag;
tr := nd.owner;
if not(tr.visible) then
@@ -977,6 +1028,20 @@ type TVclDesigner = class(tvcform)
FProjectManager.setnodesel(wnd);
return ;//
end
///////////////////特殊处理page控件///////////////////////////////////////////
if (o is class(TPageControl)) and (e is class(TMMouse)) then
begin
d := o.hittabat(e.pos);
if ifarray(d) then
begin
pid := d["idx"];
if (pid>=0) then
begin
o.SetPublish("cursel",pid,1);
end
end
end
///////////////////////////////////////////
if fselctlnode<> nd then
begin
//wd := o;//nd.Component.Cwnd;
@@ -1045,7 +1110,8 @@ type TVclDesigner = class(tvcform)
@explan(说明) 选择工具按钮 %%
**}
cct := o._tag;
FComponentCreater := cct;
FComponentCreater := cct;
//if FProjectManager then FProjectManager.hiddeneditor();
end
function CloseShowForm(o,e); //主窗口关闭
@@ -1433,8 +1499,8 @@ type TVclDesigner = class(tvcform)
{$endif}
compcwnd.Handle;
end
comp.isinherited := d["inherited"];
comp.inheritedparent := d["parent"];
comp.isinherited := d["inherited"];
comp.name := d["name"];
obarray[d["name"]] := comp;
FVariableSelecter.additem(comp);
@@ -1511,7 +1577,7 @@ type TVclDesigner = class(tvcform)
rect := _wapi.GetScreenRect();
twidth := (rect[2]-50);
width := twidth;
height := 180;
height := 190;
//calcheight(twidth);
caption := "TVCL界面设计器";
FProjectsManager := new TProjectManagerForm(self);
@@ -1563,24 +1629,36 @@ type TVclDesigner = class(tvcform)
tparent.parent := FObjInspector;
pparent.parent := FObjInspector;
//FTree.parent := tparent;
/////////////////属性筛选////////////////////////////////
fsearch := new tedit(self);
fsearch.placeholder := "筛选";
fsearch.Align := alTop;
fsearch.autosize := true;
fsearch.parent := pparent;
fsearch.OnChange := function(o,e)begin
if FPropGrid then FPropGrid.searchidex := o.text;
if FEventGrid then FEventGrid.searchidex := o.text;
end
////////////////////////////////////////////////
pedits.parent := pparent ;
FProp.parent := pedits;
FEvent.parent := pedits;
FEvent.parent := pedits;
FPropGrid.align := alclient;
FEventGrid.align := alclient;
FPropGrid.parent := FProp;
FEventGrid.parent := FEvent;
Mobjinspect();
onactivate := thisfunction(OnDesignerActivate);
fdimagelist := new TDesigImageList(self);
global editorglobalinfo ;
if ifarray(editorglobalinfo) and editorglobalinfo then
begin
fdimagelist.imgsize := editorglobalinfo["imgsize"];
fdimagelist.imgsize := editorglobalinfo["imgsize"];
sz := editorglobalinfo["fontsize"] ;
if sz>5 then FObjInspector.width :=sz*34+20;
end
Mobjinspect();
//FTree.Imagelist := fdimagelist;
fwindowinfos := new tfilesinfo(self,thisfunction(ClickTreeNode),fdimagelist,tparent);
//******************toolbar ***************
@@ -1646,6 +1724,7 @@ type TVclDesigner = class(tvcform)
fdimagelist.imgsize := d["imgsize"];
end
end ;
FTslParser := new unit(utslvclsyntaxparser).ttslscripparser();
//OnChange
//fnewmenu
end
@@ -1988,42 +2067,41 @@ type TPropEditGrid = class(TPropGrid) //
function SetComponent(v);override;
begin
if v=FComponent then exit;
ocls := Columns;
if v is class(TDComponent) then
begin
TSLData := v.GetPublishProperties();
TSLData := getneedpublished(v);//
end else
begin
TSLData := array();//array(NIL);
end
inherited;
if ocls then
begin
w := ocls[1,"width"];
if w>0 then
begin
i := 1;
self.ColumnWidth(1) := w;
end
end
end
public
function Create(AOwner);
begin
inherited;
FobjProptype := p_properys;
end
end
function getneedpublished(v);virtual;
begin
return v.GetPublishProperties();
end
end
type TEventEditGrid = class(TPropGrid) //事件编辑器
type TEventEditGrid = class(TPropEditGrid) //事件编辑器
{**
@explan(说明) 事件编辑 %%
**}
protected
function SetComponent(v);override;
begin
if v=FComponent then exit;
if v is class(TDComponent) then
begin
TSLData := v.GetPublishEvents();
//echo tostn(TSLData);
end else
begin
TSLData := array(NIL);
end
inherited;
end
public
function Create(AOwner);
begin
@@ -2031,6 +2109,10 @@ type TEventEditGrid = class(TPropGrid) //
FobjProptype := p_evnets;
OndblClick := thisfunction(GridCellDblClick);
end
function getneedpublished(v);override;
begin
return v.GetPublishEvents();
end
function GridCellDblClick(o,e);override;//双击处理
begin
i := e.iitem;
designer/utslvcldpropertytypes.tsf
+59 -42
View File
@@ -55,7 +55,7 @@ type TGridPropertyRender = class(TGCellRender) //
inherited;
Owner := AOwner;
end
Owner ;
[weakref]Owner ;
end
type TGridCellEditWithButton = class(TGridPropertyRender) //带按钮的单元格编辑
{**
@@ -387,7 +387,6 @@ type TListVariable = class(TGridList)
SetColumnWidth(0,Width-11);
end
end
function create(AOwner);override;
begin
inherited;
@@ -397,6 +396,11 @@ type TListVariable = class(TGridList)
Columns := array(
("text":"variable","width":180)
);
OnFontChanged := function()begin
ft := font;
if not ft then return ;
ItemHeight := ft.height+6;
end
end
function SetSelectedByValue(v_);override;
begin
@@ -458,7 +462,7 @@ type TListStr = class(TListVariable)
function create(AOwner);override;
begin
inherited;
Columns := array(("text":"打开编辑器","width":160));
Columns := array(("text":"编辑器","width":160));
end
function additem(v);override;
begin
@@ -913,7 +917,7 @@ type TTSLDataGrid=class(TDrawGrid)
@explan(说明)TSL数组和对象展示 %%
**}
private
fsearchidex;
FCols;
Fdata;
FObjectData;
@@ -922,7 +926,7 @@ type TTSLDataGrid=class(TDrawGrid)
FRows;
FShowTwo;
FCControls;
FColumnWidth;
FdfColumnWidth;
FRowHeader;
static FGCellRender;
FCanEditStr;
@@ -992,6 +996,14 @@ type TTSLDataGrid=class(TDrawGrid)
return FGCellRender[n];
end
private
function setsearchidex(s);
begin
if fsearchidex<>s and ifstring(s) then
begin
fsearchidex := s;
InvalidateRect(nil,false);
end
end
function SetRowHeader(v);
begin
nv := v?true:false;
@@ -1045,16 +1057,17 @@ type TTSLDataGrid=class(TDrawGrid)
begin
fcs[0]:= array("text":" ","width":min(500,wd));
end
cw := 15* ftwidth;
if FCL and allFCL and FShowTwo then
begin
FCols := FCl;
for i,v in FCols do
begin
fcs[length(fcs)]:= array("text":ifstring(v)?v:inttostr(v),"width":FMRWD);
fcs[length(fcs)]:= array("text":ifstring(v)?v:inttostr(v),"width":cw);
end
end else
begin
fcs[length(fcs)]:= array("text":" ","width":ColumnWidth>20?ColumnWidth:100);
fcs[length(fcs)]:= array("text":" ","width":fdfColumnWidth>20?fdfColumnWidth:cw);
end
Columns := fcs;
ItemCount := length(FRows);
@@ -1146,6 +1159,7 @@ type TTSLDataGrid=class(TDrawGrid)
end
end
public
property searchidex read fsearchidex write setsearchidex;
function create(AOwner);override;
begin
inherited;
@@ -1162,7 +1176,7 @@ type TTSLDataGrid=class(TDrawGrid)
FStringAlign := AL9_CENTERLEFT;
FDefAlign := AL9_CENTER;
end
function InitializeWnd();override;
begin
inherited;
@@ -1242,6 +1256,10 @@ type TTSLDataGrid=class(TDrawGrid)
begin
ds := d;
//dc.drawtext(ds,src);
if j=0 and fsearchidex and pos(lowercase(fsearchidex),lowercase(d)) then
begin
dc.font.color := 0xff;
end
class(TLabel).CanvasDrawAlignText(dc,src,ds,FStringAlign);
end else
if ifobj(d)then
@@ -1267,12 +1285,8 @@ type TTSLDataGrid=class(TDrawGrid)
begin
dc := e.canvas;
rc := e.rcitem;
{if SelectedRow = e.id then
if ifnumber(SelectRowColor) then dc.brush.color := SelectRowColor;
else
dc.brush.color := rgb(150,150,150);
else }
if color then dc.brush.color := color; //
c := color;
if c then dc.brush.color := c; //
else dc.brush.color := rgb(255,255,255);
dc.fillrect(rc);
inherited;
@@ -1315,9 +1329,8 @@ type TTSLDataGrid=class(TDrawGrid)
begin
if d["type"]="object" then
begin
rd := GetCellRender(d["class"]);
if r then return r.CelldbClick(o,e,d);
rd := GetCellRender(d["class"]);
if rd then return rd.CelldbClick(o,e,d); ///////////
end
getitemcontrol(d,p,e.iitem,cl,"grid",cp,indexs);
end else
@@ -1362,24 +1375,6 @@ type TTSLDataGrid=class(TDrawGrid)
end
end
return r;
idx := "FData";
for i,v in index do
begin
if ifnumber(v)then idx += format("[%d]",v);
else if ifstring(v)then
begin
idx += format('["%s"]',v);
end
end
if length(idx)>5 then
begin
vals := idx+":="+tostn(val)+";"; //FData["c"]["value"]:=0;
try
eval(&vals);
except
//echo "===errr";
end;
end
end
function ControlIndexs(dx);
begin
@@ -1460,7 +1455,7 @@ type TTSLDataGrid=class(TDrawGrid)
end
property Twodimensional:bool read FShowTwo write SetTwoD;
property TSLdata:variable read GetTSLData write SetData;
property ColumnWidth:integer read FColumnWidth write FColumnWidth;
property dfColumnWidth:integer read FdfColumnWidth write FdfColumnWidth;
property RowHeader:bool read FRowHeader write SetRowHeader;
property CanEditStr:bool read FCanEditStr write FCanEditStr;
property StringAlign:AlignStyle9 read FStringAlign write SetStringAlign;
@@ -3051,6 +3046,7 @@ private
public
function create(aOwner);override;begin
inherited;
ParentFont := false;
caption:="TreeViewEditor";
left:=300;
top:=300;
@@ -3256,13 +3252,15 @@ type TMultiSelList = class(TCustomControl)
function Create(AOwner);
begin
inherited;
FBtnWidth := 80;
border := true;
FList := new TListBox(self);
FList.checkbox := true;
FList.Multisel := 2;
//FList.Appenditems(array("a","b","c"));
FList.setCurrentSelection(array(0,1));
FList.parent := self;
FOkBtn := new TBTN(self);
FBtnWidth := 80;
FOkBtn := new TBTN(self);
FOkBtn.width := FBtnWidth;
FOkBtn.caption := "确定";
FOkBtn.parent := self;
@@ -3272,7 +3270,20 @@ type TMultiSelList = class(TCustomControl)
FCanceBtn.parent := self;
FCanceBtn.onclick := thisfunction(CancelClick);
FOkBtn.onclick := thisfunction(okClick);
OnFontChanged := thisfunction(DoControlAlign);
end
{function FontChanged(o);override;
begin
ft := font;
if not ft then return ;
inherited;
FBtnWidth := 5*ft.width;
FOkBtn.height := ft.height+5;
Fokbtn.width := FBtnWidth;
FCanceBtn.height := ft.height+5;
FCanceBtn.width := FCanceBtn;
end }
function GetSelectdata();
begin
idx := FList.getSelectedIndexes();
@@ -3319,18 +3330,24 @@ type TMultiSelList = class(TCustomControl)
end
function DoControlAlign();override;
begin
if FList and FOkBtn AND FCanceBtn then
ft := font;
if ft and FList and FOkBtn AND FCanceBtn then
begin
r := ClientRect;
h := FOkBtn.height;
h :=ft.height+4;
w :=ft.width*5;
c := r;
c[3]-=h+4;
FList.SetBoundsRect(c);
bt := r[3]-h-1;
FOkBtn.height := h;
FOkBtn.width := w;
FOkBtn.Top := bt;
FOkBtn.Left := r[2]-FBtnWidth-5;
FOkBtn.Left := r[2]-w-5;
FCanceBtn.top := bt;
FCanceBtn.Left := r[2]-FBtnWidth-FBtnWidth-10;
FCanceBtn.height := h;
FCanceBtn.width := w;
FCanceBtn.Left := r[2]-w*2-10;
end
end
function CancelClick(o,e);
designer/utslvclsyntaxparser.tsf
+6
View File
@@ -958,6 +958,12 @@ type tsltoken = class(tslparserbase) //
vf := 1;
setdata(FTokens,nk,v,"回车",pos,hh);
end else
if v="." and (pos< len-2) and str[pos+1]="." and str[pos+2]="." then
begin
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
setdata(FTokens,nk,"...","语句",pos,3);
pos+=2;
end else
if v in array(",",";",".","]","[",":","=","!")then
begin
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);