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
editor-install.exe
BIN
View File
Binary file not shown.
funcext/tvclib/tcontrol.tsf
+35 -27
View File
@@ -115,7 +115,7 @@ type tcontrol = class(tcomponent)
end
if ifnil(Value)then
begin
if FActionLink then
if (FActionLink is class(TActionLink) ) then
begin
FActionLink.SetAction(nil);
end
@@ -124,7 +124,7 @@ type tcontrol = class(tcomponent)
if Value is class(TBasicAction)then
begin
includestate(FControlStyle,csActionClient);
if ifnil(FActionLink)then FActionLink := createobject(GetActionLinkClass(),self);
if not(FActionLink is class(TActionLink) )then FActionLink := createobject(GetActionLinkClass(),self);
FActionLink.Action := Value;
FActionLink.Onchange := thisfunction(DoActionChange);
ActionChange(Value,csLoading in Value.ComponentState);
@@ -145,7 +145,7 @@ type tcontrol = class(tcomponent)
begin
return FActionLink;
end
if FActionLink then
if FActionLink is class(TActionLink) then
begin
return FActionLink.Action;
end
@@ -298,7 +298,6 @@ type tcontrol = class(tcomponent)
@ignore 忽略 %%
@explan(说明) 绑定处理函数到消息id %%
**}
if not ifarray(FMessagehandle)then FMessagehandle := array();
if ifnumber(id)and (iffuncptr(func))then FMessagehandle[id]:= func;
end
private //事件绑定处理
@@ -335,6 +334,10 @@ type tcontrol = class(tcomponent)
if v["access"]in array(2,3)then continue;
fstring := v["functionname"];
if not ifstring(fstring)then continue;
vpms := v["parameter"];
if not ifarray(vpms) then continue;
lvpms := length(vpms);
if lvpms=1 then continue;
//f := findfunction(fstring,o);
returntype := v["returntype"];
try
@@ -664,14 +667,14 @@ type tcontrol = class(tcomponent)
end
end }
end
function MouseHover(o,e);virtual;
function MouseEnter(o,e);virtual;
begin
if not FMouseEntereded then
begin
DoMouseEnter(o,e);
FMouseEntereded := true;
end
end
end
function MouseLeave(o,e);virtual;
begin
if FMouseEntereded then
@@ -845,14 +848,7 @@ type tcontrol = class(tcomponent)
CallMessgeFunction(FOnMouseDown,o,e);
MouseDown(o,e);
end
function WMMOUSEHOVER(o,e):WM_MOUSEHOVER;virtual;
begin
MouseHover(o,e);
end
function WMMOUSELEAVE(o,e):WM_MOUSELEAVE;virtual;
begin
MouseLeave(o,e);
end
function WMMouseMove(o,e):LM_MOUSEMOVE;virtual;
begin
CallMessgeFunction(FOnMouseMove,o,e);
@@ -1073,8 +1069,24 @@ type tcontrol = class(tcomponent)
if SetTempCursor(cr)then e.skip := true;
end
end
function CMMouseEnter(o,e):CM_MOUSEENTER;virtual;
begin
MouseEnter(o,e);
end
function CMMouseLeave(o,e):CM_MOUSELEAVE;virtual;
begin
MouseLeave(o,e);
end
public //暂时不用的消息
{
function WMMOUSEHOVER(o,e):WM_MOUSEHOVER;virtual;
begin
MouseHover(o,e);
end
function WMMOUSELEAVE(o,e):WM_MOUSELEAVE;virtual;
begin
MouseLeave(o,e);
end
function WMWindowPosChanged(o,e):LM_WINDOWPOSCHANGED;virtual;
begin
end
@@ -1096,12 +1108,7 @@ type tcontrol = class(tcomponent)
function CMHitTest(o,e):CM_HITTEST;virtual;
begin
end
function CMMouseEnter(o,e):CM_MOUSEENTER;virtual;
begin
end
function CMMouseLeave(o,e):CM_MOUSELEAVE;virtual;
begin
end
function CMHintShow(o,e):CM_HINTSHOW;virtual;
begin
end
@@ -1199,6 +1206,7 @@ type tcontrol = class(tcomponent)
end
function create(aOwner);override; //构造函数
begin
FMessagehandle := array();
inherited;
fignore_childsizing := false;
FControlFlags := array();
@@ -1363,7 +1371,7 @@ type tcontrol = class(tcomponent)
@param(e)(tuieventbase) 消息类及其子类 %%
**}
id := e.Msg;
if ifnumber(id) and FMessagehandle then
if (id>0 or id<0) and FMessagehandle then
begin
func := FMessagehandle[id];
if func then call(func,o,e);
@@ -1622,8 +1630,8 @@ type tcontrol = class(tcomponent)
@param(OnPopupMenu)(function[TControl,TMMouse]) 弹出菜单回调函数 %%
@param(OnMouseDown)(function[TControl,TMMouse]) 鼠标按下回调函数 %%
@param(OnMouseUp)(function[TControl,TMMouse]) 鼠标松开回调函数 %%
@param(OnClick)(function[TControl,TMMouse]) 報炎泣似指距痕方 %%
@param(OnDblClick)(function[TControl,TMMouse]) 報炎褒似指距痕方 %%
@param(OnClick)(function[TControl]) 報炎泣似指距痕方 %%
@param(OnDblClick)(function[TControl]) 報炎褒似指距痕方 %%
@param(PopupMenu)(tpopupmenu) 弹出菜单%%
@param(Parent)(tcontrol) 父控件 %%
@param(Visible)(bool) 是否可见 %%
@@ -1660,16 +1668,16 @@ type tcontrol = class(tcomponent)
property ControlFlags read fControlFlags ;
property Color:color read getcolor write SetColor;//FColor;
property BKBitmap:tbitmap read FBKBitmap write SetBitmap;
//property OnMouseEnter:eventhandler read FOnMouseEnter write FOnMouseEnter;
//property OnMouseLeave:eventhandler read FOnMouseLeave write FOnMouseLeave;
property OnMouseEnter:eventhandler read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave:eventhandler read FOnMouseLeave write FOnMouseLeave;
property Controls read FControls;
property Canvas: TCanvas read FCanvas;
property ignore_childsizing read fignore_childsizing write fignore_childsizing; //忽略
{**
@param(Canvas)(TCanvas) 画布对象 %%
@param(Controls)(TFpList of tcontrol) 子组件 %%
@param(OnMouseLeave)(function[TControl,tuieventbase]) 報炎宣蝕指距 %%
@param(OnMouseEnter)(function[TControl,tuieventbase]) 報炎序秘指距 %%
@param(OnMouseLeave)(function[TControl]) 報炎宣蝕指距 %%
@param(OnMouseEnter)(function[TControl]) 報炎序秘指距 %%
@param(Color)(integer) 背景色 %%
**}
function isCustomPaint(); //提供给gtk使用
funcext/tvclib/tcustomcontrol.tsf
+90 -90
View File
@@ -90,104 +90,104 @@ type tcustomcontrol=class(TWinControl)
begin
return DoHScroll(o,e);
end
function WMLButtonDown(o,e);override;//拖拽释放
begin
if fhassplitter<1 then return inherited;
if csDesigning in ComponentState then exit;
case fcurspltype of
alLeft,alRight:
begin
drgidx := 1;
end
alTop,alBottom:
begin
drgidx := 0;
end
else
begin
return inherited;
end
end ;
if fsplitterwilldrag then
begin
cimgst();
fsplitterwilldrag := false;
fsplitterdraging := true;
nxy := clienttowindow(e.xpos,e.ypos);
_wapi.ImageList_BeginDrag(fsplitterdragimglist.Handle,drgidx,12,12);
_wapi.ImageList_DragEnter(self.Handle,nxy[0],nxy[1]);
crect := clientrect;
ps := array(clienttoscreen(crect[0],crect[1]),clienttoscreen(crect[2],crect[3]));
_wapi.clipcursor(ps);
splitterenabled(false);
return ;
end
//end
inherited;
end
function WMLBUTTONUP(o,e);override;//拖拽实现
begin
if fhassplitter<1 then return inherited;
if csDesigning in ComponentState then return ;
if fsplitterdraging then
begin
cimgst();
_wapi.ImageList_DragLeave(self.Handle);
_wapi.ImageList_EndDrag();
splitterenabled(true);
fsplitterwilldrag := true;
fsplitterdraging := false;
sizeprive(e.pos);
_wapi.clipcursor(0);
return ;
end
return inherited;
end
function WMMouseMove(o,e);override; //移动
function MainWndProc(hwnd,message,wparam,lparam);override;
begin
if fhassplitter<1 then return inherited;
if csDesigning in ComponentState then return inherited;
if fsplitterdraging then
begin
cimgst();
nxy := clienttowindow(e.xpos,e.ypos);
_wapi.ImageList_DragMove(nxy[0],nxy[1]);
return ;
end else
begin
xy := e.pos();
fcurspltype := nil;
fcursplitterid := -1;
fcursplitter := nil;
for i,v in Controls.data do
begin
if (v is class(tcustomsplitter)) and (v.Visible) and (v.enabled) and pointinrect(xy,v.BoundsRect) and (v<>fcursplitter) then //拖拽
case message of
WM_MOUSEMOVE: //Òƶ¯
begin
e := new unit(utslvclevent).TMMouse(message,wparam,lparam,hwnd);
if fsplitterdraging then
begin
va := v.Align;
if va in array(alLeft,alRight) then
begin
cursor := OCR_SIZEWE;
fcurspltype := va;
fcursplitter := v;
fcursplitterid := i;
return ;
end else
if va in array(alTop,alBottom) then
cimgst();
nxy := clienttowindow(e.xpos,e.ypos);
_wapi.ImageList_DragMove(nxy[0],nxy[1]);
return ;
end else
begin
xy := e.pos();
fcurspltype := nil;
fcursplitterid := -1;
fcursplitter := nil;
for i,v in Controls.data do
begin
cursor := OCR_SIZENS;
fcurspltype := va;
fcursplitter := v;
fcursplitterid := i;
return ;
if (v is class(tcustomsplitter)) and (v.Visible) and (v.enabled) and pointinrect(xy,v.BoundsRect) and (v<>fcursplitter) and (v.Align in array(alLeft,alRight,alTop,alBottom)) then //ÍÏק
begin
va := v.Align;
if va in array(alLeft,alRight) then
begin
cursor := OCR_SIZEWE;
fcurspltype := va;
fcursplitter := v;
fcursplitterid := i;
return ;
end else
if va in array(alTop,alBottom) then
begin
cursor := OCR_SIZENS;
fcurspltype := va;
fcursplitter := v;
fcursplitterid := i;
return ;
end
end
end
end
cursor := OCR_NORMAL;
end
end
cursor := OCR_NORMAL;
WM_LBUTTONDOWN: //°´ÏÂ
begin
case fcurspltype of
alLeft,alRight:
begin
drgidx := 1;
end
alTop,alBottom:
begin
drgidx := 0;
end
else
begin
return inherited;
end
end ;
if fsplitterwilldrag then
begin
e := new unit(utslvclevent).TMMouse(message,wparam,lparam,hwnd);
cimgst();
fsplitterwilldrag := false;
fsplitterdraging := true;
nxy := clienttowindow(e.xpos,e.ypos);
_wapi.ImageList_BeginDrag(fsplitterdragimglist.Handle,drgidx,12,12);
_wapi.ImageList_DragEnter(self.Handle,nxy[0],nxy[1]);
crect := clientrect;
ps := array(clienttoscreen(crect[0],crect[1]),clienttoscreen(crect[2],crect[3]));
_wapi.clipcursor(ps);
splitterenabled(false);
return ;
end
end
WM_LBUTTONUP:
begin
if fsplitterdraging then
begin
e := new unit(utslvclevent).TMMouse(message,wparam,lparam,hwnd);
cimgst();
_wapi.ImageList_DragLeave(self.Handle);
_wapi.ImageList_EndDrag();
splitterenabled(true);
fsplitterwilldrag := true;
fsplitterdraging := false;
sizeprive(e.pos);
_wapi.clipcursor(0);
return ;
end
end
end
return inherited;
end
return inherited;
end
property OnPaint:eventhandler read FOnPaint write FOnPaint;
{**
@param(OnPaint)(function[TCustomControl,tuieventbase]) 窗口关闭消息回调 %%
funcext/tvclib/tcustomsplitter.tsf
+21 -4
View File
@@ -13,15 +13,22 @@ type tcustomsplitter = class(tgraphiccontrol)
function paint();override;
begin
//inherited;
p := parent;
if not p then return ;
r := ClientRect;
dc := Canvas;
if Border then
begin
dc.pen.color := 0;
dc.pen.Width := 2;
dc.draw("polygon",array(r[0:1],r[array(2,1)],r[array(2,3)],r[array(0,3)],r[0:1]));
dc.draw("polyline",array(r[0:1],r[array(2,1)],r[array(2,3)],r[array(0,3)],r[0:1]));
end
clr := 0x123232;
////////////µãµÄÑÕÉ«/////////////////////////
if TRANSPARENT then c := p.color;
else
c := color;
////////////////////////////
clr := sys_complementar_color(c);
x := integer(r[0]+(r[2]-r[0])/2);
y := integer(r[1]+(r[3]-r[1])/2);
sz := 4;
@@ -39,8 +46,18 @@ type tcustomsplitter = class(tgraphiccontrol)
end
end
end
function SetAlign(a);override;
private
function sys_complementar_color(c);
begin
uses utslvclauxiliary;
if (c .& 0xff000000) then
begin
return complementary_color( _wapi.GetSysColor(c .& 0x00ffffff));
end
return complementary_color(c);
end
{function SetAlign(a);override;
begin
inherited;
end
end }
end
funcext/tvclib/tslvcl.tsf
+24
View File
@@ -313,6 +313,11 @@ type tapplication=class(tcomponent)
fexitdolist.Push(f);
end
end
function DoBeforeMouseMessage(ctl);
begin
UpdateMouseControl(ctl);
end
published
property color read getcolor write setcolor;
property font read getfont write setfont;
property Visible read FVisible write SetVisible;
@@ -321,6 +326,25 @@ type tapplication=class(tcomponent)
property MainForm read Fmainform write SetMainForm;
private
fexitdolist;
[weakref]FMouseControl;//鼠标所在的控件
private
function UpdateMouseControl(ctl);
begin
if FMouseControl=ctl then return ;
if FMouseControl then
begin
FMouseControl.Perform(new tuieventbase(CM_MOUSELEAVE,0,0,0)); //
end
FMouseControl := ctl;
//////////////处理提示///////////////////
////////////////////////////////////
if FMouseControl then
begin
FMouseControl.Perform(new tuieventbase(CM_MOUSEENTER,0,0,0));
end
end
function exitloopdo();
begin
if fexitdolist then
funcext/tvclib/twincontrol.tsf
+101 -182
View File
@@ -27,7 +27,6 @@ type TWinControl = class(tcontrol)
FWMNCHITTEST;
FImageList;
fchildsizing;
//FTRACKMOUSEEVENT;
FHandle:HWND; //窗口句柄
private //窗口相关
FBorderStyle;
@@ -325,6 +324,23 @@ type TWinControl = class(tcontrol)
end
UpdateControlState();
end
function Hitcontrol(p);
begin
{**
@explan(说明) 命中自绘制控件 %%
**}
for i := ControlCount-1 downto 0 do
begin
it := Controls[i];
if it is class(TGraphicControl)then
begin
if it.Enabled and it.Visible and pointinrect(p,it.GetBoundsRect)then
begin
return it;
end
end
end
end
protected
function SetParentFont(v:bool);override;
begin
@@ -607,82 +623,43 @@ type TWinControl = class(tcontrol)
end }
end
end
function Hitcontrol(p);
begin
{**
@explan(说明) 命中控件 %%
**}
for i := ControlCount-1 downto 0 do
begin
it := Controls[i];
if it is class(TGraphicControl)then
begin
if it.Enabled and it.Visible and pointinrect(p,it.GetBoundsRect)then
begin
return it;
end
end
end
end
function MouseHover(O,e);override;
begin
inself := true;
initem := 0;
for i := ControlCount-1 downto 0 do
begin
it := FControls[i];
if(it is class(TGraphicControl))and it.visible then
begin
if inself and pointinrect(array(e.lolparamsigned,e.hilparamsigned),it.GetBoundsRect)and it.Enabled then
begin
initem := it;
inself := false;
end else
begin
it.Perform(messagecreater(nil,WM_MOUSELEAVE,0,0));
end
end
end
if inself then return inherited;
else self.Perform(messagecreater(nil,WM_MOUSELEAVE,0,0));
if initem then initem.Perform(messagecreater(nil,WM_MOUSEHOVER,0,0));
end
public //消息绑定函数
function WMMouseMove(o,e):LM_MOUSEMOVE;override;
begin
it := Hitcontrol(e.pos);
{it := Hitcontrol(e.pos);
if it then
begin
return it.WMMouseMove(it,new TMMouse(LM_MOUSEMOVE,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
//return it.Perform(new TMMouse(LM_MOUSEMOVE,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
end}
inherited;
end
function WMLButtonUp(o,e):LM_LBUTTONUP;override;
begin
it := Hitcontrol(e.pos);
{it := Hitcontrol(e.pos);
if it then
begin
return it.WMLButtonUp(it,new TMMouse(LM_LBUTTONUP,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
end}
inherited;
end
function WMRButtonUp(o,e):LM_RBUTTONUP;override;
begin
it := Hitcontrol(e.pos);
{it := Hitcontrol(e.pos);
if it then
begin
return it.WMRButtonUp(it,new TMMouse(LM_RBUTTONUP,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
end}
inherited;
end
function WMMButtonUp(o,e):LM_MBUTTONUP;override;
begin
it := Hitcontrol(e.pos);
{it := Hitcontrol(e.pos);
if it then
begin
return it.WMMButtonUp(it,new TMMouse(LM_MBUTTONUP,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
end}
inherited;
end
function WMContextMenu(o,e):LM_CONTEXTMENU;override;
@@ -701,39 +678,39 @@ type TWinControl = class(tcontrol)
end
function WMLButtonDown(o,e):LM_LBUTTONDOWN;override;
begin
it := Hitcontrol(e.pos);
{it := Hitcontrol(e.pos);
if it then
begin
return it.WMLButtonDown(it,new TMMouse(LM_LBUTTONDOWN,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
end}
inherited;
end
function WMRButtonDown(o,e):LM_RBUTTONDOWN;override;
begin
it := Hitcontrol(e.pos);
{it := Hitcontrol(e.pos);
if it then
begin
return it.WMRButtonDown(it,new TMMouse(LM_RBUTTONDOWN,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
//return it.Perform(new TMMouse(LM_MOUSEMOVE,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
end}
inherited;
end
function WMMButtonDown(o,e):LM_MBUTTONDOWN;override;
begin
it := Hitcontrol(e.pos);
{it := Hitcontrol(e.pos);
if it then
begin
return it.WMMButtonDown(it,new TMMouse(LM_MBUTTONDOWN,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
end}
inherited;
end
function WMLButtonDBLCLK(o,e):LM_LBUTTONDBLCLK;override;
begin
it := Hitcontrol(e.pos);
{it := Hitcontrol(e.pos);
if it then
begin
return it.WMLButtonDBLCLK(it,new TMMouse(LM_LBUTTONDBLCLK,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
end}
inherited;
end
public //设计器相关杂项
@@ -1040,10 +1017,7 @@ type TWinControl = class(tcontrol)
rc.right := rc.right - wd;
end
end
function WMMOUSEHOVER(o,e):WM_MOUSEHOVER;virtual;
begin
MouseHover(o,e);
end
function WMMOUSELEAVE(o,e):WM_MOUSELEAVE;virtual;
begin
MouseLeave(o,e);
@@ -1986,7 +1960,6 @@ type TWinControl = class(tcontrol)
FUpDateCount := 0;
FTabStop := false;
FBorderStyle := bsNone;
//FTRACKMOUSEEVENT := NEW TTRACKMOUSEEVENT();
FWsPopUp := false;
FWsSysMenu := false;
FWsCapton := false;
@@ -2202,12 +2175,6 @@ type TWinControl = class(tcontrol)
factivated := false;
if HandleAllocated()then
begin
{FTRACKMOUSEEVENT.hwndtrack := handle;
if OnMouseEnter or OnMouseLeave then
begin
FTRACKMOUSEEVENT.dwflags := TME_CANCEL .| TME_HOVER .| TME_LEAVE;
_wapi.TrackMouseEvent(FTRACKMOUSEEVENT._getptr_);
end }
bv := FVisible;
_wapi.DestroyWindow(self.Handle);
FVisible := bv;
@@ -2347,8 +2314,31 @@ type TWinControl = class(tcontrol)
@explan(说明)窗口主循环 %%
**}
//if message=0x85 and not( WsCaption or border or WsDlgModalFrame) then return ;
e := messagecreater(hwnd,message,wparam,lparam);
e.sender := self(true);
if message=WM_NCMOUSEMOVE then
begin
app := class(tUIglobalData).uigetdata("tuiapplication");
if app then app.DoBeforeMouseMessage(nil);
end
e := messagecreater(hwnd,message,wparam,lparam);
e.sender := self(true);
case message of
LM_MOUSEFIRST to LM_MOUSELAST,
LM_MOUSEFIRST2 to LM_RBUTTONQUADCLK,
LM_XBUTTONTRIPLECLK to LM_MOUSELAST2 :
begin
ht := Hitcontrol(e.pos);
app := class(tUIglobalData).uigetdata("tuiapplication");
if app then app.DoBeforeMouseMessage(ht?:self(true));
msgs := array(LM_LBUTTONDBLCLK:1,LM_MBUTTONDOWN:1,LM_MOUSEMOVE:1,LM_LBUTTONUP:1
,LM_RBUTTONUP:1,LM_MBUTTONUP:1,LM_LBUTTONDOWN:1,LM_RBUTTONDOWN:1);
if ht and msgs[message] then
begin
ee := new TMMouse(message,e.wparam,makelong(e.xpos-ht.left,e.ypos-ht.top));
ht.dispatch(ht,ee);
return defaulthandler(e);
end ;
end
end;
if message = WM_SYSKEYDOWN or message = WM_KEYDOWN then //快捷键实现
begin
WndProc(const e);
@@ -2435,13 +2425,6 @@ type TWinControl = class(tcontrol)
//if message = WM_MOUSEMOVE then
if message=WM_NCHITTEST then //
begin
{if OnMouseEnter or OnMouseLeave then
begin
FTRACKMOUSEEVENT.hwndtrack := hwnd;
FTRACKMOUSEEVENT.dwflags := TME_HOVER .| TME_LEAVE;
FTRACKMOUSEEVENT.dwhovertime := 600;
_wapi.TrackMouseEvent(FTRACKMOUSEEVENT._getptr_);
end }
end else
if message=WM_STYLECHANGED then
begin
@@ -2453,52 +2436,11 @@ type TWinControl = class(tcontrol)
__wstyle := e.stylenew;
end
end
(**else
if message = WM_NCCALCSIZE then
begin
if e.wparam=1 then
begin
dt := new tNCCALCSIZE_PARAMS(e.lparam)._getvalue_("rgrc");
if dt[0]=-32000 then
begin
//echo "\r\n隐藏到工具栏";
end
else if dt[4] = -32000 then
begin
//echo "\r\n从工具栏弹出";
end
else
begin
//rect1 := dt[0:3];
//rect2 := dt[4:7];
//rect3 := dt[8:];
{dx := dt[2]-dt[0]-(dt[6]-dt[4]);
dy := dt[3]-dt[1]-(dt[7]-dt[5]);
__clientsize := array(dt[10]-dt[8]+dx,dt[11]-dt[9]+dy);
x := __clientsize[0];
dxsize := x-FClientWdith;
if FClientWdith<> x then FClientWdith := x;
y := __clientsize[1];
dysize := y-FClientHeight;
if FClientHeight <> y then FClientHeight := y;
DoControlAnchor(array(dxsize,dysize));
DoControlAlign(array(0,0,x,y));}
//__oldclientsize := array(dt[10]-dt[8],dt[11]-dt[9]);
end
end
else
begin
//echo "\r\n++++calc:",caption,tostn(new tcrect(e.lparam)._getdata_);
end
//echo "\r\ncalcsize:",o.caption,"****",e.wparam;
//echo "\r\nleft:", new tcrect(e.lparam).left;
end
**)
WndProc(const e);
if not(e.skip)then
begin
ret := defaulthandler(e);
if ifnil(e.Result) then ret := defaulthandler(e);
else ret := e.Result;
end else
begin
{$ifdef linuxgtk}
@@ -2552,10 +2494,6 @@ type TWinControl = class(tcontrol)
begin
e.Result := hit;
e.skip := true;
{if (csDesigning in ComponentState) then
begin
if al <> alNone then _send_(WM_USER,1644,1644,1);
end}
end
end
end
@@ -2566,64 +2504,44 @@ type TWinControl = class(tcontrol)
procedure WndProc(e);override; //type_twinctrol
begin
//WM_NCHITTEST
msg := e.msg;
if (csDesigning in ComponentState) then
begin
msg := e.msg;
if msg = WM_NCHITTEST then
begin
r := FWMNCHITTEST.hitstyle(self(true),e);
if r<>HTCLIENT then
begin
HitWindowborder(self(true),e,r);
end else
begin
return e.Result := Wnddefaulthandler(e);
end
end else
if msg= WM_LBUTTONDOWN then
begin
if not(WsCaption) and DesigningMove() and (Align=alNone) then
begin
_Send_(WM_NCLBUTTONDOWN,HTCAPTION,0,0);
e.skip := true;
end
CallMessgeFunction(FOnDesinedsel,self(true),e);
//保留原有的点击消息
{if DesigningClick() then
case msg of
WM_NCHITTEST:
begin
CallMessgeFunction(FOnMouseUp,self(true),e);
end }
end else
if msg = WM_LBUTTONDBLCLK then
begin
CallMessgeFunction(FOnDesigDBLClick,self(true),e);
end else
if msg = WM_RBUTTONDOWN then
begin
CallMessgeFunction(FOnDesinedRclick,self(true),e);
end else
if msg = WM_USER then
begin
if e.wparam=1644 and e.lparam=1644 then
begin
//Align=alNone;
{al := Align;
if al in array(alLeft,alRight,alTop,alBottom) then
r := FWMNCHITTEST.hitstyle(self(true),e);
if r<>HTCLIENT then
begin
bs := UnAlignBounds;
bs2 := BoundsRect;
if bs <> bs2 then
begin
Align := alNone;
Align := al;
end
end
}
end
end
HitWindowborder(self(true),e,r);
end else
begin
return e.Result := Wnddefaulthandler(e);
end
end
WM_LBUTTONDOWN:
begin
if not(WsCaption) and DesigningMove() and (Align=alNone) then
begin
_Send_(WM_NCLBUTTONDOWN,HTCAPTION,0,0);
e.skip := true;
end
CallMessgeFunction(FOnDesinedsel,self(true),e);
//保留原有的点击消息
{if DesigningClick() then
begin
CallMessgeFunction(FOnMouseUp,self(true),e);
end }
end
WM_LBUTTONDBLCLK:
begin
CallMessgeFunction(FOnDesigDBLClick,self(true),e);
end
WM_RBUTTONDOWN:
begin
CallMessgeFunction(FOnDesinedRclick,self(true),e);
end
end
end
inherited;
end;
@@ -2867,13 +2785,14 @@ type TWinControl = class(tcontrol)
it := Controls[I];
if it then
begin
it.WindowProc(e);
if e.skip then Exit;
if not ifnil(e.Result)then Exit;
it.WndProc(e);
//if e.skip then Exit;
//if not(ifnil(e.Result) or (e.Result =0))then Exit;
if e.Result then Exit;
end
end;
end;
procedure NotifyControls(Msg); //type_twinctrol
procedure NotifyControls(Msg:Integer); //type_twinctrol
begin
ToAllMessage := new tuieventbase(msg,0,0,0);
Broadcast(ToAllMessage);
funcext/tvclib/ugtkinterface.tsf
+27 -2
View File
@@ -178,6 +178,10 @@ type tsgtkapi = class(tgtkapis)
function MessageBoxA(hwnd :pointer;txt:string;cap:string;flag:integer);
begin
return gtk_MessageBoxA(hwnd,txt,cap,flag);
end
function IsIconic(); //×îС»¯
begin
end
function IsWindow(h);
begin
@@ -1164,6 +1168,11 @@ type tsgtkapi = class(tgtkapis)
if not dc then return ;
if ifnumber(x) and ifnumber(y) then
begin
cairo_rectangle(dc,x-0.5,y-0.5,1,1);
gtk_rgb_color_rgb(colr,r,g,b);
cairo_set_source_rgb(dc,r,g,b);
cairo_fill(dc);
return 1;
pc := colr;
MoveToEx(dc,x,y);
pc := gtk_object_get_data(dc,"pen.color");
@@ -5854,6 +5863,17 @@ fi
return ##_f_(f);
end
procedure gtk_widget_show_all(window:pointer);
begin
_f_ := static procedure(window:pointer);cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(window);
end
function gtk_window_is_maximized(window:pointer):integer;
begin
_f_ := static function(window:pointer):integer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(window);
end
procedure gtk_window_unmaximize(window:pointer);
begin
_f_ := static procedure(window:pointer);cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(window);
@@ -7863,7 +7883,12 @@ type tgtk_ctl_object = class(_gtkeventtype)
end
end
end
case mn of
case mn of
GS_LEAVE_NOTIFY_EVENT: //À뿪
begin
id := a.handle;
AddMessageToGtkMessageQueue(id,_const.WM_NCMOUSEMOVE,0,0);
end
GS_ENTER_NOTIFY_EVENT:
begin
fwindow_cursor := 0;
@@ -7926,7 +7951,7 @@ type tgtk_ctl_object = class(_gtkeventtype)
function GtkBaseEventName();virtual; //°ó¶¨µÄÏûÏ¢
begin
//return array("destroy","map","button-press-event","motion-notify-event","button-release-event","key-press-event","key-release-event","event"); //,"set-focus-child"
return array(GS_DESTROY,GS_BUTTON_PRESS_EVENT,GS_MOTION_NOTIFY_EVENT,GS_BUTTON_RELEASE_EVENT,GS_KEY_PRESS_EVENT,GS_KEY_RELEASE_EVENT,GS_FOCUS_IN_EVENT,GS_FOCUS_OUT_EVENT,GS_WINDOW_STATE_EVENT,GS_EVENT,GS_ENTER_NOTIFY_EVENT); //,"set-focus-child"
return array(GS_DESTROY,GS_BUTTON_PRESS_EVENT,GS_MOTION_NOTIFY_EVENT,GS_BUTTON_RELEASE_EVENT,GS_KEY_PRESS_EVENT,GS_KEY_RELEASE_EVENT,GS_FOCUS_IN_EVENT,GS_FOCUS_OUT_EVENT,GS_WINDOW_STATE_EVENT,GS_EVENT,GS_ENTER_NOTIFY_EVENT,GS_LEAVE_NOTIFY_EVENT); //,"set-focus-child"
end
function CreateWnd(dwExStyle,lpClassName,lpWindowName,dwStyle,x,y,nwidth,nheight,hwndparent,hmenu,hinstance,lpParam);virtual; //¹¹Ôì´°¿Ú
begin
funcext/tvclib/utslmemo.tsf
+21 -3
View File
@@ -3149,6 +3149,9 @@ type tcustomsynhighlighter = class(TSynHighLighter)
function create(AOwner);
begin
inherited;
fkeywords := array();
fsysfuncs := array();
fsymbols := array();
fsymcolor := 0xa000a0;
fnumbercolor := 0x666666;
fkeywordcolor := 0x0000ff;
@@ -3330,6 +3333,7 @@ type tcustomsynhighlighter = class(TSynHighLighter)
end
inherited;
end
published
property keywordcolor:color read fkeywordcolor write fkeywordcolor;
property sysfuncolor:color read fsysfuncolor write fsysfuncolor;
property stringcolor:color read fstringcolor write fstringcolor;
@@ -3337,6 +3341,9 @@ type tcustomsynhighlighter = class(TSynHighLighter)
property symcolor:color read fsymcolor write fsymcolor;
property numbercolor:color read fnumbercolor write fnumbercolor;
property ignorecase:bool read fignorecase write setignorecase;
property keywords:strings read fkeywords write setkeyword;
property sysfuncs:strings read fsysfuncs write setsysfun;
property symbols:strings read fsymbols write setsyms;
private
function setignorecase(i);
begin
@@ -3528,9 +3535,14 @@ type tcustomsynhighlighter = class(TSynHighLighter)
function setkeyword(ws); //设置关键字
begin
st := new TTire();
fkeywords := array();
for i,v in ws do
begin
if v and ifstring(v) then st.add(v);
if v and ifstring(v) then
begin
st.add(v);
fkeywords[length(fkeywords)] := v;
end
end
fkeystires := array(st);
end
@@ -3575,12 +3587,14 @@ type tcustomsynhighlighter = class(TSynHighLighter)
begin
st := new TTire();
fsysfuntires := array(st);
fsysfuncs := array();
if not ifarray(d) then return ;
for i,v in d do
begin
if ifstring(v) and v then
begin
st.add(v);
fsysfuncs[length(fsysfuncs)] := v;
end
end
end
@@ -3588,11 +3602,13 @@ type tcustomsynhighlighter = class(TSynHighLighter)
begin
st := new TTire();
fsymstires := array(st);
fsymbols := array();
for i,v in d do
begin
if ifstring(v) and v then
begin
st.add(v);
fsymbols[length(fsymbols)] := v;
end
end
end
@@ -3716,8 +3732,10 @@ type tcustomsynhighlighter = class(TSynHighLighter)
FSates; //当前状态
FTokens;
fdolastline; //已经处理到行
////////////////////////////////////
fkeywords; //¹Ø¼ü×Ö
fsysfuncs; //ϵͳº¯Êý
fsymbols; //·ûºÅ
///////tire树/////////////
fkeystires;
fstrstires;
funcext/tvclib/utslvclaction.tsf
+22 -3
View File
@@ -32,7 +32,7 @@ type TBasicAction=class(TComponent)
{**
@param(FClients)( TFpList of TActionLink) 关联的组件 %%
**}
procedure Change;virtual;
procedure Change();virtual;
begin
if iffuncptr(FOnChange) then call(FOnChange,self);
end
@@ -155,6 +155,7 @@ type TCustomAction=class(TContainedAction)
@explan(说明) action类 %%
**}
private
fimageid:Integer;
FCaption:string;
FChecked:Boolean;
FChecking:Boolean;
@@ -199,6 +200,15 @@ type TCustomAction=class(TContainedAction)
FVisible := nValue;
Change();
end
procedure Setimageid(Value:Integer);
begin
if not ifnumber(Value) then return ;
nValue := Integer(Value);
if nValue=fimageid then exit;
for I := 0 to FClients.Count-1 do FClients[I].setimageid(nValue);
fimageid := nValue;
Change();
end
function getShortCut();
begin
return formatshortcut(FShortCut);
@@ -230,7 +240,7 @@ type TCustomAction=class(TContainedAction)
if Dest=Self then exit;
if Dest is class(TCustomAction)then
begin
ps := array("checked","caption","visible","enabled","shortcut");
ps := array("checked","caption","visible","enabled","shortcut","imageid");
for i,v in ps do invoke(Dest,v,1,invoke(self,v));
end else
inherited;
@@ -242,6 +252,7 @@ type TCustomAction=class(TContainedAction)
@explan(说明) 构造 %%
**}
inherited;
fimageid := -1;
FEnabled := True;
FVisible := True;
end
@@ -275,6 +286,7 @@ type TCustomAction=class(TContainedAction)
property Checked:bool read FChecked write SetChecked;
property Enabled:bool read FEnabled write SetEnabled;
property Visible:bool read FVisible write SetVisible;
property imageid:Integer read fimageid write setimageid;
property ShortCut:string read getshortcut write SetShortCut;
end;
type TCustomactionlist=class(TComponent)
@@ -350,7 +362,7 @@ type TBasicActionLink=class(TSLUIBASE)
procedure AssignClient(AClient:TObject);virtual;
begin
end
procedure Change;virtual;
procedure Change();virtual;
begin
if iffuncptr(FOnChange) then call(OnChange,FAction);
end
@@ -432,6 +444,9 @@ type TActionLink=class(TBasicActionLink)
procedure SetVisible(Value:Boolean);virtual;
begin
end
procedure setimageid(value:Integer);virtual;
begin
end
function create(AClient);override;
begin
inherited;
@@ -461,6 +476,10 @@ type TActionLink=class(TBasicActionLink)
begin
return Action is CLASS(TCustomAction);
end
function IsImageIndexLinked():Boolean;virtual;
begin
return false;
end
end;
type TControlActionLink=class(TActionLink)
funcext/tvclib/utslvclauxiliary.tsf
+18 -22
View File
@@ -1815,7 +1815,7 @@ type TNode = class() //
end
function node_insert_check(it);virtual;
begin
return (it is class(TNode))and(not it.Parent);
return (it is class(TNode))and(not it.Parent) and ckchild(it);
end
function Expand();virtual; //展开
begin
@@ -1904,6 +1904,16 @@ type TNode = class() //
FCurrentDeleteNode;
FCurrentAddNode;
FExpanded;
function ckchild(c); //检查子节点
begin
sf := self(true);
while sf do
begin
if sf=c then return false;
sf := sf.Parent;
end
return true;
end
function SetExpand(v);virtual; //已经展开
begin
if v then Expanded();
@@ -3450,9 +3460,8 @@ end;
//////////////////////////////////////
function iffuncptr(fn);
begin
return datatype(fn) in array(7,37);
//return datatype(fn)=7;
//return fn and ifobj(fn);
dt := datatype(fn);
return ((dt=7) or (dt=37));
end
function includestate(u,s);
begin
@@ -3776,18 +3785,6 @@ begin
end else
return tostn(d);
end
function DeleteItemsByIndexs(r,dxs);
begin
{**
@explan(说明) 删除数组下标, %%
@param(r)(array) 待删除下标的数组,采用字符串下标的数组,变参返回%%;
**}
if not ifarray(r)then exit;
rdx := array();
for i,v in dxs do rdx[v]:= nil;
return reindex(r,rdx);
end
function HexHash();
begin
c := array("A","B","C","D","E","F");
@@ -4362,7 +4359,7 @@ begin
len := length(data);
while (i <= len) do
begin
ordi := ord(data[i]);
ordi := ord(data[i]);
if (ordi <= 0x7f) then
begin
//编码小于等于127,只有一个字节的编码，兼容ASCII
@@ -4370,13 +4367,12 @@ begin
continue;
end else
begin
if i>=len then return false; //加入判断避免越界
ordi2 := ord(data[i + 1]);
//大于127的使用双字节编码
if (ordi >= 0x81 and
ordi <= 0xfe and
ordi2 >= 0x40 and
ordi2 <= 0xfe and
ordi2 <> 0x7f) then
if ( ordi >= 0x81 and ordi <= 0xfe) and
(ordi2 >= 0x40 and ordi2 <= 0xfe) and
(ordi2 <> 0x7f) then
begin
i += 2;
continue;
funcext/tvclib/utslvclbase.tsf
+2 -1
View File
@@ -49,7 +49,8 @@ uses uwindowsinterface;
mh := MonitorFromRect(r1,2);
info := new TMONITORINFO();
GetMonitorInfoA(mh,info._getptr_);
return info.rcmonitor;
//return info.rcmonitor;
return info.rcwork;
end
rc := new tcrect();
SystemParametersInfoA(0x30,0,rc._getptr_(),0);
funcext/tvclib/utslvclmenu.tsf
+7 -2
View File
@@ -358,6 +358,11 @@ private
protected
function SetAction(Value);virtual;
begin
if csDesigning in ComponentState then
begin
FActionLink := Value;
return;
end
if ifnil(Value)then
begin
if FActionLink then
@@ -369,7 +374,7 @@ private
if Value is class(TBasicAction)then
begin
includestate(FControlStyle,csActionClient);
if ifnil(FActionLink)then FActionLink := createobject(GetActionLinkClass(),self);
if not(FActionLink is class(TActionLink) ) then FActionLink := createobject(GetActionLinkClass(),self);
FActionLink.Action := Value;
FActionLink.Onchange := thisfunction(DoActionChange);
ActionChange(Value,csLoading in Value.ComponentState);
@@ -382,7 +387,7 @@ private
end
function GetAction();virtual;
begin
if FActionLink then
if FActionLink is class(TActionLink) then
begin
return FActionLink.Action;
end
funcext/tvclib/utslvclpage.tsf
+4 -3
View File
@@ -22,7 +22,8 @@ type tcustomtabsheet = class(TCustomControl) //
public
function AdjustSize();override;
begin
class(tcontrol).AdjustSize();
//class(tcontrol).AdjustSize();
inherited;
end
function paint();override; //设计器模式下绘制网格
begin
@@ -817,8 +818,8 @@ type tcustompagecontrol = class(tcustomtabcontrol)
h := height;
return ;
end
w := 100;
h := 100;
w := 25;
h := 25;
for i:= 0 to len-1 do
begin
FTabItems[i].PageSheet.GetPreferredSize(wi,hi);
funcext/tvclib/utslvclstdctl.tsf
+35 -15
View File
@@ -3780,7 +3780,7 @@ type TcustomListBox=class(TCustomListBoxbase)
nh := min(h,16);
nnh := integer((h-nh)/2);
rc2 := array(rc[0]+2,rc[1]+nnh,rc[0]+nh+2,rc[3]-nnh);
if fcheckbox=2 then
if FMultisel=0 then
begin
cvs.Draw("framecontrol",array(rc2[0:1],rc2[2:3]),DFC_BUTTON,DFCS_BUTTONRADIO);
if r then
@@ -5139,9 +5139,14 @@ type TcustomToolButton=class(tcomponent)
protected //action
function SetAction(Value);virtual;
begin
if csDesigning in ComponentState then
begin
FActionLink := Value;
return;
end
if ifnil(Value)then
begin
if FActionLink then
if FActionLink is class(TActionLink) then
begin
FActionLink.SetAction(nil);
end
@@ -5150,7 +5155,7 @@ type TcustomToolButton=class(tcomponent)
if Value is class(TBasicAction)then
begin
includestate(FControlStyle,csActionClient);
if ifnil(FActionLink)then FActionLink := createobject(GetActionLinkClass(),self);
if not(FActionLink is class(TActionLink) ) then FActionLink := createobject(GetActionLinkClass(),self);
FActionLink.Action := Value;
FActionLink.Onchange := thisfunction(DoActionChange);
ActionChange(Value,csLoading in Value.ComponentState);
@@ -5163,7 +5168,7 @@ type TcustomToolButton=class(tcomponent)
end
function GetAction();virtual;
begin
if FActionLink then
if FActionLink is class(TActionLink) then
begin
return FActionLink.Action;
end
@@ -5184,6 +5189,7 @@ type TcustomToolButton=class(tcomponent)
if(not CheckDefaults)or(Caption='')or(Caption=Name)then Caption := NewAction.Caption;
if(not CheckDefaults)then ShortCut := NewAction.ShortCut;
if(not CheckDefaults)or Enabled then Enabled := NewAction.Enabled;
if(not CheckDefaults) then imageid := NewAction.imageid;
//if not CheckDefaults or FChecked then Checked := NewAction.Checked;
end;
end
@@ -5471,7 +5477,11 @@ type TcustomToolBar=class(TCustomControl)
FButtons.swap(i,i+1);
end
end
if Btn.Visible then InvalidateRect(nil,false);
if Btn.Visible then
begin
CalcButtonsRect();
InvalidateRect(nil,false);
end
return cidx;
end
function InsertButton(btn,idx);
@@ -5496,10 +5506,11 @@ type TcustomToolBar=class(TCustomControl)
if nidx >= 0 then SetBtnIndex(btn,nidx);
if btn.Visible then
begin
IncPaintLock();
CalcButtonsRect();
//IncPaintLock();
InvalidateRect(nil,false);
FWillModifyToolbar := true;
DecPaintLock();
//DecPaintLock();
end
end
function DeleteButton(btn); //ɾ³ý°´Å¥
@@ -5518,10 +5529,11 @@ type TcustomToolBar=class(TCustomControl)
FButtons.splice(idx,1);
if btn.Visible then
begin
IncPaintLock();
CalcButtonsRect();
//IncPaintLock();
InvalidateRect(nil,false);
FWillModifyToolbar := true;
DecPaintLock();
//DecPaintLock();
end
end
function GetItemRect(btn); //»ñµÃ°´Å¥ÇøÓò
@@ -6113,12 +6125,12 @@ type TcustomStatusBar=class(TCustomControl)
end
function GetPreferredSize(w,h);override;
begin
class(tcontrol).GetPreferredSize(w,h);
if iffuncptr(onGetPreferredSize) then return ;
bs := BoundsRect;
cs := ClientRect;
dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
h+=dh;
if ControlCount>0 then class(TWinControl).GetPreferredSize(w,h);
if iffuncptr(onGetPreferredSize) then return inherited;
ft := Font;
if not ft then return;
c := caption;
h := max(h,ft.Height+4);
w := Width;
end
published
@@ -8177,6 +8189,10 @@ type TtoolbuttonActionLink=class(TControlActionLink)
begin
return FClient and(Action is CLASS(TCustomAction));
end
function IsImageIndexLinked():Boolean;override;
begin
return true;
end
function IsCheckedLinked():Boolean;override;
begin
return false;
@@ -8186,6 +8202,10 @@ type TtoolbuttonActionLink=class(TControlActionLink)
begin
if IsshortcutLinked() then return FClient.ShortCut := Value;
end
procedure setImageid(value:Integer);override;
begin
if IsImageIndexLinked() and FClient then FClient.imageid := value;
end
function create(AOwner);override;
begin
inherited;
funcext/tvclib/utslvcltree.tsf
+65 -6
View File
@@ -80,7 +80,7 @@ type ttreelistwnd = class(TCustomScrollControl)
x := FColWidth *(0-xPos);
cvs := Canvas;
cvs.Font := font;
PaintRect(cvs,yPos,FItemHeight,FirstLine,LastLine,xPos,FColWidth,FirstCol,LastCol);
PaintRect(cvs,yPos,FItemHeight,FirstLine,LastLine,xPos,FColWidth,FirstCol,LastCol);
end
function GetClientItemIndexs();
begin
@@ -102,6 +102,8 @@ type ttreelistwnd = class(TCustomScrollControl)
public //常用方法
function Create(AOwner);override;
begin
fshowseparators := false;
fseparatorcolor := 0;
inherited;
end
function AfterConstruction();override;
@@ -383,12 +385,29 @@ type ttreelistwnd = class(TCustomScrollControl)
x := wd *(0-xPos);
rc := ClientRect;
PrevPaint(FirstLine,LastLine);
ls := array();
for i := FirstLine to LastLine do
begin
nrc := GetIndexRect(i);
it := FItems[i];
it.paint(cvs,x,nrc[1],rc[2]-rc[1]-x,ht);
if fshowseparators then
begin
ls[i] :=array(nrc[array(0,3)],nrc[array(2,3)]);
end
end
if fshowseparators then
begin
cf := cvs.pen;
cf.style := 0;
cf.Width := 1;
cf.color := fseparatorcolor;
for i,v in ls do
begin
cvs.MoveTo(v[0]);
cvs.LineTo(v[1]);
end
end
end
function SetTopLine(idx);virtual;
begin
@@ -469,10 +488,14 @@ type ttreelistwnd = class(TCustomScrollControl)
property ItemHeight read FItemHeight write SetItemHeight;
property ItemMaxWidth read FxClientMax;
property ItemMinWidth read FItemMinWidth write SetItemMinWidth;
property showseparators:bool read fshowseparators write setshowseparators;
property separatorcolor:color read fseparatorcolor write setseparatorcolor;
{**
@param(Items)(array of TcustomTreeCtlNode) 项 %%
@param(ItemMaxWidth)(integer) 最大宽度 %%
@param(ItemHeight)(integer) 项高度 %%
@param(showseparators)(bool) 显示分割线 %%
@param(separatorcolor)(color) 分割线颜色 %%
**}
private //其他中间函数
function GetIndexClientRect(idx);virtual;
@@ -485,8 +508,26 @@ type ttreelistwnd = class(TCustomScrollControl)
rc[3]:= rc[1]+FItemHeight;
return rc;
end
end
function setseparatorcolor(v);
begin
if (v<>fseparatorcolor) and (v>0 or v<=0) then
begin
fseparatorcolor := v;
end
end
function setshowseparators(v);
begin
nv := v?true:false;
if nv<>fshowseparators then
begin
fshowseparators := nv;
InvalidateRect(nil,false);
end
end
private //属性变量
fshowseparators;//分割线
fseparatorcolor;
FHashItems;
FItemHeight; //项高
FColCount; //列数
@@ -822,7 +863,11 @@ type TcustomTreeCtlNode = class(tsluibase) //
//cvs.Pen.style := PS_SOLID;
//cvs.Pen.width := 1;
inv := 3;
BasePos := FBasePos+x;
/////////////处理最顶层/////////////////////////////
if Hierarchy=0 then BasePos := x;
else
BasePos := FBasePos+x;
///////////////////////////////////
FCheckPos := BasePos;
fitemcountflg := ItemCount or FDirtype;
for i := 1 to Hierarchy do
@@ -865,17 +910,19 @@ type TcustomTreeCtlNode = class(tsluibase) //
begin
if(ifsel and FSelImgId >= 0)or(FImgId >= 0)or(FExpandImgId >= 0 and fitemcountflg>0 and FExpanded)then //绘制selimage
begin
imh := img.Height;
dimh := integer((h-imh)/2);
if(FExpandImgId >= 0)and fitemcountflg>0 and FExpanded then
begin
img.Draw(FExpandImgId,cvs,BasePos,y+1,nil);
img.Draw(FExpandImgId,cvs,BasePos,y+1+dimh,nil);
end else
if(ifsel and FSelImgId >= 0)then
begin
img.Draw(FSelImgId,cvs,BasePos,y+1,nil);
img.Draw(FSelImgId,cvs,BasePos,y+1+dimh,nil);
end else
if FImgId >= 0 then
begin
img.Draw(FImgId,cvs,BasePos,y+1,nil);
img.Draw(FImgId,cvs,BasePos,y+1+dimh,nil);
end
BasePos += img.Height;
BasePos += inv;
@@ -1167,6 +1214,7 @@ type TcustomTreeCtlNode = class(tsluibase) //
begin
if(it is class(TcustomTreeCtlNode))and(not it.Parent)then
begin
if not ckchild(it) then continue;
odexp := it.Expanded;
it.UnExpand();
FItems.InsertBefor(it,idx0);
@@ -1198,6 +1246,7 @@ type TcustomTreeCtlNode = class(tsluibase) //
**}
if(it is class(TcustomTreeCtlNode))and(not it.Parent)then
begin
if not ckchild(it) then return false;
if idx<0 then idx := 0;
if idx>FItems.Count then idx := FItems.Count;
if not(idx >= 0)then idx := 0;
@@ -1491,6 +1540,16 @@ type TcustomTreeCtlNode = class(tsluibase) //
FChecked; //选择
static fnodehandlebase; //////
private //普通属性设置
function ckchild(c); //检查子节点
begin
sf := self(true);
while sf do
begin
if sf=c then return false;
sf := sf.Parent;
end
return true;
end
function initnodehandle();//给当前节点分配一个id
begin
if not(fnodehandlebase>0) then fnodehandlebase:= 0xff;
@@ -1891,7 +1950,7 @@ type TcustomTreeCtl = class(ttreelistwnd)
end
return inherited;
end
published //ÊôÐÔ
published //属性输出
property CurrentNode read FCurrentNode write setcurrentnode; //20221118 加上写
property selectionColor:color read FselectionColor write SetselectionColor;
property CheckBox:bool read FCheckBox write SetCheckBox;
funcext/tvclib/utvclgraphics.tsf
+1090 -252
View File
File diff suppressed because it is too large Load Diff
tsleditor.exe
BIN
View File
Binary file not shown.
tslvcltool.exe
BIN
View File
Binary file not shown.