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

跟新

This commit is contained in:
liujianjun 2025-07-22 17:28:43 +08:00
parent e4d6b23680
commit db909b5520
36 changed files with 2389 additions and 1094 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
Help/designerUserGuid.CHM
View File

Binary file not shown.

4
d_examples/desktop.ini Normal file
View File

@ -0,0 +1,4 @@
[ViewState]
Mode=
Vid=
FolderType=Generic

66
designer/ctl_mgr/t_compile_config.tfm
View File

@ -10,12 +10,12 @@ object ed_script:t_compile_config
topbottomspacing=10
>
height=560
height=562
left=638
minmaxbox=false
onclose=compile_config_close
top=208
width=484
width=488
wssizebox=true
object panel1:tpanel
autosize=true
@ -31,7 +31,7 @@ object ed_script:t_compile_config
height=25
left=10
top=10
width=448
width=452
wsdlgmodalframe=false
object lb_input:tlabel
left=2
@ -74,7 +74,7 @@ object ed_script:t_compile_config
left=10
parentcolor=true
top=45
width=448
width=452
object lb_ype:tlabel
left=6
top=21
@ -121,13 +121,12 @@ object ed_script:t_compile_config
top=44
width=324
end
object bt_output:tbtn
object bt_outputname:tbtn
autosize=true
caption=".."
enabled=false
height=21
left=408
onclick=bt_output_clk
onclick=bt_outputname_clk
top=44
width=28
end
@ -148,12 +147,13 @@ object ed_script:t_compile_config
top=67
width=324
end
object bt_outputname:tbtn
object bt_output:tbtn
autosize=true
caption=".."
enabled=false
height=21
left=408
onclick=bt_outputname_clk
onclick=bt_output_clk
top=67
width=28
end
@ -169,23 +169,23 @@ object ed_script:t_compile_config
leftrightspacing=2
topbottomspacing=2
>
height=71
height=73
left=10
parentcolor=true
top=149
width=448
width=452
object label1:tlabel
left=6
top=21
width=58
height=21
height=23
autosize=true
caption="º¯ÊýĿ¼"
end
object ed_f_dirs:tedit
autosize=true
caption="edit1"
height=21
height=23
left=66
top=21
width=312
@ -193,7 +193,7 @@ object ed_script:t_compile_config
object bt_f_dir:tbtn
autosize=true
caption=".."
height=21
height=23
left=380
onclick=bt_f_dir_clk
top=21
@ -201,7 +201,7 @@ object ed_script:t_compile_config
end
object label2:tlabel
left=6
top=44
top=46
width=58
height=21
autosize=true
@ -212,7 +212,7 @@ object ed_script:t_compile_config
caption="edit2"
height=21
left=66
top=44
top=46
width=312
end
object bt_s_dir:tbtn
@ -221,7 +221,7 @@ object ed_script:t_compile_config
height=21
left=380
onclick=bt_s_dir_clk
top=44
top=46
width=28
end
end
@ -239,8 +239,8 @@ object ed_script:t_compile_config
height=139
left=10
parentcolor=true
top=230
width=448
top=232
width=452
object lb_s_type:tlabel
left=6
top=21
@ -256,10 +256,10 @@ object ed_script:t_compile_config
left=94
text="*.tfm,*.ini"
top=21
width=318
width=322
end
object label7:tlabel
left=414
left=418
top=21
width=28
height=20
@ -281,13 +281,13 @@ object ed_script:t_compile_config
height=21
left=94
top=43
width=318
width=322
end
object bt_i_s:tbtn
autosize=true
caption=".."
height=21
left=414
left=418
onclick=bt_i_s_clk
top=43
width=28
@ -307,13 +307,13 @@ object ed_script:t_compile_config
height=21
left=94
top=66
width=318
width=322
end
object bt_i_f:tbtn
autosize=true
caption=".."
height=21
left=414
left=418
onclick=bt_i_f_clk
top=66
width=28
@ -333,13 +333,13 @@ object ed_script:t_compile_config
height=21
left=94
top=89
width=318
width=322
end
object bt_tsgadd:tbtn
autosize=true
caption=".."
height=21
left=414
left=418
onclick=bt_tsgadd_clk
top=89
width=28
@ -359,13 +359,13 @@ object ed_script:t_compile_config
height=21
left=94
top=112
width=318
width=322
end
object bt_d_f:tbtn
autosize=true
caption=".."
height=21
left=414
left=418
onclick=bt_d_f_clk
top=112
width=28
@ -385,8 +385,8 @@ object ed_script:t_compile_config
height=97
left=10
parentcolor=true
top=379
width=448
top=381
width=452
object label9:tlabel
left=6
top=21
@ -521,8 +521,8 @@ object ed_script:t_compile_config
>
height=25
left=10
top=486
width=448
top=488
width=452
wsdlgmodalframe=false
object bt_cmd:tbtn
autosize=true

23
designer/ctl_mgr/t_compile_config.tsf
View File

@ -95,7 +95,7 @@ type t_compile_config=class(tdcreateform)
function bt_tsgadd_clk(o;e);virtual;
begin
tp := array("tsg¿â":"*.tsg");
if show_dir_list(s_to_array(ed_tsg.text,true),tp)then
if show_dir_list(s_to_array(ed_tsg.text,true),tp,"tsg库目录")then
begin
ed_tsg.text := array_to_s(dir_list.get_dirs(),true);
end
@ -183,6 +183,7 @@ type t_compile_config=class(tdcreateform)
function bt_outputname_clk(o;e);virtual;
begin
f_op.filter := array(get_type():"*"+get_type());
f_op.Caption := "输出文件名";
if f_op.OpenDlg()then
begin
ed_output.text :=relative_path( f_op.filename);
@ -201,6 +202,7 @@ type t_compile_config=class(tdcreateform)
function bt_script_clk(o;e);virtual;
begin
f_op.filter := array("tsl½Å±¾":"*.tsf;*.tsl");
f_op.Caption := "入口脚本";
if f_op.OpenDlg()then
begin
e_script.text := relative_path( f_op.filename);
@ -210,6 +212,7 @@ type t_compile_config=class(tdcreateform)
function bt_ico_clk(o;e);virtual;
begin
f_op.filter := array("icoͼ±ê":"*.ico");
f_op.Caption := "图标文件";
if f_op.OpenDlg()then
begin
ed_ico.text := relative_path( f_op.filename);
@ -217,28 +220,28 @@ type t_compile_config=class(tdcreateform)
end
function bt_d_f_clk(o;e);virtual;
begin
if show_m_editor(s_to_array(ed_exclude_f.text))then
if show_m_editor(s_to_array(ed_exclude_f.text),"排除函数")then
begin
ed_exclude_f.text := array_to_s(m_list_editor.get_data());
end
end
function bt_i_f_clk(o;e);virtual;
begin
if show_m_editor(s_to_array(ed_include_f.text))then
if show_m_editor(s_to_array(ed_include_f.text),"指定函数")then
begin
ed_include_f.text := array_to_s(m_list_editor.get_data());
end
end
function bt_i_s_clk(o;e);virtual;
begin
if show_m_editor(s_to_array(ed_include_s.text))then
if show_m_editor(s_to_array(ed_include_s.text),"指定资源")then
begin
ed_include_s.text := array_to_s(m_list_editor.get_data());
end
end
function bt_output_clk(o;e);
begin
if show_m_editor(s_to_array(ed_out_f.text))then
if show_m_editor(s_to_array(ed_out_f.text),"输出函数")then
begin
ed_out_f.text := array_to_s(m_list_editor.get_data());
end
@ -246,14 +249,14 @@ type t_compile_config=class(tdcreateform)
function bt_s_dir_clk(o;e);
begin
if show_dir_list(s_to_array(ed_s_dirs.text,true))then
if show_dir_list(s_to_array(ed_s_dirs.text,true),nil,"资源目录")then
begin
ed_s_dirs.text := array_to_s(dir_list.get_dirs(),true);
end
end
function bt_f_dir_clk(o;e);
begin
if show_dir_list(s_to_array(ed_f_dirs.text,true))then
if show_dir_list(s_to_array(ed_f_dirs.text,true),nil,"函数目录")then
begin
ed_f_dirs.text := array_to_s(dir_list.get_dirs(),true);
end
@ -274,19 +277,21 @@ type t_compile_config=class(tdcreateform)
invoke(self,v["name"],nil);
end
end
function show_dir_list(data,filetype);
function show_dir_list(data,filetype,cp);
begin
dir_list.Left := Left-20;
dir_list.top := top+50;
dir_list.set_dirs(data);
dir_list.fopentype := filetype;
if ifstring(cp) then dir_list.Caption := cp;
return dir_list.ShowModal();
end
function show_m_editor(data);
function show_m_editor(data,cp);
begin
m_list_editor.Left := Left-20;
m_list_editor.top := top+50;
m_list_editor.set_data(data);
if ifstring(cp) then m_list_editor.Caption := cp;
return m_list_editor.ShowModal();
end
function enabled_script_input(f);

2
designer/ctl_mgr/t_editor_color_mgr.tfm
View File

@ -35,6 +35,7 @@ object ditor_color_mgr:t_editor_color_mgr
onselchanged=colorcombobox1_onselchanged
top=18
width=132
parentfont=false
end
object listbox1:tlistbox
caption="listbox1"
@ -55,6 +56,7 @@ object ditor_color_mgr:t_editor_color_mgr
onselchanged=colorcombobox2_onselchanged
top=18
width=177
parentfont=false
end
object openfileadlg1:topenfileadlg
left=314

76
designer/udesignerproject.tsf
View File

