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

更新界面库

Browse Source
This commit is contained in:
liujianjun
2026-01-06 16:43:22 +08:00
parent db909b5520
commit 91f0c75959
39 changed files with 2891 additions and 1670 deletions
Download Patch File Download Diff File Expand all files Collapse all files
designer/ctl_mgr/t_compile_config.tfm
+10 -10
View File
@@ -169,7 +169,7 @@ object ed_script:t_compile_config
leftrightspacing=2
topbottomspacing=2
>
height=73
height=71
left=10
parentcolor=true
top=149
@@ -178,14 +178,14 @@ object ed_script:t_compile_config
left=6
top=21
width=58
height=23
height=21
autosize=true
caption="函数目录"
end
object ed_f_dirs:tedit
autosize=true
caption="edit1"
height=23
height=21
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=23
height=21
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=46
top=44
width=58
height=21
autosize=true
@@ -212,7 +212,7 @@ object ed_script:t_compile_config
caption="edit2"
height=21
left=66
top=46
top=44
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=46
top=44
width=28
end
end
@@ -239,7 +239,7 @@ object ed_script:t_compile_config
height=139
left=10
parentcolor=true
top=232
top=230
width=452
object lb_s_type:tlabel
left=6
@@ -385,7 +385,7 @@ object ed_script:t_compile_config
height=97
left=10
parentcolor=true
top=381
top=379
width=452
object label9:tlabel
left=6
@@ -521,7 +521,7 @@ object ed_script:t_compile_config
>
height=25
left=10
top=488
top=486
width=452
wsdlgmodalframe=false
object bt_cmd:tbtn
designer/ctl_mgr/t_compile_config.tsf
+15 -12
View File
@@ -1,6 +1,5 @@
type t_compile_config=class(tdcreateform)
uses tslvcl;
uses tslvcl;
gp_dir:tgroupbox;
bt_f_dir:tbtn;
bt_s_dir:tbtn;
@@ -13,21 +12,14 @@ type t_compile_config=class(tdcreateform)
lb_ype:tlabel;
cb_type:tcombobox;
lb_output:tlabel;
ed_output:tedit;
gp_other:tgroupbox;
ed_output:tedit;
gp_other:tgroupbox;
bt_i_s:tbtn;
lb_ico:tlabel;
ed_ico:tedit;
bt_ico:tbtn;
bt_output:tbtn;
f_op:topenfileadlg;
f_op:topenfileadlg;
bt_outputname:tbtn;
lb_output_f:tlabel;
ed_out_f:tedit;
@@ -134,6 +126,17 @@ type t_compile_config=class(tdcreateform)
ed_ico.text := r["buildico"];
ed_tsg.text := r["pkg"];
e_namespace.text := r["nspace"];
if r["designer"] then
begin
e_script.Enabled := false;
cb_type.Enabled := false;
ck_gui.Enabled := false;
end else
begin
e_script.Enabled := true;
cb_type.Enabled := true;
ck_gui.Enabled := true;
end
//ck_s_rp.Checked := r["resourcekeepdir"];
end
function get_config();
designer/ctl_mgr/t_editor_color_mgr.tfm
+2 -2
View File
@@ -33,9 +33,9 @@ object ditor_color_mgr:t_editor_color_mgr
itemindex=0
left=10
onselchanged=colorcombobox1_onselchanged
parentfont=false
top=18
width=132
parentfont=false
end
object listbox1:tlistbox
caption="listbox1"
@@ -54,9 +54,9 @@ object ditor_color_mgr:t_editor_color_mgr
itemindex=0
left=154
onselchanged=colorcombobox2_onselchanged
parentfont=false
top=18
width=177
parentfont=false
end
object openfileadlg1:topenfileadlg
left=314
designer/ctl_mgr/t_editor_config.tfm
+1
View File
@@ -217,6 +217,7 @@ object editor_config:t_editor_config
caption="取消"
height=31
left=191
onclick=bt_cancel_clk
top=8
width=94
end
designer/ctl_mgr/t_editor_config.tsf
+1 -1
View File
@@ -33,7 +33,7 @@ type t_editor_config=class(tdcreateform)
end
function bt_cancel_clk(o;e);
begin
o.Visible := false;
Visible := false;
//calldatafunction(foncancel_clk,self,e);
end
function bt_ok_clk(o;e);
designer/ctl_mgr/t_function_finder.tfm
+4 -4
View File
@@ -29,7 +29,7 @@ object functionfinder:t_function_finder
align=altop
autosize=true
caption="panel1"
height=41
height=39
left=0
top=0
width=804
@@ -55,7 +55,7 @@ object functionfinder:t_function_finder
object ck_prev:tcheckbtn
autosize=true
caption="从头匹配"
height=27
height=25
left=371
top=8
visible=true
@@ -82,11 +82,11 @@ object functionfinder:t_function_finder
text="函数"
>
]
height=566
height=568
left=0
ondblclick=listfunc_ondblclick
popupmenu=popupmenu1
top=41
top=39
width=804
end
object popupmenu1:tpopupmenu
designer/ctl_mgr/textcompclassadder.tfm
+82 -53
View File
@@ -1,80 +1,109 @@
object extcompclassadder:textcompclassadder
autosize=true
caption="添加"
height=406
left=474
minmaxbox=false
onclose=extcompclassadder_close
top=316
width=402
width=420
wssizebox=false
object e_classname:tedit
caption="edit1"
height=25
left=99
readonly=true
top=28
width=247
end
object label1:tlabel
left=20
top=21
width=72
height=32
caption="控件类"
end
object b_classfile:tbtn
caption="..."
height=24
left=354
onclick=b_classfile_clk
top=29
width=21
end
object label2:tlabel
left=20
top=72
width=65
height=33
caption="图标"
end
object p_imgshow:tpanel
autosize=false
caption="img"
height=195
left=91
top=107
width=245
height=120
left=183
top=181
width=130
wsdlgmodalframe=false
end
object b_img:tbtn
caption="添加图标"
height=25
left=100
onclick=b_img_clk
top=72
width=176
end
object b_ok:tbtn
autosize=true
caption="确定"
enabled=true
height=31
left=134
height=21
left=64
onclick=b_ok_clk
top=306
width=72
top=322
width=42
end
object b_cancel:tbtn
autosize=true
caption="取消"
height=31
left=271
height=21
left=276
onclick=b_cancel_clk
top=306
width=73
top=321
width=42
end
object f_open:topenfileadlg
left=22
top=146
left=42
top=184
height=30
width=30
caption="文件选择"
end
object panel1:tpanel
align=altop
autosize=true
caption="panel1"
childsizing=<
layout=1
controlsperline=3
horizontalspacing=10
verticalspacing=10
leftrightspacing=10
topbottomspacing=10
>
height=72
left=0
top=0
width=366
wsdlgmodalframe=false
object label1:tlabel
left=10
top=10
width=44
height=21
caption="控件类"
end
object e_classname:tedit
caption="edit1"
height=21
left=64
readonly=true
top=10
width=247
end
object b_classfile:tbtn
caption="..."
height=21
left=321
onclick=b_classfile_clk
top=10
width=35
end
object label2:tlabel
left=10
top=41
width=44
height=21
caption="图标"
end
object b_img:tbtn
caption="添加图标"
height=21
left=64
onclick=b_img_clk
top=41
width=247
end
object label3:tlabel
left=321
top=41
width=35
height=21
caption=""
end
end
end
designer/ctl_mgr/textcompclassadder.tsf
+10 -8
View File
@@ -1,14 +1,16 @@
type textcompclassadder=class(tdcreateform)
uses tslvcl;
e_classname:tedit;
label1:tlabel;
b_classfile:tbtn;
label2:tlabel;
p_imgshow:tpanel;
b_img:tbtn;
uses tslvcl;
p_imgshow:tpanel;
b_ok:tbtn;
b_cancel:tbtn;
f_open:topenfileadlg;
f_open:topenfileadlg;
panel1:tpanel;
label1:tlabel;
e_classname:tedit;
b_classfile:tbtn;
label2:tlabel;
b_img:tbtn;
label3:tlabel;
function Create(AOwner);override; //构造
begin
inherited;
designer/ctl_mgr/textcompclassmgr.tfm
+35 -21
View File
@@ -1,11 +1,13 @@
object extcompclassmgr:textcompclassmgr
autosize=true
caption="注册控件-管理"
height=467
left=447
height=444
left=930
minmaxbox=false
onclose=extcompclassmgr_close
top=272
width=484
top=287
width=446
wspopup=false
wssizebox=true
object listbox1:tlistbox
caption="listbox1"
@@ -16,49 +18,61 @@ object extcompclassmgr:textcompclassmgr
width=344
end
object b_del:tbtn
autosize=true
caption="删除"
enabled=false
height=31
left=364
height=21
left=368
onclick=b_del_clk
top=224
width=88
top=73
width=42
end
object b_add:tbtn
autosize=true
caption="添加"
height=31
left=364
height=21
left=368
onclick=b_add_clk
top=279
width=88
top=176
width=42
end
object b_ok:tbtn
autosize=true
caption="完成"
height=31
left=364
height=21
left=368
onclick=b_ok_clk
top=346
width=88
wssizebox=false
wssysmenu=false
top=288
width=42
end
object statusbar1:tstatusbar
autosize=true
caption="statusbar1"
height=25
height=19
items= [<
width=500
text="控件管理"
>
]
left=0
top=403
width=468
parentfont=false
top=386
width=430
end
object label1:tlabel
left=8
top=5
width=176
height=36
parentfont=false
caption="控件列表"
end
object label2:tlabel
left=394
top=388
width=16
height=17
autosize=true
caption=" "
end
end
designer/ctl_mgr/textcompclassmgr.tsf
+4 -12
View File
@@ -6,29 +6,21 @@ type textcompclassmgr=class(tdcreateform)
b_ok:tbtn;
statusbar1:tstatusbar;
label1:tlabel;
label2:tlabel;
function Create(AOwner);override; //¹¹Ôì
begin
inherited;
end
function extcompclassmgr_close(o;e);virtual;
function extcompclassmgr_close(o;e);
begin
{**
@explan(说明) 主窗口关闭回调 %%
@param(e)(tuievent) 消息对象 %%
@param(o)(ttimer) 当前主窗口 %%
**}
e.skip:= true;
Visible := false;
inherited;
end
function b_ok_clk(o;e);virtual;
function b_ok_clk(o;e);
begin
Visible := false;
end
function b_del_clk(o;e);virtual;
function b_del_clk(o;e);
begin
idx := listbox1.ItemIndex;
if idx>=0 and parent then
designer/ctl_mgr/vcldesginer.tpj
+16 -71
View File
@@ -1,71 +1,16 @@
array(
"name":"vcldesginer",
"version":"1.1.2",
"dir":(
),
"files":(
"textcompclassadder":(
"name":"textcompclassadder",
"type":"form",
"dir":""
),
"textcompclassmgr":(
"name":"textcompclassmgr",
"type":"form",
"dir":""
),
"tfm_inheritedwnd":(
"name":"tfm_inheritedwnd",
"type":"form",
"dir":""
),
"t_bconfig_cmd_shower":(
"name":"t_bconfig_cmd_shower",
"type":"form",
"dir":""
),
"t_compile_config":(
"name":"t_compile_config",
"type":"form",
"dir":""
),
"t_dir_list":(
"name":"t_dir_list",
"type":"form",
"dir":""
),
"t_m_list_editor":(
"name":"t_m_list_editor",
"type":"form",
"dir":""
),
"t_function_finder":(
"name":"t_function_finder",
"type":"form",
"dir":""
),
"t_shortcut_keys_view":(
"name":"t_shortcut_keys_view",
"type":"form",
"dir":""
),
"tsl1":(
"name":"tsl1",
"type":"tsl",
"dir":""
),
"t_editor_color_mgr":(
"name":"t_editor_color_mgr",
"type":"form",
"dir":""
),
"t_editor_config":(
"name":"t_editor_config",
"type":"form",
"dir":""
)
),
"mainform":"t_shortcut_keys_view",
"entryscript":"vcldesginer",
"commandline":"\"$(TSL_EXE)\" \"$(FULL_CURRENT_PATH)\" -libpath \"$(SEARCH_PATH)\""
)
array("name":"vcldesginer","version":"1.1.2","dir":
(),"files":
("textcompclassadder":
("name":"textcompclassadder","type":"form","dir":""),"textcompclassmgr":
("name":"textcompclassmgr","type":"form","dir":""),"tfm_inheritedwnd":
("name":"tfm_inheritedwnd","type":"form","dir":""),"t_bconfig_cmd_shower":
("name":"t_bconfig_cmd_shower","type":"form","dir":""),"t_code_format_mgr":
("name":"t_code_format_mgr","type":"form","dir":""),"t_compile_config":
("name":"t_compile_config","type":"form","dir":""),"t_dir_list":
("name":"t_dir_list","type":"form","dir":""),"t_editor_color_mgr":
("name":"t_editor_color_mgr","type":"form","dir":""),"t_editor_config":
("name":"t_editor_config","type":"form","dir":""),"t_function_finder":
("name":"t_function_finder","type":"form","dir":""),"t_m_list_editor":
("name":"t_m_list_editor","type":"form","dir":""),"t_shortcut_keys_view":
("name":"t_shortcut_keys_view","type":"form","dir":"")),"mainform":"textcompclassmgr")
designer/teditorform.tsf
+449 -430
View File
File diff suppressed because it is too large Load Diff
designer/udesignerproject.tsf
+61 -45
View File
@@ -13,6 +13,10 @@ type TProjectManagerForm = class(TVCForm) //
minmaxbox := false;
Border := false;
FProjectCoder := new TDesignerProjectsRecoder();
fbtncontainer := new tpanel(self);
fbtncontainer.Align := alBottom;
fbtncontainer.autosize := true;
fbtncontainer.parent := self;
FDesigner := AOwner;
visible := false;
WsSizeBox := true;
@@ -20,23 +24,15 @@ type TProjectManagerForm = class(TVCForm) //
WsPopUp := true;
WsSysMenu := true;
rc := _wapi.GetScreenRect();
//l :=(rc[2]-rc[0])/2-280;
//t :=(rc[3]-rc[1])/2-230;
//SetBoundsRect(array(l,t,480+l,300+t));
SetBoundsRect(array(100,100,700,500));
FList := new TProgValueList(self);
FList.Align := alClient;
FList.Border := true;
d := GetAllProjects();
p := array();
for i,v in d do p[i]:= array("caption":v["name"],"value":v["file"]);
FList.SetData(p);
if p then FList.SetCurrentSelection(0);
FLinea := new TLabel(self);
FLinea.caption := "";
FLinea.height := 2;
FLinea.left :=-1;
FLinea.Color := rgb(30,144,255);
FLinea.parent := self;
FList.parent := self;
FList.OnDblClick := thisfunction(OpenSelectedObject);
FDelBtn := new TBtn(self);
@@ -45,8 +41,7 @@ type TProjectManagerForm = class(TVCForm) //
FOpenBtn.height := 28;
FDelBtn.height := 28;
FOpenBtn.caption := "打开";
FDelBtn.parent := self;
FOpenBtn.parent := self;
FDelBtn.OnClick := function(o,e)
begin
cid := FList.getCurrentSelection();
@@ -62,6 +57,23 @@ type TProjectManagerForm = class(TVCForm) //
end
end
FOpenBtn.OnClick := thisfunction(OpenSelectedObject);
spc := new TLabel(self);
spc2 := new TLabel(self);
spc.caption := " ";
spc2.caption := " ";
FOpenBtn.autosize := true;
spc.autosize := true;
spc2.autosize := true;
FDelBtn.autosize := true;
FDelBtn.Align := alRight;
FOpenBtn.Align := alRight;
spc.Align := alRight;
spc2.Align := alRight;
spc2.parent := fbtncontainer;
FOpenBtn.parent := fbtncontainer;
spc.parent := fbtncontainer;
FDelBtn.parent := fbtncontainer;
end
function OpenSelectedObject();
begin
@@ -105,23 +117,7 @@ type TProjectManagerForm = class(TVCForm) //
if it then n := it["value"];
return n;
end
function DoControlAlign();override;
begin
if FList and FDelBtn and FOpenBtn and FLinea then
begin
rc := ClientRect;
rc1 := rc;
rc1[3]-= 35;
FList.SetBoundsRect(rc1);
FLinea.top := rc1[3]+2;
tp := rc1[3]+5;
FDelBtn.Top := tp;
FDelBtn.left := rc[2]-200;
FOpenBtn.Top := tp;
FOpenBtn.left := rc[2]-100;
if rc[2]>FLinea.width then FLinea.width := rc[2];
end
end
function CreateTpjFomFile(f);
begin
if AddAproject(F)then
@@ -188,7 +184,7 @@ end
ls := FProjectCoder.ListProjects();
return ls;
end
FLinea;
fbtncontainer;
FList;
FDelBtn;
FOpenBtn;
@@ -541,7 +537,7 @@ type TProjectView = class(TVCForm) //
fnewmenu.Enabled := false;
fgoformmenu.Enabled := false;
fnewmenu.caption := "新建";
for i,v in array("form","panel","script","tsf") do
for i,v in array("form","panel","script","tsf","继承窗口") do
begin
it := new TMenu(self);
it.caption := v;
@@ -593,7 +589,9 @@ type TProjectView = class(TVCForm) //
if it=ftree.RootNode then
begin
if FAddtoolbtn then FAddtoolbtn.Enabled := false;
return FDesigner.ExecuteCommand("hiddrennode",nil);
r := FDesigner.ExecuteCommand("hiddrennode",nil);
FCurrentOpend := nil;
return r;
end
if it then
begin
@@ -673,6 +671,10 @@ type TProjectView = class(TVCForm) //
begin
AddFormToCurrentDir(createnamea("form"),cnd);
end
"继承窗口":
begin
add_inherited();
end
end
end
@@ -904,7 +906,11 @@ type TProjectView = class(TVCForm) //
function ShowEditor(); //显示函数编辑
begin
//FTslEditer.Show(SW_SHOWNOACTIVATE); //
FTslEditer.Show(); //
if _wapi.IsIconic(FTslEditer.Handle)<>0 then
begin
FTslEditer.Show(SW_RESTORE);
end else
FTslEditer.Show(); //
_wapi.bringWindowToTop(FTslEditer.Handle);
it := FTslEditer.GetCurrentEditer();
if it then return it.SetFocus();
@@ -990,11 +996,17 @@ type TProjectView = class(TVCForm) //
begin
if fopenbuzy then return ;
fio := ioFileseparator();
if not(n and ifstring(n)) then return FDesigner.ExecuteCommand("hiddrennode",nil);;
if not(n and ifstring(n)) then
begin
r := FDesigner.ExecuteCommand("hiddrennode",nil);
FCurrentOpend := nil;
return r;
end
nopend := FTree.NameInTree(n,nil,true);
if not nopend then
begin
FDesigner.ExecuteCommand("hiddrennode",nil);
FCurrentOpend := nil;
return ;
end
if nopend=FCurrentOpend then
@@ -1248,7 +1260,7 @@ end %%,fn);
DeleteAllFiles(FCProjectPath+dp);
end
FCurrentOpend := nil;
FTree.DeleteCurrentNode();
FTree.DeleteCurrentNode(cn);
SaveProjInfo();
end
end
@@ -1274,7 +1286,7 @@ end %%,fn);
end
end;
end
FTree.DeleteCurrentNode();
FTree.DeleteCurrentNode(nd);
SaveProjInfo();
end
end
@@ -1657,6 +1669,7 @@ end
exit;
end
d := get_config_info();
d["designer"] := true;
ShowEditor();
d := FTslEditer.build_with_data(FCProjectPath,d);
if d then
@@ -1687,14 +1700,7 @@ end
end else
begin
for i := length(exename) downto 2 do
begin
if exename[i]="\\" then
begin
exename := exename[1:i]+"tsl.exe";
break;
end
end
exename := gettslexefullpath();
filecopy("",exename,"",FWrapFolder.Folder+"\\tsl\\tsl.exe",false);
end
ReWriteString(FWrapFolder.Folder+"\\start.cmd",s);
@@ -1738,6 +1744,15 @@ end
end
function saveCurrentEdit(nd); //编辑的节点,不送入保存当前节点
begin
if nd = "all" then
begin
r := FDesigner.ExecuteCommand("allopendnod",nil);
for i,v in r do
begin
saveCurrentEdit(v);
end
return ;
end
if not nd then nd := FCurrentOpend;
if nd then
begin
@@ -1794,6 +1809,7 @@ end
begin
FDesigner.UnLoadTreeNode(nd);
if nd = FCurrentOpend then FCurrentOpend := nil;
FTree.CurrentNode := nd.parent; //跳转到当前关闭节点的父节点 20151205
end
end
end
@@ -2637,9 +2653,9 @@ type TFileTree = class(TTreeCtl)
begin
FPNode.RecyclingChildren();
end
function DeleteCurrentNode(); //删除节点
function DeleteCurrentNode(c); //删除节点
begin
C := CurrentNode;
if not c then C := CurrentNode;
if not c then return false;
if FPNode=c then return false;
//pc := c.parent;
designer/utslcodeeditor.tsf
+389 -269
View File
@@ -856,6 +856,7 @@ type TExecuteEditer=class(TCustomControl) //ִ
begin
FMemo.ExecuteCommand(FMemo.ecGotoXY,array(1,1));
FMemO.SetFocus();
center_popup_wnd(self);
show();
end
function Create(AOwner);
@@ -1800,6 +1801,30 @@ type TPageEditer=class(TPage) //
end
[weakref]FPageItemOnRClick;
end
type teditorcoolbar = class(tcoolbar)
function create(AOwner);
begin
inherited;
end
function doControlALign();override;
begin
inherited;
r := ClientRect;
cts := Controls;
h := 0;
for i := 0 to cts.count-1 do
begin
vi := cts[i];
if vi.Visible then
begin
h := max(h,vi.Height+vi.top);
w := max(w,vi.Width+vi.left);
end
end
if (h>Height) or (h<Height-30) then Height := h;
if w>Width then Width := w;
end
end
type TTslChmHelp=class()
function SearchWord(s);
begin
@@ -1851,9 +1876,11 @@ type TEditer=class(TCustomcontrol) //
ftoolbara := new TToolBar(self); //工具栏
ftoolbarb := new TToolBar(self); //工具栏
FStatus := new TStatusBar(self); //状态栏
fcoolbar := new tcoolbar(self);
fcoolbar := new teditorcoolbar(self);
ftoolbara.Align := alNone;
ftoolbarb.Align := alNone;
ftoolbarb.autosize := true;
ftoolbara.autosize := true;
fcoolbar.autosize := true;
FInfoShowWnd := new TEditerAuxiliary(self);
FPageEditer := new TPageEditer(self);
@@ -1949,14 +1976,8 @@ type TEditer=class(TCustomcontrol) //
////////
FListPages.Visible := false;
////////////////////////////
FPageMenu := new TPopUpMenu(self);
for i,v in array("关闭","关闭其他标签","关闭左侧所有","关闭右侧所有","复制文件名","复制文件全名","重新加载","打开目录","另存为") do
begin
mi := new TMenu(self);
mi.Caption := v;
mi.Parent := FPageMenu;
mi.OnClick := thisfunction(PageMenuClick);
end
init_page_title_popmenu();
/////////////////////////////////////////////////////////////////////////////////////
FExecuteEditer := new TExecuteEditer(self);
FExecuteEditer.visible := false;
////////////
@@ -2065,6 +2086,54 @@ type TEditer=class(TCustomcontrol) //
fsyssizemgr := new tsyssizemgr(self);
fsyssizemgr.Parent := self;
end
function init_page_title_popmenu(); //初始化page的标题菜单
begin
FPageMenu := new TPopUpMenu(self);
mi := new TMenu(self);
mi.Caption := "关闭";
mi.Parent := FPageMenu;
mi.OnClick := thisfunction(do_close_cpage);
mi := new TMenu(self);
mi.Caption := "关闭其他标签";
mi.Parent := FPageMenu;
mi.OnClick := thisfunction(do_close_lrpage);
mi := new TMenu(self);
mi.Caption := "关闭左侧所有";
mi.Parent := FPageMenu;
mi.OnClick := thisfunction(do_close_lpage);
mi := new TMenu(self);
mi.Caption := "关闭右侧所有";
mi.Parent := FPageMenu;
mi.OnClick := thisfunction(do_close_rpage);
mi := new TMenu(self);
mi.Caption := "复制文件名";
mi.Parent := FPageMenu;
mi.OnClick := thisfunction(do_copy_page_name);
mi := new TMenu(self);
mi.Caption := "复制文件全名";
mi.Parent := FPageMenu;
mi.OnClick := thisfunction(do_copy_page_path);
mi := new TMenu(self);
mi.Caption := "重新加载";
mi.Parent := FPageMenu;
mi.OnClick := thisfunction(do_reload_page);
mi := new TMenu(self);
mi.Caption := "打开目录";
mi.Parent := FPageMenu;
mi.OnClick := thisfunction(do_open_page_dir);
mi := new TMenu(self);
mi.Caption := "另存为";
mi.Parent := FPageMenu;
mi.OnClick := thisfunction(do_save_page_as);
end
function modifysyssize();
begin
global editorglobalinfo;
@@ -2648,272 +2717,259 @@ type TEditer=class(TCustomcontrol) //
end
DeletePageItem(it);
end
function PageMenuClick(o,e);
///////////////////////////////////////////////////////////////////
function do_close_cpage(); //关闭当前
begin
it := GetCurrentItem();
if not it then return;
case o.Caption of
"关闭":
if not it then return ;
docloseapageitem(it);
end
function do_close_lpage(); //关闭左侧所有
begin
it := GetCurrentItem();
if not it then return ;
its := GetAllPageItems();
itss := array();
for i := 0 to its.Length()-1 do
begin
iti := its[i];
if iti=it then break ;
itss[i] := iti;
end
fcloseflag := true;
try
for i,iti in itss do
begin
docloseapageitem(it);
end
"关闭左侧所有":
begin
its := GetAllPageItems();
itss := array();
for i := 0 to its.Length()-1 do
begin
iti := its[i];
if iti=it then break ;
itss[i] := iti;
end
fcloseflag := true;
try
for i,iti in itss do
begin
docloseapageitem(iti);
end
finally
fcloseflag := false;
end;
if itss then FPageEditer.CallSelChanged();
docloseapageitem(iti);
end
"关闭右侧所有":
begin
dodel := 0;
its := GetAllPageItems();
itss := array();
for i := 0 to its.Length()-1 do
finally
fcloseflag := false;
end;
if itss then FPageEditer.CallSelChanged();
end
function do_close_rpage(); //关闭右侧
begin
it := GetCurrentItem();
if not it then return ;
dodel := 0;
its := GetAllPageItems();
itss := array();
for i := 0 to its.Length()-1 do
begin
itss[i] := its[i];
end
fcloseflag := true;
try
for i,iti in itss do
begin
if dodel then docloseapageitem(iti);
if iti=it then
begin
itss[i] := its[i];
end
fcloseflag := true;
try
for i,iti in itss do
begin
if dodel then docloseapageitem(iti);
if iti=it then
begin
dodel := 1;
end ;
end
finally
fcloseflag := false;
end;
if dodel then FPageEditer.CallSelChanged();
end
"关闭其他标签":
dodel := 1;
end ;
end
finally
fcloseflag := false;
end;
if dodel then FPageEditer.CallSelChanged();
end
function do_close_lrpage(); //关闭其他
begin
it := GetCurrentItem();
if not it then return ;
Cit := it;
its := GetAllPageItems();
fcloseflag := true;
try
for i := 0 to its.Length()-1 do
begin
it := its[i];
if it.FEditer.ChangedFlag then
begin
Cit := it;
its := GetAllPageItems();
fcloseflag := true;
try
for i := 0 to its.Length()-1 do
r := MessageBoxA("存在未保存的文件,是否保存!","提示",3,self);
if r=IDYES then
begin
SaveAllPageItems();
break;
end else
if r=IDCANCEL then
begin
return;
end else
begin
it := its[i];
if it.FEditer.ChangedFlag then
begin
r := MessageBoxA("存在未保存的文件,是否保存!","提示",3,self);
if r=IDYES then
begin
SaveAllPageItems();
break;
end else
if r=IDCANCEL then
begin
return;
end else
begin
end
break;
end
end
CloseAllPageItems(Cit);
finally
fcloseflag := false;
end;
end
"另存为":
begin
if JudgeItemState(it)then return;
//FFileopen.OverwritePrompt := true;
if FFileSave.OpenDlg()then
begin
fn := FFileSave.FileName;
dfn := it.ScriptPath;
CreateDirWithFileName(fn);
//echo format('FileCopy("","%s","","%s",false)',dfn,fn);
ret := FileCopy("",dfn,"",fn,false);
if ret then
begin
it.ScriptPath := fn;
if SavePageItem(it)=0 then
begin
it.FEditer.ChangedFlag := true;
end
if it.fisnewfile then
begin
FileDelete("",dfn);
it.fisnewfile := false;
end
end
end
//FFileopen.OverwritePrompt := false;
end
"重新加载":
begin
LoadFromFile(it,true);
end
"复制文件全名":
begin
if not FCliper then FCliper := new TClipBoard(self);
FCliper.text := it.OrigScriptPath;
end
"复制文件名":
begin
if not FCliper then FCliper := new TClipBoard(self);
FCliper.text := it.Caption;
end
"打开目录":
begin
p := it.ScriptPath;
if FileExists("",p)then
begin
{for i := length(p)downto 3 do
begin
if p[i]="\\" then
begin
p := p[1:i];
break;
end
end}
//_wapi.WinExec('cmd.exe /C start "" "'+p,1);
_wapi.openresourcemanager(p);
end
end
"采用cmd执行":
begin
//ExecutePageItemWithCmd(it);
break;
end
end
CloseAllPageItems(Cit);
finally
fcloseflag := false;
end;
end
function do_save_page_as(); //另存为
begin
it := GetCurrentItem();
if not it then return ;
if JudgeItemState(it)then return;
//FFileopen.OverwritePrompt := true;
if FFileSave.OpenDlg()then
begin
fn := FFileSave.FileName;
dfn := it.ScriptPath;
CreateDirWithFileName(fn);
//echo format('FileCopy("","%s","","%s",false)',dfn,fn);
ret := FileCopy("",dfn,"",fn,false);
if ret then
begin
it.ScriptPath := fn;
if SavePageItem(it)=0 then
begin
it.FEditer.ChangedFlag := true;
end
if it.fisnewfile then
begin
FileDelete("",dfn);
it.fisnewfile := false;
end
end
end
end
function do_reload_page(); //重新加载
begin
it := GetCurrentItem();
if not it then return ;
LoadFromFile(it,true);
end
function do_copy_page_path(); //复制文件全名
begin
it := GetCurrentItem();
if not it then return ;
if not FCliper then FCliper := new TClipBoard(self);
FCliper.text := it.OrigScriptPath;
end
function do_copy_page_name(); //复制文件名
begin
it := GetCurrentItem();
if not it then return ;
if not FCliper then FCliper := new TClipBoard(self);
FCliper.text := it.Caption;
end
function do_open_page_dir(); //打开文件夹
begin
it := GetCurrentItem();
if not it then return ;
p := it.ScriptPath;
if FileExists("",p)then
begin
{for i := length(p)downto 3 do
begin
if p[i]="\\" then
begin
p := p[1:i];
break;
end
end}
//_wapi.WinExec('cmd.exe /C start "" "'+p,1);
_wapi.openresourcemanager(p);
end
end
//////////////////////////////////////////////////////////////
function PageItemOnRClick(o,e);
begin
if FPageEditer.GetItemIndexByPos(e.pos)>= 0 then o.PopUpMenu := FPageMenu;
else o.PoPupMenu := nil;
end
function PageEditerMenuClick(o,e);
/////////////右键菜单/////////////////////////////////////////
function do_to_unix_lf();//linux行结尾
begin
cp := o.Caption;
if ("转unix(LF)"=cp) then
it := GetCurrentItem();
it.scripttype := 1;
SavePageItem(it,1);
end
function do_copy_page();//复制
begin
it := GetCurrentItem();
if it then
begin
it := GetCurrentItem();
it.scripttype := 1;
SavePageItem(it,1);
//it.FEditer.ChangedFlag := true;
return ;
end else
if ("转windows(CR LF)"=cp) then
begin
it := GetCurrentItem();
it.scripttype := 0;
SavePageItem(it,1);
return ;
end else
if ("另存为"=cp) then
begin
return PageMenuClick(o,e);
end else
if pos("复制",cp)=1 then
begin
it := GetCurrentItem();
if it then
ed := it.FEditer;
if ed then
begin
ed := it.FEditer;
if ed then
begin
ed.ExecuteCommand(ed.ecCopy);
end
//it.FEditer.ReadOnly := not(o.Checked);
ed.ExecuteCommand(ed.ecCopy);
end
return;
end else
if pos("粘贴",cp)=1 then
end
end
function do_past_page();//粘贴
begin
it := GetCurrentItem();
if it then
begin
it := GetCurrentItem();
if it then
ed := it.FEditer;
if ed then
begin
ed := it.FEditer;
if ed then
begin
ed.ExecuteCommand(ed.ecPaste);
end
//it.FEditer.ReadOnly := not(o.Checked);
ed.ExecuteCommand(ed.ecPaste);
end
return;
end else
if pos("剪切",cp)=1 then
end
end
function do_cut_page();//剪切
begin
it := GetCurrentItem();
if it then
begin
it := GetCurrentItem();
if it then
ed := it.FEditer;
if ed then
begin
ed := it.FEditer;
if ed then
begin
ed.ExecuteCommand(ed.ecCut);
end
//it.FEditer.ReadOnly := not(o.Checked);
ed.ExecuteCommand(ed.ecCut);
end
return;
end else
if pos("定位",cp)=1 then
end
end
function do_goto_line();//定位
begin
center_popup_wnd(FGotoLineWnd,true);//InitShowWndPos(FGotoLineWnd,"g",200,200);
FGotoLineWnd.ShowGoto();
end
function do_to_win_lf();//win 行结尾
begin
it := GetCurrentItem();
it.scripttype := 0;
SavePageItem(it,1);
end
function do_goto_func(o);//查看函数
begin
cs := o.Caption;
if length(cs)<6 then return;
s :=(o.Caption)[6:];
GetCurrentEditer().Tryjump(s);
end
function do_read_only(o);//只读
begin
it := GetCurrentItem();
if it then
begin
center_popup_wnd(FGotoLineWnd,true);//InitShowWndPos(FGotoLineWnd,"g",200,200);
FGotoLineWnd.ShowGoto();
return;
end else
if pos("查看",cp)=1 then
begin
cs := o.Caption;
if length(cs)<6 then return;
s :=(o.Caption)[6:];
GetCurrentEditer().Tryjump(s);
return;
end else
if pos("只读",cp)=1 then
begin
it := GetCurrentItem();
if it then
begin
it.FEditer.ReadOnly := not(o.Checked);
end
return;
end else
if pos("执行",cp)=1 then
begin
it := GetCurrentItem();
ExecutePageItem(it);
return;
end else
if pos("停止",cp)=1 then
begin
if FEchoWnd.Exeing()then FEchoWnd.EndExe();
return;
end else
if cp = "转换为大写" then
begin
upperorlowercase(1);
end else
if cp = "转换为小写" then
begin
upperorlowercase(0);
end else
if cp = "删除尾空白" then
begin
seltrimright();
end
it.FEditer.ReadOnly := not(o.Checked);
end
end
function do_execute_page();//执行
begin
it := GetCurrentItem();
ExecutePageItem(it);
end
function do_execute_stop();//停止执行
begin
if FEchoWnd.Exeing()then FEchoWnd.EndExe();
end
function do_upper_case();//转大写
begin
upperorlowercase(1);
end
function do_lower_case();//转大写
begin
upperorlowercase(0);
end
function do_del_line_end();//删除行尾空白
begin
seltrimright();
end
///////////////////////////////////////////////////////////
function PageEditerOnRClick(o,e);
begin
o.popupMenu := nil;
@@ -2921,28 +2977,92 @@ type TEditer=class(TCustomcontrol) //
begin
FPageEditerMenu := new TPopUpMenu(self);
FPageEditerMenus := array();
for i,v in array("查看","复制(C)","粘贴(V)","剪切(X)","定位(G)","只读","转换为大写","转换为小写","删除尾空白","文档格式","执行(F9)","停止执行","另存为") do
begin
it := new TMenu(self);
it.Caption := v;
it.parent := FPageEditerMenu;
if "文档格式"=v then
begin
for j,vj in array("转unix(LF)","转windows(CR LF)") do
begin
subit := new TMenu(self);
FPageEditerMenus[vj]:= subit;
subit.Caption := vj ;
subit.Parent := it;
subit.OnClick := thisfunction(PageEditerMenuClick);
end
FPageEditerMenus[v] := it;
continue;
end
FPageEditerMenus[v]:= it;
it.OnClick := thisfunction(PageEditerMenuClick);
end
it := new TMenu(self);
it.Caption := "查看";
it.parent := FPageEditerMenu;
FPageEditerMenus["查看"] := it;
it.OnClick := thisfunction(do_goto_func);
subit := new TMenu(self);
subit.Caption := "文档格式";
subit.Parent := FPageEditerMenu;
it := new TMenu(self);
it.Caption := "转unix(LF)";
it.parent := subit;
FPageEditerMenus["转unix(LF)"] := it;
it.OnClick := thisfunction(do_to_unix_lf);
it := new TMenu(self);
it.Caption := "转windows(CR LF)";
it.parent := subit;
FPageEditerMenus["转windows(CR LF)"] := it;
it.OnClick := thisfunction(do_to_win_lf);
it := new TMenu(self);
it.Caption := "复制(C)";
it.parent := FPageEditerMenu;
FPageEditerMenus["复制(C)"] := it;
it.OnClick := thisfunction(do_copy_page);
it := new TMenu(self);
it.Caption := "粘贴(V)";
it.parent := FPageEditerMenu;
FPageEditerMenus["粘贴(V)"] := it;
it.OnClick := thisfunction(do_past_page);
it := new TMenu(self);
it.Caption := "剪切(X)";
it.parent := FPageEditerMenu;
FPageEditerMenus["剪切(X)"] := it;
it.OnClick := thisfunction(do_cut_page);
it := new TMenu(self);
it.Caption := "定位(G)";
it.parent := FPageEditerMenu;
FPageEditerMenus["定位(G)"] := it;
it.OnClick := thisfunction(do_goto_line);
it := new TMenu(self);
it.Caption := "只读";
it.parent := FPageEditerMenu;
FPageEditerMenus["只读"] := it;
it.OnClick := thisfunction(do_read_only);
it := new TMenu(self);
it.Caption := "转换为大写";
it.parent := FPageEditerMenu;
FPageEditerMenus["转换为大写"] := it;
it.OnClick := thisfunction(do_upper_case);
it := new TMenu(self);
it.Caption := "转换为小写";
it.parent := FPageEditerMenu;
FPageEditerMenus["转换为小写"] := it;
it.OnClick := thisfunction(do_lower_case);
it := new TMenu(self);
it.Caption := "删除尾空白";
it.parent := FPageEditerMenu;
FPageEditerMenus["删除尾空白"] := it;
it.OnClick := thisfunction(do_del_line_end);
it := new TMenu(self);
it.Caption := "执行(F9)";
it.parent := FPageEditerMenu;
FPageEditerMenus["执行(F9)"] := it;
it.OnClick := thisfunction(do_execute_page);
it := new TMenu(self);
it.Caption := "停止执行";
it.parent := FPageEditerMenu;
FPageEditerMenus["停止执行"] := it;
it.OnClick := thisfunction(do_execute_stop);
it := new TMenu(self);
it.Caption := "另存为";
it.parent := FPageEditerMenu;
FPageEditerMenus["另存为"] := it;
it.OnClick := thisfunction(do_save_page_as);
end
iflx := GetCurrentItem().scripttype = 1;
FPageEditerMenus["转unix(LF)"].Enabled := not iflx;
designer/utslcodeformat.tsf
+25 -7
View File
@@ -152,6 +152,7 @@ type TFormatParser = class
begin
FSynParser2.add(v);
end
fmreadword := array("return":1,"rdo":1,"rdo2":1,"echo":1);
FHtmlParser := NEW TTire();
FHtmlParser.Add("<?tsl");
FArrayType := 1;
@@ -289,13 +290,20 @@ type TFormatParser = class
begin
FFormatStr[fl-1:fl]:=" "+tk.FStr+"\r\n";
end
else FFormatStr+= " "+tk.FStr+ "\r\n";
else
begin
if FFormatStr and FFormatStr[length(FFormatStr)]=" " then FFormatStr+=tk.FStr+ "\r\n";
else
FFormatStr+= " "+tk.FStr+ "\r\n";
end
FCWordCount :=0;
FLWordLength :=0;
end else
if (tk.FType .& TK_SYN_S){ and (tk.FStr="*")} then //修正(**) 问题 20231127修正
begin
FFormatStr+= " "+tk.FStr+" ";
if FFormatStr and FFormatStr[length(FFormatStr)]=" " then FFormatStr+= tk.FStr+" ";
else
FFormatStr+= " "+tk.FStr+" ";
end else
if (tk.FType .& TK_SYN) and (tk.FStr=";") then
begin
@@ -321,7 +329,9 @@ type TFormatParser = class
if FCWordCount then
begin
FFormatStr +=" "+tk.FStr;
if FFormatStr and FFormatStr[length(FFormatStr)]=" " then FFormatStr +=tk.FStr;
else
FFormatStr +=" "+tk.FStr;
end else
begin
FFormatStr+= FHier.HierStr()+ tk.FStr;
@@ -399,18 +409,25 @@ type TFormatParser = class
FFormatStr+="\r\n";
end
end
if (tk.FType=TK_W) and fmreadword[ lowercase(tk.FStr)] then
begin
spc :=" ";
end else
spc :="";
if FCWordCount then
begin
ttk := GetPrevTK();
if ttk and ( (tk.FTypeSub .& TK_DO) or (tk.FTypeSub .& TK_END) or (((ttk.FType .& TK_W) or (ttk.FType .& TK_KEY) or (ttk.FType .& TK_STR) ) and ((tk.FType .& TK_W) or (tk.FType .& TK_KEY) or (tk.FType .& TK_STR))) ) then
// if ttk and ((ttk.FType .& TK_W) or (ttk.FType .& TK_KEY)) or ((tk.FType .& TK_W) or (tk.FType .& TK_KEY)) then
begin
FFormatStr+=" "+tk.FStr;
if FFormatStr and FFormatStr[length(FFormatStr)]=" " then FFormatStr+=tk.FStr+spc;
else
FFormatStr+=" "+tk.FStr+spc;
end
else FFormatStr+=tk.FStr
else FFormatStr+=tk.FStr+spc;
end else
begin
FFormatStr+=FHier.HierStr()+tk.FStr;
FFormatStr+=FHier.HierStr()+tk.FStr+spc;
end
FCWordCount++;
FLWordLength+=tk.FStrL;
@@ -970,7 +987,7 @@ type TFormatParser = class
nchange := true;
end
end ;
if not nchange then t1 := TK_KEY;
if not nchange then t1 := TK_KEY;
end
TK := new TTK(FScript[sp:ep],t1,stype);
TK.FFirst := FAtRowFirst;
@@ -1446,6 +1463,7 @@ type TFormatParser = class
end
end
private
fmreadword;
FAlignBlockComment;
FAtRowFirst;
FArrayType;
designer/utslsynmemo.tsf
-5
View File
@@ -271,11 +271,6 @@ type TTSLCompletion= class(TSynCompletion)
class function GetCodeBlocks();
begin
r := array();
{try
FCodeBlocks := GetTslCompletionCodeBlocks();
except
FCodeBlocks := array();
end}
if ifarray(FCodeBlocks) then
begin
idx := 0;
designer/utslvcldcomponents.tsf
+38 -11
View File
@@ -22,6 +22,19 @@ type TDComponent = class()
static const cst_m_savewindow = "保存窗口";
static const cst_tip_willcut = "即将剪切:";
static const cst_tip_willdelete = "即将删除:";
private //注册设计控件
class function dcompisok(v,o); //判断注册的控件是否OK
begin
n := "";
try
o := createobject(v);
n := o.dclassname();
oo := createobject(o.WndClass(),nil);
except
return 0;
end
return n;
end
public //注册设计控件
class function GetClassItem(n);
begin
@@ -44,8 +57,7 @@ type TDComponent = class()
begin
if (v is class(TDComponent) ) then
begin
o := createobject(v);
n := o.dclassname();
n := dcompisok(v,o);
if n and ifstring(n) then
begin
n := lowercase(n);
@@ -53,7 +65,7 @@ type TDComponent = class()
end
end
end
end
end
class function RegestorClassItemsext(its);
begin
if not ifarray(fdcomponentobjectsext) then fdcomponentobjectsext := array();
@@ -62,12 +74,7 @@ type TDComponent = class()
begin
if (v is class(TDComponent) ) then
begin
try
o := createobject(v);
n := o.dclassname();
except
continue;
end
n := dcompisok(v,o);
if n and ifstring(n) then
begin
n := lowercase(n);
@@ -677,6 +684,22 @@ type TDComponent = class()
"body":
"" );
SetDefalutEvent(ev,true);
///////////////////////////////////////////////////////////////
ev :=array(
"event":"onmouseenter",
"name":"mouseenter",
"param":array(pm[0]),
"body":
"" );
SetDefalutEvent(ev,true);
///////////////////////////////////////////////////////////////
ev :=array(
"event":"onmouseleave",
"name":"mouseleave",
"param":array(pm[0]),
"body":
"" );
SetDefalutEvent(ev,true);
///////////////////////////////////////////////////////
ev :=array(
"event":"ondblclick",
@@ -1042,6 +1065,7 @@ type TDRootComponent = class(TDComponent)
function Create(AOwner);override;
begin
inherited;
excludepropertys := array("width","height");
end
function CheckParentWnd(Pwnd);override;
begin
@@ -1587,7 +1611,6 @@ type TDImageList = class(TDRootComponent)
function GetPublishProperties();override;
begin
r := inherited;
r := r[ array("name","top","left","images","imgwidth","imgheight")];
return r;
end
@@ -2401,7 +2424,7 @@ BFC6105000000097048597300000EC300000EC301C76FA864000000E549444154
function Create(AOwner);override;
begin
inherited;
fiscontainerdcmp := false;
//fiscontainerdcmp := false;
end
end
@@ -2627,6 +2650,10 @@ type TDActionList = class(TDRootComponent)
begin
inherited;
end
function GetPublishProperties();override;
begin
return inherited;
end
end
//**************FMainMenu********************************
type TPopUpMenuWindow = class(TDVirutalWindow)
designer/utslvcldebuger.tsf
+102 -67
View File
@@ -446,23 +446,54 @@ type TTslDebuga=class(TCustomControl)
begin
return filedelete("",(TS_ModulePath()+"FunCache.ini"));
end
/////////按钮图标///////////////////////////////
[weakref]
fdbtn_continue;
fdbtn_breakpoint;
fdbtn_pause;
fdbtn_into;
fdbtn_out;
fdbtn_minstep;
fdbtn_next;
fdbtn_stop;
fdbtn_flushsyms;
fdbtn_flushsym;
public
property runbtncall read frunbtncall write frunbtncall;
property runbtncall read frunbtncall write frunbtncall;
//"添加/删除断点F5","暂停","继续","进入","跳出","单步","下一行(F8)","终止","刷新符号表","刷新当前符号"
function addbtns(btns); //添加菜单
begin
FBtns := btns;
for i,v in Fbtns do
begin
v.onClick := thisfunction(Dbgtooldo);
if v.Caption="添加/删除断点F5" then continue;
if v.Caption="继续" then
begin
v.onClick := thisfunction(dbgtooldorun);
v.Caption := "调试运行";
continue;
end
v.Visible := false;
end
FBtns := btns ;
fdbtn_continue := btns["继续"];
fdbtn_breakpoint := btns["添加/删除断点F5"];
fdbtn_pause := btns["暂停"];
fdbtn_into := btns["进入"];
fdbtn_out := btns["跳出"];
fdbtn_minstep := btns["单步"];
fdbtn_next := btns["下一行(F8)"];
fdbtn_stop := btns["终止"];
fdbtn_flushsyms := btns["刷新符号表"];
fdbtn_flushsym := btns["刷新当前符号"];
fdbtn_continue.onClick := thisfunction(dbgtooldorun);
fdbtn_continue.Caption := "调试运行";
fdbtn_breakpoint.onClick:= thisfunction(Dbgtooldo);
fdbtn_pause.onClick:= thisfunction(Dbgtooldo);
fdbtn_pause.Visible := false;
fdbtn_into.onClick:= thisfunction(Dbgtooldo);
fdbtn_into.Visible := false;
fdbtn_out.onClick:= thisfunction(Dbgtooldo);
fdbtn_out.Visible := false;
fdbtn_next.onClick:= thisfunction(Dbgtooldo);
fdbtn_next.Visible := false;
fdbtn_stop.onClick:= thisfunction(Dbgtooldo);
fdbtn_stop.Visible := false;
fdbtn_flushsyms.onClick:= thisfunction(Dbgtooldo);
fdbtn_flushsyms.Visible := false;
fdbtn_flushsym.onClick:= thisfunction(Dbgtooldo);
fdbtn_flushsym.Visible := false;
end
function DbgNextLine(); //下一行
begin
@@ -570,6 +601,7 @@ type TTslDebuga=class(TCustomControl)
fdbgselwnd.cancel_clk := thisfunction(serwnd_cclk);
fdbgselwnd.dbg_clk := thisfunction(dbg_clk);
end
center_popup_wnd(fdbgselwnd);
fdbgselwnd.setlist();
if flg then
begin
@@ -834,15 +866,14 @@ type TTslDebuga=class(TCustomControl)
end
function Dbgtooldo(o,e)
begin
cp := o.Caption;
case cp of
"调试运行":
case o of
fdbtn_continue:
begin
//echo "调试运行";
it := Owner.GetCurrentItem(); //Owner.GetAllPageItems();
Debuglocal(it);
end
"添加/删除断点F5":
fdbtn_breakpoint:
begin
it := Owner.GetCurrentItem();
if it then
@@ -850,7 +881,7 @@ type TTslDebuga=class(TCustomControl)
it.FEditer.SwitchMarkLine();
end
end
"暂停":
fdbtn_pause:
begin
ExecuteCommand("dbgpause");
if Fdebugedwhandle then
@@ -858,45 +889,35 @@ type TTslDebuga=class(TCustomControl)
_Wapi.postmessagea(Fdebugedwhandle,WM_NULL,0,0);
end
end
"进入":
fdbtn_into:
begin
ExecuteCommand("dbgstep")
end
"单步":
begin
//dbgstep();
end
"下一行(F8)":
end
fdbtn_next:
begin
ExecuteCommand("dbgstepover");
end
"跳出":
fdbtn_out:
begin
ExecuteCommand("dbgstepout");
end
"继续":
begin
dbgtooldorun(o,e);
end
"终止":
//"继续":dbgtooldorun(o,e);
fdbtn_stop:
begin
ExecuteCommand("dbgreset");
end
"单步":
begin
end
"刷新符号表":
fdbtn_flushsyms:
begin
ExecuteCommand("dbggetallvalue");
end
"刷新当前符号":
fdbtn_flushsym:
begin
ExecuteCommand("dbggetcurrentnode");
end
"清除文本框":
{"清除文本框":
begin
FShowText.Text := "";
end
end}
end;
end
function dbgeventcall(d); //回调
@@ -1584,6 +1605,10 @@ type TTslDebuga=class(TCustomControl)
FBtns["刷新符号表"].Visible := true;
FBtns["刷新当前符号"].Visible := true;
FBtns["继续"].Visible := (flg = "暂停") ;
if (flg = "暂停") then
begin
FBtns["继续"].Caption := "继续";
end
//FBtns["终止"].Visible := true;
end
"继续":
@@ -1604,6 +1629,7 @@ type TTslDebuga=class(TCustomControl)
begin
hiddenbtns();
FBtns["继续"].Visible := true;
FBtns["继续"].Caption := "调试运行";
end
end
end
@@ -2665,7 +2691,28 @@ type tdbgvalueshowgrid=class(TDrawGrid)
o.show();
end
end
fmdim1;
fmdim2;
fmstring;
fmjson;
public
function dim1clk();
begin
Twodimensional := false;
end
function dim2clk();
begin
if FCanedit then return;
Twodimensional := true;
end
function showstring1();
begin
return showstring(1);
end
function showstring0();
begin
return showstring(0);
end
function create(AOwner);override;
begin
inherited;
@@ -2688,34 +2735,22 @@ type tdbgvalueshowgrid=class(TDrawGrid)
FStringAlign := AL9_CENTERLEFT;
FDefAlign := AL9_CENTER;
mu := new TPopupmenu(self);
for i,v in array("一维","二维","原串","json") do
begin
mi := new TMenu(self);
mi.parent := mu;
mi.caption := v;
mi.OnClick := function(o,e)
begin
case o.caption of
"一维":
begin
Twodimensional := false;
end
"二维":
begin
if FCanedit then return;
Twodimensional := true;
end
"原串":
begin
showstring();
end
"json":
begin
showstring(1);
end
end
end
end
fmdim1 := new TMenu(self);
fmdim1.Caption := "一维";
fmdim1.onClick := thisfunction(dim1clk);
fmdim2 := new TMenu(self);
fmdim2.Caption := "二维";
fmdim2.onClick := thisfunction(dim2clk);
fmstring := new TMenu(self);
fmstring.Caption := "原串";
fmstring.onClick := thisfunction(showstring0);
fmjson := new TMenu(self);
fmjson.Caption := "json";
fmjson.onClick := thisfunction(showstring1);
fmdim1.parent := mu;
fmdim2.parent := mu;
fmstring.parent := mu;
fmjson.parent := mu;
PopupMenu := mu;
onfontchanged := function()begin
ft := font;
designer/utslvcldesigner.tsf
+56 -26
View File
@@ -47,11 +47,11 @@ type TVclDesigner = class(tvcform)
begin
FProjectManager.WrapTo();
end
function designerondo();
function designerondo();//撤销
begin
if fdolist then fdolist.undo();
end
function designerredo();
function designerredo();//反撤销
begin
if fdolist then fdolist.redo();
end
@@ -542,7 +542,10 @@ type TVclDesigner = class(tvcform)
if itemnames then itemnames := itemnames[1:];
return r;
end
function saveallform();
begin
FProjectManager.saveCurrentEdit("all");
end
function saveCurrentForm(); //保存当前编辑
begin
FProjectManager.saveCurrentEdit();
@@ -554,10 +557,10 @@ type TVclDesigner = class(tvcform)
**}
return array(
("type":"menu","caption":"文件","filed":"ffilemenu","onclick",nil,"items":(
("type":"menu","caption":"保存","onclick":thisfunction(saveCurrentForm),
"bitmap":getsaveallbitmapinfo()),
("type":"menu","caption":"代码编辑","onclick":thisfunction(openclassfile),
"bitmap":geteditcodebitmapinfo())
("type":"menu","caption":"打开工程","onclick":thisfunction(OpenFileFromTpjFile),"bitmap":GetOpenFileBitmapInfo()),
("type":"menu","caption":"代码编辑","onclick":thisfunction(openclassfile),"bitmap":geteditcodebitmapinfo()),
("type":"menu","caption":"保存","onclick":thisfunction(saveallform), "bitmap":getsaveallbitmapinfo()),
("type":"menu","caption":"退出","onclick":thisfunction(sendclosedesigner))
)),
("type":"menu","caption":"视图","filed":"fviewmenu","items":(
("type":"menu","caption":"工程文件管理","checked":1,"bitmap":GetWindowMgrBmp(),"onclick":thisfunction(ShowProjectView)),
@@ -598,13 +601,10 @@ type TVclDesigner = class(tvcform)
)),
("type":"menu","caption":"帮助","items":(
("type":"menu","caption":"关于","onclick":thisfunction(openabout)),
("type":"menu","caption":"使用手册","onclick":thisfunction(OpenHelp)),
("type":"menu","caption":"tsl语言","onclick":thisfunction(OpenHelp),
"bitmap":getmanubmpinfo()),
("type":"menu","caption":"控件详情","onclick":thisfunction(OpenHelp),
"bitmap":getctlsbmpinfo()),
("type":"menu","caption":"范例","onclick":thisfunction(OpenExaple),
"bitmap":getexamplesbmpinfo())
("type":"menu","caption":"使用手册","onclick":thisfunction(designer_help)),
("type":"menu","caption":"tsl语言","onclick":thisfunction(tsl_help),"bitmap":getmanubmpinfo()),
("type":"menu","caption":"控件详情","onclick":thisfunction(ctldetail_help),"bitmap":getctlsbmpinfo()),
("type":"menu","caption":"范例","onclick":thisfunction(OpenExaple),"bitmap":getexamplesbmpinfo())
),
)
@@ -675,13 +675,30 @@ type TVclDesigner = class(tvcform)
end
return s;
end
function OpenHelp(o,e); //打开帮助
////////////////打开帮助//////////////////////////////////////////////////////
function tsl_help();//tsl语言帮助
begin
OpenHelp("tsl语言");
end
function designer_help();//设计器帮助
begin
OpenHelp("使用手册");
end
function ctl_help();//常用控件
begin
OpenHelp("常用控件");
end
function ctldetail_help();//详情
begin
OpenHelp("控件详情");
end
function OpenHelp(c); //帮助
begin
if not FChmHelper then
begin
FChmHelper := new unit(UtslCodeEditor).TTslChmHelp(_wapi);
end
case o.caption of
case c of
"tsl语言":
begin
FChmHelper.ChmName := "help"$ioFileseparator()$"LANGUAGEGUIDE.CHM";
@@ -693,8 +710,7 @@ type TVclDesigner = class(tvcform)
//_wapi.WinExec(format('cmd.exe /C call "start %s"',p),0); //http://bzjj.sinaapp.com/tslvclhelp/index.html
//_wapi.WinExec(format('start "%s"',p),0);
//_wapi.WinExec('cmd.exe /C start http://bzjj.sinaapp.com/tslvclhelp/index.html',0);
//_wapi.WinExec('cmd.exe /C "start http://bzjj.sinaapp.com/tvcldesignerhelp/tvcldesigner.pdf"',0);
//_wapi.WinExec('cmd.exe /C "start http://bzjj.sinaapp.com/tvcldesignerhelp/tvcldesigner.pdf"',0);
end
"常用控件":
begin
@@ -738,6 +754,10 @@ type TVclDesigner = class(tvcform)
p.Invalidaterect(nil,0);
//setcomponentfocus(o,false);
end
function sendclosedesigner(); //发送消息关闭窗口
begin
_send_(WM_CLOSE,self.Handle,0,0,1);
end
function DesignerClose(o,e) //控件窗口关闭
begin
{**
@@ -1566,7 +1586,7 @@ type TVclDesigner = class(tvcform)
if vi in array("(none)","create","destroy","recycling","loadfromtfm") then continue;
FFunctionSelecter.additem(vi);
end
end
end
function create(AOwner);
begin
inherited;
@@ -1664,9 +1684,11 @@ type TVclDesigner = class(tvcform)
//******************toolbar ***************
tlbar := FProjectManager.FTslEditer.gettoolbar();
savebtn := FProjectManager.FTslEditer.gettoolbarbtn();
savebtn[0]._tag := array(thisfunction(saveallform),savebtn[0].onclick);
savebtn[1]._tag := array(thisfunction(saveCurrentForm),savebtn[1].onclick);
for i,v in savebtn do //处理一下保存工程
begin
v._tag := array(thisfunction(saveCurrentForm),v.onclick);
//v._tag := array(thisfunction(saveCurrentForm),v.onclick);
v.onclick := function(o,e)
begin
for i,v in o._tag do
@@ -1692,14 +1714,18 @@ type TVclDesigner = class(tvcform)
tlbar.parent := self;
tlbar.arrange :="0;1";
sp1 := new tsplitter(self);
sp1.width := 10;
sp1.TRANSPARENT := false;
sp1.Color := _wapi.GetSysColor(COLOR_MENUBAR);;
sp1.Align := alLeft;
sp1.parent := self;
FToolBars := new TDesignertoolbars(self);
FToolBars := new TDesignertoolbars(self);
FToolBars.Imagelist := fdimagelist;
addtoolbuttons();
FToolBars.Align := alClient;
FToolBars.Align := alLeft;//alClient;
FToolBars.parent := self;
FToolBars.GetPreferredSize(wt,ht);
tlbar.width :=twidth-wt-80;
//************菜单******************************
createmainmenubyarray(mainmenus(),FMenu0,self);
Mainmenu := FMenu0;
@@ -1716,6 +1742,7 @@ type TVclDesigner = class(tvcform)
FProjectFilesave.parent := self;
FProjectManager.FTslEditer.setdbugruncall(thisfunction(debugproject)); //设置调试回调
FProjectManager.newmenu.parent := ffilemenu;//
FProjectManager.newmenu.Zorder := 3;
FProjectManager.goformmenu.parent := fviewmenu;//
FToolBars.onnotification := function(o,e)begin
d := e.msg;
@@ -1727,6 +1754,8 @@ type TVclDesigner = class(tvcform)
FTslParser := new unit(utslvclsyntaxparser).ttslscripparser();
//OnChange
//fnewmenu
WSSizebox := false;
autosize := true;
end
property VariableSelecter read FVariableSelecter; //当前控件树的变量对象
private //其他资源函数
@@ -2082,7 +2111,7 @@ type TPropEditGrid = class(TPropGrid) //
if w>0 then
begin
i := 1;
self.ColumnWidth(1) := w;
self.ColumnWidth(1) := w;
end
end
end
@@ -2090,7 +2119,6 @@ type TPropEditGrid = class(TPropGrid) //
function Create(AOwner);
begin
inherited;
FobjProptype := p_properys;
end
function getneedpublished(v);virtual;
begin
@@ -2106,7 +2134,6 @@ type TEventEditGrid = class(TPropEditGrid) //
function Create(AOwner);
begin
inherited;
FobjProptype := p_evnets;
OndblClick := thisfunction(GridCellDblClick);
end
function getneedpublished(v);override;
@@ -2212,6 +2239,7 @@ type TDesignertoolbars = class(TPageControl) //
FToolsheets := array();
ftoolbars := array();
inherited;
autosize := true;
//ParentFont := false;
align := alClient;
@@ -2227,6 +2255,7 @@ type TDesignertoolbars = class(TPageControl) //
if not st then
begin
st := new TTabSheet(self);
st.autosize := true;
st.caption := t;
if t<>"隐藏" then
begin
@@ -2340,6 +2369,7 @@ type TViewBitmap = class(TvcForm)
lb := new TLabel(self);
FLB := lb;
lb.caption := "浏览图片:";
lb.autosize := true;
lb.left := 650;
lb.top := 20;
lb.width := 200;
designer/utslvcldpropertytypes.tsf
+1 -3
View File
@@ -604,9 +604,6 @@ type TPropGrid = class(TTSLDataGrid)
@explan(说明)属性编辑器 %%
**}
protected
FobjProptype;
static const p_properys="peopery";
static const p_evnets="pevents";
FDesigner;
private
FCellEditers;
@@ -701,6 +698,7 @@ type TPropGrid = class(TTSLDataGrid)
bkfc := FComponent;
FComponent := nil;
SetComponent(bkfc);
InvalidateRect(rec,true);
end else
begin
rec := GetSubItemRect(i,j);
designer/utslvclsyntaxparser.tsf
+28 -1
View File
@@ -75,6 +75,28 @@ type tslparser = class(tslparserbase) //
begin
return FTokener.tslstr;
end
function format_c_inherited(pa);
begin
lenpa := length(pa);
if lenpa<2 then return ;
npa := array(pa[0]);
npai := 0;
pa_i := 1;
while pa_i<lenpa do
begin
if pa[pa_i]="." then
begin
if pa_i+1<lenpa then npa[npai]+= "."+pa[pa_i+1];
pa_i++;
end else
begin
npai++;
npa[npai] := pa[pa_i];
end
pa_i++;
end
if npa<>pa then pa := npa;
end
public
function create();
begin
@@ -117,6 +139,8 @@ type tslparser = class(tslparserbase) //
if tk="," then continue;
else inh[length(inh)]:= tk;
end
format_c_inherited(inh);
r["inherited"]:= inh;
end
while true do
@@ -233,8 +257,11 @@ type tslparser = class(tslparserbase) //
r["inheritedendpos"] := pos;
break;
end
if tk <> "," then pa[length(pa)]:= tk;
if tk <> "," then pa[length(pa)]:= tk;
end
////////20251106///////////////////////////////////
format_c_inherited(pa);
//////////////////////////////////////
r["inherited"]:= pa;
end else
begin