diff --git a/Help/designerUserGuid.CHM b/Help/designerUserGuid.CHM index 10a57a1..35d0248 100644 Binary files a/Help/designerUserGuid.CHM and b/Help/designerUserGuid.CHM differ diff --git a/d_examples/desktop.ini b/d_examples/desktop.ini new file mode 100644 index 0000000..d957fd1 --- /dev/null +++ b/d_examples/desktop.ini @@ -0,0 +1,4 @@ +[ViewState] +Mode= +Vid= +FolderType=Generic diff --git a/designer/ctl_mgr/t_compile_config.tfm b/designer/ctl_mgr/t_compile_config.tfm index 6e4a4e9..0c1eaf0 100644 --- a/designer/ctl_mgr/t_compile_config.tfm +++ b/designer/ctl_mgr/t_compile_config.tfm @@ -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 diff --git a/designer/ctl_mgr/t_compile_config.tsf b/designer/ctl_mgr/t_compile_config.tsf index 237eb51..0d7cc78 100644 --- a/designer/ctl_mgr/t_compile_config.tsf +++ b/designer/ctl_mgr/t_compile_config.tsf @@ -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); diff --git a/designer/ctl_mgr/t_editor_color_mgr.tfm b/designer/ctl_mgr/t_editor_color_mgr.tfm index 35a5d55..4104cb8 100644 --- a/designer/ctl_mgr/t_editor_color_mgr.tfm +++ b/designer/ctl_mgr/t_editor_color_mgr.tfm @@ -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 diff --git a/designer/udesignerproject.tsf b/designer/udesignerproject.tsf index 6fcc988..739e0f4 100644 --- a/designer/udesignerproject.tsf +++ b/designer/udesignerproject.tsf @@ -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=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 ctARect[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 diff --git a/designer/utslcodeformat.tsf b/designer/utslcodeformat.tsf index 7e0d674..924fd47 100644 --- a/designer/utslcodeformat.tsf +++ b/designer/utslcodeformat.tsf @@ -133,6 +133,9 @@ type TFormatParser = class "%%","(*","//","#!", "", "?>", + "...", + ":>",":<",":<>", ":==",":>=",":<=", + "::>","::<","::<>", "::==","::>=","::<=", //"0x","0O","0b", ); TslSyn2 := array("div=","union2=","intersect=","outersect=","minus=","end.",); diff --git a/designer/utslsynmemo.tsf b/designer/utslsynmemo.tsf index 8c3aedf..9a7e023 100644 --- a/designer/utslsynmemo.tsf +++ b/designer/utslsynmemo.tsf @@ -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<%/") then begin if ttk then @@ -1248,8 +1253,8 @@ type TTslSynHighLighter = class(TSynHighLighter) end function GetLineTokens(idx);override; begin - if idx1 then exit; if not nd.owner then exit; d := nd.owner.Designer; @@ -550,214 +555,245 @@ type TDComponent = class() {** @explan(说明) 构造控件的构造函数 %% **} + fisiherted := false; Fexludepropertys := array(); fiscontainerdcmp := true; feventnametable := array(); - +/////////////////////////////////////////////////////////////// + pm := array(); + pm[0] := ComponentClass(); + pm[1] := new unit(utslvclevent).TMMouse(); ev := array( "event":"onmouseup", - "name":"ms_up", - "virtual":true, - "param":array("o","e"), - "body": -" {** - @explan(说明) 鼠标按下 %% - @param(o)(control)控件 %% - @param(e)(TMMouse) 鼠标消息对象 %% - **} - if e.button()=mbLeft then - begin - echo '\\r\\n:左键'; - end else - if e.button()=mbRight then - begin - echo '\\r\\n:右键'; - end else - if e.button()=mbMiddle then - begin - echo '\\r\\n:滚轮'; - end - echo '\\r\\npos:',e.xpos,'===',e.ypos; - inherited; -" - ); + "name":"mouseup", + "param":pm, + "body":" {** + @explan(说明) 鼠标弹起 %% + **}"); SetDefalutEvent(ev,true); - +/////////////////////////////////////////////////////////////// ev := array( "event":"onmousedown", - "name":"ms_down", - "virtual":true, - "param":array("o","e"), - "body": -" {** - @explan(说明) 鼠标按下 %% - @param(o)(control)控件 %% - @param(e)(TMMouse) 鼠标消息对象 %% - **} - if e.button()=mbLeft then - begin - echo '\\r\\n:左键'; - end else - if e.button()=mbRight then - begin - echo '\\r\\n:右键'; - end else - if e.button()=mbMiddle then - begin - echo '\\r\\n:滚轮'; - end - if e.shiftdouble() then - begin - echo '\\r\\n:双击'; - end - echo '\\r\\npos:',e.xpos,'===',e.ypos; - inherited; -" - ); - SetDefalutEvent(ev,true); + "name":"mousedown", + "param":pm, + "body":" {** + @explan(说明) 鼠标按下 %% + **}"); + SetDefalutEvent(ev,true); +/////////////////////////////////////////////////////////////// + pm[1] := new unit(utslvclevent).tmm_move(); ev := array( "event":"onmousemove", - "name":"ms_move", - "virtual":true, - "param":array("o","e"), + "name":"mousemove", + "param":pm, "body": " {** - @explan(说明) 鼠标移动 %% - @param(o)(control)控件 %% - @param(e)(TMMouse) 鼠标消息对象 %% - **} - echo '\\r\\npos:',e.xpos,'===',e.ypos; - inherited; -" - ); - SetDefalutEvent(ev,true); + @explan(说明) 鼠标移动 %% + **}"); + SetDefalutEvent(ev,true); +/////////////////////////////////////////////////////////////// + pm[1] := new unit(utslvclevent).TMKEY(); ev := array( "event":"onkeyup", "name":"keyup", - "virtual":true, - "param":array("o","e"), + "param":pm, "body": " {** @explan(说明) 按键弹起 %% - @param(o)(control)控件 %% - @param(e)(TMKEY) 按键消息对象 %% - **} - echo '\\r\\nchar:',e.char; - echo '\\r\\nascii:',e.charcode; - if ssShift in e.shiftstate then - begin - echo '\\r\\nshift 按键'; - end - if ssAlt in e.shiftstate then - begin - echo '\\r\\nalt 按键'; - end - if ssCtrl in e.shiftstate then - begin - echo '\\r\\nctrl 按键'; - end - inherited;" - ); + **}"); SetDefalutEvent(ev,true); +/////////////////////////////////////////////////////////////// ev := array( "event":"onkeydown", "name":"keydown", - "virtual":true, - "param":array("o","e"), + "param":pm, "body": " {** - @explan(说明) 按键按下 %% - @param(o)(control)控件 %% - @param(e)(TMKEY) 按键消息对象 %% - **} - echo '\\r\\nchar:',e.char; - echo '\\r\\nascii:',e.charcode; - if ssShift in e.shiftstate then - begin - echo '\\r\\nshift 按键'; - end - if ssAlt in e.shiftstate then - begin - echo '\\r\\nalt 按键'; - end - if ssCtrl in e.shiftstate then - begin - echo '\\r\\nctrl 按键'; - end - inherited;" - ); - SetDefalutEvent(ev,true); - ev := array( + @explan(说明) 按键按下 %% + **}"); + SetDefalutEvent(ev,true); +/////////////////////////////////////////////////////////////// + pm[1] := new unit(utslvclevent).tmk_press(); + ev := array( "event":"onkeypress", "name":"keypress", - "virtual":true, - "param":array("o","e"), + "param":pm, "body": " {** - @explan(说明) 字符消息 %% - @param(o)(control)控件 %% - @param(e)(TMKEY) 按键消息对象 %% - **} - echo '\\r\\nchar:',e.char; - echo '\\r\\nascii:',e.charcode; - if ssShift in e.shiftstate then - begin - echo '\\r\\nshift 按键'; - end - if ssCtrl in e.shiftstate then - begin - echo '\\r\\nctrl 按键'; - end - inherited;" - ); + @explan(说明) 字符消息 %% + **}"); + SetDefalutEvent(ev,true); +/////////////////////////////////////////////////////////////// + pm[1] := new unit(utslvclevent).tmmousewheel(); + ev := array( + "event":"onmousewheel", + "name":"mousewheel", + "param":pm, + "body":""); SetDefalutEvent(ev,true); - ev := array( +/////////////////////////////////////////////////////////////// + pm[1] := new unit(utslvclevent).tmnotif(); + ev := array( "event":"onnotification", - "name":"note", - "virtual":true, - "param":array("o","e"), + "name":"notification", + "param":pm, "body": " {** - @explan(说明) 通知消息 %% - @param(o)(control)控件 %% - @param(e)(tuieventbase) 消息对象,msg成员为通知内容, - 该消息可以通过组件 relnotification(消息内容) - 发送到所有组件,需要处理该消息的组件可以处理 %% + @explan(说明) 通知消息 %% + @param(msg)(any) 通知的内容 %% + **}"); + SetDefalutEvent(ev,true); +/////////////////////////////////////////////////////////////// + pm[1] := new unit(utslvclevent).tmmeasuresize(); + ev :=array( + "event":"ongetpreferredsize", + "name":"getpreferredsize", + "param":pm, + "body": +" {** + @explan(说明) 获取最佳的尺寸 %% **} - - inherited;" - ); + ht := 100; + wd := 200; +" ); SetDefalutEvent(ev,true); +////////////////////////////////////////////////////// ev :=array( "event":"onclick", "name":"clk", - "param":array("o","e"), - "virtual":true, + "param":array(pm[0]), "body": " {** - @explan(说明) 点击回调 %% - @param(o)(tcontrol)选择按钮 %% - @param(e)(tuievent) 消息对象 %% - **} - inherited;" - ); - SetDefalutEvent(ev,true); - ev :=array( - "event":"ongetpreferredsize", - "name":"gprefsize", - "param":array("o","e"), - "virtual":true, - "body": -" {** - @explan(说明) 获取最佳的尺寸 %% - @param(o)(tcontrol)控件 %% - @param(e)(tmmeasuresize) 消息对象 %% + @explan(说明) 点击回调 %% **} - e.width := 50; //宽度 - e.height := 300; //高度 " ); - SetDefalutEvent(ev,true); + SetDefalutEvent(ev,true); +/////////////////////////////////////////////////////////////// + ev :=array( + "event":"onrclick", + "name":"rclk", + "param":array(pm[0]), + "body": +"" ); + SetDefalutEvent(ev,true); +/////////////////////////////////////////////////////// + ev :=array( + "event":"ondblclick", + "name":"dblclk", + "param":array(pm[0]), + "body":"" ); + SetDefalutEvent(ev,true); +/////////////////////////////////////////////////////// + ev :=array( + "event":"onkillfocus", + "name":"killfocus", + "param":array(pm[0]), + "body":"" ); + SetDefalutEvent(ev,true); +////////////////////////////////////////////////////// + ev :=array( + "event":"onsetfocus", + "name":"setfocus", + "param":array(pm[0]), + "body":"" ); + SetDefalutEvent(ev,true); +//////////////////////////////////////////////////////// + ev :=array( + "event":"onfontchanged", + "name":"fontchanged", + "param":array(pm[0]), + "body":""); + SetDefalutEvent(ev,true); +////////////////////////////////////////////////////////// + ev :=array( + "event":"onpaint", + "name":"paint", + "param":array(pm[0]), + "body": +" {** + @explan(说明) 自绘制 %% + **} +" ); + SetDefalutEvent(ev,true); +//////////////////////////////////////////////////////////////////////////// + ev :=array( + "event":"oncreated", + "name":"crt", + "param":array(pm[0]), + "body": +" {** + @explan(说明) 构造 %% + **} +" ); + SetDefalutEvent(ev,true); +////////////////////////////////////////////////////////////////////////// + ev :=array( + "event":"ondestroy", + "name":"destroy", + "param":array(pm[0]), + "body": +" {** + @explan(说明) 销毁 %% + **} +" + ); + SetDefalutEvent(ev,true); +//////////////////////////////////////////////////////////////////////// + pm[1] := new unit(utslvclevent).tmcontextpop(); + ev :=array( + "event":"onpopupmenu", + "name":"popmenu", + "param":pm, + "body": +" {** + @explan(说明) 弹出右键菜单 %% + **} +" ); + SetDefalutEvent(ev,true); +////////////////////////////////////////////////////////////////// + pm[1] := new unit(utslvclevent).tminqurequit(); + ev :=array( + "event":"oninqurequit", + "name":"inqurequit", + "param":pm, + "body": +" {** + @explan(说明) 询问退出 %% + **} +"); + SetDefalutEvent(ev,true); +////////////////////////////////////////////////////////////// + pm[1] := new unit(utslvclevent).tmactivate(); + ev :=array( + "event":"onactivate", + "name":"activate", + "param":pm, + "body": +" {** + @explan(说明) 窗口activate状态切换 %% + **} +"); + SetDefalutEvent(ev,true); +////////////////////////////////////////////////////////////// + ev :=array( + "event":"onsize", + "name":"size", + "param":array(pm[0]), + "body":" {** + @explan(说明) 窗口大小改变 %% + **}"); + SetDefalutEvent(ev,true); +////////////////////////////////////////////////////////////////////// + ev :=array( + "event":"onmove", + "name":"move", + "param":array(pm[0]), + "body":" {** + @explan(说明) 位置改变 %% + **}"); + SetDefalutEvent(ev,true); +////////////////////////////////////////////////////////////////////// if not(AOwner is class(TComponent)) then exit; c := WndClass(); if c is class(TComponent) then @@ -785,7 +821,14 @@ type TDComponent = class() {** @explan(说明)获得所有的属性%% **} - if FCwnd then return excludepro(FCwnd.GetPublishProperties()); + if FCwnd then + begin + ps := FCwnd.GetPublishProperties(); + r := excludepro(ps); + if inheritedparent then return r; + if fisiherted then reindex(r,array("name":nil)); + return r; + end return array(); end function GetPublishEvents();virtual; @@ -844,10 +887,15 @@ type TDComponent = class() begin if TreeNode then begin + pcn :=""; if inheritedparent then begin pcn := "("+inheritedparent+")"; - end else pcn := ""; + end else + begin + if fisiherted then + pcn := "<"; + end TreeNode.caption := v+":"+cn+pcn; end if ifstring(odn) and v then @@ -865,6 +913,18 @@ type TDComponent = class() {** @explan(说明) 设置控件节点被选择时候的操作 %% **} + ///////////////处理节点为page的情况/////////////////////////////////////////// + acwnd := FCwnd; + while (acwnd is class(TWincontrol)) and acwnd.parent do + begin + p := acwnd.parent; + if (p is class(TPageControl)) then + begin + p.cursel := acwnd; + end + acwnd := p; + end + /////////////////////////////////////////////////////// if (FCwnd is class(TWincontrol)) and FCwnd.HandleAllocated() then begin FCwnd._wapi.BringWindowToTop(FCwnd.Handle); @@ -899,7 +959,14 @@ type TDComponent = class() oname := nn;//obj.name; end end - if TreeNode then TreeNode.caption := oname+":"+cn; + if TreeNode then + begin + if not(inheritedparent) and fisiherted then + begin + cn := cn+"<"; + end + TreeNode.caption := oname+":"+cn; + end end return nn; end @@ -907,17 +974,20 @@ type TDComponent = class() begin if ifarray(ev) then hs := createtslfunction(ev); - if not hs then + if not(hs) and not(ndf) then //清除默认 begin FDefaultEvent := nil; return ; end - r := format("type ca = class\r\n%s \r\nend",hs); + r := "type ca = class\r\n "$hs$"\r\nend"; if CheckTslCode(r,err) then begin feventnametable[ev["event"]] := ev; if not ndf then FDefaultEvent := ev["event"]; + end else + begin + //echo tostn(ev),"\r\n",r; end end public @@ -932,17 +1002,13 @@ type TDComponent = class() r := array(); r["name"] := n; r["event"] := n; - r["virtual"] := true; - r["param"] := array("o","e"); + r["param"] := array(ComponentClass(),new tuieventbase()); r["body"] := format(" {** - @explan(说明) %s消息回调 %% - @param(o)(tcomponent) 组件 %% - @param(e)(tuievent) 消息对象 %% + @explan(说明) %s消息回调 %% **} - inherited; - ",n); +",n); end return r; end @@ -959,33 +1025,15 @@ format(" @param(Imgs)(integer) 图标序号,不需要使用 %% **} private - 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 iIDYES then e.skip := true; - inherited; -"); + **}"); end end type TDPanelForm = class(TDForm) {** @explan(说明) 主窗口 %% **} - function WndClass();override; begin return class(TDCreatePanel); - //return class(TDCreatePanel); end function create(AOwner);override; begin @@ -1842,18 +1881,10 @@ type TDTimer = class(TDRootComponent) DefaultEvent := array( "event":"ontimer", "name":"time", - "virtual":true, - "param":array("o","e"), - "body": -" - {** - @explan(说明) 定时调 %% - @param(e)(tuievent) 消息对象 %% - @param(o)(ttimer) 定时器对象 %% - **} - inherited; -" - ); + "param":array(ComponentClass()), + "body":" {** + @explan(说明) 定时回调 %% + **}"); end end @@ -1899,19 +1930,33 @@ type tdworkerctl = class(TDRootComponent) function Create(AOwner);override; begin inherited; +/////////////////////////////////////////////////////////////// + pm := array(ComponentClass()); + pm[1] := "errmsg"; + ev := array( + "event":"onerror", + "name":"onerr", + "param":pm, + "body": +" {** + @explan(说明) 工作线程错误 %% + @param(errmsg)(string) 错误信息 %% + @param(sender)(tworkerctl) 工作线程对象 %% + **}"); + SetDefalutEvent(ev,true); +///////////////////// + pm[1] := "d"; DefaultEvent := array( "event":"onmessage", "name":"message", - "virtual":true, - "param":array("o","d"), + "param":pm, "body": " {** @explan(说明) 工作线程 %% @param(d)(any) 数据 %% - @param(o)(tworkerctl) 工作线程对象 %% + @param(sender)(tworkerctl) 工作线程对象 %% **} - inherited; " ); end @@ -2259,7 +2304,7 @@ type TDToolBar = class(TDComponent) function Create(AOwner);override; begin inherited; - excludepropertys := array("childsizing"); + excludepropertys := array("childsizing","wscaption","wspopup","wssysmenu","onclose","onactivate"); end function ComponentCreater(tnode,owner);override; begin @@ -2303,7 +2348,7 @@ type TDcoolBar = class(TDComponent) function Create(AOwner);override; begin inherited; - excludepropertys := array("childsizing"); + excludepropertys := array("childsizing","wscaption","wspopup","wssysmenu","onclose","onactivate"); end function ComponentCreater(tnode,owner);override; begin @@ -2527,6 +2572,14 @@ type TDAction = class(TDComponent) begin inherited; fiscontainerdcmp := false; + pm := array(ComponentClass()); + DefaultEvent := array( + "event":"onexecute", + "name":"execute", + "param":pm, + "body":" {** + @explan(说明) 执行action % + **}"); end end type TDActionList = class(TDRootComponent) @@ -2784,29 +2837,25 @@ C6D53F7109130000000049454E44AE42608200"; function Create(AOwner);override; begin inherited; - excludepropertys := array("childsizing"); + excludepropertys := array("childsizing","wscaption","wspopup","wssysmenu","onclose","onactivate"); //fiscontainerdcmp := false; fiscontainerdcmp := true; + pm := array(); + pm[0] := ComponentClass(); + pm[1] := new unit(utslvcltree).tm_nodeseled(); DefaultEvent := array( "event":"onselchanged", - "name":"sel", - "virtual":true, - "param":array("o","e"), - "body": -" - {** - @explan(说明) item选择改变回调 %% - @param(e)(tuieventtree) 消息对象 %% - @param(o)(ttreeview)树控件 %% - **} - if e.itemold and e.itemnew then - begin - MessageBoxA(e.itemold.caption+' 切换到 '+e.itemnew.caption,'提示',0,o); - end - inherited; -" - - ); + "name":"selchanged", + "param":pm, + "body":" "); +///////////////////////////////////////////////////////// + pm[1] := new unit(utslvcltree).tm_nodeseling(); + ev := array( + "event":"onselchanging", + "name":"selchanging", + "param":pm, + "body":" "); + SetDefalutEvent(ev,true); end end //**************tgraphicsctl***************************** @@ -2846,7 +2895,7 @@ E44AE426082"; function Create(AOwner);override; begin inherited; - excludepropertys := array("childsizing"); + excludepropertys := array("childsizing","wscaption","wspopup","wssysmenu","onclose","onactivate"); fiscontainerdcmp := false; end @@ -2884,8 +2933,27 @@ E488B2001B40B7405A5A1A9E8A406C10A0AA0514E5036C00DD0210387EFC3818C function Create(AOwner);override; begin inherited; - excludepropertys := array("childsizing"); + excludepropertys := array("childsizing","wscaption","wspopup","wssysmenu","onclose","onactivate"); fiscontainerdcmp := false; +//////////////////////////////////////////////// + pm := array(); + pm[0] := ComponentClass(); + DefaultEvent := array( + "event":"onincrease", + "name":"increase", + "param":pm, + "body":" {** + @explan(说明) 增加回调 % + **}"); +///////////////////////////////////////////////////////// + ev := array( + "event":"ondecrease", + "name":"decrease", + "param":pm, + "body":" {** + @explan(说明) 减少回调 % + **}"); + SetDefalutEvent(ev,true); end end @@ -2912,27 +2980,19 @@ type TDListView = class(TDComponent) function Create(AOwner);override; begin inherited; - excludepropertys := array("childsizing"); + excludepropertys := array("childsizing","wscaption","wspopup","wssysmenu","onclose","onactivate"); //fiscontainerdcmp := false; fiscontainerdcmp := true; + DefaultEvent := array( "event":"onselchanged", - "name":"sel", - "param":array("o","e"), - "virtual":true, - "body": -" - {** + "name":"selchanged", + "param":array(ComponentClass()), + "body":" {** @explan(说明) 选择发生改变回调 %% - @param(o)(tlistview) tlistview对象 %% - **} - MessageBoxA('当前选中:'+tostn(o.selectedid),'提示',0,o); - inherited; -" - ); + **}" ); end - end type TDgridctl = class(TDComponent) {** @@ -2953,27 +3013,26 @@ type TDgridctl = class(TDComponent) function Create(AOwner);override; begin inherited; - excludepropertys := array("childsizing"); + excludepropertys := array("childsizing","wscaption","wspopup","wssysmenu","onclose","onactivate"); //fiscontainerdcmp := false; fiscontainerdcmp := true; + pm := array(); + pm[0] := ComponentClass(); + pm[1] := new unit(utslvclgrid).tgriddrawcellevent(); DefaultEvent := array( "event":"ondrawcell", "name":"drawcell", - "param":array("o","e"), - "virtual":true, + "param":pm, "body": " {** @explan(说明) 绘制表格 %% - @param(o)(tlistview) grid对象 %% - @param(e)(tuieventbase) 消息对象包括,row,col,rec,cavas等属性提供绘制信息 %% **} //绘制表头 - i := e.row; - j := e.col; - rec := e.rec; - cvs := e.canvas; - if iFoh 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; diff --git a/designer/utslvcldpropertytypes.tsf b/designer/utslvcldpropertytypes.tsf index 5caa4cd..132881e 100644 --- a/designer/utslvcldpropertytypes.tsf +++ b/designer/utslvcldpropertytypes.tsf @@ -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); diff --git a/designer/utslvclsyntaxparser.tsf b/designer/utslvclsyntaxparser.tsf index e707986..4b4a4fa 100644 --- a/designer/utslvclsyntaxparser.tsf +++ b/designer/utslvclsyntaxparser.tsf @@ -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); diff --git a/editor-install.exe b/editor-install.exe index 9b89cae..5970aa2 100644 Binary files a/editor-install.exe and b/editor-install.exe differ diff --git a/funcext/tvclib/tcomponent.tsf b/funcext/tvclib/tcomponent.tsf index 22f9e42..308b19c 100644 --- a/funcext/tvclib/tcomponent.tsf +++ b/funcext/tvclib/tcomponent.tsf @@ -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; diff --git a/funcext/tvclib/tcontrol.tsf b/funcext/tvclib/tcontrol.tsf index 4734475..00ccfc5 100644 --- a/funcext/tvclib/tcontrol.tsf +++ b/funcext/tvclib/tcontrol.tsf @@ -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) 控件是否有效 %% diff --git a/funcext/tvclib/tcustomcontrol.tsf b/funcext/tvclib/tcustomcontrol.tsf index 5cff9fa..7a7a28e 100644 --- a/funcext/tvclib/tcustomcontrol.tsf +++ b/funcext/tvclib/tcustomcontrol.tsf @@ -18,6 +18,7 @@ type tcustomcontrol=class(TWinControl) cvs.rcpaint := PAINTSTRUCT().rcpaint(); try Paint(); + inherited; finally cvs.Handle := 0; end; diff --git a/funcext/tvclib/tslvcl.tsf b/funcext/tvclib/tslvcl.tsf index 782c27f..51982eb 100644 --- a/funcext/tvclib/tslvcl.tsf +++ b/funcext/tvclib/tslvcl.tsf @@ -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); diff --git a/funcext/tvclib/tuieventbase.tsf b/funcext/tvclib/tuieventbase.tsf index 0297e18..d6cea34 100644 --- a/funcext/tvclib/tuieventbase.tsf +++ b/funcext/tvclib/tuieventbase.tsf @@ -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 {** diff --git a/funcext/tvclib/twincontrol.tsf b/funcext/tvclib/twincontrol.tsf index cd38907..834bf6b 100644 --- a/funcext/tvclib/twincontrol.tsf +++ b/funcext/tvclib/twincontrol.tsf @@ -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 y0 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 diff --git a/funcext/tvclib/utslmemo.tsf b/funcext/tvclib/utslmemo.tsf index 0363788..fb73536 100644 --- a/funcext/tvclib/utslmemo.tsf +++ b/funcext/tvclib/utslmemo.tsf @@ -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]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 diff --git a/funcext/tvclib/utslvclevent.tsf b/funcext/tvclib/utslvclevent.tsf index 7ead8c7..d33115d 100644 --- a/funcext/tvclib/utslvclevent.tsf +++ b/funcext/tvclib/utslvclevent.tsf @@ -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(说明)窗口样式改变消息 %% diff --git a/funcext/tvclib/utslvclgrid.tsf b/funcext/tvclib/utslvclgrid.tsf index 74a65d5..d1a3fea 100644 --- a/funcext/tvclib/utslvclgrid.tsf +++ b/funcext/tvclib/utslvclgrid.tsf @@ -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); diff --git a/funcext/tvclib/utslvclmemstruct.tsf b/funcext/tvclib/utslvclmemstruct.tsf index 9066797..515e9c8 100644 --- a/funcext/tvclib/utslvclmemstruct.tsf +++ b/funcext/tvclib/utslvclmemstruct.tsf @@ -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 (* diff --git a/funcext/tvclib/utslvclpage.tsf b/funcext/tvclib/utslvclpage.tsf index 03cdb8f..3871e2b 100644 --- a/funcext/tvclib/utslvclpage.tsf +++ b/funcext/tvclib/utslvclpage.tsf @@ -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=0 and id=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=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. \ No newline at end of file diff --git a/funcext/tvclib/utslvclstdctl.tsf b/funcext/tvclib/utslvclstdctl.tsf index 15a9875..c36b281 100644 --- a/funcext/tvclib/utslvclstdctl.tsf +++ b/funcext/tvclib/utslvclstdctl.tsf @@ -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 diff --git a/funcext/tvclib/utslvcltree.tsf b/funcext/tvclib/utslvcltree.tsf index 8b19684..a5c1d4e 100644 --- a/funcext/tvclib/utslvcltree.tsf +++ b/funcext/tvclib/utslvcltree.tsf @@ -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 diff --git a/funcext/tvclib/utvclgraphics.tsf b/funcext/tvclib/utvclgraphics.tsf index d7cecd9..3a68dd9 100644 --- a/funcext/tvclib/utvclgraphics.tsf +++ b/funcext/tvclib/utvclgraphics.tsf @@ -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,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 ///////////事件存储对象/////////////////////// diff --git a/funcext/tvclib/uvclthreadworker.tsf b/funcext/tvclib/uvclthreadworker.tsf index 8d7078e..2601859 100644 --- a/funcext/tvclib/uvclthreadworker.tsf +++ b/funcext/tvclib/uvclthreadworker.tsf @@ -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 diff --git a/funcext/tvclib/uvcpropertytypespersistence.tsf b/funcext/tvclib/uvcpropertytypespersistence.tsf index ff4b17a..9218261 100644 --- a/funcext/tvclib/uvcpropertytypespersistence.tsf +++ b/funcext/tvclib/uvcpropertytypespersistence.tsf @@ -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 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"); diff --git a/tsleditor.exe b/tsleditor.exe index 32acc4e..e1d849d 100644 Binary files a/tsleditor.exe and b/tsleditor.exe differ diff --git a/tslvcltool.exe b/tslvcltool.exe index 6d88a78..2c5735c 100644 Binary files a/tslvcltool.exe and b/tslvcltool.exe differ