@ -4,7 +4,7 @@ interface
@param(说明) 设计器工程相关工具,包括历史工程,工程目录管理,代码编辑器 %%
@date(20220518)
**}
uses utslvclauxiliary,tslvcl,utslmemo,UTslSynMemo,UVCPropertyTypesPersistence,UtslCodeEditor,utslvclsyntaxparser;
uses utslvclauxiliary,utslvcldcomponents,tslvcl,utslmemo,UTslSynMemo,UVCPropertyTypesPersistence,UtslCodeEditor,utslvclsyntaxparser;
function SetWndPostWithMouse(wnd,lft);
type TProjectManagerForm = class(TVCForm) //工程管理 TCustomControl
function Create(AOwner);override;
@ -175,7 +175,7 @@ end
%%,n,n+"main");
ReWriteString(cprojpath+n+".tsl",r);
ReWriteString(cprojpath+n+"main.tsf",CreateAForm(n+"main"));
ReWriteString(cprojpath+n+format("%smain.tfm",n),CreateAtfm(n+"main",n+"main"));
ReWriteString(cprojpath+n+"main.tfm",CreateAtfm(n+"main",n+"main"));
//ReWriteString(cprojpath+"resource.tfm"+fio+format("%smain.tfm",n),CreateAtfm(n+"main",n+"main"));
//写入缓存
FProjectCoder.AddProject(n,f);
@ -352,6 +352,8 @@ type TProjectView = class(TVCForm) //
FInput.visible := false;
FInput.parent := self;
FTslEditer := new TTslEditer(AOwner);
FTslEditer.ParentFont := false;
FTslEditer.dbclkcreate := false;
FTslEditer.Notification(FTslEditer,"change_editor_keys");
FTslEditer.FExecuteEditer.cannotadd := true;
FTslEditer.FExecuteEditer.onsaveclk := function(o,e)
@ -402,11 +404,12 @@ type TProjectView = class(TVCForm) //
begin
app := initializeapplication();
app.font := array("width":ginfo["fontsize"],"height" :ginfo["fontsize"]*2);
FTslEditer.font := array("width":ginfo["fontsize"],"height" :ginfo["fontsize"]*2);
NotifyComponent(self,ginfo);
end
end
FTslEditer.Parent := AOwner;
//FTslEditer.Parent := AOwner;
FTmfParser := new TTmfParser();
FTslParser := new ttslscripparser();
FTreeTool := new TToolBar(self);
@ -553,6 +556,11 @@ type TProjectView = class(TVCForm) //
if fopenbuzy then return ;
ftree.setsel(nd);
end
function getall_class_tsf();//列表
begin
ls := FTree.get_leaf_nodes();
return ls;
end
function OpenTreeNode(); //打开当前节点
begin
if not FCProjectPath then return Messageboxa("工程没打开","提示",0,self);
@ -895,8 +903,11 @@ type TProjectView = class(TVCForm) //
function ShowEditor(); //显示函数编辑
begin
FTslEditer.Show(SW_SHOWNOACTIVATE); //
//FTslEditer.Show(SW_SHOWNOACTIVATE); //
FTslEditer.Show(); //
_wapi.bringWindowToTop(FTslEditer.Handle);
it := FTslEditer.GetCurrentEditer();
if it then return it.SetFocus();
end
function hiddeneditor(rc);//隐藏
begin
@ -965,9 +976,10 @@ type TProjectView = class(TVCForm) //
return r;
end
end
function GoToAFunction(n); //Ìøתµ½º¯Êý
function GoToAFunction(n,fn); //跳转到函数
begin
fn := FCurrentOpend.gettsfname();
if not fn then
fn := FCurrentOpend.gettsfname();
r := FTslEditer.GoToFunction(fn,n);
saveformcode(fn);
ShowEditor();
@ -1037,9 +1049,13 @@ type TProjectView = class(TVCForm) //
//FTfmComponets := array();
//FTmfParser.GetAllSubObjects(nil,FTfmComponets);
FDesigner.LoadTreeNode(FTmfParser,inh,FCurrentOpend);
xx := FTslEditer.OpenAndGotoFileByName(FCurrentOpend.gettsfname());
FDesigner.LoadTreeNode(FTmfParser,inh,FCurrentOpend);
FDesigner.EditerCodeChanged(FCurrentOpend);
end else //缺少tfm文件
begin
xx := FTslEditer.OpenAndGotoFileByName(FCurrentOpend.gettsfname());
ShowEditor();
end
fopenbuzy := false;
end else
@ -1330,7 +1346,7 @@ end
%%,n,nd.Fname,us);
ReWriteString(ph,r);
FTmfParser.ScriptPath := nd.gettmfname();
r := FTmfParser.inheritedcoy(n+"1",n,nd.Fname);
r := FTmfParser.inheritedcopy(n+"1",n,nd.Fname);
ReWriteString(tfm,r);
//ReWriteString((FCProjectPath+"resource.tfm"+fio+n+".tfm"),r);
end else
@ -2206,7 +2222,7 @@ BD141CA912494F502D48D224F45050274A21E03806FF2C7CA7516022D7D000000
function GoToFunction(fn,n);
begin
it := OpenAndGotoFileByName(fn);
if it then it.GotoFunction(n);
if it then return it.GotoFunction(n);
end
function AddFunction(n,fn,finfo); //添加函数
begin
@ -2429,6 +2445,12 @@ type TFileTree = class(TTreeCtl)
end
fprojectpath;
fio;
function get_leaf_nodes();
begin
leafs := array();
GetNodeLeafs(FPNode,leafs);
return leafs;
end
function GetInfo(dir,files); //获得信息
begin
leafs := array();
@ -3117,6 +3139,7 @@ end
////////////////////////////////////////////////////////////////
function move_tfm_to_tsf(dir);
begin
if not(FileList("",dir+iofileseparator()+"resource.tfm"+iofileseparator()+"*.tfm")) then return ;
tsfs := array();
tfms := array();
find_tsf_tfm(dir,tsfs,tfms);
@ -3248,41 +3271,6 @@ function LegalFolderName(n); //Ŀ¼
begin
return ifstring(n) and n and (1=ParseRegExpr("^[A-Za-z_]\\w{2,}$",n,v,vp,vl)) and (lowercase(n)<>"con");
end
function createtslfunction(f);//¹¹Ô캯Êý
begin
n := f["name"];
p := f["param"];
b := f["body"];
ps := "";
if ifarray(p)then
begin
len := length(p);
for i := 0 to len-1 do
begin
v := p[i];
if ifstring(v)then ps += v;
if i<len-1 then ps += ";";
end
end
hs := nil;
vt := "";
if f["virtual"] then vt := "virtual;";
if ifstring(n) and ifstring(b)then
begin
//hs := "\r\nfunction "+n+"("+ps+");"+vt+"\r\n\tbegin\r\n"+b+"\r\n\tend\r\n";
bs := str2array(b,"\r\n");
bs2 := "";
for i,v in bs do
begin
if not v then continue;
bs2 += " "+v+"\r\n";
end
hs := "\r\n\ function "+n+"("+ps+");"+vt+"\r\n\ begin\r\n"+bs2+"\r\n\ end\r\n";
end
//hs := "\r\n\tfunction "+n+"("+ps+");"+vt+"\r\n\tbegin\r\n"+b+"\r\n\tend\r\n";
return hs;
end
function SetWndPostWithMouse(wnd,lft);
begin
{**

164
designer/utslcodeeditor.tsf
View File

@ -1229,12 +1229,23 @@ type TPageEditerItem=class(TPageItem)
p := crec[0];
if ifarray(p)then
begin
tpl := FEditer.TopLine;
cxy := FEditer.CaretY;
FEditer.ExecuteCommand(FEditer.ecGotoXY,p);
FEditer.ExecuteCommand(FEditer.ecString,fld+";\r\n ");
if p[1]<cxy then
begin
FEditer.TopLine := tpl+1;
FEditer.CaretY := cxy+1;
end else
begin
FEditer.TopLine := tpl;
FEditer.CaretY := cxy;
end
end
end
end
function getuses();
function getuses();//获取uses
begin
if not FTslParser then return 0;
d := GetClassInfo();
@ -1262,8 +1273,19 @@ type TPageEditerItem=class(TPageItem)
p := rec[0];
if ifarray(p) then
begin
FEditer.ExecuteCommand(FEditer.ecGotoXY,rec[0]);
FEditer.ExecuteCommand(FEditer.ecString,adus);
tpl := FEditer.TopLine;
cxy := FEditer.CaretY;
FEditer.ExecuteCommand(FEditer.ecGotoXY,rec[0]);
FEditer.ExecuteCommand(FEditer.ecString,adus);
if p[1]<cxy then
begin
FEditer.TopLine := tpl+1;
FEditer.CaretY := cxy+1;
end else
begin
FEditer.TopLine := tpl;
FEditer.CaretXY := cxy;
end
end
end
end
@ -1305,11 +1327,23 @@ type TPageEditerItem=class(TPageItem)
if v["name"]=nfld then
begin
frec := GetInfoRowCol2(v);
tpl := FEditer.TopLine;
cxy := FEditer.CaretY;
if ifarray(frec[0])and ifarray(frec[1])then
begin
FEditer.ExecuteCommand(FEditer.ecGotoXY,frec[0]);
FEditer.ExecuteCommand(FEditer.ecSelGotoXY,frec[1]);
FEditer.SelText := nn?(nn+";"):"";
if cxy>=frec[1,1] then //删除
begin
cn := frec[1,1]-frec[0,1];
FEditer.TopLine := tpl-cn;
FEditer.CaretY := cxy-cn;
end else
begin
FEditer.TopLine := tpl;
FEditer.CaretY := cxy;
end
end
wek := v["dstatic"];
if wek then
@ -1332,12 +1366,11 @@ type TPageEditerItem=class(TPageItem)
FEditer.ExecuteCommand(FEditer.ecSelGotoXY,frec[1]);
FEditer.SelText := nn?(nn+";"):"";
end
end
end
end
end
end
function GoToFunction(fn);
function GoToFunction(fn);//定位到函数
begin
if not(ifstring(fn))then return false;
nfld := lowercase(fn);
@ -1355,6 +1388,7 @@ type TPageEditerItem=class(TPageItem)
return true;
end
end
return d["inherited",0];
end
function AddFunction(fn,finfo); //添加函数
begin
@ -1429,6 +1463,7 @@ type TPageEditerItem=class(TPageItem)
if cp then cp.PrePareCompletion(t);
RepreComple := false;
end
//////////转码/////////////////////////
function ToUnicode_big();
begin
if FEnCode="UCS2-big" then return;
@ -1497,6 +1532,7 @@ type TPageEditerItem=class(TPageItem)
FEnCode := "ANSI";
end
end
///////////////////////////////
function SetLoadScript(s); //保存文件
begin
if not ifstring(s)then return;
@ -1576,8 +1612,7 @@ type TPageEditerItem=class(TPageItem)
end
function getmfunctioninfo();
begin
if not ftslparser2 then
ftslparser2 := new ttslscripparser();
if not ftslparser2 then ftslparser2 := new ttslscripparser();
ftslparser2.Script :=FEditer.Text;
return ftslparser2.gettslfunctions();
end
@ -1799,6 +1834,7 @@ type TEditer=class(TCustomcontrol) //
function Create(AOwner);override;
begin
inherited;
fdbclkcreate := true;
if not Fhightercolor then
Fhightercolor := new thighlitcolor(self);
FOpenHistory := new TMyarrayb();
@ -1980,7 +2016,7 @@ type TEditer=class(TCustomcontrol) //
DoControlAlign();
end
/////////////////////
FStatus.Items := array(("text":"","width":0.85),("text":"","width":0.16));
FStatus.Items := array(("text":"","width":0.7),("text":"","width":0.31));
/////////////////////////////////////////
//FInfoShowWnd.Caption := "信息:";
////构造节点////////////////////////////////////////////////////
@ -2041,6 +2077,7 @@ type TEditer=class(TCustomcontrol) //
sz := editorglobalinfo["fontsize"];
sz2 := sz*2;
app.font := array("width":sz,"height":sz2);
self.font := array("width":sz,"height":sz2);
if not(r) or (ifarray( r ) and r["imgsize"]<>editorglobalinfo["imgsize"]) then NotifyComponent(fsyssizemgr,editorglobalinfo);
end
end
@ -3407,6 +3444,7 @@ type TEditer=class(TCustomcontrol) //
end
function CreateAFile(); //构造文件
begin
if not fdbclkcreate then return ;
if FTslCacheDir then
begin
idx := 0;
@ -3885,6 +3923,7 @@ type TEditer=class(TCustomcontrol) //
end
published //property 位置
FHistoryDir;
property dbclkcreate read fdbclkcreate write fdbclkcreate;
property hltcolor read gethclor write sethclor;
function showhltcolor();
begin
@ -3982,13 +4021,15 @@ type TEditer=class(TCustomcontrol) //
fs := data["target"];
finder := finder_set_info(data,ed.Text);
idx := 0;
rsult := finder.replace_all(r);
rsult := finder.replace_all(r);
if rsult then
begin
FFindListWnd.ffindstr := fs;
idx := length(rsult);
ed.ExecuteCommand(ed.ecSelectAll);
ed.SelText := r;
lastidx := -1;
sct := integer((FFindListWnd.Width-10)/(FFindListWnd.font.Width))-17;
for i,v in rsult do
begin
if i=0 then
@ -3997,12 +4038,11 @@ type TEditer=class(TCustomcontrol) //
if rdx=lastidx then continue;
lastidx := rdx;
if not ifstring(v[3]) then continue;
scap := format(" %d:(µÚ%dÐÐ) ",i,rdx)+limitstringlength(v[3]);
scap := format(" %d:(第%d行) ",i,rdx)+ limitstringlength(v[3],sct);
FFindListWnd.AppendItem(array("caption":scap,"file":it.OrigScriptPath,"line":rdx));
end
end
end
function Find_InFiles(d,o,rep,ct);
begin
@ -4133,8 +4173,13 @@ type TEditer=class(TCustomcontrol) //
lastidx := -1;
if rsult then
begin
if not fnoshow then
begin
FFindListWnd.ffindstr := fs;
end
rt := length(rsult);
iits := 0;
sct := integer((FFindListWnd.Width-10)/(FFindListWnd.font.Width))-17;
for i,v in rsult do
begin
if i=0 and (not fnoshow) then
@ -4145,7 +4190,7 @@ type TEditer=class(TCustomcontrol) //
if rdx=lastidx then continue;
lastidx := rdx;
if not ifstring(v[3]) then continue;
scap := format(" %d:(µÚ%dÐÐ) ",i,rdx)+limitstringlength(v[3]);
scap := format(" %d:(第%d行) ",i,rdx)+ limitstringlength(v[3],sct);
FFindListWnd.AppendItem(array("caption":scap,"file":it.OrigScriptPath,"line":rdx));
iits++;
if iits>80 then
@ -4313,6 +4358,7 @@ type TEditer=class(TCustomcontrol) //
FGoBackB; // := new TMyarrayB();
FRebackFlag;
FPageEditer;
fdbclkcreate;
fcoolbar;
ftoolbara;
ftoolbarb;
@ -5281,15 +5327,18 @@ type TFindListWnd=class(TListBox) //
function Create(AOwner);
begin
inherited;
//font := array("width":11,"height":22);
//ParentFont := false;
{onnotification := function(o,e)begin
ms := e.message;
if ifarray(ms) and ms[0] ="font" then
begin
font := ms[1];
end
end }
ffindstr := "";
ownerdraw := true;
ondrawlist := thisfunction(findbox_drawlist); //绘制
end
function FontChanged(o);override;
begin
ft := font;
if ft then
begin
if ownerdraw then ItemHeight := font.Height+4;
return inherited;
end
end
function CheckListItem(s);override;
begin
@ -5302,6 +5351,62 @@ type TFindListWnd=class(TListBox) //
if not ifstring(r)then return "";
return r;
end
ffindstr; //查找的串
fignorcase;//忽略大小写
function findbox_drawlist(sender:tlistbox; evnt:tlistdrawevent; cvs:tcanvas; idx:integer; ARect:array of integer);
begin
ft := cvs.font;
w := ft.Width;
s := GetItemText(idx);
if not s then return ;
rc := ARect;
if pos("find:",s)=1 then
begin
ft.Color := 0xf0a000;
return cvs.DrawText(s,rc);
end
if ffindstr then
begin
x := 0;
ls := length(s);
ct := integer((rc[2]-rc[0])/w)-3;
if ct>1 and ct<ls then
begin
if bytetype(s,ct)=1 then
begin
s := s[1:(ct-1)]+"...";
end else s := s[1:ct]+"...";
end
p := 1;
ss := str2array(lowercase(s),lowercase(ffindstr));
lenf := length(ffindstr);
lenss := length(ss)-1;
for i,v in ss do
begin
if v then
begin
ft.Color := 0;
lenv := length(v);
rc[2] := lenv*w+x;
cvs.DrawText(s[p:(p+lenv-1)],rc);
x := rc[2];
rc[0] := x;
p+=lenv;
end
if x>ARect[2] then break;
if lenss>i then
begin
ft.Color := 244;
rc[2] := lenf*w+x;
cvs.DrawText(s[p:(p+lenf-1)],rc);
p+=lenf;
x := rc[2];
if x>ARect[2] then break;
rc[0] := x;
end
end
end
end
end
type TFindWnd=class(TPage)
type TFindBtn=class(TBtn)
@ -5775,8 +5880,6 @@ type TGoToLineWnd=class(TVCForm) //
function Create(AOwner);override;
begin
inherited;
//ParentFont := false;
//font := array("width":10,"height":20);
wssizebox := false;
minmaxbox := false;
WsDlgModalFrame := true;
@ -5815,9 +5918,6 @@ type TGoToLineWnd=class(TVCForm) //
childsizing := array("layout":1,"leftrightspacing":5,"topbottomspacing":10,"verticalspacing":5,"controlsperline":3);
autosize := true;
end
function DoControlAlign();override;
begin
end
function ShowGoto();
begin
show();
@ -5937,6 +6037,7 @@ type tsyssizemgr = class(TVCForm)
pal.Parent := self;
childsizing := array("layout":1,"controlsperline":2);
pal.childsizing := array("layout":1,"controlsperline":2,"topbottomspacing":3);
fpal2 := pal;
autosize := true;
fok.onclick := thisfunction(okclk);
fcancel.onclick := thisfunction(cancelclk);
@ -5948,6 +6049,7 @@ type tsyssizemgr = class(TVCForm)
ft := font;
e.Height := ft.Height+5;
e.Width := ft.Width*7;
if fpal2 then e.Width :=fpal2.Width;
end
function okclk(o,e);
begin
@ -5982,7 +6084,8 @@ type tsyssizemgr = class(TVCForm)
setinfo(editorglobalinfo?:array());
center_popup_wnd(self);
return ShowModal();
end
end
fpal2;
fsysimg;
fsysfont;
end
@ -6062,10 +6165,11 @@ function gettslexe();
begin
return static gettslexefullpath();
end
function limitstringlength(s);
function limitstringlength(s,n);
begin
return trim(s);
len := length(s);
n := 150;
if not(n>30) then n := 150;
if len>n then
begin
if bytetype(s,n)=1 then

3
designer/utslcodeformat.tsf
View File

@ -133,6 +133,9 @@ type TFormatParser = class
"%%","(*","//","#!",
"<?tslx>",
"?>",
"...",
":>",":<",":<>", ":==",":>=",":<=",
"::>","::<","::<>", "::==","::>=","::<=",
//"0x","0O","0b",
);
TslSyn2 := array("div=","union2=","intersect=","outersect=","minus=","end.",);

17
designer/utslsynmemo.tsf
View File

@ -1013,9 +1013,7 @@ type TTslSynHighLighter = class(TSynHighLighter)
end
tvi := s[idx];
if tvi=" " or tvi="\t" then
begin
begin
SetTToken(tokens,const ccs,idx-1,array("%%"));
return ParserTokenLines(s,idx+1,e,ccs,tokens);
end
@ -1023,7 +1021,7 @@ type TTslSynHighLighter = class(TSynHighLighter)
end
end else
begin
SetTToken(tokens,"%",idx-1);
SetTToken(tokens,"%",idx-1);
idx--;
end
end
@ -1053,6 +1051,13 @@ type TTslSynHighLighter = class(TSynHighLighter)
SetTToken(tokens,"<",idx);
end
end else
if vi="." and (idx<e-2) and s[idx+1]="." and s[idx+2]="." then //////////¼ÓÈë´¦Àí ...
begin
if ttk then
SetTToken(tokens,ttk,idx-1);
SetTToken(tokens,"...",idx+2);
idx+=2;
end else
if pos(vi,"`~@#$^&*)+-;,.?:[]|\\=><%/") then
begin
if ttk then
@ -1248,8 +1253,8 @@ type TTslSynHighLighter = class(TSynHighLighter)
end
function GetLineTokens(idx);override;
begin
if idx<FSatesCount then
return FTokens[idx];
if idx<FSatesCount then return FTokens[idx];
return nil;
end
private
function FindRightChar(c,s,b,e,zy); //²éÕÒ·â±ÕµÄ×Ö·û

1065
designer/utslvcldcomponents.tsf
View File

File diff suppressed because it is too large Load Diff

5
designer/utslvcldebuger.tsf
View File

@ -2717,6 +2717,11 @@ type tdbgvalueshowgrid=class(TDrawGrid)
end
end
PopupMenu := mu;
onfontchanged := function()begin
ft := font;
if not ft then return ;
ItemHeight := ft.Height+4;
end
end
function DoDrawSubItem(o,e);override;
begin

152
designer/utslvcldesigner.tsf
View File

@ -41,6 +41,7 @@ type TVclDesigner = class(tvcform)
FStopMenu;
FProjectsManager;
FProjectManager;
FTslParser;//解析器
//***************************
function WrapProjectTo(); //打包当前
begin
@ -116,7 +117,7 @@ type TVclDesigner = class(tvcform)
height := (integer(mx*32/twidth)+1)*32+60+30{+24}+5;
end
function TreeNode2tfmsub(lib,node,itemnames,nd);//tmf文件字符串
function TreeNode2tfmsub(lib,node,itemnames,nd,bshow);//tmf文件字符串
begin
if not(node) then
begin
@ -128,7 +129,7 @@ type TVclDesigner = class(tvcform)
if not tr then return ;
it := tr.RootItem;
node := (it.items)[0];
ifnit := true;
ifnit := true;
end
if not ifarray(itemnames) then itemnames := array();
if not ifarray(lib) then lib := array();
@ -145,7 +146,7 @@ type TVclDesigner = class(tvcform)
begin
tcname := tc.name;
tcclassname := tc.dclassname;
if not(tcclassname and tcname and ifstring(tcname) and ifstring(tcclassname)) then raise "错误!";
if not(tcclassname and tcname and ifstring(tcname) and ifstring(tcclassname)) then return " ";//raise "错误!"$" "$tcname$" "$tcclassname$"<<<<";
oorinh := (tc.isinherited)?"inherited ":"object ";
ihp := "";
if tc.isinherited then
@ -153,8 +154,9 @@ type TVclDesigner = class(tvcform)
if ifstring(tc.inheritedparent) then
begin
ihp := "("+tc.inheritedparent+")";
bshow := true;
end
end
end else bshow := true;
r+= oorinh + tcname +":"+tcclassname+ihp+"\r\n";
itemnames[length(itemnames)] := array(tcname,tcclassname);
cr := tc.GetChangedPublish();
@ -163,10 +165,18 @@ type TVclDesigner = class(tvcform)
if not(v and ifstring(i) and ifstring(v) ) then continue; //严格判断
r+=tab;
r+= i + "=" + v +"\r\n";
bshow := true;
end
for i := 0 to node.ItemCount-1 do
begin
r += tablelines( TreeNode2tfmsub(lib,(node.items)[i],itemnames),tab);
ibshow := false;
rri := TreeNode2tfmsub(lib,(node.items)[i],itemnames,nil,ibshow);
if ibshow then
begin
rr := tablelines( rri,tab);
r += rr;
bshow := true;
end
end
r += "end";
end
@ -469,12 +479,12 @@ type TVclDesigner = class(tvcform)
begin
Foh := o.height;
_send_(WM_USER,123,123,1);
e.skip := true;
return ;
end
SC_MINIMIZE:
begin
e.skip := true;
return ;
//e.skip := true;
end
SC_DEFAULT:
begin
@ -487,6 +497,8 @@ type TVclDesigner = class(tvcform)
end
SC_RESTORE:
begin
Foh := o.height;
_send_(WM_USER,123,123,1);
end
end;
@ -503,7 +515,7 @@ type TVclDesigner = class(tvcform)
begin
if e.wparam = 123 and e.lparam=123 then
begin
if o.height>Foh then
if {o.height>Foh}true then
begin
o.height := Foh; //gtk 逻辑正确但是设置无效
end
@ -911,8 +923,46 @@ type TVclDesigner = class(tvcform)
end
end else
begin
FProjectManager.GoToAFunction(dv);
return ;
inh := FProjectManager.GoToAFunction(dv);
if not ifstring(inh) then return ;
////////////////父类中查找////////////////////////////////////////////
flg := true;
fs := FProjectManager.getall_class_tsf();
while flg and inh do //循环查找父类
begin
fn := 0;
for i,v in fs do //查找父类文件
begin
if v.fname=inh and v.FType<>"tsl" then
begin
fn := v.gettsfname();
break;
end
end
if not fn then break;//没找到文件退出
FTslParser.ScriptPath := fn;
ci := FTslParser.GetClassInfo();
for i,vf in ci["funcs"] do //对比函数名
begin
if dv=vf then
begin
flg := false;
break;
end
end
if flg then //没找到函数,继续找上一级父类
begin
inh := ci["inherited",0] ;
end else //找到函数,提示跳转
begin
if messageboxa("函数:"$dv$"在父类:"$inh$"中,是否打开","打开提示!",1,self)=IDOK then
begin
return FProjectManager.GoToAFunction(dv,v.gettsfname());
end
end
end
//////////////////////////////////////////////////////////////////
end
end
end
@ -969,6 +1019,7 @@ type TVclDesigner = class(tvcform)
{**
@explan(说明) 组件被点击 %%
**}
uses utslvclevent;
nd := o._tag;
tr := nd.owner;
if not(tr.visible) then
@ -977,6 +1028,20 @@ type TVclDesigner = class(tvcform)
FProjectManager.setnodesel(wnd);
return ;//
end
///////////////////特殊处理page控件///////////////////////////////////////////
if (o is class(TPageControl)) and (e is class(TMMouse)) then
begin
d := o.hittabat(e.pos);
if ifarray(d) then
begin
pid := d["idx"];
if (pid>=0) then
begin
o.SetPublish("cursel",pid,1);
end
end
end
///////////////////////////////////////////
if fselctlnode<> nd then
begin
//wd := o;//nd.Component.Cwnd;
@ -1045,7 +1110,8 @@ type TVclDesigner = class(tvcform)
@explan(说明) 选择工具按钮 %%
**}
cct := o._tag;
FComponentCreater := cct;
FComponentCreater := cct;
//if FProjectManager then FProjectManager.hiddeneditor();
end
function CloseShowForm(o,e); //主窗口关闭
@ -1433,8 +1499,8 @@ type TVclDesigner = class(tvcform)
{$endif}
compcwnd.Handle;
end
comp.isinherited := d["inherited"];
comp.inheritedparent := d["parent"];
comp.isinherited := d["inherited"];
comp.name := d["name"];
obarray[d["name"]] := comp;
FVariableSelecter.additem(comp);
@ -1511,7 +1577,7 @@ type TVclDesigner = class(tvcform)
rect := _wapi.GetScreenRect();
twidth := (rect[2]-50);
width := twidth;
height := 180;
height := 190;
//calcheight(twidth);
caption := "TVCL界面设计器";
FProjectsManager := new TProjectManagerForm(self);
@ -1563,24 +1629,36 @@ type TVclDesigner = class(tvcform)
tparent.parent := FObjInspector;
pparent.parent := FObjInspector;
//FTree.parent := tparent;
/////////////////属性筛选////////////////////////////////
fsearch := new tedit(self);
fsearch.placeholder := "筛选";
fsearch.Align := alTop;
fsearch.autosize := true;
fsearch.parent := pparent;
fsearch.OnChange := function(o,e)begin
if FPropGrid then FPropGrid.searchidex := o.text;
if FEventGrid then FEventGrid.searchidex := o.text;
end
////////////////////////////////////////////////
pedits.parent := pparent ;
FProp.parent := pedits;
FEvent.parent := pedits;
FEvent.parent := pedits;
FPropGrid.align := alclient;
FEventGrid.align := alclient;
FPropGrid.parent := FProp;
FEventGrid.parent := FEvent;
Mobjinspect();
onactivate := thisfunction(OnDesignerActivate);
fdimagelist := new TDesigImageList(self);
global editorglobalinfo ;
if ifarray(editorglobalinfo) and editorglobalinfo then
begin
fdimagelist.imgsize := editorglobalinfo["imgsize"];
fdimagelist.imgsize := editorglobalinfo["imgsize"];
sz := editorglobalinfo["fontsize"] ;
if sz>5 then FObjInspector.width :=sz*34+20;
end
Mobjinspect();
//FTree.Imagelist := fdimagelist;
fwindowinfos := new tfilesinfo(self,thisfunction(ClickTreeNode),fdimagelist,tparent);
//******************toolbar ***************
@ -1646,6 +1724,7 @@ type TVclDesigner = class(tvcform)
fdimagelist.imgsize := d["imgsize"];
end
end ;
FTslParser := new unit(utslvclsyntaxparser).ttslscripparser();
//OnChange
//fnewmenu
end
@ -1988,42 +2067,41 @@ type TPropEditGrid = class(TPropGrid) //
function SetComponent(v);override;
begin
if v=FComponent then exit;
ocls := Columns;
if v is class(TDComponent) then
begin
TSLData := v.GetPublishProperties();
TSLData := getneedpublished(v);//
end else
begin
TSLData := array();//array(NIL);
end
inherited;
if ocls then
begin
w := ocls[1,"width"];
if w>0 then
begin
i := 1;
self.ColumnWidth(1) := w;
end
end
end
public
function Create(AOwner);
begin
inherited;
FobjProptype := p_properys;
end
end
function getneedpublished(v);virtual;
begin
return v.GetPublishProperties();
end
end
type TEventEditGrid = class(TPropGrid) //事件编辑器
type TEventEditGrid = class(TPropEditGrid) //事件编辑器
{**
@explan(说明) 事件编辑 %%
**}
protected
function SetComponent(v);override;
begin
if v=FComponent then exit;
if v is class(TDComponent) then
begin
TSLData := v.GetPublishEvents();
//echo tostn(TSLData);
end else
begin
TSLData := array(NIL);
end
inherited;
end
public
function Create(AOwner);
begin
@ -2031,6 +2109,10 @@ type TEventEditGrid = class(TPropGrid) //
FobjProptype := p_evnets;
OndblClick := thisfunction(GridCellDblClick);
end
function getneedpublished(v);override;
begin
return v.GetPublishEvents();
end
function GridCellDblClick(o,e);override;//双击处理
begin
i := e.iitem;

101
designer/utslvcldpropertytypes.tsf
View File

@ -55,7 +55,7 @@ type TGridPropertyRender = class(TGCellRender) //
inherited;
Owner := AOwner;
end
Owner ;
[weakref]Owner ;
end
type TGridCellEditWithButton = class(TGridPropertyRender) //带按钮的单元格编辑
{**
@ -387,7 +387,6 @@ type TListVariable = class(TGridList)
SetColumnWidth(0,Width-11);
end
end
function create(AOwner);override;
begin
inherited;
@ -397,6 +396,11 @@ type TListVariable = class(TGridList)
Columns := array(
("text":"variable","width":180)
);
OnFontChanged := function()begin
ft := font;
if not ft then return ;
ItemHeight := ft.height+6;
end
end
function SetSelectedByValue(v_);override;
begin
@ -458,7 +462,7 @@ type TListStr = class(TListVariable)
function create(AOwner);override;
begin
inherited;
Columns := array(("text":"´ò¿ª±à¼­Æ÷","width":160));
Columns := array(("text":"±à¼­Æ÷","width":160));
end
function additem(v);override;
begin
@ -913,7 +917,7 @@ type TTSLDataGrid=class(TDrawGrid)
@explan(说明)TSL数组和对象展示 %%
**}
private
fsearchidex;
FCols;
Fdata;
FObjectData;
@ -922,7 +926,7 @@ type TTSLDataGrid=class(TDrawGrid)
FRows;
FShowTwo;
FCControls;
FColumnWidth;
FdfColumnWidth;
FRowHeader;
static FGCellRender;
FCanEditStr;
@ -992,6 +996,14 @@ type TTSLDataGrid=class(TDrawGrid)
return FGCellRender[n];
end
private
function setsearchidex(s);
begin
if fsearchidex<>s and ifstring(s) then
begin
fsearchidex := s;
InvalidateRect(nil,false);
end
end
function SetRowHeader(v);
begin
nv := v?true:false;
@ -1045,16 +1057,17 @@ type TTSLDataGrid=class(TDrawGrid)
begin
fcs[0]:= array("text":" ","width":min(500,wd));
end
cw := 15* ftwidth;
if FCL and allFCL and FShowTwo then
begin
FCols := FCl;
for i,v in FCols do
begin
fcs[length(fcs)]:= array("text":ifstring(v)?v:inttostr(v),"width":FMRWD);
fcs[length(fcs)]:= array("text":ifstring(v)?v:inttostr(v),"width":cw);
end
end else
begin
fcs[length(fcs)]:= array("text":" ","width":ColumnWidth>20?ColumnWidth:100);
fcs[length(fcs)]:= array("text":" ","width":fdfColumnWidth>20?fdfColumnWidth:cw);
end
Columns := fcs;
ItemCount := length(FRows);
@ -1146,6 +1159,7 @@ type TTSLDataGrid=class(TDrawGrid)
end
end
public
property searchidex read fsearchidex write setsearchidex;
function create(AOwner);override;
begin
inherited;
@ -1162,7 +1176,7 @@ type TTSLDataGrid=class(TDrawGrid)
FStringAlign := AL9_CENTERLEFT;
FDefAlign := AL9_CENTER;
end
function InitializeWnd();override;
begin
inherited;
@ -1242,6 +1256,10 @@ type TTSLDataGrid=class(TDrawGrid)
begin
ds := d;
//dc.drawtext(ds,src);
if j=0 and fsearchidex and pos(lowercase(fsearchidex),lowercase(d)) then
begin
dc.font.color := 0xff;
end
class(TLabel).CanvasDrawAlignText(dc,src,ds,FStringAlign);
end else
if ifobj(d)then
@ -1267,12 +1285,8 @@ type TTSLDataGrid=class(TDrawGrid)
begin
dc := e.canvas;
rc := e.rcitem;
{if SelectedRow = e.id then
if ifnumber(SelectRowColor) then dc.brush.color := SelectRowColor;
else
dc.brush.color := rgb(150,150,150);
else }
if color then dc.brush.color := color; //
c := color;
if c then dc.brush.color := c; //
else dc.brush.color := rgb(255,255,255);
dc.fillrect(rc);
inherited;
@ -1315,9 +1329,8 @@ type TTSLDataGrid=class(TDrawGrid)
begin
if d["type"]="object" then
begin
rd := GetCellRender(d["class"]);
if r then return r.CelldbClick(o,e,d);
rd := GetCellRender(d["class"]);
if rd then return rd.CelldbClick(o,e,d); ///////////
end
getitemcontrol(d,p,e.iitem,cl,"grid",cp,indexs);
end else
@ -1362,24 +1375,6 @@ type TTSLDataGrid=class(TDrawGrid)
end
end
return r;
idx := "FData";
for i,v in index do
begin
if ifnumber(v)then idx += format("[%d]",v);
else if ifstring(v)then
begin
idx += format('["%s"]',v);
end
end
if length(idx)>5 then
begin
vals := idx+":="+tostn(val)+";"; //FData["c"]["value"]:=0;
try
eval(&vals);
except
//echo "===errr";
end;
end
end
function ControlIndexs(dx);
begin
@ -1460,7 +1455,7 @@ type TTSLDataGrid=class(TDrawGrid)
end
property Twodimensional:bool read FShowTwo write SetTwoD;
property TSLdata:variable read GetTSLData write SetData;
property ColumnWidth:integer read FColumnWidth write FColumnWidth;
property dfColumnWidth:integer read FdfColumnWidth write FdfColumnWidth;
property RowHeader:bool read FRowHeader write SetRowHeader;
property CanEditStr:bool read FCanEditStr write FCanEditStr;
property StringAlign:AlignStyle9 read FStringAlign write SetStringAlign;
@ -3051,6 +3046,7 @@ private
public
function create(aOwner);override;begin
inherited;
ParentFont := false;
caption:="TreeViewEditor";
left:=300;
top:=300;
@ -3256,13 +3252,15 @@ type TMultiSelList = class(TCustomControl)
function Create(AOwner);
begin
inherited;
FBtnWidth := 80;
border := true;
FList := new TListBox(self);
FList.checkbox := true;
FList.Multisel := 2;
//FList.Appenditems(array("a","b","c"));
FList.setCurrentSelection(array(0,1));
FList.parent := self;
FOkBtn := new TBTN(self);
FBtnWidth := 80;
FOkBtn := new TBTN(self);
FOkBtn.width := FBtnWidth;
FOkBtn.caption := "确定";
FOkBtn.parent := self;
@ -3272,7 +3270,20 @@ type TMultiSelList = class(TCustomControl)
FCanceBtn.parent := self;
FCanceBtn.onclick := thisfunction(CancelClick);
FOkBtn.onclick := thisfunction(okClick);
OnFontChanged := thisfunction(DoControlAlign);
end
{function FontChanged(o);override;
begin
ft := font;
if not ft then return ;
inherited;
FBtnWidth := 5*ft.width;
FOkBtn.height := ft.height+5;
Fokbtn.width := FBtnWidth;
FCanceBtn.height := ft.height+5;
FCanceBtn.width := FCanceBtn;
end }
function GetSelectdata();
begin
idx := FList.getSelectedIndexes();
@ -3319,18 +3330,24 @@ type TMultiSelList = class(TCustomControl)
end
function DoControlAlign();override;
begin
if FList and FOkBtn AND FCanceBtn then
ft := font;
if ft and FList and FOkBtn AND FCanceBtn then
begin
r := ClientRect;
h := FOkBtn.height;
h :=ft.height+4;
w :=ft.width*5;
c := r;
c[3]-=h+4;
FList.SetBoundsRect(c);
bt := r[3]-h-1;
FOkBtn.height := h;
FOkBtn.width := w;
FOkBtn.Top := bt;
FOkBtn.Left := r[2]-FBtnWidth-5;
FOkBtn.Left := r[2]-w-5;
FCanceBtn.top := bt;
FCanceBtn.Left := r[2]-FBtnWidth-FBtnWidth-10;
FCanceBtn.height := h;
FCanceBtn.width := w;
FCanceBtn.Left := r[2]-w*2-10;
end
end
function CancelClick(o,e);

6
designer/utslvclsyntaxparser.tsf
View File

@ -958,6 +958,12 @@ type tsltoken = class(tslparserbase) //
vf := 1;
setdata(FTokens,nk,v,"»Ø³µ",pos,hh);
end else
if v="." and (pos< len-2) and str[pos+1]="." and str[pos+2]="." then
begin
if length(vs)then setdata(FTokens,nk,vs,"Óï¾ä",pos,hh);
setdata(FTokens,nk,"...","Óï¾ä",pos,3);
pos+=2;
end else
if v in array(",",";",".","]","[",":","=","!")then
begin
if length(vs)then setdata(FTokens,nk,vs,"Óï¾ä",pos,hh);

BIN
editor-install.exe
View File

Binary file not shown.

38
funcext/tvclib/tcomponent.tsf
View File

@ -248,7 +248,7 @@ private
if op=opRemove or op=opInsert then return 0;
if fonnotification then
begin
e := new tuieventbase(op,0,0,0);
e := new unit(utslvclevent).tmnotif(op);
e.sender := a;
CallMessgeFunction(fonnotification,self(true),e);
return e.skip;
@ -258,7 +258,7 @@ private
begin
if foninqurequit then
begin
e := new tuieventbase(0,0,0,0);
e := new unit(utslvclevent).tminqurequit();//tuieventbase(0,0,0,0);
CallMessgeFunction(foninqurequit,self(true),e);
return e.skip;
end
@ -335,12 +335,6 @@ public //
FEventsProperties := array();
FVariableProperties := array();
FComponentCreated := true;
return;
If AOwner is class(tcomponent)then
begin
FOwner := AOwner;
AOwner.InsertComponent(Self);
end
end
function set_loadstate(v); //设置loading状态
begin
@ -519,30 +513,6 @@ public //
FChangedinheritedProperties;
FChangedProperties;
FVariableProperties;
{function GetPublishInfo();//属性获取
begin
r := publishs();
rr := array();
ri := 0;
for i,v in r do
begin
if ifstring(v) then rr[ri++] := lowercase(v);
end
return rr;
end }
{function OrderPublish(r,od); //排序发布的东西
begin
if od then
begin
r1 := array();
for i,v in od do
begin
vi := r[v];
if vi then r1[v]:= vi;
end
r := r1;
end
end}
public //设计器属性设置相关
function GetPublishproperties();virtual; //获得属性信息
begin
@ -551,7 +521,6 @@ public //
**}
ps := GetPropInfo();
r := array();
//pps := GetPublishInfo();
for i,v in ps do
begin
typ := v["type"];
@ -561,7 +530,6 @@ public //
if otype then
begin
n := v["name"];
//if pps and not(n in pps)then continue;
if typ in array("variable","popupmenu","syscursor","tmainmenu")then
begin
r[n]:= otype.FormatEdit(FVariableProperties[n],v["write"]?true:false);
@ -676,7 +644,6 @@ public //
if ifobj(otype)then
begin
iv := otype.UnformatEdit(v); //反转换
//if FChangedProperties[n]=vi then continue; //没有改变
if FChangedProperties[n]=iv then continue; //没有改变
SetChangedPublish(n,iv,pp); //保存
if n="visible" or n="wspopup" or n="enabled" then
@ -724,7 +691,6 @@ public //
@param(ComponentStyle)() 样式结合 %%
@param(ComponentCreated)(bool) 样式结合 %%
**}
//property DesignInfo read FDesignInfo write FDesignInfo;
property ComponentCreated read FComponentCreated;
property Components read FComponents;
property ComponentState read FComponentState write SetComponentState;

98
funcext/tvclib/tcontrol.tsf
View File

@ -441,42 +441,66 @@ type tcontrol = class(tcomponent)
{**
@explan(说明)根据消息参数构造消息对象;
**}
if message in array(WM_MOUSEMOVE,WM_LBUTTONDOWN,
case message of
WM_CLOSE :
begin
r := new tmclose(message,wparam,lparam,hwnd);
end
WM_MOUSEMOVE :
begin
r := new tmm_move(message,wparam,lparam,hwnd);
end
WM_CONTEXTMENU :
begin
r := new tmcontextpop(message,wparam,lparam,hwnd);
end
WM_LBUTTONDOWN,
WM_RBUTTONDOWN,WM_LBUTTONUP,
WM_RBUTTONUP,WM_LBUTTONDBLCLK,
WM_RBUTTONDBLCLK,WM_MBUTTONDOWN,WM_MBUTTONUP,WM_MBUTTONDBLCLK)then
begin
r := new TMMouse(message,wparam,lparam,hwnd);
end else
if message=WM_MENUSELECT then
begin
r := new TMMENUSELECT(message,wparam,lparam,hwnd);
end else
if message=WM_MEASUREITEM then
begin
r := new TMMEASUREITEM(message,wparam,lparam,hwnd);
end else
if message in array(WM_KEYDOWN,WM_KEYUP,WM_CHAR,WM_SYSCHAR,WM_SYSKEYDOWN,WM_SYSKEYUP)THEN
begin
r := new TMKEY(message,wparam,lparam,hwnd);
end else
if message=WM_DRAWITEM then
begin
r := new TMDRAWITEM(message,wparam,lparam,hwnd);
end else
if message=WM_NOTIFY then
begin
r := new TMNOTIFY(message,wparam,lparam,hwnd);
end else
if message=WM_MOUSEWHEEL then
begin
r := new TMMOUSEWHEEL(message,wparam,lparam,hwnd);
end else
if message=WM_STYLECHANGED or message=WM_STYLECHANGING then
begin
r := new TMSTYLECHANG(message,wparam,lparam,hwnd);
end else
r := new tuieventbase(message,wparam,lparam,hwnd);
WM_RBUTTONDBLCLK,WM_MBUTTONDOWN,WM_MBUTTONUP,WM_MBUTTONDBLCLK :
begin
r := new TMMouse(message,wparam,lparam,hwnd);
end
WM_MENUSELECT :
begin
r := new TMMENUSELECT(message,wparam,lparam,hwnd);
end
WM_MEASUREITEM :
begin
r := new TMMEASUREITEM(message,wparam,lparam,hwnd);
end
WM_ACTIVATE :
begin
r := new tmactivate(message,wparam,lparam,hwnd);
end
WM_KEYDOWN,WM_KEYUP,
WM_SYSCHAR,WM_SYSKEYDOWN,WM_SYSKEYUP :
begin
r := new TMKEY(message,wparam,lparam,hwnd);
end
WM_CHAR:
begin
r := new tmk_press(message,wparam,lparam,hwnd);
end
WM_DRAWITEM :
begin
r := new TMDRAWITEM(message,wparam,lparam,hwnd);
end
WM_NOTIFY :
begin
r := new TMNOTIFY(message,wparam,lparam,hwnd);
end
WM_MOUSEWHEEL :
begin
r := new TMMOUSEWHEEL(message,wparam,lparam,hwnd);
end
WM_STYLECHANGED ,WM_STYLECHANGING :
begin
r := new TMSTYLECHANG(message,wparam,lparam,hwnd);
end
else
r := new tuieventbase(message,wparam,lparam,hwnd);
end ;
return r;
//return new tuieventbase(message,wparam,lparam,hwnd);
end
@ -1014,7 +1038,7 @@ type tcontrol = class(tcomponent)
function WMMove(o,e):LM_MOVE;virtual;
begin
if not NoRecycled() then return ;
CallMessgeFunction(OnMove,o,e);
CallMessgeFunction(fOnMove,o,e);
if (o is class(TWinControl)) and o.WsPopUp then return ;
if (Align=alNone) then
begin
@ -1029,7 +1053,7 @@ type tcontrol = class(tcomponent)
function WMSize(o,e):LM_SIZE;virtual;
begin
if not NoRecycled() then return ;
CallMessgeFunction(OnSize,o,e);
CallMessgeFunction(fOnSize,o,e);
DoWMSIZE(o,e);
p := Parent ;
if p and p.childsizing.layout>0 then return p.AdjustSize();
@ -1580,7 +1604,7 @@ type tcontrol = class(tcomponent)
@param(Cursor)(tcursor 通过 member of TSystemCursor 设置) 系统鼠标 %%
**}
property Font:font read GetControlFont write SetControlFont;//write SetFont;
property OnMouseWheel read FOnMouseWheel write FOnMouseWheel;
property OnMouseWheel:eventhandler read FOnMouseWheel write FOnMouseWheel;
{**
@param(Caption)(string) 控件标题 %%
@param(Enabled)(bool) 控件是否有效 %%

1
funcext/tvclib/tcustomcontrol.tsf
View File

@ -18,6 +18,7 @@ type tcustomcontrol=class(TWinControl)
cvs.rcpaint := PAINTSTRUCT().rcpaint();
try
Paint();
inherited;
finally
cvs.Handle := 0;
end;

18
funcext/tvclib/tslvcl.tsf
View File

@ -33,10 +33,10 @@ function ExitMessageLoop(); //
function NotifyComponent(Sender,Act,ToComponent); //notfiy
//////////////////////操作/////////////////////
Function tslcstructure(data,dsize,pack,ptr);
//function CompareRect(orect,nrect);
function calldatafunction();
function CallMessgeFunction(f,o,e);
function CallMessageFunction(f,o,e); //执行消息回调
//////////////////////执行tsl脚本代码////////////////////
//function TSL_Check(func,funclen,oResult);
function CheckTslCode(code,err); //检查tsl语法
@ -1276,6 +1276,7 @@ type TpanelForm=class(tpanel) //
protected
function SetWsPopUp(v);override;
begin
if self(true).classinfo()["classname"]<>"tdcreatepanel" then return inherited;
if csDesigning in ComponentState then
begin
end else
@ -1285,6 +1286,7 @@ type TpanelForm=class(tpanel) //
end
function GetWsPopUp();override;
begin
if self(true).classinfo()["classname"]<>"tdcreatepanel" then return inherited;
if csDesigning in ComponentState then
begin
return true;
@ -1317,7 +1319,7 @@ type TpanelForm=class(tpanel) //
end
function SetDesigning(f,fc);override;
begin
if f then wspopup := true;
if f and (self(true).classinfo()["classname"]="tdcreatepanel") then wspopup := true;
inherited;
end
end
@ -1489,8 +1491,7 @@ type tmemo = class(TSynMemoNorm) //
function DoTextChanged(p);override;//文本改变
begin
inherited;
if Fonchange then
calldatafunction(Fonchange,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(Fonchange,self(true));
end
function GetPreferredSize(w,h);override;
begin
@ -3591,8 +3592,7 @@ type TListView = class(TDrawGrid)
end
function CallSelChanged();
begin
if OnSelChanged then
return calldatafunction(OnSelChanged,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(FSelectedChanged,self(true));
end
function SetCanSelected(v);
begin
@ -5203,7 +5203,7 @@ type TQuotations=class(tcomponent)
**}
if not ifarray(d)then exit;
FData := d;
calldatafunction(FOncallBack,self(true));
CallMessgeFunction(FOncallBack,self(true));
end
public
function create(AOwner);override;
@ -6530,6 +6530,10 @@ function GetTextWidthAndHeightWidthFont(s,f,mul);//
begin
return unit(utslvclgdi).GetTextWidthAndHeightWidthFont(s,f,mul);
end
function CallMessageFunction(f,o,e); //执行消息回调
begin
return unit(utslvclauxiliary).CallMessgeFunction(f,o,e);
end
function CallMessgeFunction(f,o,e); //执行消息回调
begin
return unit(utslvclauxiliary).CallMessgeFunction(f,o,e);

5
funcext/tvclib/tuieventbase.tsf
View File

@ -64,6 +64,11 @@ type tuieventbase=class(TSLUICONST)
Lparam := l;
Hwnd := h;
end
function expandinfo();virtual; //作为函数参数展开
begin
//返回二维数组,字段 name ,var,alias,type
return array();
end
function hilparam();
begin
{**

86
funcext/tvclib/twincontrol.tsf
View File

@ -62,6 +62,7 @@ type TWinControl = class(tcontrol)
FWsDlgModalFrame;
private //模态相关
//*******showmodal******************
fmodalcenter;//模态居中
FModaling;
FModalCode;
FMinWidth;
@ -129,6 +130,7 @@ type TWinControl = class(tcontrol)
FMSG := new TTagMSG();
msg := FMSG._getptr_;
//显示自己
center_self();
_wapi.ShowWindow(hWnd,SW_SHOW);
_wapi.BringWindowToTop(hWnd);
//disable掉父窗口
@ -918,7 +920,7 @@ type TWinControl = class(tcontrol)
function WMACTIVATE(o,e):WM_ACTIVATE;virtual;
begin
factivated := e.wparam;
CallMessgeFunction(OnActivate,o,e);
CallMessgeFunction(fOnActivate,o,e);
if e.skip then return ;
defaulthandler(e);
if factivated and ContainsControl(factivecontrol) then
@ -1557,6 +1559,27 @@ type TWinControl = class(tcontrol)
end
procedure PaintWindow(DC:HDC);virtual;
begin
///////////////////设计器中选中绘制/////////////////////////////////////////////
if (csDesigning in ComponentState) and FDesignSelect then //选中
begin
c := getwndclientrect();
x := (c[0]+c[2])/2;
y := (c[1]+c[3])/2;
ps := array(
(x,c[1]),
(c[0],y),
(c[2],y),
(x,c[3])
);
cvs := Canvas;
cvs.Brush.color := sys_complementar_color(Color);
sz := 4;
for i,v in ps do
begin
cvs.draw_rect().rect(array(v[0]-sz,v[1]-sz,v[0]+sz,v[1]+sz)).draw();
end
end
////////////////////////////////////////////////////
end
function SetTempCursor(Value);override;
begin
@ -1946,6 +1969,7 @@ type TWinControl = class(tcontrol)
end
function create(aowner);override; //type_twinctrol
begin
fmodalcenter := true;
inherited;
fchildsizing := new t_children_sizer(self(true));
//fbordercolor := rgb(190,190,190);
@ -2073,17 +2097,20 @@ type TWinControl = class(tcontrol)
dy := 20;
x := 0;
y := 0;
c := 0;
c := sys_complementar_color(color);
bbc := cv.brush.color;
cv.brush.color := c;
while y<rc[3] do
begin
y+=dx;
x := 0;
while x<rc[2] do
begin
x+=dx;
cv.SetPixel(array(x,y),c);
x+=dx;
cv.FillRect(array(x-1,y-1,x+1,y+1));
end
end
cv.brush.color := bbc;
ctls := controls;
rcs := array();
sel := -1;
@ -2112,7 +2139,7 @@ type TWinControl = class(tcontrol)
pct := cv.pen.style;
pcw := cv.pen.width;
cv.pen.Style := PS_DOT;
cv.pen.color := 0x3f3f3f;
cv.pen.color := c;//0x3f3f3f;
for i := 0 to len do
begin
if i=sel then continue;
@ -2294,6 +2321,14 @@ type TWinControl = class(tcontrol)
end
end
private //绘制相关成员
function sys_complementar_color(c);
begin
if (c .& 0xff000000) then
begin
return complementary_color( _wapi.GetSysColor(c .& 0x00ffffff));
end
return complementary_color(c);
end
FPaintRects;
FUpDateCount;
public
@ -2553,7 +2588,7 @@ type TWinControl = class(tcontrol)
_Send_(WM_NCLBUTTONDOWN,HTCAPTION,0,0);
e.skip := true;
end
CallMessgeFunction(OnDesignClick,self(true),e);
CallMessgeFunction(FOnDesinedsel,self(true),e);
//保留原有的点击消息
{if DesigningClick() then
begin
@ -2562,11 +2597,11 @@ type TWinControl = class(tcontrol)
end else
if msg = WM_LBUTTONDBLCLK then
begin
CallMessgeFunction(OnDesignDBLClick,self(true),e);
CallMessgeFunction(FOnDesigDBLClick,self(true),e);
end else
if msg = WM_RBUTTONDOWN then
begin
CallMessgeFunction(OnDesignRClick,self(true),e);
CallMessgeFunction(FOnDesinedRclick,self(true),e);
end else
if msg = WM_USER then
begin
@ -2902,11 +2937,11 @@ type TWinControl = class(tcontrol)
property OnActivate:eventhandler read FOnActivate write FOnActivate;
property OnClose:eventhandler read FOnClose write FOnClose;
property OnKeyDown:eventhandler read FOnKeyDown write FOnKeyDown;
property OnsysKeyDown:eventhandler read FOnsysKeyDown write FOnsysKeyDown;
property OnsysKeyDown read FOnsysKeyDown write FOnsysKeyDown;
property OnKeyUp:eventhandler read FOnKeyUp write FOnKeyUp;
property OnsysKeyUp:eventhandler read FOnsysKeyUp write FOnsysKeyUp;
property OnsysKeyUp read FOnsysKeyUp write FOnsysKeyUp;
property OnKeyPress:eventhandler read FOnKeyPress write FOnKeyPress;
property OnSysKeyPress:eventhandler read FOnSysKeyPress write FOnSysKeyPress;
property OnSysKeyPress read FOnSysKeyPress write FOnSysKeyPress;
property OnDesignClick read FOnDesinedsel write FOnDesinedsel;
property OnDesignDBLClick read FOnDesigDBLClick write FOnDesigDBLClick;
property OnDesignRClick read FOnDesinedRclick write FOnDesinedRclick;
@ -2923,7 +2958,34 @@ type TWinControl = class(tcontrol)
property ActiveControl read getactivecontrol write setactivecontrol;
property Active read factivated;//是否获活动窗口
property childsizing:tchildsizing read fchildsizing write setchildsizing;
property modalcenter read fmodalcenter write fmodalcenter; //模态时候居中
private //模态相关
function center_self();
begin
////////////////////窗口居中处理/////////////////////////////////
////////////////////wnd待居中的窗口/////////////////////////////////
////////////////////pwnd父窗口/////////////////////////////////
if not fmodalcenter then return ;
wnd := self(true);
pd := wnd.parent;
if pd and pd.Visible then
begin
while not(pd.wspopup) do
begin
npd := pd.parent;
if npd then pd := npd;
else break;
end
r := pd.ClientRect;
xy := pd.clienttoscreen(r[0],r[1]);
end else
begin
xy := array(0,0);
r := wnd._wapi.GetScreenRect();
end
wnd.Left := max(0,xy[0]+(r[2]-r[0]-wnd.width)/2) ;
wnd.top := max(0,xy[1]+(r[3]-r[1]-wnd.Height)/2);
end
property Modaling read FModaling;
{**
@param(BorderStyle)(bsNone|bsSingle) 边框样式 %%
@ -2933,7 +2995,7 @@ type TWinControl = class(tcontrol)
@param(OnClose)(function[TWincontrol,tuieventbase]) 窗口关闭消息回调 %%
@param(OnKeyDown)(function[TWincontrol,TMKEY]) 按键按下回调 %%
@param(OnKeyUp)(function[TWincontrol,TMKEY]) 按键松开 %%
@param(OnKeyPress)(function[TWincontrol,TMKEY]) ×Ö·ûÏûÏ¢ %%
@param(OnKeyPress)(function[TWincontrol,tmk_press]) 字符消息 %%
**}
private //ShortCut
function dispatchshortcut(c,st); //快捷键分发

36
funcext/tvclib/ugtkinterface.tsf
View File

@ -1062,6 +1062,16 @@ type tsgtkapi = class(tgtkapis)
end
Function DrawTextExA(hdc :pointer;txt:string;len:integer;rec:array of integer;fmt:integer;lpdtp:pointer):integer;
begin
//DT_LEFT := 0;
DT_RIGHT := 0x2;
//DT_TOP := 0;
DT_BOTTOM:= 0x8;
DT_CENTER := 0x1;
DT_VCENTER:= 0x4;
DT_SINGLELINE:= 0x20;
//DT_TABSTOP:= 0x80;
fmt := (fmt>0 or fmt<0)?fmt:0;
dfs := (fmt .& DT_SINGLELINE) = DT_SINGLELINE;
slen := length( txt);
if slen<1 then return ;
ft := gtk_object_get_data(hdc,"font");
@ -1082,23 +1092,19 @@ type tsgtkapi = class(tgtkapis)
if vi="\r" then continue;
if vi="\n" then
begin
rs++;
mxl := max(mxl,rl);
rl := 0;
if not dfs then
begin
rs++;
mxl := max(mxl,rl);
rl := 0;
end
continue;
end
rl++;
end
if dfs then slen := rl;
ht := ht*rs;
mxl := max(mxl,rl);
//DT_LEFT := 0;
DT_RIGHT := 0x2;
//DT_TOP := 0;
DT_BOTTOM:= 0x8;
DT_CENTER := 0x1;
DT_VCENTER:= 0x4;
//DT_SINGLELINE:= 0x20;
//DT_TABSTOP:= 0x80;
mxl := max(mxl,rl);
rw := rec[2]-rec[0];
nlen := min(len, min(integer(rw/wd),mxl));
sx := rec[0];
@ -1140,7 +1146,11 @@ type tsgtkapi = class(tgtkapis)
y := 0;//gtk_object_get_data(hdc,"viewport.y");
reci := array(rec[0]+x,rec[1]+y,rec[2]+x,rec[3]+y);
cairo_clip_rec(hdc,reci);
r := TextOutexA(hdc,sx,sy-dht,txt,slen);
if dfs then
begin
r := TextOutexA(hdc,sx,sy-dht,replacetext(replacetext(txt,"\r",""),"\n",""),slen);
end else
r := TextOutexA(hdc,sx,sy-dht,txt,slen);
cairo_restore(hdc);
return r;
end

119
funcext/tvclib/utslmemo.tsf
View File

@ -456,7 +456,9 @@ type TCustomMemoCmd=class() //
static const ecPrevBlock=0x2BE;static const ecNextJumpOut=0x2BF;static const ecPrevJumpOut=0x2C0;
static const ecUserFirst=0x3E9;static const ecFind=0x3EA;static const ecReplace=0x3EB;
static const ecSearchAgain=0x3EC;static const ecFindAll=0x3ED;static const ecString=0x3EE;
static const ecSearchUpAgain=0x3EF;
static const ecSearchUpAgain=0x3EF;
//////////////////////选择模式/////////////////////////////////
static const smNormal = 0;static const smLine = 1;static const smColumn = 2;
end
type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //编辑器基类
@ -518,10 +520,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
static const crUnindent = 7;
static const crSilentDelete = 8;
static const crSilentDeleteAfterCursor = 9;
static const crNothing = 10;
static const smNormal = 0;
static const smLine = 1;
static const smColumn = 2;
static const crNothing = 10;
//****************
protected
@ -693,9 +692,42 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
begin
cvs.Brush.Color := fselectbkcolor;//rgb(192,192,192);
src := r;
if FSelectionMode=smLine then
if FSelectionMode=smLine then //行选择
begin
end else
if FSelectionMode=smColumn then //块选择
begin
if bb[0]=ee[0] then
begin
src[0]+= fCharWidth *(bb[1]-1);
src[2]:= src[0]+fCharWidth *(ee[1]-bb[1]);
end
else
begin
t1 := bb;
t2 := ee;
bb := array(min(t1[0],t2[0]),min(t1[1],t2[1]));
ee := array(max(t1[0],t2[0]),max(t1[1],t2[1]));
s := FLines.GetStringByIndex(i);
ls := length(s);
dx := 0;
case bytetype(s,bb[1]) of
2:
begin
src[0]+= fCharWidth *(bb[1]);
dx := -1;
end
else src[0]+= fCharWidth *(bb[1]-1);
end ;
case bytetype(s,ee[1]-1) of
1:src[2]:= src[0]+max(0,fCharWidth *(min(ee[1],ls+1)-bb[1]+1+dx));
else src[2]:= src[0]+max(0,fCharWidth *(min(ee[1],ls+1)-bb[1]+dx));
end ;
end
end else
begin
if bb[0]=ee[0]then //同一行
begin
@ -1027,7 +1059,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
if ftmemlockv.locked then return ;
if e.skip then return;
c := e.wparam;
if ReadOnly then return;
if ReadOnly or (FSelectionMode=smColumn) then return;
if c=13 then return CharInput("\r\n");
if c<32 and not(c in array(9))then return;
cc := e.char;
@ -1139,7 +1171,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
end
function CharInput(c);virtual;//插入字符
begin
if not ReadOnly then return InsertChars(c);
if not(ReadOnly or (FSelectionMode=smColumn)) then return InsertChars(c);
end
function ExecuteCommand(cmd,data);override;//执行命令
begin
@ -1801,7 +1833,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
end
function SetSelectionMode(v);
begin
if(v <> FSelectionMode)and(v in array(smNormal,smLine))then FSelectionMode := v;
if(v <> FSelectionMode)and(v in array(smNormal,smLine,smColumn))then FSelectionMode := v;
end
function MoveCaretHorz(stp,sel);
begin
@ -2236,7 +2268,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
function GetBlockEnd();
begin
if GetSelAvail()then
begin
begin
if fBlockEnd[0]<fBlockBegin[0]or(fBlockEnd[0]=fBlockBegin[0]and fBlockEnd[1]<fBlockBegin[1])then return fBlockBegin;
else return fBlockEnd;
end
@ -2297,6 +2329,52 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
if i<len then r += "\r\n";
end
end else
if sm=smColumn then
begin
if bb[0]=ee[0]then
begin
s := fLines[bb[0]-1].FStr;
if not s then return "";
bg := min(bb[1],ee[1]);
ed := max(bb[1],ee[1]);
if bg<ed then return s[bg:(ed-1)]; //2023078 出错
return "";
end else
begin
//第一行
r += "";
//中间
for i := bb[0]-1 to ee[0]-1 do
begin
s := fLines[i].FStr;
ls := length(s);
t1 := bb;
t2 := ee;
bb := array(min(t1[0],t2[0]),min(t1[1],t2[1]));
ee := array(max(t1[0],t2[0]),max(t1[1],t2[1]));
if bb[1]<=ls then
begin
dx := 0;
case bytetype(s,bb[1]) of
2:
begin
bx := bb[1]+1;
dx := -1;
end
else bx := bb[1];
end ;
case bytetype(s,ee[1]-1) of
1: ex := min(ee[1],ls);
else ex:= min(ee[1]-1,ls);
end ;
if bx<=ex then r += s[bx:ex];
end
if i<ee[0]-1 then r += "\r\n";
end
//最后一行
end
end else
begin
if bb[0]=ee[0]then
begin
@ -2958,7 +3036,7 @@ type TSynHighLighter = class(TComponent) //
r := FCacheTokens[ridx];
if r then return r;
s := Flines.GetSTringByIndex(ridx);
if not ifstring(s) then return;
if not ifstring(s) then return nil;
idx := 1;
len := length(s);
tks := array();
@ -3199,6 +3277,7 @@ type tcustomsynhighlighter = class(TSynHighLighter)
function GetLineTokens(idx);override;
begin
if idx<FSatesCount then return FTokens[idx];
return nil;
end
function SetTToken(tokens,ttk,idx,ext);override; //设置token
begin
@ -3766,7 +3845,7 @@ type TSynCustomMemo = class(TCustomMemo)
end
function CharInput(c);override; //字符输入
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
if c="\r\n" then
begin
if FinishCompletion() then //确定键
@ -4061,28 +4140,28 @@ type TSynMemoNorm = class(TsynCustomMemo) //
end
ord("V"):
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
ExecuteCommand(ecPaste);
end
ord("X"):
begin
//if (ssAlt in e.shiftstate) then return ExecuteCommand(ecRedo);
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
ExecuteCommand(ecCut);
end
ord("Y"),ord("L"):
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
return ExecuteCommand(ecDeleteLine);
end
ord("Z"):
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
return ExecuteCommand(ecUndo);
end
ord("U"):
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
return ExecuteCommand(ecRedo);
end
VK_LEFT:
@ -4115,7 +4194,7 @@ type TSynMemoNorm = class(TsynCustomMemo) //
VK_TAB:
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
FSheetTabFlage := true;
return ExecuteCommand(ecShifttab,array(TabChar,"\t"," "));
end
@ -4182,13 +4261,13 @@ type TSynMemoNorm = class(TsynCustomMemo) //
end
VK_DELETE:
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
ExecuteCommand(ecDeleteChar);
return CancelCompletion();
end
VK_BACK :
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
ExecuteCommand(ecDeleteLastChar,1);
return CancelCompletion();
end

3
funcext/tvclib/utslvclaction.tsf
View File

@ -82,8 +82,7 @@ type TBasicAction=class(TComponent)
if csDesigning in ComponentState then return ;
if FOnExecute then
begin
e := new tuieventbase(0,0,0,0);
if iffuncptr(FOnExecute) then call(FOnExecute,self(true),e);
if iffuncptr(FOnExecute) then call(FOnExecute,self(true));
return true;
end
return false;

137
funcext/tvclib/utslvclauxiliary.tsf
View File

@ -615,7 +615,7 @@ type tarray1dlk=class //
function dochanged(info);
begin
if onchangelock then return ;
if fonchanged then CallMessgeFunction(fonchanged,self(true),info);
if fonchanged then CallMessgeFunction(fonchanged,self(true),info);
end
function SwapNoCheck(i,j);
begin
@ -910,7 +910,7 @@ type tstrindexarray = class() //
begin
{**
@explan(˵Ã÷) »ñµÃtsl array %%
@param(n)(bool) false 返回小写下标，true 返回原始下标 %%
@param(n)(bool) true 返回小写下标，false 返回原始下标 %%
**}
r := array();
for i,v in FData do
@ -3450,8 +3450,9 @@ end;
//////////////////////////////////////
function iffuncptr(fn);
begin
return datatype(fn) in array(7,37);
//return datatype(fn)=7;
return fn and ifobj(fn);
//return fn and ifobj(fn);
end
function includestate(u,s);
begin
@ -4039,12 +4040,136 @@ begin
if m in array(1,3,5,7,8,10,12) then return 31;
return 30;
end
function CallMessgeFunction2(f,o,e);
begin
{**
@ignore(忽略)
**}
if iffuncptr(f) then return call(f,o,e);
end
function get_evt_expand(e,n); //展开形式
begin
if (n=0 or n>2) and (e is class(tuieventbase)) then
begin
ps := e.expandinfo();
//echo e.Classinfo()["classname"],"\r\n";
if ps and ifarray(ps) then
begin
r := ps[0:(n-3)];
len := length(r);
n := len+2;
return r;
end
end
n := min(n,2);
return array();
end
function CallMessgeFunction(f,o,e);
begin
{**
{**
@ignore(ºöÂÔ)
**}
if iffuncptr(f) then return call(f,o,e);
**}
if not iffuncptr(f) then return ;
//////////////事件信息处理//////////////
ff := f.functioninfo();
ffp := ff["parameter"];
plen := length(ffp);
ex := get_evt_expand(e,plen);
//////////////////////////////////
case plen of
1:
begin
r := call(f,o);
end
3:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
r := call(f,o,e,x0);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
end
4:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
r := call(f,o,e,x0,x1);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
if ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
end
5:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
if ifstring(ex[2,"name"]) then x2 := invoke(e,ex[2,"name"]); else x2 := nil;
r := call(f,o,e,x0,x1,x2);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
if ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
if ex[2,"var"] then invoke(e,ex[2,"name"],1,x2);
end
6:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
if ifstring(ex[2,"name"]) then x2 := invoke(e,ex[2,"name"]); else x2 := nil;
if ifstring(ex[3,"name"]) then x3 := invoke(e,ex[3,"name"]); else x3 := nil;
r := call(f,o,e,x0,x1,x2,x3);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
if ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
if ex[2,"var"] then invoke(e,ex[2,"name"],1,x2);
if ex[3,"var"] then invoke(e,ex[3,"name"],1,x3);
end
7:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
if ifstring(ex[2,"name"]) then x2 := invoke(e,ex[2,"name"]); else x2 := nil;
if ifstring(ex[3,"name"]) then x3 := invoke(e,ex[3,"name"]); else x3 := nil;
if ifstring(ex[4,"name"]) then x4 := invoke(e,ex[4,"name"]); else x4 := nil;
r := call(f,o,e,x0,x1,x2,x3,x4);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
if ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
if ex[2,"var"] then invoke(e,ex[2,"name"],1,x2);
if ex[3,"var"] then invoke(e,ex[3,"name"],1,x3);
if ex[4,"var"] then invoke(e,ex[4,"name"],1,x4);
end
8:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
if ifstring(ex[2,"name"]) then x2 := invoke(e,ex[2,"name"]); else x2 := nil;
if ifstring(ex[3,"name"]) then x3 := invoke(e,ex[3,"name"]); else x3 := nil;
if ifstring(ex[4,"name"]) then x4 := invoke(e,ex[4,"name"]); else x4 := nil;
if ifstring(ex[5,"name"]) then x5 := invoke(e,ex[5,"name"]); else x5 := nil;
r := call(f,o,e,x0,x1,x2,x3,x4,x5);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
if ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
if ex[2,"var"] then invoke(e,ex[2,"name"],1,x2);
if ex[3,"var"] then invoke(e,ex[3,"name"],1,x3);
if ex[4,"var"] then invoke(e,ex[4,"name"],1,x4);
if ex[5,"var"] then invoke(e,ex[5,"name"],1,x5);
end
9:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
if ifstring(ex[2,"name"]) then x2 := invoke(e,ex[2,"name"]); else x2 := nil;
if ifstring(ex[3,"name"]) then x3 := invoke(e,ex[3,"name"]); else x3 := nil;
if ifstring(ex[4,"name"]) then x4 := invoke(e,ex[4,"name"]); else x4 := nil;
if ifstring(ex[5,"name"]) then x5 := invoke(e,ex[5,"name"]); else x5 := nil;
if ifstring(ex[6,"name"]) then x6 := invoke(e,ex[6,"name"]); else x6 := nil;
r := call(f,o,e,x0,x1,x2,x3,x4,x5,x6);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
if ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
if ex[2,"var"] then invoke(e,ex[2,"name"],1,x2);
if ex[3,"var"] then invoke(e,ex[3,"name"],1,x3);
if ex[4,"var"] then invoke(e,ex[4,"name"],1,x4);
if ex[5,"var"] then invoke(e,ex[5,"name"],1,x5);
if ex[6,"var"] then invoke(e,ex[6,"name"],1,x6);
end else
begin
r := call(f,o,e);
end
end ;
return r;
end
function CheckArrayIsNumbers(Value,n);
begin

151
funcext/tvclib/utslvclevent.tsf
View File

@ -74,6 +74,13 @@ type tmmeasuresize = class(tuieventbase)
width := -1;
height := -1;
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"width","alias":"wd","type":"integer","var":true);
r[1] := array("name":"height","alias":"ht","type":"integer","var":true);
return r;
end
width;
height;
end
@ -106,8 +113,17 @@ type TMKEY=class(tuieventbase)
function create(m,w,l,h);override;
begin
inherited;
FChar := chr(w);
if w>0 then
FChar := chr(w);
else FChar := chr(0);
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"charcode","alias":"key","type":"word");
r[1] := array("name":"shiftstate","alias":"shift","type":"tshiftstateenum");
return r;
end
property char read FChar;
property CharCode read wparam;
property shiftstate read getshiftsate;
@ -117,6 +133,22 @@ type TMKEY=class(tuieventbase)
@param(shiftstate)(arry of TShiftStateEnum member ) ascii码 %%
**}
end
type tmk_press=class(TMKEY)
{**
@param(说明) 按键输入
**}
public
function create(m,w,l,h);override;
begin
inherited;
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"char","alias":"key","type":"string");
return r;
end
end
Type TtageDrawItem=class(tslcstructureobj)
private
@ -265,7 +297,7 @@ type TSIFTSTATE = class(TSLUICONST)
end;
end
type TMMOUSEWHEEL=class(tuieventbase)
type tmmousewheel=class(tuieventbase)
{**
@explan(说明)鼠标滚动消息类 %%
**}
@ -288,12 +320,26 @@ type TMMOUSEWHEEL=class(tuieventbase)
property delta read hiwparamsigned;
property ypos read hilparamsigned;
property xpos read lolparamsigned;
property pos read getpos;
function expandinfo();override;
begin
r := array();
i := 0;
r[i++] := array("name":"shiftstate","alias":"shift","type":"tshiftstateenum");
r[i++] := array("name":"delta","alias":"delta","type":"integer");
r[i++] := array("name":"pos","alias":"mousepos","type":"array of integer");
return r;
end
{**
@param(ypos)(integer)鼠标的y坐标 %%
@param(xpos)(integer)鼠标的x坐标 %%
@param(delta)(integer)运动距离 %%
**}
private
function getpos();
begin
return array(xpos,ypos);
end
FKeyState;
end
type TMMouse=class(tuieventbase)
@ -370,9 +416,110 @@ type TMMouse=class(tuieventbase)
shiftstate();
return(ssDouble in FKeyState);
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"button","alias":"button","type":"tmousebutton");
r[1] := array("name":"shiftstate","alias":"shift","type":"tshiftstateenum");
r[2] := array("name":"xpos","alias":"x","type":"integer");
r[3] := array("name":"ypos","alias":"y","type":"integer");
return r;
end
private
FKeyState;
end
type tmm_move=class(TMMouse)
{**
@explan(说明) 鼠标移动消息类 %%
**}
public
function create(m,w,l,h);override;
begin
inherited;
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"shiftstate","alias":"shift","type":"tshiftstateenum");
r[1] := array("name":"xpos","alias":"x","type":"integer");
r[2] := array("name":"ypos","alias":"y","type":"integer");
return r;
end
end
type tmcontextpop = class(tuieventbase)
function create(m,w,l,h);
begin
inherited;
end
property mousepos read getpos; //鼠标位置
function expandinfo();override;
begin
r := array();
r[0] := array("name":"mousepos","alias":"mousepos","type":"array of integer");
return r;
end
private
function getpos();
begin
return array(lolparamsigned(),hilparamsigned());
end
end
type tmnotif = class(tuieventbase) //通知消息
function create(op);
begin
inherited create(op,0,0,0);
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"msg","alias":"msg");
r[1] := array("name":"skip","alias":"stopnotify","type":"bool","var":true);
return r;
end
end
type tmclose = class(tuieventbase) //窗口关闭
function create(m,w,l,h);
begin
inherited;
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"skip","alias":"stopclose","type":"bool","var":true);
return r;
end
end
type tminqurequit = class(tuieventbase) //退出询问
function create();
begin
inherited create(0,0,0,0);
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"skip","alias":"stopquit","type":"bool","var":true);
return r;
end
end
type tmactivate = class(tuieventbase)
function create(m,w,l,h);
begin
inherited;
end
property deactivate read getdeactivate;
function expandinfo();override;
begin
r := array();
r[0] := array("name":"deactivate","alias":"deactivate","type":"bool");
return r;
end
private
function getdeactivate();
begin
return Wparam=0;
end
end
type TMSTYLECHANG=class(tuieventbase)
{**
@explan(说明)窗口样式改变消息 %%

46
funcext/tvclib/utslvclgrid.tsf
View File

@ -69,6 +69,12 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
// end
function GetPreferredSize(w,h);override;
begin
if csDesigning in ComponentState then
begin
w := 250;
h := 150;
return ;
end
if ongetpreferredsize then return inherited;
w := Width;
h := Height;
@ -822,7 +828,7 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
begin
if fonhitcellsizer then
begin
e := new tuieventbase(0,r,i,0);
e := new triddragsize(0,r,i,0);
CallMessgeFunction(fonhitcellsizer,self(true),e);
return e.skip;
end
@ -1175,11 +1181,47 @@ type tgriddrawcellevent = class(tuieventbase)
rec := rc;
canvas := cvs;
end
function expandinfo();override;
begin
r := array();
idx := 0;
r[idx++] := array("name":"canvas","alias":"cvs","type":"tcanvas");
r[idx++] := array("name":"row","alias":"rowidx","type":"integer");
r[idx++] := array("name":"col","alias":"colidx","type":"integer");
r[idx++] := array("name":"rec","alias":"arec");
return r;
end
row;
col;
rec;
canvas;
end
end
type triddragsize=class(tuieventbase)
function create(a,b,c,d);
begin
inherited;
end
function expandinfo();override;
begin
r := array();
i := 0;
r[i++] := array("name":"idx","alias":"idx","type":"integer");
r[i++] := array("name":"r_or_c","alias":"r_or_c","type":"integer");
r[i++] := array("name":"skip","alias":"stopact","type":"bool","var":true);
return r;
end
property idx read getidx;
property r_or_c read getrc;
private
function getidx();
begin
return lparam;
end
function getrc();
begin
return wparam;
end
end
implementation
type TPAINTCOUNT=class()//»æÖƱê¼Ç
function create(v);

23
funcext/tvclib/utslvclmemstruct.tsf
View File

@ -1501,6 +1501,29 @@ type TMONITORINFO=class(tslcstructureobj)
property rcwork index "rcwork" read _getvalue_ write _setvalue_;
property dwflags index "dwflags" read _getvalue_ write _setvalue_;
end
type tagTRACKMOUSEEVENT=class(tslcstructureobj)
private
static SSTRUCT;
class function getstruct()
begin
if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array(
("cbsize","int",0),
("dwflags","int",0),
("hwndtrack","pointer",),
("dwhovertime","int",200)));
return SSTRUCT;
end
public
function create(ptr)
begin
inherited create(getstruct(),ptr);
cbsize := _size_();
end
property cbsize index "cbsize" read _getvalue_ write _setvalue_;
property dwFlags index "dwflags" read _getvalue_ write _setvalue_;
property hwndtrack index "hwndtrack" read _getvalue_ write _setvalue_;
property dwhovertime index "dwhovertime" read _getvalue_ write _setvalue_;
end
implementation
(*

193
funcext/tvclib/utslvclpage.tsf
View File

@ -1,4 +1,5 @@
unit utslvclpage;
/////////20250710 tab控件添加inert_tab方法//////////////////////////////////
interface
uses utslvclauxiliary,utslvclbase,utslvclgdi;
type tcustomtabsheet = class(TCustomControl) //控件页面
@ -71,15 +72,13 @@ type tcustomtabcontrol = class(TCustomControl)
begin
if FCurrentid<>-1 and fOnSelChanging then
begin
e := new tuieventbase(0,FCurrentid,id,0); //m,w,l,h
e := new tmtabselchanging(0,FCurrentid,id,0); //m,w,l,h
doonSelChanging(self(true),e);
if e.skip then return ;
end
FPrevid := FCurrentid;
FCurrentid := id;
InsureIdxVisible(id);
//InvalidateRect(nil,false);
//DoControlAlign();
DoControlAlign();
if FOnSelChanged then
begin
@ -92,43 +91,6 @@ type tcustomtabcontrol = class(TCustomControl)
FCurrentid := -1;
end
end
function RemovePageTab(id);//移除sheet
begin
if not(id>=0) then return ;
FTabItems.splice(id,1);
if id = FCurrentid then
begin
if id = 0 then
begin
if FTabItems.length()=0 then
begin
FCurrentid := -1;
FPrevid := -1;
end
end
FCurrentid := -1;
FPrevid := -1;
cid := min(max(0,id-1),FTabItems.length()-1);
if cid >=0 then
begin
return setselidx(cid);
end else
begin
if FOnSelChanged then
begin
doonSelChange(self(true),new tuieventbase(0,-1,-1,0));
end
end
end else
if id<FCurrentid then
begin
FCurrentid--;
end
FPrevid := -1;
DoControlAlign();
//CalcTabs();
//InvalidateRect(nil,false);
end
function CreateTableItem(cp);
begin
r := new tcustomtabitem();
@ -148,7 +110,7 @@ type tcustomtabcontrol = class(TCustomControl)
FTabHeight := fh+8;
end
FTabItemswidth := array();
e := new tuieventbase(0,0,0,0);
e := new tmtabmeasure(0,-1);
for i := 0 to FTabItems.length()-1 do
begin
pg := FTabItems[i];
@ -400,7 +362,6 @@ type tcustomtabcontrol = class(TCustomControl)
begin
FirstViewIndex-- ;
DoControlAlign();//CalcTabs();
//InvalidateRect(nil,false);
end
end
function scrollnext(); //滚动到上一个
@ -419,8 +380,6 @@ type tcustomtabcontrol = class(TCustomControl)
end
end ;
FirstViewIndex++ ;
//CalcTabs();
//InvalidateRect(nil,false);
DoControlAlign();
end
end
@ -619,7 +578,6 @@ type tcustomtabcontrol = class(TCustomControl)
begin
it.Caption := Value;
DoControlAlign();
//InvalidateRect(nil,false);
end
end
function SetTabIndex(AIndex,AIndexnew);
@ -646,6 +604,59 @@ type tcustomtabcontrol = class(TCustomControl)
//InvalidateRect(nil,false);
end
end
function remove_tab_byidx(id);virtual;//移除tab
begin
{**
@explan(说明) 移除标签 %%
@param(idx)(integer) 序号 %%
**}
if not(id>=0 and id<FTabItems.length()) then return ;
FTabItems.splice(id,1);
if id = FCurrentid then
begin
if id = 0 then
begin
if FTabItems.length()=0 then
begin
FCurrentid := -1;
FPrevid := -1;
end
end
FCurrentid := -1;
FPrevid := -1;
cid := min(max(0,id-1),FTabItems.length()-1);
if cid >=0 then
begin
return setselidx(cid);
end else
begin
if FOnSelChanged then
begin
doonSelChange(self(true),new tuieventbase(0,-1,-1,0));
end
end
end else
if id<FCurrentid then
begin
FCurrentid--;
end
FPrevid := -1;
DoControlAlign();
end
function insert_tab(c,idx);virtual; //插入tab
begin
{**
@explan(说明) 插入标签 %%
@param(c)(string) 标签 %%
@param(idx)(integer) 位置,默认为尾部 %%
**}
if not ifstring(c) then return 0;
cp := CreateTableItem(c);
if idx>=0 or idx<0 then FTabItems.splice(integer(idx),0,cp);
else FTabItems.Push(cp);
DoControlAlign();
return 1;
end
function Recycling();override;
begin
FOnSelChanged := nil;
@ -656,7 +667,7 @@ type tcustomtabcontrol = class(TCustomControl)
{**
@param(cursel)(integer) 当前选中序号 %%
@param(TabCount)(integer) page数量 %%
@param(OnSelChange)(function[tcustompagecontrol,tuieventbase]) 标签已经切换 %%
@param(OnSelChanged)(function[tcustompagecontrol,tuieventbase]) 标签已经切换 %%
@param(OnSelChanging)(function[tcustompagecontrol,tuieventbase]) 标签正在切换 %%
@param(Onrclcik)(function[tcustompagecontrol,tuieventbase]) 右键点击 %%
**}
@ -790,6 +801,11 @@ type tcustompagecontrol = class(tcustomtabcontrol)
if not (page is class(TWinControl)) then CalcTabs();
InvalidateRect(nil,false);
end
end
protected
function remove_tab_byidx(id);override;
begin
return inherited;
end
public
function GetPreferredSize(w,h);override;
@ -837,7 +853,7 @@ type tcustompagecontrol = class(tcustomtabcontrol)
begin
if not isacceptsheettype(AControl){ not(AControl is class(tcustomtabsheet))} then return;
id := GetPageID(AControl);
RemovePageTab(id);
remove_tab_byidx(id);
//fcoolbands.deleteitem(AControl,true);
end
Function SetCurSel(id);override; //设置当前序号
@ -946,6 +962,10 @@ type tcustompagecontrol = class(tcustomtabcontrol)
tabs;
faccepttype;
private
function insert_tab(c,idx);override; //插入tab
begin
end
function isacceptsheettype(c);
begin
for i,v in faccepttype do
@ -953,6 +973,64 @@ type tcustompagecontrol = class(tcustomtabcontrol)
if c is v then return true;
end
end
end
type tmtabselchanging = class(tuieventbase) //改变
function create(m,w,l,h);
begin
inherited;
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"lparam","alias":"nselidx","type":"integer");
r[1] := array("name":"skip","alias":"stopchange","type":"bool","var":true);
return r;
end
end
type tmtabmeasure = class(tuieventbase)
function create(i,w);
begin
inherited create(nil,w,i,0);
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"idx","alias":"idx","type":"integer");
r[1] := array("name":"width","alias":"wid","type":"integer","var":true);
return r;
end
property idx read wparam ; //序号
property width read lparam write lparam;//宽度
end
type teventdrawtab = class(tuieventbase)
{**
@explan(说明)绘制消息对象 %%
@param(idx)(integer) 序号 %%
@param(sel)(integer) 是否选中 %%
@param(rec)(array(左上右下)) 区域 %%
@param(canvas)(TCanvas) 画布 %%
**}
function create(id,s,rc,cvs);
begin
inherited create(0,0,0,0);
idx := id;
sel := s;
rec := rc;
canvas := cvs;
end
function expandinfo();override;
begin
r := array();
i := 0;
r[i++] := array("name":"canvas","alias":"cvs","type":"tcanvas");
r[i++] := array("name":"idx","alias":"idx","type":"integer");
r[i++] := array("name":"rec","alias":"arec","type":"array of integer");
return r;
end
idx;
sel;
rec;
canvas;
end
implementation
type tcustomtabitem = class() //
@ -990,27 +1068,6 @@ type tcustomtabitem = class() //
property PageSheet read FPageSheet Write FPageSheet;
_tag;
end
type teventdrawtab = class(tuieventbase)
{**
@explan(说明)单元格绘制消息对象 %%
@param(idx)(integer) 序号 %%
@param(sel)(integer) 是否选中 %%
@param(rec)(array(左上右下)) 区域 %%
@param(canvas)(TCanvas) 画布 %%
**}
function create(id,s,rc,cvs);
begin
inherited create(0,0,0,0);
idx := id;
sel := s;
rec := rc;
canvas := cvs;
end
idx;
sel;
rec;
canvas;
end
initialization
end.

173
funcext/tvclib/utslvclstdctl.tsf
View File

@ -502,7 +502,7 @@ type tcustombtn = class(TCustomControl) //
3: df := DT_RIGHT
4: df := DT_LEFT .| DT_VCENTER;
6: df := DT_RIGHT .| DT_VCENTER;
7: d := DT_BOTTOM .| DT_LEFT;
7: df := DT_BOTTOM .| DT_LEFT;
8: df := DT_BOTTOM .|DT_CENTER;
9: df := DT_BOTTOM .| DT_RIGHT;
else
@ -530,12 +530,46 @@ type tcustombtn = class(TCustomControl) //
end
function GetPreferredSize(w,h);override;
begin
class(tcontrol).GetPreferredSize(w,h);
if ongetpreferredsize then return ;
if iffuncptr(onGetPreferredSize) then return class(tcontrol).GetPreferredSize(w,h); //
bs := BoundsRect;
cs := ClientRect;
dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
h+=dh;
dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
dw := (bs[2]-bs[0])-(cs[2]-cs[0]);
c := caption;lc := length(c);
ft := font;
fw := ft.Width;
fh := ft.Height;
if FtextPosition=0 then
begin
w := fw*(lc+2);
h := fh+4;
end else
begin
rs := 1;
mlen := 0;
mmlen := 0;
for i := 1 to lc do
begin
ci := c[i];
case ci of
"\r":
begin
continue;
end
"\n":
begin
rs+=1;
mmlen := max(mmlen,mlen);
mlen := -1;
end
end ;
mlen++;
end
w := fw*(max(mmlen,mlen)+2);
h := fh*rs+4;
end
w += dw;
h += dh;
end
function FontChanged(o);override; //字体改变
begin
@ -624,12 +658,11 @@ type tcustombtn = class(TCustomControl) //
end
function setTextPosition(n);
begin
if not ifnumber(n) or n<0 or n>9 then
n:=0;
else
n:=integer(n);
if not(n>=0 and n<=9) then return ;
n:=integer(n);
if FtextPosition=n then return ;
FtextPosition:=n;
AdjustSize();
InvalidateRect(nil,false);
end
function judgestate(o,e);
@ -684,7 +717,10 @@ type tcustomcheckbtn=class(tcustombtn) //checkbtn
function GetPreferredSize(w,h);override;
begin
inherited;
w+=20+1;
//w+=20+1;
c := caption;
if c then w+=21;
else w := 21;
end
published
property checked:bool read FcheckState write setChecked;
@ -2555,6 +2591,7 @@ type TcustomLabel = class(TGraphicControl)
if v <> FTextAlign then
begin
FTextAlign := v;
AdjustSize();
InvalidateRect(nil,true);
end
end
@ -2578,6 +2615,47 @@ type TcustomLabel = class(TGraphicControl)
set_Preferre_size();
inherited;
end
function GetPreferredSize(w,h);override;
begin
if iffuncptr(onGetPreferredSize) then return class(tcontrol).GetPreferredSize(w,h); //
ft := font;
if not ft then return ;
fw := ft.Width;
fh := ft.Height;
c := caption;lc := length(c);
if FTextAlign=0 then
begin
w := fw*(lc)+2;
h := fh+3;
end else
begin
rs := 1;
mlen := 0;
mmlen := 0;
for i := 1 to lc do
begin
ci := c[i];
case ci of
"\r":
begin
continue;
end
"\n":
begin
rs+=1;
mmlen := max(mmlen,mlen);
mlen := -1;
end
end ;
mlen++;
end
w := fw*(max(mmlen,mlen))+2;
h := fh*rs+3;
end
bd := Border;
w += bd;
h += bd;
end
function FontChanged(o);override;
begin
inherited;
@ -2768,7 +2846,7 @@ type tcustomedit=class(TCustomControl)
begin
ft := Font;
if not ft then return ;
if ongetpreferredsize then
if iffuncptr(onGetPreferredSize) then
begin
return class(tcontrol).GetPreferredSize(w,h);
end
@ -2802,16 +2880,13 @@ type tcustomedit=class(TCustomControl)
inherited;
end
function doonmaxtext();
begin
if FOnMaxText then
CallMessgeFunction(FOnMaxText,self(true),new tuieventbase(0,0,0,0));
begin
CallMessgeFunction(FOnMaxText,self(true));
end
function DoChanged();
begin
if FOnChange then
CallMessgeFunction(FOnChange,self(true),new tuieventbase(0,0,0,0));
if FOnUpdate then
CallMessgeFunction(FOnUpdate,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(FOnChange,self(true));
CallMessgeFunction(FOnUpdate,self(true));
end
function FontChanged(sender);override;
begin
@ -3479,6 +3554,16 @@ type TCustomListBoxbase=class(TCustomScrollControl)
begin
return FItemCount;
end
function GetPreferredSize(w,h);override;
begin
if csDesigning in ComponentState then
begin
w := 250;
h := 150;
return ;
end
return inherited;
end
published
property ItemCount read GetItemCount write SetItemCount;
property ItemHeight read GetYScrollDelta;
@ -3530,6 +3615,15 @@ type tlistdrawevent = class(tuieventbase)
rec := r;
Canvas := c;
end
function expandinfo();override;
begin
r := array();
i := 0;
r[i++] := array("name":"canvas","alias":"cvs","type":"tcanvas");
r[i++] := array("name":"idx","alias":"idx","type":"integer");
r[i++] := array("name":"rec","alias":"ARect","type":"array of integer");
return r;
end
rec;
idx;
sel;
@ -3707,7 +3801,7 @@ type TcustomListBox=class(TCustomListBoxbase)
end
function PaintIdexText(idx,rc,cvs);virtual;
begin
if fownerdraw and Fondrawlist then
if fownerdraw and iffuncptr( Fondrawlist) then
begin
e := new tlistdrawevent(idx,rc[4],rc,cvs);
CallMessgeFunction(Fondrawlist,self(true),e);
@ -4263,7 +4357,7 @@ type TcustomListBox=class(TCustomListBoxbase)
end
function calllistselchengd();
begin
if FselectionChange then CallMessgeFunction(FselectionChange,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(FselectionChange,self(true));
end
private
fselbkcolor;
@ -4316,7 +4410,7 @@ type TCustomComboBoxbase=class(TCustomControl)
function GetPreferredSize(w,h);override;
begin
class(tcontrol).GetPreferredSize(w,h);
if onGetPreferredSize then return ;
if iffuncptr(onGetPreferredSize) then return ;
bs := BoundsRect;
cs := ClientRect;
dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
@ -4598,6 +4692,7 @@ type TcustomComboBox=class(TCustomComboBoxbase)
end
function DoControlAlign();override;
begin
if not FEdit then return ;
rc := ClientRect;
rc[2]-= 20;
FEdit.SetBoundsRect(rc);
@ -5153,7 +5248,7 @@ type TcustomToolBar=class(TCustomControl)
begin
ft := Font;
if not ft then return ;
if ongetpreferredsize then return class(tcontrol).GetPreferredSize(w,h);
if iffuncptr(onGetPreferredSize) then return class(tcontrol).GetPreferredSize(w,h);
ftw := ft.Width;
fth := ft.Height;
brec := BoundsRect;
@ -6019,7 +6114,7 @@ type TcustomStatusBar=class(TCustomControl)
function GetPreferredSize(w,h);override;
begin
class(tcontrol).GetPreferredSize(w,h);
if ongetpreferredsize then return ;
if iffuncptr(onGetPreferredSize) then return ;
bs := BoundsRect;
cs := ClientRect;
dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
@ -6077,6 +6172,7 @@ type TcustomStatusBar=class(TCustomControl)
{**
@explan(说明) 设置多个项目 %%
**}
if Fitems=its then return ;
Fitems := array();
for i,v in its do
begin
@ -6446,7 +6542,7 @@ type TCustomSpinEdit = class(TCustomControl)
function GetPreferredSize(w,h);override;
begin
class(tcontrol).GetPreferredSize(w,h);
if ongetpreferredsize then return ;
if iffuncptr(onGetPreferredSize) then return ;
ft := Font;
if not ft then return ;
h := ft.Height+4;
@ -7026,7 +7122,7 @@ type tcustomipaddr = class(TCustomControl)
end
function DoIpChanged();
begin
return CallMessgeFunction(onAddrChange,self(true),new tuieventbase(0,0,0,0));
return CallMessgeFunction(FaddrChange,self(true));
end
function cleanAddr();
begin
@ -7130,7 +7226,7 @@ type tcustomipaddr = class(TCustomControl)
begin
ft := Font;
if not ft then return ;
if ongetpreferredsize then
if iffuncptr(onGetPreferredSize) then
begin
return class(tcontrol).GetPreferredSize(w,h);
end
@ -7676,9 +7772,8 @@ type tcustomtimepicker = class(tthreeEntry)
ti := strtointdef(t,0);
if ti<0 then p.text := "24";
else if ti>24 then p.text := "0";
end
if Fonselectchange then
calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0));
end
CallMessgeFunction(Fonselectchange,self(true));
end
end
end
@ -7846,9 +7941,8 @@ type tcustomdatetimepicker = class(tthreeEntry)
ct := getmonthdates(y,m);
if d>ct then es[2].text := inttostr(ct);
end
end
if Fonselectchange then
calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0));
end
CallMessgeFunction(Fonselectchange,self(true)) ;
end
"dtadate":
begin
@ -7860,18 +7954,15 @@ type tcustomdatetimepicker = class(tthreeEntry)
es[0].text := inttostr(y);
es[1].text := inttostr(m);
es[2].text := inttostr(d);
if Fonselectchange then
calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(Fonselectchange,self(true));
end else
begin
y := strtointdef(es[0].text,2021);
m := strtointdef(es[1].text,1);
d := strtointdef(es[2].text,1);
return array(y,m,d);
end
end
end
end
end
end
function ShowDropDown(f);virtual;
@ -7985,8 +8076,7 @@ type tcustommonthcalendar = class(TCustomControl)
r := FCalender.ExecuteCommand("meselbypos",e.pos);
if std=3 or r="today" then
begin
if FonSelect then
CallMessgeFunction(FonSelect,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(FonSelect,self(true));
end
end
end
@ -8034,8 +8124,7 @@ type tcustommonthcalendar = class(TCustomControl)
end
function DoDatechanged();
begin
if FonSelectChange then
CallMessgeFunction(FonSelectChange,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(FonSelectChange,self(true));
end
function recycling();override;
begin

99
funcext/tvclib/utslvcltree.tsf
View File

@ -114,8 +114,8 @@ type ttreelistwnd = class(TCustomScrollControl)
FItemHeight := font.height+2;
FxClientMax := fColWidth;
FItemMinWidth := FxClientMax;
height := 400;
width := 300;
height := 150;
width := 250;
border := true;
autoscroll := 3;
ThumbTrack := true;
@ -453,6 +453,16 @@ type ttreelistwnd = class(TCustomScrollControl)
end
return r;
end
function GetPreferredSize(w,h);override;
begin
if csDesigning in ComponentState then
begin
w := 250;
h := 150;
return ;
end
return inherited;
end
published //属性
property Items read GetItems;
property ItemCount read GetItemCount;
@ -574,23 +584,65 @@ type ttreelistwnd = class(TCustomScrollControl)
end
end
type TTreeSelCHngedEvent=class(tuieventbase)
type tm_nodeseling=class(tuieventbase)
{**
@explan(说明) 导航选择改变消息%%
@explan(说明) 节点选择正在改变%%
**}
function create(m,w,l,h);override;
function create(m,ito,itn,h);override;
begin
inherited;
ItemOld := ito;
ItemNew := itn;
item := itn;
end
function expandinfo();override;
begin
r := array();
i := 0;
r[i++] := array("name":"itemold","alias":"node","type":"tcustomtreectlnode");
r[i++] := array("name":"itemnew","alias":"nselnode","type":"tcustomtreectlnode");
r[i++] := array("name":"skip","alias":"stopchang","type":"bool","var":true);
return r;
end
ItemOld;
ItemNew;
Item;
end
type tm_nodeseled=class(tm_nodeseling)
{**
@explan(说明) 节点选择成功改变%%
**}
function create(m,ito,itn,h);override;
begin
ItemOld := ito;
ItemNew := itn;
item := itn;
end
function expandinfo();override;
begin
r := inherited;
r := r[0:length(r)-2];
return r;
end
ItemOld;
ItemNew;
Item;
Item;
end
type tm_nodechang = class(tuieventbase)
{**
@param(ItemOld)(TcustomTreeCtlNode) 旧的节点 %%
@param(ItemNew)(TcustomTreeCtlNode) 新节点 %%
@param(Item)(TcustomTreeCtlNode) 当前节点 %%
@explan(说明) 节点改变消息%%
**}
end
function create(m,w,l,h);
begin
Item := w;
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"Item","alias":"node","type":"tcustomtreectlnode");
return r;
end
Item;
end
type TcustomTreeCtlNode = class(tsluibase) //树结点
{**
@explan(说明) 树结点 %%
@ -1617,10 +1669,7 @@ type TcustomTreeCtl = class(ttreelistwnd)
begin
if FonEmptyNodeExapanding then
begin
e := new TTreeSelCHngedEvent(0,0,0,0);
e.item := pm;
e.ItemNew := pm;
e.ItemOld := pm;
e := new tm_nodechang(0,pm,0,0);
CallMessgeFunction(FonEmptyNodeExapanding,self(true),e);
end
end
@ -1832,6 +1881,16 @@ type TcustomTreeCtl = class(ttreelistwnd)
dc.pen.color := rgb(171,173,179);
dc.draw("polyline",ls);
end
function GetPreferredSize(w,h);override;
begin
if csDesigning in ComponentState then
begin
w := 100;
h := 125;
return ;
end
return inherited;
end
published //属性
property CurrentNode read FCurrentNode write setcurrentnode; //20221118 加上写
property selectionColor:color read FselectionColor write SetselectionColor;
@ -1970,12 +2029,14 @@ type TcustomTreeCtl = class(ttreelistwnd)
t1 := FCurrentNode;
//if t1 then InvalidateItem(t1,false);
//InvalidateItem(it,false);
ne := new TTreeSelCHngedEvent(0,0,0,0);
ne.ItemOld := t1;
ne.ItemNew := it;
ne.Item := it;
//ne := new TTreeSelCHngedEvent(0,0,0,0);
//ne.ItemOld := t1;
//ne.ItemNew := it;
//ne.Item := it;
ne := new tm_nodeseling(nil,t1,it);
CallMessgeFunction(FOnSelChanging,self(true),ne);
if ne.Skip then return true;
ne := new tm_nodeseled(nil,t1,it);
FCurrentNode := it;
CallMessgeFunction(FOnSelChanged,self(true),ne);
end

208
funcext/tvclib/utvclgraphics.tsf
View File

@ -207,7 +207,7 @@ app := initializeapplication();
app.createform(class(tfm),fm);
fm.show();
app.run();
type tfm = class(tvcform)
type tfm = class(tvcform,tg_const)
function create(aowner);
begin
inherited;
@ -234,10 +234,10 @@ type tfm = class(tvcform)
line.lineinfo.color := 0xff0000;
line.markinfo.bkcolor := 0x00ff00;
line.markinfo.color := 0x0000ff;
line.mark_mode := "on";
line.mark_mode := tgc_on;
line.markinfo.size := 30;
line.markinfo.style := line.tgc_mks_pentagram;
line.polyline_style := line.tgc_LS_staircase;
line.markinfo.style := tgc_mks_pentagram;
line.polyline_style := tgc_LS_staircase;
d := array();
idx := 0;
for i:= -pi() to pi() step 0.2 do
@ -256,7 +256,7 @@ app := initializeapplication();
app.createform(class(tfm),fm);
fm.show();
app.run();
type tfm = class(tvcform)
type tfm = class(tvcform,tg_const)
function create(aowner);
begin
inherited;
@ -280,7 +280,7 @@ type tfm = class(tvcform)
axs.axises(1).lineinfo.color := 0x00ff00;
sf := new tg_my_surf();
sf.lineinfo.color := 0x0000ff;
sf.lineinfo.style := sf.tgc_BS_SOLID;
sf.lineinfo.style := tgc_BS_SOLID;
sf.graph_data := get_surf_data();
sf.parent := axs;
return ;
@ -388,7 +388,7 @@ app := initializeapplication();
app.createform(class(tfm),fm);
fm.show();
app.run();
type tfm = class(tvcform)
type tfm = class(tvcform,tg_const)
function create(aowner);
begin
inherited;
@ -402,7 +402,7 @@ type tfm = class(tvcform)
//////////设置坐标轴属性////////////////////////
axs := new tg_axes();
axs.box := true;
axs.figure := fg.figure;
axs.figure := fg;
axs.title.text := "hello pie ";
axs.axises(1).tics_color := 0x0000ff;
axs.axises(1).fontinfo.size := 8;
@ -421,7 +421,7 @@ type tfm = class(tvcform)
for i,v in args do
begin
line := new tg_Polyline();
line.polyline_style := line.tgc_LS_filled;
line.polyline_style := tgc_LS_filled;
line.closed := true;
c := (i=2)?1.1:1;
line.graph_data := 1+get_pie_lines(v[0],v[1],i=prominentidx,prominentrate);
@ -459,7 +459,7 @@ app := initializeapplication();
app.createform(class(tfm),fm);
fm.show();
app.run();
type tfm = class(tvcform)
type tfm = class(tvcform,tg_const)
function create(aowner);
begin
inherited;
@ -504,7 +504,7 @@ type tfm = class(tvcform)
gtx.text := array("按住鼠标左键","移动我");
gtx.data := array(0.3,0.2);
//处理鼠标按下
gtx.addEventListener("mouse_down",function(e)begin
gtx.addEventListener(evt_mouse_down,function(e)begin
fdragtext := e.target;
ftextinitpos := fdragtext.data;
x := e.cvsx;y := e.cvsy;
@ -512,7 +512,7 @@ type tfm = class(tvcform)
fmousedownpos := array(x1,y1);
end);
//移动标签
fg.addEventListener("mouse_move",function(e)begin
fg.addEventListener(evt_mouse_move,function(e)begin
if fdragtext then
begin
e.stoppropagation();
@ -524,7 +524,7 @@ type tfm = class(tvcform)
end
end ,true);
//处理鼠标松开
fg.addEventListener("mouse_up",function(e)begin
fg.addEventListener(evt_mouse_up,function(e)begin
if fdragtext then
begin
e.stoppropagation();
@ -548,12 +548,12 @@ type tfm = class(tvcform)
fhitidx := r;
return r>=0;
end
line.addEventListener("mouse_out",function(e)begin
line.addEventListener(evt_mouse_out,function(e)begin
if e.eventPhase<>2 then return ;
fmovetip.Visible := false;
e.stoppropagation();
end,true);
line.addEventListener("mouse_move",function(e)
line.addEventListener(evt_mouse_move,function(e)
begin
if e.eventPhase<>2 then return ;
e.stoppropagation();
@ -638,18 +638,24 @@ end }
type tg_WinControl = class(tcustomcontrol,tg_figure_container) //绘图窗口
function create(AOwner);
begin
if not(s_flush_interval>9) then
begin
s_flush_interval := 150;
ftgwindows := array();
end
class(tcustomcontrol).create(AOwner);
width := 300;
height := 300;
class(tg_figure_container).create();
fg_timer := new unit(utslvclstdctl).tcustomtimer(self);
fg_timer.Interval := 300;
fg_timer.Interval := s_flush_interval;
fg_timer.Ontimer := thisfunction(figure_need_fresh);
ffigureprepared := false;
ffigure.rec_getter := function()begin
return clientrect;
end
ffigure.fresh_caller := thisfunction(flushfigure);
ftgwindows[length(ftgwindows)] := makeweakref(self(true));
end
function flushfigure();
begin
@ -692,10 +698,35 @@ type tg_WinControl = class(tcustomcontrol,tg_figure_container) //
if ffigure then
begin
d := e_2_array(e,evt_mouse_down);
if ffigure.executecommand(evt_mouse_down,d)=1 then e.skip := true;
if ffigure.executecommand(evt_mouse_down,d)=1 then e.skip := true;
SetFocus();
end
//echo "\r\n",functionname(),tostn(array(xy,bt,sh));
end
function KeyDown(o,e);override;
begin
if ffigure then
begin
d := ek_2_array(e,evt_key_down);
if ffigure.executecommand(evt_key_down,d)=1 then e.skip := true;
end
end
function keyup(o,e);override;
begin
if ffigure then
begin
d := ek_2_array(e,evt_key_up);
if ffigure.executecommand(evt_key_up,d)=1 then e.skip := true;
end
end
function keypress(o,e);override;
begin
if ffigure then
begin
d := ek_2_array(e,evt_key_press);
if ffigure.executecommand(evt_key_press,d)=1 then e.skip := true;
end
end
function MouseMove(o,e);override;
begin
if ffigure then
@ -729,16 +760,58 @@ type tg_WinControl = class(tcustomcontrol,tg_figure_container) //
function Recycling();override;
begin
ffigure:=nil;
for i := 0 to length(ftgwindows)-1 do
begin
if ftgwindows[i] =self then
begin
deleteindex(ftgwindows,i);
break;
end
end
inherited;
end
class function set_sys_flush_interal(itv); //设置所有窗口的刷新间隔
begin
if itv>9 and itv<>s_flush_interval then
begin
s_flush_interval := itv;
for i,v in ftgwindows do
begin
v.flash_interval := itv;
end
end
end
property flush_interval read get_interval write set_interval; //当前窗口的刷新间隔
private
function get_interval();
begin
return fg_timer.Interval;
end
function set_interval(itv);
begin
return fg_timer.Interval := itv;
end
function figure_need_fresh(o,e); //定时刷新
begin
o.stop();
if not ffigureprepared then return ; //没有准备好
if f_validate_doing then return;
InvalidateRect(nil,false);
InvalidateRect(nil,false);
end
function ek_2_array(e,tp);
begin
d := array();
st := e.shiftstate();
sft := 0x0 in st;
sctl := 0x2 in st;
d := array(
"type":tp,
"shift":sft,
"ctrl":sctl,
"key":e.char,
"keycode":e.CharCode,
);
return d;
end
function e_2_array(e,tp);
begin
@ -757,6 +830,8 @@ type tg_WinControl = class(tcustomcontrol,tg_figure_container) //
return d;
end
private
static s_flush_interval;
static ftgwindows;
fmovecnt;
fg_timer;
f_validate_doing;
@ -790,6 +865,18 @@ type tg_figure = class(tg_evet_conainter) //
function executecommand(cmd,p);
begin
case cmd of
evt_key_down:
begin
return cmd_key_event(evt_key_down,p);
end
evt_key_up:
begin
return cmd_key_event(evt_key_up,p);
end
evt_key_press:
begin
return cmd_key_event(evt_key_press,p);
end
"figure_need_fresh":
begin
fresh();
@ -950,7 +1037,24 @@ type tg_figure = class(tg_evet_conainter) //
r[len-i] := v;
end
return r;
end
end
function cmd_key_event(evtname,p) ;
begin
if not fMouseOnOBJ then return ;
d := p;
d["istrusted"] := true;
d["bubbles"] := true;
onds := array();
nnd := fMouseOnOBJ;
while nnd do
begin
onds[length(onds)] := nnd;
nnd := nnd.parent;
end
evt := new tg_evt_key(evtname,d);
dispatchEvent(evt,onds);
return evt.stoppropagationed or evt.defaultPrevented; //是否停止
end
function cmd_mouse_event(evtname,p);
begin
d := p;
@ -987,7 +1091,8 @@ type tg_figure = class(tg_evet_conainter) //
end
fMouseOnOBJ := ninnode;
evt := new tg_evt_mouse(evt_mouse_in,d); //处理mouse in
dispatchEvent(evt,nds);
dispatchEvent(evt,nds);
return true;
end
end else
begin
@ -1176,6 +1281,7 @@ type tg_axes = class(tg_base) //
cvs.axesrec := r;
cvs.axesvector := get_top_outer_points();
//paint(cvs);
cvs.executecommand("painter",self(true));
paint_grid(cvs);
inherited;
cvs.axesunclip();
@ -2351,7 +2457,11 @@ type tg_canvas = class(TcustomCanvas) //
ffigurergn.rect := fg.rect();
faxesrgntemp := new TRGNPOLY();//new TRGNRECT();
//ffigurergn.
end
end
function executecommand(cmd,p);override;
begin
if cmd ="painter" then fpainter := p;
end
function axesclip(); //裁剪坐标系范围
begin
if faxesrgn then
@ -2386,6 +2496,23 @@ type tg_canvas = class(TcustomCanvas) //
property figure:tg_figure read ffigure; //绘制区域
property axesvector read faxesvector write set_clip_vector; //坐标系区域
property axesrec read FaxesRec write set_clip_rect; //坐标系矩形区域
property painter read fpainter;
////////////绘制相关//////////////////////////////////////////////
function tg_movto(x,y,z);//移动
begin
if not fpainter then return ;
if fpainter.zoom_to_xyz(x,y,z,x0,y0) then return moveto(x0,y0);
end
function tg_lineto(x,y,z);//画线
begin
if not fpainter then return ;
if fpainter.zoom_to_xyz(x,y,z,x0,y0) then return lineto(x0,y0);
end
function tg_trans(a,x,y,z);//旋转
begin
if not fpainter then return ;
if fpainter.zoom_to_xyz(x,y,z,x0,y0) then return trans(a,x0,y0);
end
private
FaxesRec;
faxesvector;
@ -2395,6 +2522,7 @@ type tg_canvas = class(TcustomCanvas) //
faxesrgntemp;
ffigurerect;
[weakref]ffigure;
[weakref]fpainter;
private
function set_clip_rect(rec);
begin
@ -3076,12 +3204,12 @@ type tg_text = class(tg_base)
if not zoom_to_xyz(fdata[0],fdata[1],fdata[2],x,y) then return ;
if clip_state=tgc_on or ((p:=parent) and p.clip_state=tgc_on) then
begin
bx := axes.zoom_box;
{bx := axes.zoom_box;
vj := fdata;
if vj[0]<bx[0,0] or vj[1]<bx[1,0] or vj[2]<bx[2,0] or vj[0]>bx[0,1] or vj[1]>bx[1,1] or vj[2]>bx[2,1] then
begin
return ;
end
end }
cvs.axesclip();
end
else cvs.axesunclip();
@ -4393,7 +4521,8 @@ type tg_base = class(TNode,tg_evet_conainter) //
end
function paint_pre(cvs);virtual;
begin
begin
cvs.executecommand("painter",self(true));
paint(cvs);
lgns := array();
for i := 0 to NodeCount-1 do
@ -4697,6 +4826,9 @@ type tg_const = class()
//static const tgc_out_lower_right = "out_lower_right";
//static const tgc_out_lower_left = "out_lower_left";
//////////////
static evt_key_down = "key_down";
static evt_key_up = "key_up";
static evt_key_press = "key_press";
static evt_mouse_down = "mouse_down";
static evt_mouse_wheel = "mouse_wheel";
static evt_mouse_move = "mouse_move";
@ -4804,8 +4936,8 @@ type tg_evt_mouse = class(tg_evt_custom) //
fdouble := pms["double"];
fbutton := pms["button"];
fshift := pms["shift"];
fctl := pms["ctrl"];
fctl := pms["fdelta"];
fctrl := pms["ctrl"];
fdelta := pms["fdelta"];
end
end
property cvsx read fcvsx;
@ -4825,6 +4957,28 @@ type tg_evt_mouse = class(tg_evt_custom) //
fctrl;
fbutton;
end
type tg_evt_key = class(tg_evt_custom) //key消息
function create(etyp,pms);
begin
inherited;
if ifarray(pms) then
begin
fshift := pms["shift"];
fctrl := pms["ctrl"];
fkey := pms["key"];
fkeycode := pms["keycode"];
end
end
property key read fkey;
property shift read fshift;
property ctrl read fctrl;
property keycode read fkeycode;
private
fshift;
fctrl;
fkey;
fkeycode;
end
implementation
///////////事件存储对象///////////////////////

3
funcext/tvclib/uvclthreadworker.tsf
View File

@ -172,7 +172,7 @@ type t_worker_host = class(t_worker_base)
{**
@param(OnMessage)(function[TThreadWorker,data]) 消息回调 %%
@param(OnStart)(function[TThreadWorker]) 子线程启动 %%
@param(OnError)(function[TThreadWorker,d]) 子线程启动 %%
@param(OnError)(function[TThreadWorker,d]) 子线程运行错误%%
**}
function terminate();override;
begin
@ -576,6 +576,7 @@ begin
end
function iffuncptr(fn);
begin
return datatype(fn) in array(7,37);
//return datatype(fn)=7;
return ifobj(fn);
end

362
funcext/tvclib/uvcpropertytypespersistence.tsf
View File

@ -6,65 +6,39 @@ uses utslvclauxiliary;//,utslvclgdi;
**}
////////////tmf文件相关//////////////////////////////////////////////
/////////////tmf字符串解析///////////////////////
function RegComponentPropertyType(vc);
function RegComponentPropertyType(vc);
function GetComponentPropertyType(n);
type TTmfParserbase = class
{**
@explan(说明) 解析基类,提供基础类型,提供类型常量
目前使用的常量有 TT_NUM,TT_BIN,TT_STR,TT_SYM%%
**}
Static Fsok;
static TT_NUM;//数字
static TT_LLB;//大括号
static TT_RLB;//大括号
static TT_LSB; //(
static TT_RSB; //)
static TT_STR;//字符串
static TT_SYM;//符号
static TT_POI;//点 .
static TT_SIG;// : + - :< > =
static TT_BNK;//空白 \r \n \t
static TT_ITEM;
static TT_RMB;
static TT_LMB;
static TT_SET;
static TT_COLL;
static TT_LIST;
static TT_BIN;
static TT_BOOL;
static TT_IDENT;
static TT_HEX;
static TT_COMP;
static const TT_NUM = 1; //数字
static const TT_LLB = 2; //大括号
static const TT_RLB = 3; //大括号
static const TT_LSB = 4; //(
static const TT_RSB = 5; //)
static const TT_STR = 6; //字符串
static const TT_SYM = 7; //符号
static const TT_POI = 8; //点 .
static const TT_SIG = 9; // : + - :< > =
static const TT_BNK = 10; //空白 \r \n \t
static const TT_ITEM = 11;
static const TT_LMB = 12;
static const TT_RMB = 13;
static const TT_SET = 14;
static const TT_HASH = 15;
static const TT_COLL = 0x10;
static const TT_BIN = 0x11;
static const TT_BOOL = 0x12;
static const TT_LIST = 0x13;
static const TT_IDENT = 0x14;
static const TT_HEX = 0x15;
static const TT_COMP = 0x16;
public
class function sinit();virtual;
begin
if not Fsok then
begin
TT_NUM := 1; //数字
TT_LLB := 2; //大括号
TT_RLB := 3; //大括号
TT_LSB := 4; //(
TT_RSB := 5; //)
TT_STR := 6; //字符串
TT_SYM := 7; //符号
TT_POI := 8; //点 .
TT_SIG := 9; // : + - :< > =
TT_BNK := 10; //空白 \r \n \t
TT_ITEM := 11;
TT_LMB := 12;
TT_RMB := 13;
TT_SET := 14;
TT_HASH := 15;
TT_COLL := 0x10;
TT_BIN := 0x11;
TT_BOOL := 0x12;
TT_LIST := 0x13;
TT_IDENT := 0x14;
TT_HEX := 0x15;
TT_COMP := 0x16;
Fsok := true;
end
end
end
class function PError(msg,lev);
begin
//messagebox(msg,"解析错误",1);
@ -73,7 +47,7 @@ type TTmfParserbase = class
begin
sinit();
end
end
type TTmfParserToken = class(TTmfParserbase)
{**
@ -89,8 +63,6 @@ type TTmfParserToken = class(TTmfParserbase)
FTokens;
FSplitter; //分隔符
FSyms; //符号
FNumberChar;
FHexChar;
Function SetScript(S);//设置文本
begin
IF FScript <> S then
@ -360,9 +332,6 @@ type TTmfParserToken = class(TTmfParserbase)
//Ffloat := FNumbers union array(".");
FSplitter := array(' ','\t',"\r","\n",";",",");
FSyms := array("=",":","(",")","<",">","[","]");
FNumberChar := inttostr(0 -> 9);
FHexChar := FNumberChar union array("a","b","c","d","e","f",
"A","B","C","D","E","F");
end
property Script read FScript write SetScript;
{**
@ -511,26 +480,67 @@ type TTmfParser = class(TTmfParserbase)
end
function gettree2(); //获得继承关系树
begin
tx := mtic;
d := gettreeasobject();
if d then
begin
d.setinhertedpaths(fssourdirs);//设置路径
d.initinherited();
d.initinherited(); //解析继承的数据文件信息
d.addinode(d.finheritednode); //合并继承的信息
getnodelist(d,lst,dlist); //获取冲突的对象
for i,v in dlist do //删除冲突的成员
begin
try
v["p"].fobjects.deleteindex(v["n"]);
except
end;
end
return object2tree2(d);
end
end
function inheritedcoy(n,t,ht);
function getnodelist(d,lst,dlist); //获取排除对象列表,以及冲突的对象
begin
d := gettreeasobject();
if d then
begin
d.setinhertedpaths(fssourdirs);//设置路径
d.initinherited();
return d.inheritedstr(n,t,ht,0);
end
return "";
if not ifarray(lst) then lst := array();
if not ifarray(dlist) then dlist := array();
fos := d.fobjects;
for i,v in fos.IndexNames() do
begin
vd := fos[v];
if lst[v] then //父类中的优先级大于最新添加的,因为新加入的不能和原有的重名,如果积累中添加了,子类也应该被删掉
begin
if lst[v,"i"] and not(vd.ifinherited) then //删除当前这个
begin
dlist[length(dlist)] := array("p":d,"n":v);
end else
if vd.ifinherited and not(lst[v,"i"]) then //删除上一个
begin
dlist[length(dlist)] := lst[v,array("p","n")];
lst[v] := array("p":d,"nd":vd,"n":v,"i":vd.ifinherited,"ct":vd.inheritedcount);
end else
if not(vd.ifinherited) and not(lst[v,"i"]) then //删除当前
begin
dlist[length(dlist)] := array("p":d,"n":v);
end else
if vd.ifinherited<lst[v,"ct"] then //删除当前
begin
dlist[length(dlist)] := array("p":d,"n":v);
end else //删除上一个
begin
dlist[length(dlist)] := lst[v,array("p","n")];
lst[v] := array("p":d,"nd":vd,"n":v,"i":vd.ifinherited,"ct":vd.inheritedcount);
end
end else
begin
lst[v] := array("p":d,"nd":vd,"n":v,"i":vd.ifinherited,"ct":vd.inheritedcount);
end
getnodelist(vd,lst,dlist);
end
end
function inheritedcopy(n,t,ht); //构造继承的tfm文本
begin
return inheritedstr(n,t,ht);
end
function object2tree2(t); //获得继承关系
function object2tree2(t); //获得继承关系数组
begin
r := array();
r["inherited"] := t.ifinherited;
@ -551,23 +561,21 @@ type TTmfParser = class(TTmfParserbase)
objs[v] := object2tree2(fos[v]);
end
r["property"] := ps;
r["object"] := objs;
r["object"] := objs;
return r;
end
function gettreeasobject();
function gettreeasobject();//当前tfm对象
begin
if ftreeobj then return ftreeobj;
gettree();
if FTree then
begin
//ttfmnode
ftreeobj := createndeobjects(FTree);
return ftreeobj;
end
return nil;
end
function createndeobjects(d);
function createndeobjects(d);//构造tfm对象树
begin
if ifarray(d) then
begin
@ -661,7 +669,7 @@ type TTmfParser = class(TTmfParserbase)
end
end
end
function createobj();
function createobj(); //解析对象
begin
{**
@explan(说明) 获取对象 %%
@ -672,13 +680,12 @@ type TTmfParser = class(TTmfParserbase)
if (tv="object" or tv="inherited") and(tt <> TT_STR) then
begin
r := getobject();
if tv="inherited" then
r["inherited"] := true;
r["inherited"] := (tv="inherited")?true:false;
return r;
end
end
end
function getobject();
function getobject();//解析对象内容
begin
{**
@explan(说明) 获得对象 %%
@ -710,43 +717,46 @@ type TTmfParser = class(TTmfParserbase)
begin
ctoken(tv,tt);
lx := tt;
{if tv="item" and(tt <> TT_STR)then
if tt<>TT_STR then
begin
lx := TT_ITEM;
val := getabitem();
end else}
if tv="[" and(tt <> TT_STR)then
case tv of
"[":
begin
lx := TT_SET;
val := getset();
end
"<":
begin
val := getabitem(tv,fff); // getab();
if fff then lx := TT_COLL;
else lx := TT_ITEM; //TT_COLL;
end
"(":
begin
val := getsb();
lx := TT_LIST;
end
"{":
begin
val := getlb();
lx := TT_BIN;
end
"true":
begin
val := true;
lx := TT_NUM;
end
"false":
begin
val := false;
lx := TT_NUM;
end
else val := tv;
end ;
end else
begin
lx := TT_SET;
val := getset();
end else
if tv="<" and(tt <> TT_STR)then
begin
val := getabitem(tv,fff); // getab();
if fff then lx := TT_COLL;
else lx := TT_ITEM; //TT_COLL;
end else
if tv="(" and(tt <> TT_STR)then
begin
val := getsb();
lx := TT_LIST;
end else
if tv="{" and(tt <> TT_STR)then
begin
val := getlb();
lx := TT_BIN;
end else
if tv="true" and(tt <> TT_STR)then
begin
val := true;
lx := TT_NUM;
end else
if tv="false" and(tt <> TT_STR)then
begin
val := false;
lx := TT_NUM;
end else
val := tv;
val := tv;
end
end
function getmembers();
begin
@ -821,7 +831,6 @@ type TTmfParser = class(TTmfParserbase)
begin
ctoken(tv,tt);
if tv="]" and tt <> TT_STR then return r;
//if tv="item" and tt <> TT_STR then r[rl++]:= array("value":getabitem(tv),"type":TT_ITEM);
else if tv="<" and tt <> TT_STR then
begin
v := getabitem(tv,fff);
@ -835,7 +844,6 @@ type TTmfParser = class(TTmfParserbase)
function getabitem(tp,ifitem);
begin
if not ifstring(tp)then endtp := "end";
//else if tp="item" then endtp := "end";
else if tp="<" then endtp := ">";
else PError("dict错误",1);
r := array();
@ -844,7 +852,7 @@ type TTmfParser = class(TTmfParserbase)
while whileok() do
begin
ctoken(tv,tt);
if tv=endtp {"end"}and tt <> TT_STR then return r;
if tv=endtp and tt <> TT_STR then return r;
p := tv;
ptt := tt;
ctoken(tv,tt);
@ -854,13 +862,7 @@ type TTmfParser = class(TTmfParserbase)
if ifnil(val)or ifnil(lx)then PError("item无值",1);
r[rl++]:= array("name":p,"value":val,"type":lx);
end else
{if p="item" and ptt <> TT_STR and(length(r)<1)then
begin
ifitem := true;
btoken(2);
return getab();
end else}
PError("item没有=",1);
PError("item没有=",1);
end
end
function getab();
@ -877,10 +879,6 @@ type TTmfParser = class(TTmfParserbase)
begin
return r;
end else
{if tv="item" and tt <> TT_STR then
begin
r[rl++]:= getabitem();
end else}
begin
return PError("<>内容错误",1);
end
@ -905,8 +903,7 @@ type TTmfParser = class(TTmfParserbase)
begin
return r;
end else
{if tv="item" and tt <> TT_STR then r[rl++]:= array("value":getabitem(tv),"type":TT_ITEM);
else }if tv="<" and tt <> TT_STR then
if tv="<" and tt <> TT_STR then
begin
v := getabitem(tv,fff);
lx := fff?TT_COLL:TT_ITEM;
@ -2275,11 +2272,67 @@ type ttfmnode = class()
end
function create(t,n);
begin
inheritedcount := 0;
fnodename := n;
fnodetype := t;
fpropertys := new tstrindexarray();
fobjects := new tstrindexarray();
finheritedpaths := array();
end
function addinode(nd);
begin
//if not nd then return ;
if nd and nd.finheritednode then nd.addinode(nd.finheritednode);
for i,v in fobjects.IndexNames() do
begin
ov := fobjects[v];
if ov.ifinherited then //继承的控件
begin
if ifobj(nd) then
begin
fd := nd.getnodebyname(v); //ov.fnodename
if fd then
begin
ov.inheritedcount++;
ov.finheritednode :=fd;
end else //不在继承源头,删除
begin
fobjects.deleteindex(v);
end
end else //不在继承源头,删除
begin
fobjects.deleteindex(v);
end
end else
begin
end
end
if nd then
begin
for i,v in nd.getnodenames() do //添加父窗口控件
begin
ov := fobjects[v];
nnd := nd.getnodebyname(v);
if not ov then
begin
fobjects[v] := nnd.copyinh(); //复制属性
end else ov.addinode(nnd); //添加属性
end
end
end
function copyinh();//继承拷贝
begin
r := new ttfmnode(fnodetype,fnodename);
for i,v in fobjects.IndexNames() do
begin
vv := fobjects[v];
vi := vv.copyinh();
r.addobject(vi);
end
r.finheritednode := self;
r.ifinherited := true;
return r;
end
function get_inherited(data);
begin
@ -2290,9 +2343,10 @@ type ttfmnode = class()
begin
nd.setinhertedpaths(finheritedpaths);
nd.initinherited();
finheritednode := nd;
//addinheritednode(nd); 此处屏蔽
end
finheritednode := nd;
addinheritednode(nd);
end
function initinherited();
begin
@ -2330,6 +2384,9 @@ type ttfmnode = class()
end
function addinheritednode(nd); //处理继承的节点
begin
///////////////查找空白/////////////////////////////////////
///////////////////////////////////////////////////////////////
for i,v in fobjects.IndexNames() do
begin
ov := fobjects[v];
@ -2350,8 +2407,15 @@ type ttfmnode = class()
fobjects.deleteindex(v);
end
end
ov.addinheritednode(nd);
end
if fd then
ov.addinheritednode(fd);
end
end
function getnodenames();
begin
return fobjects.IndexNames();
end
function getnodebyname(sb);//获得节点
begin
@ -2434,29 +2498,8 @@ type ttfmnode = class()
r[i] := fpropertys[v];
end
return r;
end
function inheritedstr(n,t,ht,h);
begin
if ifnil(n) then n := fnodename;
if ifnil(t) then t := fnodetype;
ws := "";
if not(h>=0) then h := 0;
for i:= 0 to h-1 do
begin
ws+=" ";
end
r := ws+"inherited "+n+":"+t;
if ht then r+="("+ht+")";
r+="\r\n";
for i,v in fobjects.IndexNames() do
begin
vo := fobjects[v];
r+=vo.inheritedstr(nil,nil,nil,h+1);
end
r+="\r\n";
r+=ws+"end\r\n";
return r;
end
end
inheritedcount;
ifinherited;
finheritedname;
finheritednode;
@ -2464,10 +2507,17 @@ type ttfmnode = class()
fnodename;
fobjects;
private
fpropertys;
fpropertys;
finheritedpaths;
end
function inheritedstr(n,t,ht);
begin
r := "inherited "+n+":"+t;
if ht then r+="("+ht+")";
r+="\r\n";
r+="end\r\n";
return r;
end
function tablelines(str,n);
begin
lines := str2array(str,"\r\n");

BIN
tsleditor.exe
View File

Binary file not shown.

BIN
tslvcltool.exe
View File

Binary file not shown.