diff --git a/designer/ctl_mgr/t_compile_config.tfm b/designer/ctl_mgr/t_compile_config.tfm index 0c1eaf0..847ac5e 100644 --- a/designer/ctl_mgr/t_compile_config.tfm +++ b/designer/ctl_mgr/t_compile_config.tfm @@ -169,7 +169,7 @@ object ed_script:t_compile_config leftrightspacing=2 topbottomspacing=2 > - height=73 + height=71 left=10 parentcolor=true top=149 @@ -178,14 +178,14 @@ object ed_script:t_compile_config left=6 top=21 width=58 - height=23 + height=21 autosize=true caption="函数目录" end object ed_f_dirs:tedit autosize=true caption="edit1" - height=23 + height=21 left=66 top=21 width=312 @@ -193,7 +193,7 @@ object ed_script:t_compile_config object bt_f_dir:tbtn autosize=true caption=".." - height=23 + height=21 left=380 onclick=bt_f_dir_clk top=21 @@ -201,7 +201,7 @@ object ed_script:t_compile_config end object label2:tlabel left=6 - top=46 + top=44 width=58 height=21 autosize=true @@ -212,7 +212,7 @@ object ed_script:t_compile_config caption="edit2" height=21 left=66 - top=46 + top=44 width=312 end object bt_s_dir:tbtn @@ -221,7 +221,7 @@ object ed_script:t_compile_config height=21 left=380 onclick=bt_s_dir_clk - top=46 + top=44 width=28 end end @@ -239,7 +239,7 @@ object ed_script:t_compile_config height=139 left=10 parentcolor=true - top=232 + top=230 width=452 object lb_s_type:tlabel left=6 @@ -385,7 +385,7 @@ object ed_script:t_compile_config height=97 left=10 parentcolor=true - top=381 + top=379 width=452 object label9:tlabel left=6 @@ -521,7 +521,7 @@ object ed_script:t_compile_config > height=25 left=10 - top=488 + top=486 width=452 wsdlgmodalframe=false object bt_cmd:tbtn diff --git a/designer/ctl_mgr/t_compile_config.tsf b/designer/ctl_mgr/t_compile_config.tsf index 0d7cc78..c4f0da3 100644 --- a/designer/ctl_mgr/t_compile_config.tsf +++ b/designer/ctl_mgr/t_compile_config.tsf @@ -1,6 +1,5 @@ type t_compile_config=class(tdcreateform) - uses tslvcl; - + uses tslvcl; gp_dir:tgroupbox; bt_f_dir:tbtn; bt_s_dir:tbtn; @@ -13,21 +12,14 @@ type t_compile_config=class(tdcreateform) lb_ype:tlabel; cb_type:tcombobox; lb_output:tlabel; - ed_output:tedit; - - gp_other:tgroupbox; - - - + ed_output:tedit; + gp_other:tgroupbox; bt_i_s:tbtn; lb_ico:tlabel; ed_ico:tedit; bt_ico:tbtn; bt_output:tbtn; - f_op:topenfileadlg; - - - + f_op:topenfileadlg; bt_outputname:tbtn; lb_output_f:tlabel; ed_out_f:tedit; @@ -134,6 +126,17 @@ type t_compile_config=class(tdcreateform) ed_ico.text := r["buildico"]; ed_tsg.text := r["pkg"]; e_namespace.text := r["nspace"]; + if r["designer"] then + begin + e_script.Enabled := false; + cb_type.Enabled := false; + ck_gui.Enabled := false; + end else + begin + e_script.Enabled := true; + cb_type.Enabled := true; + ck_gui.Enabled := true; + end //ck_s_rp.Checked := r["resourcekeepdir"]; end function get_config(); diff --git a/designer/ctl_mgr/t_editor_color_mgr.tfm b/designer/ctl_mgr/t_editor_color_mgr.tfm index 4104cb8..388d87e 100644 --- a/designer/ctl_mgr/t_editor_color_mgr.tfm +++ b/designer/ctl_mgr/t_editor_color_mgr.tfm @@ -33,9 +33,9 @@ object ditor_color_mgr:t_editor_color_mgr itemindex=0 left=10 onselchanged=colorcombobox1_onselchanged + parentfont=false top=18 width=132 - parentfont=false end object listbox1:tlistbox caption="listbox1" @@ -54,9 +54,9 @@ object ditor_color_mgr:t_editor_color_mgr itemindex=0 left=154 onselchanged=colorcombobox2_onselchanged + parentfont=false top=18 width=177 - parentfont=false end object openfileadlg1:topenfileadlg left=314 diff --git a/designer/ctl_mgr/t_editor_config.tfm b/designer/ctl_mgr/t_editor_config.tfm index 296d5ab..c558dca 100644 --- a/designer/ctl_mgr/t_editor_config.tfm +++ b/designer/ctl_mgr/t_editor_config.tfm @@ -217,6 +217,7 @@ object editor_config:t_editor_config caption="取消" height=31 left=191 + onclick=bt_cancel_clk top=8 width=94 end diff --git a/designer/ctl_mgr/t_editor_config.tsf b/designer/ctl_mgr/t_editor_config.tsf index 8b3ffc4..92e0e27 100644 --- a/designer/ctl_mgr/t_editor_config.tsf +++ b/designer/ctl_mgr/t_editor_config.tsf @@ -33,7 +33,7 @@ type t_editor_config=class(tdcreateform) end function bt_cancel_clk(o;e); begin - o.Visible := false; + Visible := false; //calldatafunction(foncancel_clk,self,e); end function bt_ok_clk(o;e); diff --git a/designer/ctl_mgr/t_function_finder.tfm b/designer/ctl_mgr/t_function_finder.tfm index 1a521d0..bdd1a55 100644 --- a/designer/ctl_mgr/t_function_finder.tfm +++ b/designer/ctl_mgr/t_function_finder.tfm @@ -29,7 +29,7 @@ object functionfinder:t_function_finder align=altop autosize=true caption="panel1" - height=41 + height=39 left=0 top=0 width=804 @@ -55,7 +55,7 @@ object functionfinder:t_function_finder object ck_prev:tcheckbtn autosize=true caption="从头匹配" - height=27 + height=25 left=371 top=8 visible=true @@ -82,11 +82,11 @@ object functionfinder:t_function_finder text="函数" > ] - height=566 + height=568 left=0 ondblclick=listfunc_ondblclick popupmenu=popupmenu1 - top=41 + top=39 width=804 end object popupmenu1:tpopupmenu diff --git a/designer/ctl_mgr/textcompclassadder.tfm b/designer/ctl_mgr/textcompclassadder.tfm index 65062d8..f8195b0 100644 --- a/designer/ctl_mgr/textcompclassadder.tfm +++ b/designer/ctl_mgr/textcompclassadder.tfm @@ -1,80 +1,109 @@ object extcompclassadder:textcompclassadder + autosize=true caption="添加" height=406 left=474 minmaxbox=false onclose=extcompclassadder_close top=316 - width=402 + width=420 wssizebox=false - object e_classname:tedit - caption="edit1" - height=25 - left=99 - readonly=true - top=28 - width=247 - end - object label1:tlabel - left=20 - top=21 - width=72 - height=32 - caption="控件类" - end - object b_classfile:tbtn - caption="..." - height=24 - left=354 - onclick=b_classfile_clk - top=29 - width=21 - end - object label2:tlabel - left=20 - top=72 - width=65 - height=33 - caption="图标" - end object p_imgshow:tpanel + autosize=false caption="img" - height=195 - left=91 - top=107 - width=245 + height=120 + left=183 + top=181 + width=130 wsdlgmodalframe=false end - object b_img:tbtn - caption="添加图标" - height=25 - left=100 - onclick=b_img_clk - top=72 - width=176 - end object b_ok:tbtn + autosize=true caption="确定" enabled=true - height=31 - left=134 + height=21 + left=64 onclick=b_ok_clk - top=306 - width=72 + top=322 + width=42 end object b_cancel:tbtn + autosize=true caption="取消" - height=31 - left=271 + height=21 + left=276 onclick=b_cancel_clk - top=306 - width=73 + top=321 + width=42 end object f_open:topenfileadlg - left=22 - top=146 + left=42 + top=184 height=30 width=30 caption="文件选择" end + object panel1:tpanel + align=altop + autosize=true + caption="panel1" + childsizing=< + layout=1 + controlsperline=3 + horizontalspacing=10 + verticalspacing=10 + leftrightspacing=10 + topbottomspacing=10 + > + height=72 + left=0 + top=0 + width=366 + wsdlgmodalframe=false + object label1:tlabel + left=10 + top=10 + width=44 + height=21 + caption="控件类" + end + object e_classname:tedit + caption="edit1" + height=21 + left=64 + readonly=true + top=10 + width=247 + end + object b_classfile:tbtn + caption="..." + height=21 + left=321 + onclick=b_classfile_clk + top=10 + width=35 + end + object label2:tlabel + left=10 + top=41 + width=44 + height=21 + caption="图标" + end + object b_img:tbtn + caption="添加图标" + height=21 + left=64 + onclick=b_img_clk + top=41 + width=247 + end + object label3:tlabel + left=321 + top=41 + width=35 + height=21 + caption="" + end + end end \ No newline at end of file diff --git a/designer/ctl_mgr/textcompclassadder.tsf b/designer/ctl_mgr/textcompclassadder.tsf index 0c2b32c..fc132a3 100644 --- a/designer/ctl_mgr/textcompclassadder.tsf +++ b/designer/ctl_mgr/textcompclassadder.tsf @@ -1,14 +1,16 @@ type textcompclassadder=class(tdcreateform) - uses tslvcl; - e_classname:tedit; - label1:tlabel; - b_classfile:tbtn; - label2:tlabel; - p_imgshow:tpanel; - b_img:tbtn; + uses tslvcl; + p_imgshow:tpanel; b_ok:tbtn; b_cancel:tbtn; - f_open:topenfileadlg; + f_open:topenfileadlg; + panel1:tpanel; + label1:tlabel; + e_classname:tedit; + b_classfile:tbtn; + label2:tlabel; + b_img:tbtn; + label3:tlabel; function Create(AOwner);override; //构造 begin inherited; diff --git a/designer/ctl_mgr/textcompclassmgr.tfm b/designer/ctl_mgr/textcompclassmgr.tfm index f8ff195..b53f9ab 100644 --- a/designer/ctl_mgr/textcompclassmgr.tfm +++ b/designer/ctl_mgr/textcompclassmgr.tfm @@ -1,11 +1,13 @@ object extcompclassmgr:textcompclassmgr + autosize=true caption="注册控件-管理" - height=467 - left=447 + height=444 + left=930 minmaxbox=false onclose=extcompclassmgr_close - top=272 - width=484 + top=287 + width=446 + wspopup=false wssizebox=true object listbox1:tlistbox caption="listbox1" @@ -16,49 +18,61 @@ object extcompclassmgr:textcompclassmgr width=344 end object b_del:tbtn + autosize=true caption="删除" enabled=false - height=31 - left=364 + height=21 + left=368 onclick=b_del_clk - top=224 - width=88 + top=73 + width=42 end object b_add:tbtn + autosize=true caption="添加" - height=31 - left=364 + height=21 + left=368 onclick=b_add_clk - top=279 - width=88 + top=176 + width=42 end object b_ok:tbtn + autosize=true caption="完成" - height=31 - left=364 + height=21 + left=368 onclick=b_ok_clk - top=346 - width=88 - wssizebox=false - wssysmenu=false + top=288 + width=42 end object statusbar1:tstatusbar + autosize=true caption="statusbar1" - height=25 + height=19 items= [< width=500 text="控件管理" > ] left=0 - top=403 - width=468 + parentfont=false + top=386 + width=430 end object label1:tlabel left=8 top=5 width=176 height=36 + parentfont=false caption="控件列表" end + object label2:tlabel + left=394 + top=388 + width=16 + height=17 + autosize=true + caption=" " + end end \ No newline at end of file diff --git a/designer/ctl_mgr/textcompclassmgr.tsf b/designer/ctl_mgr/textcompclassmgr.tsf index 72e7f41..0749819 100644 --- a/designer/ctl_mgr/textcompclassmgr.tsf +++ b/designer/ctl_mgr/textcompclassmgr.tsf @@ -6,29 +6,21 @@ type textcompclassmgr=class(tdcreateform) b_ok:tbtn; statusbar1:tstatusbar; label1:tlabel; + label2:tlabel; function Create(AOwner);override; //构造 begin inherited; end - function extcompclassmgr_close(o;e);virtual; + function extcompclassmgr_close(o;e); begin - - {** - @explan(说明) 主窗口关闭回调 %% - @param(e)(tuievent) 消息对象 %% - @param(o)(ttimer) 当前主窗口 %% - **} e.skip:= true; Visible := false; - inherited; - end - - function b_ok_clk(o;e);virtual; + function b_ok_clk(o;e); begin Visible := false; end - function b_del_clk(o;e);virtual; + function b_del_clk(o;e); begin idx := listbox1.ItemIndex; if idx>=0 and parent then diff --git a/designer/ctl_mgr/vcldesginer.tpj b/designer/ctl_mgr/vcldesginer.tpj index 8a062ec..d344566 100644 --- a/designer/ctl_mgr/vcldesginer.tpj +++ b/designer/ctl_mgr/vcldesginer.tpj @@ -1,71 +1,16 @@ -array( - "name":"vcldesginer", - "version":"1.1.2", - "dir":( - ), - "files":( - "textcompclassadder":( - "name":"textcompclassadder", - "type":"form", - "dir":"" - ), - "textcompclassmgr":( - "name":"textcompclassmgr", - "type":"form", - "dir":"" - ), - "tfm_inheritedwnd":( - "name":"tfm_inheritedwnd", - "type":"form", - "dir":"" - ), - "t_bconfig_cmd_shower":( - "name":"t_bconfig_cmd_shower", - "type":"form", - "dir":"" - ), - "t_compile_config":( - "name":"t_compile_config", - "type":"form", - "dir":"" - ), - "t_dir_list":( - "name":"t_dir_list", - "type":"form", - "dir":"" - ), - "t_m_list_editor":( - "name":"t_m_list_editor", - "type":"form", - "dir":"" - ), - "t_function_finder":( - "name":"t_function_finder", - "type":"form", - "dir":"" - ), - "t_shortcut_keys_view":( - "name":"t_shortcut_keys_view", - "type":"form", - "dir":"" - ), - "tsl1":( - "name":"tsl1", - "type":"tsl", - "dir":"" - ), - "t_editor_color_mgr":( - "name":"t_editor_color_mgr", - "type":"form", - "dir":"" - ), - "t_editor_config":( - "name":"t_editor_config", - "type":"form", - "dir":"" - ) - ), - "mainform":"t_shortcut_keys_view", - "entryscript":"vcldesginer", - "commandline":"\"$(TSL_EXE)\" \"$(FULL_CURRENT_PATH)\" -libpath \"$(SEARCH_PATH)\"" -) \ No newline at end of file + +array("name":"vcldesginer","version":"1.1.2","dir": +(),"files": +("textcompclassadder": +("name":"textcompclassadder","type":"form","dir":""),"textcompclassmgr": +("name":"textcompclassmgr","type":"form","dir":""),"tfm_inheritedwnd": +("name":"tfm_inheritedwnd","type":"form","dir":""),"t_bconfig_cmd_shower": +("name":"t_bconfig_cmd_shower","type":"form","dir":""),"t_code_format_mgr": +("name":"t_code_format_mgr","type":"form","dir":""),"t_compile_config": +("name":"t_compile_config","type":"form","dir":""),"t_dir_list": +("name":"t_dir_list","type":"form","dir":""),"t_editor_color_mgr": +("name":"t_editor_color_mgr","type":"form","dir":""),"t_editor_config": +("name":"t_editor_config","type":"form","dir":""),"t_function_finder": +("name":"t_function_finder","type":"form","dir":""),"t_m_list_editor": +("name":"t_m_list_editor","type":"form","dir":""),"t_shortcut_keys_view": +("name":"t_shortcut_keys_view","type":"form","dir":"")),"mainform":"textcompclassmgr") \ No newline at end of file diff --git a/designer/teditorform.tsf b/designer/teditorform.tsf index d018bc1..1f40764 100644 --- a/designer/teditorform.tsf +++ b/designer/teditorform.tsf @@ -72,7 +72,7 @@ type teditorform = class(TVCform) // end function editerinfo(); begin - s := "tsl语言本地编辑器\r\n版本:1.0.0\r\n日期:2022-07-19"; + s := "tsl语言本地编辑器\r\n版本:1.0.0\r\n日期:2025-07-19"; sc := get_resource_by_name("tsleditor.tsl.about"); if ifstring(sc) then return sc; f := tslfilename()+".about"; @@ -86,76 +86,20 @@ type teditorform = class(TVCform) // end return s; end + function Create(AOwner);override; - begin + begin inherited ; - GLobal G_OpenHostory; - //////////////////目录///////////////////// - basepath := TS_GetUserProfileHome(); - sp := ioFileseparator(); - FCache := basepath+"editer"+sp+"cmpCaches"; - FPathDirPath := basepath+"editer"+sp+"paths.tsm"; - Fexefilepath := basepath+"editer"+sp+"tslfile.tsm"; - FOpendpaths := basepath+"editer"+sp+"openedpaths.tsm"; - FTabWidthpath := basepath+"editer"+sp+"tabwidpath.tsm"; - Fsysfontpath := basepath+"editer"+sp+"sysfont.tsm"; - FexefileCmds := basepath+"editer"+sp+"cmds.tsm"; - FHistoryPath := basepath+"editer"+sp+"HistoryPath.tsm"; - FCodeblockPath := basepath+"editer"+sp+"BlockManager.tsm"; - FFindhistroypath := basepath+"editer"+sp+"findhistory.tsm"; - FFormatpath := basepath+"editer"+sp+"tslformat.tsm"; - Fhighlightpath := basepath+"editer"+sp+"highlight.tsm"; - feditorglobalpath := basepath+"editer"+sp+"feditorglobalpath.tsm"; - Fremotepath := basepath+"editer"+sp; - CreateDirWithFileName(basepath+"editer"+sp+"1.txt"); - CreateDirWithFileName(basepath+"editer"+sp+"cmpCaches"+sp+"1.txt"); - fdirspath := basepath+"editer"+sp+"tsldirpath.tsm"; - //TBlockManager - //echo "\r\n",FCache; + init_edt_dirs(); //////////////////////////////////////// rc:=_wapi.GetScreenRect(); SetBoundsRect(RC); - caption := "tsl代码编辑器"; - m := new TMainMenu(self); + caption := "tsl代码编辑器"; ////////////////////////////////////////////// - FmTool := new TMenu(self); - FmTool.Caption := c_m_window; - fmglobsearch := new TMenu(self); - fmglobsearch.caption := c_m_logwindow; - fmglobsearch.OnClick := function(o,e) - begin - FEDter.SwitchLogWnd(); - end - fmglobdir := new TMenu(self); - fmglobdir.caption := c_m_dir; - fmglobdir.onclick := function(o,e) - begin - v := not(Fdirview.Visible); - Fdirview.Visible := v; - fdirspliter.Visible := v; - - end - + m := new TMainMenu(self); + Fmwindows := init_window_menus(); //初始化窗口菜单 /////////////////////////////////////////////////////// - FEnCodeMenu := new TMenu(self); - FEnCodeMenu.Caption := c_m_encode; - FCodeMenus := array(); - for i,v in array(c_e_None,c_e_ansi,c_e_utf8,c_e_utf8bom,c_e_ucs2big,c_e_ucs2little,c_e_separator,c_e_to_ansi,c_e_to_utf8,c_e_to_utf8bom,c_e_to_ucs2big,c_e_to_ucs2little) do - begin - it := new TMenu(self); - it.Caption := v; - FCodeMenus[i] := it; - if v=c_e_separator then it.TSeparator := true; - else - if v in array(c_e_ucs2big,c_e_ucs2little,c_e_utf8bom) then - begin - it.Enabled := false; - end else - begin - it.OnClick := thisfunction(ClickEnCodeMenu); - end - it.Parent := FEnCodeMenu; - end + FEnCodeMenu := init_encode_menus();//初始化后编码菜单 /////////////////////////////////////////////////////////////// Fmopen := new TMenu(self); newaction := new TAction(self); @@ -165,9 +109,7 @@ type teditorform = class(TVCform) // begin return FEdter.OpenAfile(); end; - Fmopen.action := newaction; - - + Fmopen.action := newaction; Fmnew:= new TMenu(self); newaction := new TAction(self); NewAction.ShortCut := "ctrl+N"; @@ -184,8 +126,7 @@ type teditorform = class(TVCform) // FOpenHistoryMenu.caption := c_m_open_history; FOpenHistoryMenu.OnClick := function(o,e)begin FEdter.ShowHistoryWnd(); - end - + end //////////////////////////////////////////////////////////////////// FTslLangMenu := new tmenu(self); FTslLangMenu.Caption := c_m_lang_config; @@ -200,66 +141,19 @@ type teditorform = class(TVCform) // FCodeBlockMenu.caption := c_m_tsl_block; FCodeBlockMenu.OnClick := function(o,e)begin class(UtslCodeEditor).move_popwnd_to_center2(fBlockManager); - fBlockManager.ShowModal(); - - end - - FMenuSet := new TMenu(self); - FMenuSet.caption := c_m_config; - fmtslexepath := new TMenu(self); - if 1=importfile(ftstream(),"",Fexefilepath,tslexefile) then - begin - end else - begin - sexe := SysExecName(); - if ifstring(sexe) and sexe then - begin - for i:= length(sexe) downto 3 do - begin - if sexe[i]=sp then - begin - if sp="/" then sexe := sexe[1:i]+"TSL"; - else - sexe := sexe[1:i]+"tsl.exe"; - break; - end - end - tslexefile := sexe; - end - end - fBlockManager := new TBlockManager(self); - fBlockManager.WsDlgModalFrame := true; - fBlockManager.caption := c_m_block_mgr; - fBlockManager.minmaxbox := false; - fBlockManager.Visible := false; - fBlockManager.Parent := self; - fBlockManager.SaveClick := function(o,e)begin - d := fBlockManager.GetData(); - Exportfile(ftstream(),"",FCodeblockPath,d); - fBlockManager.EndModal(); - class(TTSLCompletion).FCodeBlocks := d; - end - - if 1= importfile(ftstream(),"",FCodeblockPath,d) and d and ifarray(d) then - begin - fBlockManager.SetData(d); - class(TTSLCompletion).FCodeBlocks := d; - end else - begin - try - d := GetTslCompletionCodeBlocks(); - fBlockManager.SetData(d); - class(TTSLCompletion).FCodeBlocks := d; - except - - end + fBlockManager.ShowModal(); end + init_codeblock_wnd(); //初始化代码块编辑窗口 ///////////////////////////////////////// //////////////////////////////////////////////// + fmtslexepath := new TMenu(self); fmtslexepath.caption :=c_m_exec_config; fmfile := new TMenu(self); fmfile.caption := c_m_file; fmfile.parent := m; + + FMenuSet := new TMenu(self); + FMenuSet.caption := c_m_config; FMenuSet.parent := m; Fmopen.parent := fmfile; Fmnew.parent := fmfile; @@ -269,29 +163,12 @@ type teditorform = class(TVCform) // FCodeBlockMenu.Parent := FTslLangMenu; FTslFormatMenu.Parent := FTslLangMenu; tbwidth := 4; - if importfile(ftstream(),"",FTabWidthpath,d)=1 and ( d>0 ) then //tab宽度 - begin - tbwidth := d; - end - FMTabContain :=new TMenu(self); + fmshowhltediter :=new TMenu(self); fmshowhltediter.caption := c_m_edit_color; fmsysfont :=new TMenu(self); fmsysfont.caption := c_m_font; - - FMTabs := array(); - FMTabContain.Caption := c_m_tab_config; - for i:= 0 to 6 do - begin - tm := new TMenu(self); - if i=0 then tm.Caption := "\\t"; - else - tm.Caption := inttostr(i)+c_m_blank; - if tbwidth=i then tm.Checked := true; - tm.Onclick := thisfunction(TabWidthClick); - FMTabs[i] := tm; - tm.Parent := FMTabContain; - end + FMTabContain := init_tabwidth_menus(tbwidth); //初始化tab按键信息 FMTabContain.parent := FMenuSet; fmshowhltediter.Parent := FMenuSet; fmsysfont.Parent := FMenuSet; @@ -302,11 +179,8 @@ type teditorform = class(TVCform) // FEdter.modifysyssize(); end mainmenu := m; - FmTool.parent := m; + Fmwindows.parent := m; FEnCodeMenu.parent := m; - - fmglobsearch.parent := FmTool; - fmglobdir.parent := FmTool; FSearchDir := new TSearchDir(self); FSearchDir.onsaveclick := function(o,e)begin return o.EndModal(1); @@ -317,239 +191,56 @@ type teditorform = class(TVCform) // //FEdter.FExecuteEditer.ShowModal(); FEdter.ShowExeEditer(); end - - FCloseMenu := new tmenu(self); - FCloseMenu.Caption:=c_m_close_min; - //FCloseMenu.parent := FMenuSet; - FCloseMenu.OnClick := function(o,e) - begin - FCloseMenu.Checked := not(FCloseMenu.Checked); - end - FEdter := New TEditer(self); - - Fdirview := new tdirviewer(FEdter); - Fdirview.fcloseclick := function(o,e)begin - Fdirview.Visible := false; - fdirspliter.Visible := false; - end - Fdirview.Visible := false; - Fdirview.align := alLeft; - fdirspliter := new tsplitter(self); - fdirspliter.Visible := false; - fdirspliter.align := alLeft; - Fdirview.Parent := self; - fdirspliter.Parent := self; - - - FEdter.Visible := false; - - //语言按钮 - FSynMenu := New TMenu(self); - FSynMenu.Caption := c_m_lang; - FSynMenus := array(); - for i,v in FEdter.GetSynTypeNames() do - begin - it := new TMenu(self); - it.Caption := v; - FSynMenus[i] := it; - it.OnClick := thisfunction(ClickSynMenu); - it.Parent := FSynMenu; - end + + init_work_dir_wnd();//初始化工作目录 + ////////////////////////////////////////////// + FEdter := New TEditer(self); + FSynMenu := init_lang_menus();//语言菜单 FSynMenu.Parent := m; - - FRunMenu := new TMenu(self); - FRunMenu.caption := c_m_run; - FExeaction := new TAction(self); - FExeaction.caption := c_m_exec; - FExeaction.ShortCut := "F9"; - FExeaction.onexecute := function(o,e) - begin - FEdter.ExecutePageItem(FEdter.GetCurrentItem()); - end - for i,v in array(c_m_cmd_config,c_m_debuger,c_m_tsl_dir,c_m_exec,c_m_exec_debug,c_m_remote_debug,c_m_remote_debug_wait,c_m_compile) do - begin - it := new TMenu(self); - if v = c_m_exec then - begin - it.Action := FExeaction; - end - if v=c_m_debuger then - begin - it.caption := v; - ite := new TMenu(self); - ite.caption := c_m_editor; - ite.Parent := it; - itb := new TMenu(self); - itb.caption := c_m_exer; - global g_debug_chooser; - g_debug_chooser := c_m_exer; - itb.Checked := true; - itb.Parent := it; - itb._tag := ite; - ite._tag := itb; - f := function(o,e)begin - o.Checked := true; - o._tag.Checked := false; - global g_debug_chooser; - g_debug_chooser := o.caption; - end - ite.OnClick := f; - itb.OnClick := f; - end else - begin - it.caption := v; - it.OnClick := thisfunction(clickRun); - end - it.Parent := FRunMenu; - end - FRunMenu.Parent := m; - + FRunMenu := init_run_menus();//执行菜单 + FRunMenu.Parent := m; + + FEdter.Visible := false; FEdter.Parent := self; ////////////////////////////////////////////////// - FHelpMenu := new TMenu(self); - FHelpMenu.Caption := c_m_help; - FHelpMenus := array(); - for i,v in array(c_m_manu,c_m_tsl_help,c_m_about) do - begin - vi := new TMenu(self); - vi.Caption := v; - vi.OnClick := thisfunction(HelpClick); - vi.Parent := FHelpMenu; - end + FHelpMenu := init_help_menus(); //初始帮助菜单 FHelpMenu.parent := m; ///////////////////////////////// FEdter.TslCacheDir := FCache; FEdter.TabWidth :=tbwidth; FEdter.OnPageItemSelChanged := thisfunction(PageItemSelChanged); FEdter.OnPageEditerChanged := thisfunction(PageEditerChanged); + if 1=importfile(ftstream(),"",Fexefilepath,tslexefile) then + begin + end else + begin + tslexefile := gettslexefullpath(); + end FEdter.TslExe := tslexefile; FEdter.align := alClient; - if (importfile(ftstream(),"",feditorglobalpath,ginfo)=1) and ifarray(ginfo) then - begin - global editorglobalinfo ; - editorglobalinfo := ginfo; - if ifarray(ginfo) then - begin - app := initializeapplication(); - app.font := array("width":ginfo["fontsize"],"height" :ginfo["fontsize"]*2); - NotifyComponent(self,ginfo); - end - - end - if importfile(ftstream(),"",fdirspath,dirs)=1 then - begin - Fdirview.addrootdirs(dirs); - end - FEdter.FHistoryDir:= Fremotepath; - if importfile(ftstream(),"",FPathDirPath,dirs)=1 then - begin - FEdter.TslSearchDir := formatsearchdir(dirs); - end else - begin - fn := SysExecName(); - fio := ioFileseparator(); - for i:= length(fn) downto 1 do - begin - if fn[i]=fio then - begin - dirs := array( - fn[1:i]+"funcext" - ); - break; - end - end - FEdter.TslSearchDir := dirs; - end - if ifarray(dirs) and dirs then FDirs := dirs; - if G_OpenHostory then - begin - if 1= importfile(ftstream(),"",FOpendpaths,opinfo) then - begin - if ifarray(opinfo) then - begin - for i,v in opinfo["pages"] do - begin - it := FEdter.OpenAndGoLineByName(v["filename"],v["r"]); - if it then - begin - ls := it.FEditer.Lines; - for j,vj in v["f2"] do - begin - if vj and ls[j]then ls[j].FMarked := true; - end - if v["isnewfile"] then it.fisnewfile := true; - end - end - if ifarray(opinfo["currentpage"]) then - begin - it := FEdter.OpenAndGotoFileByName( opinfo["currentpage"][0],opinfo["currentpage"][1]); - //if it then it.FEditer.SetFocus(); - end - end - end - if 1= importfile(ftstream(),"",FHistoryPath,hist) then - begin - FEdter.SetHistoryFiles(hist); - end - if 1 = importfile(ftstream(),"",FFindhistroypath,fds) then - begin - FEdter.SetFindHistroy(fds); - end - if 1 = importfile(ftstream(),"",Fhighlightpath,fds) then - begin - FEdter.hltcolor := fds; - end - - end - if 1=Importfile(ftstream(),"",FexefileCmds,cmds) then - begin - //echo "getok\r\n"; - FEdter.FExecuteEditer.SetData(cmds); - end else - begin - FEdter.FExecuteEditer.SetData(array( - //"items":(("caption":"tsl","exe":format('"%s" "%s" -libpath "%s"',tslexefile,"$(FULL_CURRENT_PATH)","$(CURRENT_DIRECTORY)"+sp+";"))), - "items":(("caption":"tsl","exe":format('"%s" "%s" -libpath "%s"',"$(TSL_EXE)","$(FULL_CURRENT_PATH)","$(SEARCH_PATH)"))), - "itemindex":0 - )); - end - + load_edt_other_info();//加载其他信息 + /////////////////////////////////////////////// onclose := thisfunction(closemain); - FFileopen := new TOpenFileADlg(self); - FFileopen.Filter := array("执行文件":"*.exe"); - FFileopen.parent := self; formIcon := GetIcon(); FEdter.Visible := true; - - FFormatInfoWnd := NEW t_editor_config(self);//t_code_format_mgr(self); - FFormatInfoWnd.Visible := false; - FFormatInfoWnd.WsDlgModalFrame := true; - FFormatInfoWnd.Parent := self; - FFormatInfoWnd.onclose := function(o,e)begin - e.skip := true; - o.Visible := false; - //o.EndModal(); - - end - FFormatInfoWnd.OnOkClicked := function(o,e)begin - //o.EndModal(); - //o.show(); - o.Visible := false; - d := o.GetData(); - FEdter.SetCodeFormatInfo(d); - Exportfile(ftstream(),"",FFormatpath,d); - end - if 1=Importfile(ftstream(),"",FFormatpath,FMTDATA) then - begin - //echo "getok\r\n"; - if ifarray(FMTDATA) then FEdter.SetCodeFormatInfo(FMTDATA); - FFormatInfoWnd.setdata(FMTDATA); - end - + init_code_format_wnd(); //初始化格式窗口 end - function HelpClick(o,e); + //////////帮助////////////////////////////////// + function help_editor_manu(); begin - case o.Caption of + HelpClick(c_m_manu); + end + function help_tsl(); + begin + HelpClick(c_m_tsl_help); + end + function help_about(); + begin + HelpClick(c_m_about); + end + function HelpClick(c); + begin + case c of c_m_manu: begin return FEdter.showeditorchm(); @@ -565,6 +256,7 @@ type teditorform = class(TVCform) // end end + /////////////////////////////////// function PageItemSelChanged(o,it) begin if it then @@ -662,12 +354,6 @@ type teditorform = class(TVCform) // end function closemain(o,e); begin - if FCloseMenu.CHecked then - begin - e.skip := true; - show(SW_SHOWMINNOACTIVE); - return ; - end fd := MessageBoxA('是否关闭编辑器','关闭',MB_YESNO,o); if fd<>IDYES then return e.skip := true; its := FEdter.GetAllPageItems(); @@ -695,50 +381,11 @@ type teditorform = class(TVCform) // end end - d := Fdirview.getrootdirs(); - if d and ifarray(d) then - begin - exportfile(ftstream(),"",fdirspath,d); - end - d := FEdter.FExecuteEditer.GetData(); - if d and ifarray(d) then - begin - exportfile(ftstream(),"",FexefileCmds,d); - end - d := FEdter.GetHistoryFiles(); - if ifarray(d) and d then - begin - Exportfile(ftstream(),"",FHistoryPath,d); - end - d := FEdter.GetFindHistory(); - if ifarray(d) and d then - begin - Exportfile(ftstream(),"",FFindhistroypath,d); - end - d := FEdter.hltcolor; - if ifarray(d) and d then - begin - Exportfile(ftstream(),"",Fhighlightpath,d); - end - global editorglobalinfo ; - if ifarray(editorglobalinfo) and editorglobalinfo then - begin - Exportfile(ftstream(),"",feditorglobalpath,editorglobalinfo); - end - save_opend_file_name(); + save_edt_caches(); //保存编辑器的缓存数据 FEdter.CloseAllPageItems(); end - function save_opend_file_name(); - begin - global g_dotsavehistory; - if g_dotsavehistory then return ; - d := FEdter.GetAllPagesInfo(); - if not ifarray(d) then d := array(); - if flastopend = d then return ; - exportfile(ftstream(),"",FOpendpaths,d); - flastopend := d; - end - function clickRun(o,e); + + function clickRun(o,e); //执行菜单点击 begin case o.caption of c_m_compile: @@ -767,7 +414,7 @@ type teditorform = class(TVCform) // end end end - function ClickSynMenu(o,e); + function ClickSynMenu(o,e); //语法切换处理 begin it := FEdter.GetCurrentItem(); if not it then return ; @@ -775,7 +422,7 @@ type teditorform = class(TVCform) // FEdter.SetPageItemSyn(it,o.caption); ModifySynMenu(it); end - function ClickEnCodeMenu(o,e); + function ClickEnCodeMenu(o,e);//编码菜单点击 begin it := FEdter.GetCurrentItem(); if not it then return ; @@ -816,12 +463,12 @@ type teditorform = class(TVCform) // end; ModifyEnCodeMenu(it); end - function OpenAndGotoFileByName(f,line); + function OpenAndGotoFileByName(f,line); //打开并跳转到行 begin if f and ifstring(f) then FEdter.OpenAndGotoFileByName(f,line); end - function ModifyEnCodeMenu(it); + function ModifyEnCodeMenu(it); //选择编码菜单项目 begin if not it then return ; bm := it.EnCode; @@ -835,7 +482,7 @@ type teditorform = class(TVCform) // v.Checked := false; end end - function ModifySynMenu(it); + function ModifySynMenu(it); //选择语法菜单项目 begin if not it then return ; bm := it.FSynType; @@ -848,19 +495,394 @@ type teditorform = class(TVCform) // v.Checked := false; end end - private - function formatsearchdir(d); - begin - for i,v in d do - begin - if not ifarray(v) then return d; - if v["s"] then return v["d"]; - end - return array(); - end - protected + private - type TBlockEditer = class(TPanel) + function init_edt_dirs(); //初始化编辑器的一些目录 + begin + //////////////////目录///////////////////// + basepath := TS_GetUserProfileHome(); + sp := ioFileseparator(); + FCache := basepath+"editer"+sp+"cmpCaches"; + FPathDirPath := basepath+"editer"+sp+"paths.tsm"; + Fexefilepath := basepath+"editer"+sp+"tslfile.tsm"; + FOpendpaths := basepath+"editer"+sp+"openedpaths.tsm"; + FTabWidthpath := basepath+"editer"+sp+"tabwidpath.tsm"; + Fsysfontpath := basepath+"editer"+sp+"sysfont.tsm"; + FexefileCmds := basepath+"editer"+sp+"cmds.tsm"; + FHistoryPath := basepath+"editer"+sp+"HistoryPath.tsm"; + FCodeblockPath := basepath+"editer"+sp+"BlockManager.tsm"; + FFindhistroypath := basepath+"editer"+sp+"findhistory.tsm"; + FFormatpath := basepath+"editer"+sp+"tslformat.tsm"; + Fhighlightpath := basepath+"editer"+sp+"highlight.tsm"; + feditorglobalpath := basepath+"editer"+sp+"feditorglobalpath.tsm"; + Fremotepath := basepath+"editer"+sp; + CreateDirWithFileName(basepath+"editer"+sp+"1.txt"); + CreateDirWithFileName(basepath+"editer"+sp+"cmpCaches"+sp+"1.txt"); + fdirspath := basepath+"editer"+sp+"tsldirpath.tsm"; + end + function init_work_dir_wnd();//初始化工作目录 + begin + Fdirview := new tdirviewer(FEdter); + Fdirview.fcloseclick := function(o,e)begin + Fdirview.Visible := false; + fdirspliter.Visible := false; + end + Fdirview.Visible := false; + Fdirview.align := alLeft; + fdirspliter := new tsplitter(self); + fdirspliter.Visible := false; + fdirspliter.align := alLeft; + Fdirview.Parent := self; + fdirspliter.Parent := self; + if importfile(ftstream(),"",fdirspath,dirs)=1 then + begin + Fdirview.addrootdirs(dirs); + end + end + function init_codeblock_wnd(); //初始化代码块编辑窗口 + begin + fBlockManager := new TBlockManager(self); + fBlockManager.WsDlgModalFrame := true; + fBlockManager.caption := c_m_block_mgr; + fBlockManager.minmaxbox := false; + fBlockManager.Visible := false; + fBlockManager.Parent := self; + fBlockManager.SaveClick := function(o,e)begin + d := fBlockManager.GetData(); + Exportfile(ftstream(),"",FCodeblockPath,d); + fBlockManager.EndModal(); + class(TTSLCompletion).FCodeBlocks := d; + end + + if 1= importfile(ftstream(),"",FCodeblockPath,d) and d and ifarray(d) then + begin + fBlockManager.SetData(d); + class(TTSLCompletion).FCodeBlocks := d; + end else + begin + try + d := GetTslCompletionCodeBlocks(); + fBlockManager.SetData(d); + class(TTSLCompletion).FCodeBlocks := d; + except + + end + end + end + function init_code_format_wnd(); //初始化格式窗口 + begin + FFormatInfoWnd := NEW t_editor_config(self); + FFormatInfoWnd.Visible := false; + FFormatInfoWnd.WsDlgModalFrame := true; + FFormatInfoWnd.Parent := self; + FFormatInfoWnd.onclose := function(o,e)begin + e.skip := true; + o.Visible := false; + end + FFormatInfoWnd.OnOkClicked := function(o,e)begin + o.Visible := false; + d := o.GetData(); + FEdter.SetCodeFormatInfo(d); + Exportfile(ftstream(),"",FFormatpath,d); + end + if 1=Importfile(ftstream(),"",FFormatpath,FMTDATA) then + begin + if ifarray(FMTDATA) then FEdter.SetCodeFormatInfo(FMTDATA); + FFormatInfoWnd.setdata(FMTDATA); + end + end + function init_tabwidth_menus(tbwidth); //初始化tab按键信息 + begin + if importfile(ftstream(),"",FTabWidthpath,d)=1 and ( d>0 ) then //tab宽度 + begin + tbwidth := d; + end + FMTabs := array(); + FMTabContain :=new TMenu(self); + FMTabContain.Caption := c_m_tab_config; + for i:= 0 to 6 do + begin + tm := new TMenu(self); + if i=0 then tm.Caption := "\\t"; + else + tm.Caption := inttostr(i)+c_m_blank; + if tbwidth=i then tm.Checked := true; + tm.Onclick := thisfunction(TabWidthClick); + FMTabs[i] := tm; + tm.Parent := FMTabContain; + end + return FMTabContain; + end + function init_lang_menus();//语言菜单 + begin + FSynMenu := New TMenu(self); + FSynMenu.Caption := c_m_lang; + FSynMenus := array(); + for i,v in FEdter.GetSynTypeNames() do + begin + it := new TMenu(self); + it.Caption := v; + FSynMenus[i] := it; + it.OnClick := thisfunction(ClickSynMenu); + it.Parent := FSynMenu; + end + return FSynMenu; + end + function init_help_menus(); //初始帮助菜单 + begin + FHelpMenu := new TMenu(self); + FHelpMenu.Caption := c_m_help; + //////////////////////////////////////// + mmhi := new TMenu(self); + mmhi.caption := c_m_manu; + mmhi.OnClick := thisfunction(help_editor_manu); + mmhi.Parent := FHelpMenu; + + mmhi := new TMenu(self); + mmhi.caption := c_m_tsl_help; + mmhi.OnClick := thisfunction(help_tsl); + mmhi.Parent := FHelpMenu; + mmhi := new TMenu(self); + mmhi.caption := c_m_about; + mmhi.OnClick := thisfunction(help_about); + mmhi.Parent := FHelpMenu; + return FHelpMenu; + end + function init_run_menus();//初始执行菜单 + begin + FRunMenu := new TMenu(self); + FRunMenu.caption := c_m_run; + FExeaction := new TAction(self); + FExeaction.caption := c_m_exec; + FExeaction.ShortCut := "F9"; + FExeaction.onexecute := function(o,e) + begin + FEdter.ExecutePageItem(FEdter.GetCurrentItem()); + end + for i,v in array(c_m_cmd_config,c_m_debuger,c_m_tsl_dir,c_m_exec,c_m_exec_debug,c_m_remote_debug,c_m_remote_debug_wait,c_m_compile) do + begin + it := new TMenu(self); + if v = c_m_exec then + begin + it.Action := FExeaction; + end + if v=c_m_debuger then + begin + it.caption := v; + ite := new TMenu(self); + ite.caption := c_m_editor; + ite.Parent := it; + itb := new TMenu(self); + itb.caption := c_m_exer; + global g_debug_chooser; + g_debug_chooser := c_m_exer; + itb.Checked := true; + itb.Parent := it; + itb._tag := ite; + ite._tag := itb; + f := function(o,e)begin + o.Checked := true; + o._tag.Checked := false; + global g_debug_chooser; + g_debug_chooser := o.caption; + end + ite.OnClick := f; + itb.OnClick := f; + end else + begin + it.caption := v; + it.OnClick := thisfunction(clickRun); + end + it.Parent := FRunMenu; + end + return FRunMenu; + end + function init_window_menus(); //初始窗口菜单 + begin + ms := new TMenu(self); + ms.Caption := c_m_window; + fmglobsearch := new TMenu(self); + fmglobsearch.caption := c_m_logwindow; + fmglobsearch.OnClick := function(o,e) + begin + FEDter.SwitchLogWnd(); + end + fmglobdir := new TMenu(self); + fmglobdir.caption := c_m_dir; + fmglobdir.onclick := function(o,e) + begin + v := not(Fdirview.Visible); + Fdirview.Visible := v; + fdirspliter.Visible := v; + end + fmglobsearch.Parent := ms; + fmglobdir.Parent := ms; + return ms; + end + function init_encode_menus(); //初始化后编码菜单 + begin + FEnCodeMenu := new TMenu(self); + FEnCodeMenu.Caption := c_m_encode; + FCodeMenus := array(); + for i,v in array(c_e_None,c_e_ansi,c_e_utf8,c_e_utf8bom,c_e_ucs2big,c_e_ucs2little,c_e_separator,c_e_to_ansi,c_e_to_utf8,c_e_to_utf8bom,c_e_to_ucs2big,c_e_to_ucs2little) do + begin + it := new TMenu(self); + it.Caption := v; + FCodeMenus[i] := it; + if v=c_e_separator then it.TSeparator := true; + else + if v in array(c_e_ucs2big,c_e_ucs2little,c_e_utf8bom) then + begin + it.Enabled := false; + end else + begin + it.OnClick := thisfunction(ClickEnCodeMenu); + end + it.Parent := FEnCodeMenu; + end + return FEnCodeMenu; + end + function load_edt_other_info();//加载其他信息 + begin + GLobal G_OpenHostory; + if (importfile(ftstream(),"",feditorglobalpath,ginfo)=1) and ifarray(ginfo) then + begin + global editorglobalinfo ; + editorglobalinfo := ginfo; + if ifarray(ginfo) then + begin + app := initializeapplication(); + app.font := array("width":ginfo["fontsize"],"height" :ginfo["fontsize"]*2); + NotifyComponent(self,ginfo); + end + end + + FEdter.FHistoryDir:= Fremotepath; + if importfile(ftstream(),"",FPathDirPath,dirs)=1 then + begin + FEdter.TslSearchDir := formatsearchdir(dirs); + end else + begin + fn := SysExecName(); + fio := ioFileseparator(); + for i:= length(fn) downto 1 do + begin + if fn[i]=fio then + begin + dirs := array( + fn[1:i]+"funcext" + ); + break; + end + end + FEdter.TslSearchDir := dirs; + end + if ifarray(dirs) and dirs then FDirs := dirs; + if G_OpenHostory then + begin + if 1= importfile(ftstream(),"",FOpendpaths,opinfo) then + begin + if ifarray(opinfo) then + begin + for i,v in opinfo["pages"] do + begin + it := FEdter.OpenAndGoLineByName(v["filename"],v["r"]); + if it then + begin + ls := it.FEditer.Lines; + for j,vj in v["f2"] do + begin + if vj and ls[j]then ls[j].FMarked := true; + end + if v["isnewfile"] then it.fisnewfile := true; + end + end + if ifarray(opinfo["currentpage"]) then + begin + it := FEdter.OpenAndGotoFileByName( opinfo["currentpage"][0],opinfo["currentpage"][1]); + //if it then it.FEditer.SetFocus(); + end + end + end + if 1= importfile(ftstream(),"",FHistoryPath,hist) then + begin + FEdter.SetHistoryFiles(hist); + end + if 1 = importfile(ftstream(),"",FFindhistroypath,fds) then + begin + FEdter.SetFindHistroy(fds); + end + if 1 = importfile(ftstream(),"",Fhighlightpath,fds) then + begin + FEdter.hltcolor := fds; + end + end + if 1=Importfile(ftstream(),"",FexefileCmds,cmds) then + begin + FEdter.FExecuteEditer.SetData(cmds); + end else + begin + FEdter.FExecuteEditer.SetData(array( + "items":(("caption":"tsl","exe":format('"%s" "%s" -libpath "%s"',"$(TSL_EXE)","$(FULL_CURRENT_PATH)","$(SEARCH_PATH)"))), + "itemindex":0 + )); + end + end + function formatsearchdir(d); + begin + for i,v in d do + begin + if not ifarray(v)then return d; + if v["s"] then return v["d"]; + end + return array(); + end + function save_edt_caches(); //保存编辑器的缓存数据 + begin + d := Fdirview.getrootdirs(); + if d and ifarray(d) then + begin + exportfile(ftstream(),"",fdirspath,d); + end + d := FEdter.FExecuteEditer.GetData(); + if d and ifarray(d) then + begin + exportfile(ftstream(),"",FexefileCmds,d); + end + d := FEdter.GetHistoryFiles(); + if ifarray(d) and d then + begin + Exportfile(ftstream(),"",FHistoryPath,d); + end + d := FEdter.GetFindHistory(); + if ifarray(d) and d then + begin + Exportfile(ftstream(),"",FFindhistroypath,d); + end + d := FEdter.hltcolor; + if ifarray(d) and d then + begin + Exportfile(ftstream(),"",Fhighlightpath,d); + end + global editorglobalinfo ; + if ifarray(editorglobalinfo) and editorglobalinfo then + begin + Exportfile(ftstream(),"",feditorglobalpath,editorglobalinfo); + end + save_opend_file_name(); + end + function save_opend_file_name(); //保存当前打开的文件 + begin + global g_dotsavehistory; + if g_dotsavehistory then return ; + d := FEdter.GetAllPagesInfo(); + if not ifarray(d) then d := array(); + if flastopend = d then return ; + exportfile(ftstream(),"",FOpendpaths,d); + flastopend := d; + end + protected +type TBlockEditer = class(TPanel) uses TSLVCL,UtslCodeEditor; function Create(AOwner);override; begin @@ -1072,7 +1094,6 @@ type TBlockManager=class(TVCForm) end "保存": begin - //echo tostn(FList.ListValues); calldatafunction(FSaveClick,self,e); end @@ -1412,7 +1433,6 @@ end FFormatInfoWnd; fBlockManager; FCodeMenus; - FCloseMenu; FSynMenus; FCPB; FMTabs; @@ -1420,7 +1440,6 @@ end FOpendpaths; FTabWidthpath; Fsysfontpath; - FFileopen; FexefileCmds; FCodeblockPath; FHistoryPath; diff --git a/designer/udesignerproject.tsf b/designer/udesignerproject.tsf index 739e0f4..e580174 100644 --- a/designer/udesignerproject.tsf +++ b/designer/udesignerproject.tsf @@ -13,6 +13,10 @@ type TProjectManagerForm = class(TVCForm) // minmaxbox := false; Border := false; FProjectCoder := new TDesignerProjectsRecoder(); + fbtncontainer := new tpanel(self); + fbtncontainer.Align := alBottom; + fbtncontainer.autosize := true; + fbtncontainer.parent := self; FDesigner := AOwner; visible := false; WsSizeBox := true; @@ -20,23 +24,15 @@ type TProjectManagerForm = class(TVCForm) // WsPopUp := true; WsSysMenu := true; rc := _wapi.GetScreenRect(); - //l :=(rc[2]-rc[0])/2-280; - //t :=(rc[3]-rc[1])/2-230; - //SetBoundsRect(array(l,t,480+l,300+t)); SetBoundsRect(array(100,100,700,500)); FList := new TProgValueList(self); + FList.Align := alClient; FList.Border := true; d := GetAllProjects(); p := array(); for i,v in d do p[i]:= array("caption":v["name"],"value":v["file"]); FList.SetData(p); if p then FList.SetCurrentSelection(0); - FLinea := new TLabel(self); - FLinea.caption := ""; - FLinea.height := 2; - FLinea.left :=-1; - FLinea.Color := rgb(30,144,255); - FLinea.parent := self; FList.parent := self; FList.OnDblClick := thisfunction(OpenSelectedObject); FDelBtn := new TBtn(self); @@ -45,8 +41,7 @@ type TProjectManagerForm = class(TVCForm) // FOpenBtn.height := 28; FDelBtn.height := 28; FOpenBtn.caption := "打开"; - FDelBtn.parent := self; - FOpenBtn.parent := self; + FDelBtn.OnClick := function(o,e) begin cid := FList.getCurrentSelection(); @@ -62,6 +57,23 @@ type TProjectManagerForm = class(TVCForm) // end end FOpenBtn.OnClick := thisfunction(OpenSelectedObject); + spc := new TLabel(self); + spc2 := new TLabel(self); + spc.caption := " "; + spc2.caption := " "; + FOpenBtn.autosize := true; + spc.autosize := true; + spc2.autosize := true; + FDelBtn.autosize := true; + FDelBtn.Align := alRight; + FOpenBtn.Align := alRight; + spc.Align := alRight; + spc2.Align := alRight; + spc2.parent := fbtncontainer; + FOpenBtn.parent := fbtncontainer; + spc.parent := fbtncontainer; + FDelBtn.parent := fbtncontainer; + end function OpenSelectedObject(); begin @@ -105,23 +117,7 @@ type TProjectManagerForm = class(TVCForm) // if it then n := it["value"]; return n; end - function DoControlAlign();override; - begin - if FList and FDelBtn and FOpenBtn and FLinea then - begin - rc := ClientRect; - rc1 := rc; - rc1[3]-= 35; - FList.SetBoundsRect(rc1); - FLinea.top := rc1[3]+2; - tp := rc1[3]+5; - FDelBtn.Top := tp; - FDelBtn.left := rc[2]-200; - FOpenBtn.Top := tp; - FOpenBtn.left := rc[2]-100; - if rc[2]>FLinea.width then FLinea.width := rc[2]; - end - end + function CreateTpjFomFile(f); begin if AddAproject(F)then @@ -188,7 +184,7 @@ end ls := FProjectCoder.ListProjects(); return ls; end - FLinea; + fbtncontainer; FList; FDelBtn; FOpenBtn; @@ -541,7 +537,7 @@ type TProjectView = class(TVCForm) // fnewmenu.Enabled := false; fgoformmenu.Enabled := false; fnewmenu.caption := "新建"; - for i,v in array("form","panel","script","tsf") do + for i,v in array("form","panel","script","tsf","继承窗口") do begin it := new TMenu(self); it.caption := v; @@ -593,7 +589,9 @@ type TProjectView = class(TVCForm) // if it=ftree.RootNode then begin if FAddtoolbtn then FAddtoolbtn.Enabled := false; - return FDesigner.ExecuteCommand("hiddrennode",nil); + r := FDesigner.ExecuteCommand("hiddrennode",nil); + FCurrentOpend := nil; + return r; end if it then begin @@ -673,6 +671,10 @@ type TProjectView = class(TVCForm) // begin AddFormToCurrentDir(createnamea("form"),cnd); end + "继承窗口": + begin + add_inherited(); + end end end @@ -904,7 +906,11 @@ type TProjectView = class(TVCForm) // function ShowEditor(); //显示函数编辑 begin //FTslEditer.Show(SW_SHOWNOACTIVATE); // - FTslEditer.Show(); // + if _wapi.IsIconic(FTslEditer.Handle)<>0 then + begin + FTslEditer.Show(SW_RESTORE); + end else + FTslEditer.Show(); // _wapi.bringWindowToTop(FTslEditer.Handle); it := FTslEditer.GetCurrentEditer(); if it then return it.SetFocus(); @@ -990,11 +996,17 @@ type TProjectView = class(TVCForm) // begin if fopenbuzy then return ; fio := ioFileseparator(); - if not(n and ifstring(n)) then return FDesigner.ExecuteCommand("hiddrennode",nil);; + if not(n and ifstring(n)) then + begin + r := FDesigner.ExecuteCommand("hiddrennode",nil); + FCurrentOpend := nil; + return r; + end nopend := FTree.NameInTree(n,nil,true); if not nopend then begin FDesigner.ExecuteCommand("hiddrennode",nil); + FCurrentOpend := nil; return ; end if nopend=FCurrentOpend then @@ -1248,7 +1260,7 @@ end %%,fn); DeleteAllFiles(FCProjectPath+dp); end FCurrentOpend := nil; - FTree.DeleteCurrentNode(); + FTree.DeleteCurrentNode(cn); SaveProjInfo(); end end @@ -1274,7 +1286,7 @@ end %%,fn); end end; end - FTree.DeleteCurrentNode(); + FTree.DeleteCurrentNode(nd); SaveProjInfo(); end end @@ -1657,6 +1669,7 @@ end exit; end d := get_config_info(); + d["designer"] := true; ShowEditor(); d := FTslEditer.build_with_data(FCProjectPath,d); if d then @@ -1687,14 +1700,7 @@ end end else begin - for i := length(exename) downto 2 do - begin - if exename[i]="\\" then - begin - exename := exename[1:i]+"tsl.exe"; - break; - end - end + exename := gettslexefullpath(); filecopy("",exename,"",FWrapFolder.Folder+"\\tsl\\tsl.exe",false); end ReWriteString(FWrapFolder.Folder+"\\start.cmd",s); @@ -1738,6 +1744,15 @@ end end function saveCurrentEdit(nd); //编辑的节点,不送入保存当前节点 begin + if nd = "all" then + begin + r := FDesigner.ExecuteCommand("allopendnod",nil); + for i,v in r do + begin + saveCurrentEdit(v); + end + return ; + end if not nd then nd := FCurrentOpend; if nd then begin @@ -1794,6 +1809,7 @@ end begin FDesigner.UnLoadTreeNode(nd); if nd = FCurrentOpend then FCurrentOpend := nil; + FTree.CurrentNode := nd.parent; //跳转到当前关闭节点的父节点 20151205 end end end @@ -2637,9 +2653,9 @@ type TFileTree = class(TTreeCtl) begin FPNode.RecyclingChildren(); end - function DeleteCurrentNode(); //删除节点 + function DeleteCurrentNode(c); //删除节点 begin - C := CurrentNode; + if not c then C := CurrentNode; if not c then return false; if FPNode=c then return false; //pc := c.parent; diff --git a/designer/utslcodeeditor.tsf b/designer/utslcodeeditor.tsf index 04bf809..51509a8 100644 --- a/designer/utslcodeeditor.tsf +++ b/designer/utslcodeeditor.tsf @@ -856,6 +856,7 @@ type TExecuteEditer=class(TCustomControl) //执 begin FMemo.ExecuteCommand(FMemo.ecGotoXY,array(1,1)); FMemO.SetFocus(); + center_popup_wnd(self); show(); end function Create(AOwner); @@ -1800,6 +1801,30 @@ type TPageEditer=class(TPage) // end [weakref]FPageItemOnRClick; end +type teditorcoolbar = class(tcoolbar) + function create(AOwner); + begin + inherited; + end + function doControlALign();override; + begin + inherited; + r := ClientRect; + cts := Controls; + h := 0; + for i := 0 to cts.count-1 do + begin + vi := cts[i]; + if vi.Visible then + begin + h := max(h,vi.Height+vi.top); + w := max(w,vi.Width+vi.left); + end + end + if (h>Height) or (hWidth then Width := w; + end +end type TTslChmHelp=class() function SearchWord(s); begin @@ -1851,9 +1876,11 @@ type TEditer=class(TCustomcontrol) // ftoolbara := new TToolBar(self); //工具栏 ftoolbarb := new TToolBar(self); //工具栏 FStatus := new TStatusBar(self); //状态栏 - fcoolbar := new tcoolbar(self); + fcoolbar := new teditorcoolbar(self); ftoolbara.Align := alNone; ftoolbarb.Align := alNone; + ftoolbarb.autosize := true; + ftoolbara.autosize := true; fcoolbar.autosize := true; FInfoShowWnd := new TEditerAuxiliary(self); FPageEditer := new TPageEditer(self); @@ -1949,14 +1976,8 @@ type TEditer=class(TCustomcontrol) // //////// FListPages.Visible := false; //////////////////////////// - FPageMenu := new TPopUpMenu(self); - for i,v in array("关闭","关闭其他标签","关闭左侧所有","关闭右侧所有","复制文件名","复制文件全名","重新加载","打开目录","另存为") do - begin - mi := new TMenu(self); - mi.Caption := v; - mi.Parent := FPageMenu; - mi.OnClick := thisfunction(PageMenuClick); - end + init_page_title_popmenu(); + ///////////////////////////////////////////////////////////////////////////////////// FExecuteEditer := new TExecuteEditer(self); FExecuteEditer.visible := false; //////////// @@ -2065,6 +2086,54 @@ type TEditer=class(TCustomcontrol) // fsyssizemgr := new tsyssizemgr(self); fsyssizemgr.Parent := self; end + function init_page_title_popmenu(); //初始化page的标题菜单 + begin + FPageMenu := new TPopUpMenu(self); + mi := new TMenu(self); + mi.Caption := "关闭"; + mi.Parent := FPageMenu; + mi.OnClick := thisfunction(do_close_cpage); + + mi := new TMenu(self); + mi.Caption := "关闭其他标签"; + mi.Parent := FPageMenu; + mi.OnClick := thisfunction(do_close_lrpage); + + mi := new TMenu(self); + mi.Caption := "关闭左侧所有"; + mi.Parent := FPageMenu; + mi.OnClick := thisfunction(do_close_lpage); + + mi := new TMenu(self); + mi.Caption := "关闭右侧所有"; + mi.Parent := FPageMenu; + mi.OnClick := thisfunction(do_close_rpage); + + mi := new TMenu(self); + mi.Caption := "复制文件名"; + mi.Parent := FPageMenu; + mi.OnClick := thisfunction(do_copy_page_name); + + mi := new TMenu(self); + mi.Caption := "复制文件全名"; + mi.Parent := FPageMenu; + mi.OnClick := thisfunction(do_copy_page_path); + + mi := new TMenu(self); + mi.Caption := "重新加载"; + mi.Parent := FPageMenu; + mi.OnClick := thisfunction(do_reload_page); + + mi := new TMenu(self); + mi.Caption := "打开目录"; + mi.Parent := FPageMenu; + mi.OnClick := thisfunction(do_open_page_dir); + + mi := new TMenu(self); + mi.Caption := "另存为"; + mi.Parent := FPageMenu; + mi.OnClick := thisfunction(do_save_page_as); + end function modifysyssize(); begin global editorglobalinfo; @@ -2648,272 +2717,259 @@ type TEditer=class(TCustomcontrol) // end DeletePageItem(it); end - function PageMenuClick(o,e); + /////////////////////////////////////////////////////////////////// + function do_close_cpage(); //关闭当前 begin it := GetCurrentItem(); - if not it then return; - case o.Caption of - "关闭": + if not it then return ; + docloseapageitem(it); + end + function do_close_lpage(); //关闭左侧所有 + begin + it := GetCurrentItem(); + if not it then return ; + its := GetAllPageItems(); + itss := array(); + for i := 0 to its.Length()-1 do + begin + iti := its[i]; + if iti=it then break ; + itss[i] := iti; + end + fcloseflag := true; + try + for i,iti in itss do begin - docloseapageitem(it); - end - "关闭左侧所有": - begin - its := GetAllPageItems(); - itss := array(); - for i := 0 to its.Length()-1 do - begin - iti := its[i]; - if iti=it then break ; - itss[i] := iti; - end - fcloseflag := true; - try - for i,iti in itss do - begin - docloseapageitem(iti); - end - finally - fcloseflag := false; - end; - if itss then FPageEditer.CallSelChanged(); - + docloseapageitem(iti); end - "关闭右侧所有": - begin - dodel := 0; - its := GetAllPageItems(); - itss := array(); - for i := 0 to its.Length()-1 do + finally + fcloseflag := false; + end; + if itss then FPageEditer.CallSelChanged(); + end + function do_close_rpage(); //关闭右侧 + begin + it := GetCurrentItem(); + if not it then return ; + dodel := 0; + its := GetAllPageItems(); + itss := array(); + for i := 0 to its.Length()-1 do + begin + itss[i] := its[i]; + end + fcloseflag := true; + try + for i,iti in itss do + begin + if dodel then docloseapageitem(iti); + if iti=it then begin - itss[i] := its[i]; - end - fcloseflag := true; - try - for i,iti in itss do - begin - if dodel then docloseapageitem(iti); - if iti=it then - begin - dodel := 1; - end ; - end - finally - fcloseflag := false; - end; - if dodel then FPageEditer.CallSelChanged(); - end - "关闭其他标签": + dodel := 1; + end ; + end + finally + fcloseflag := false; + end; + if dodel then FPageEditer.CallSelChanged(); + end + function do_close_lrpage(); //关闭其他 + begin + it := GetCurrentItem(); + if not it then return ; + Cit := it; + its := GetAllPageItems(); + fcloseflag := true; + try + for i := 0 to its.Length()-1 do + begin + it := its[i]; + if it.FEditer.ChangedFlag then begin - Cit := it; - its := GetAllPageItems(); - fcloseflag := true; - try - for i := 0 to its.Length()-1 do + r := MessageBoxA("存在未保存的文件,是否保存!","提示",3,self); + if r=IDYES then + begin + SaveAllPageItems(); + break; + end else + if r=IDCANCEL then + begin + return; + end else begin - it := its[i]; - if it.FEditer.ChangedFlag then - begin - r := MessageBoxA("存在未保存的文件,是否保存!","提示",3,self); - if r=IDYES then - begin - SaveAllPageItems(); - break; - end else - if r=IDCANCEL then - begin - return; - end else - begin - end - break; - end end - CloseAllPageItems(Cit); - finally - fcloseflag := false; - end; - end - "另存为": - begin - if JudgeItemState(it)then return; - //FFileopen.OverwritePrompt := true; - if FFileSave.OpenDlg()then - begin - fn := FFileSave.FileName; - dfn := it.ScriptPath; - CreateDirWithFileName(fn); - //echo format('FileCopy("","%s","","%s",false)',dfn,fn); - ret := FileCopy("",dfn,"",fn,false); - if ret then - begin - it.ScriptPath := fn; - if SavePageItem(it)=0 then - begin - it.FEditer.ChangedFlag := true; - end - if it.fisnewfile then - begin - FileDelete("",dfn); - it.fisnewfile := false; - end - end - end - //FFileopen.OverwritePrompt := false; - end - "重新加载": - begin - LoadFromFile(it,true); - end - "复制文件全名": - begin - if not FCliper then FCliper := new TClipBoard(self); - FCliper.text := it.OrigScriptPath; - end - "复制文件名": - begin - if not FCliper then FCliper := new TClipBoard(self); - FCliper.text := it.Caption; - end - "打开目录": - begin - p := it.ScriptPath; - if FileExists("",p)then - begin - {for i := length(p)downto 3 do - begin - if p[i]="\\" then - begin - p := p[1:i]; - break; - end - end} - //_wapi.WinExec('cmd.exe /C start "" "'+p,1); - _wapi.openresourcemanager(p); - end - end - "采用cmd执行": - begin - //ExecutePageItemWithCmd(it); + break; end end + CloseAllPageItems(Cit); + finally + fcloseflag := false; + end; end + function do_save_page_as(); //另存为 + begin + it := GetCurrentItem(); + if not it then return ; + if JudgeItemState(it)then return; + //FFileopen.OverwritePrompt := true; + if FFileSave.OpenDlg()then + begin + fn := FFileSave.FileName; + dfn := it.ScriptPath; + CreateDirWithFileName(fn); + //echo format('FileCopy("","%s","","%s",false)',dfn,fn); + ret := FileCopy("",dfn,"",fn,false); + if ret then + begin + it.ScriptPath := fn; + if SavePageItem(it)=0 then + begin + it.FEditer.ChangedFlag := true; + end + if it.fisnewfile then + begin + FileDelete("",dfn); + it.fisnewfile := false; + end + end + end + end + function do_reload_page(); //重新加载 + begin + it := GetCurrentItem(); + if not it then return ; + LoadFromFile(it,true); + end + function do_copy_page_path(); //复制文件全名 + begin + it := GetCurrentItem(); + if not it then return ; + if not FCliper then FCliper := new TClipBoard(self); + FCliper.text := it.OrigScriptPath; + end + function do_copy_page_name(); //复制文件名 + begin + it := GetCurrentItem(); + if not it then return ; + if not FCliper then FCliper := new TClipBoard(self); + FCliper.text := it.Caption; + end + function do_open_page_dir(); //打开文件夹 + begin + it := GetCurrentItem(); + if not it then return ; + p := it.ScriptPath; + if FileExists("",p)then + begin + {for i := length(p)downto 3 do + begin + if p[i]="\\" then + begin + p := p[1:i]; + break; + end + end} + //_wapi.WinExec('cmd.exe /C start "" "'+p,1); + _wapi.openresourcemanager(p); + end + end + ////////////////////////////////////////////////////////////// function PageItemOnRClick(o,e); begin if FPageEditer.GetItemIndexByPos(e.pos)>= 0 then o.PopUpMenu := FPageMenu; else o.PoPupMenu := nil; end - function PageEditerMenuClick(o,e); + /////////////右键菜单///////////////////////////////////////// + function do_to_unix_lf();//linux行结尾 begin - cp := o.Caption; - if ("转unix(LF)"=cp) then + it := GetCurrentItem(); + it.scripttype := 1; + SavePageItem(it,1); + end + function do_copy_page();//复制 + begin + it := GetCurrentItem(); + if it then begin - it := GetCurrentItem(); - it.scripttype := 1; - SavePageItem(it,1); - //it.FEditer.ChangedFlag := true; - return ; - end else - if ("转windows(CR LF)"=cp) then - begin - it := GetCurrentItem(); - it.scripttype := 0; - SavePageItem(it,1); - return ; - end else - if ("另存为"=cp) then - begin - return PageMenuClick(o,e); - end else - if pos("复制",cp)=1 then - begin - it := GetCurrentItem(); - if it then + ed := it.FEditer; + if ed then begin - ed := it.FEditer; - if ed then - begin - ed.ExecuteCommand(ed.ecCopy); - end - //it.FEditer.ReadOnly := not(o.Checked); + ed.ExecuteCommand(ed.ecCopy); end - return; - end else - if pos("粘贴",cp)=1 then + end + end + function do_past_page();//粘贴 + begin + it := GetCurrentItem(); + if it then begin - it := GetCurrentItem(); - if it then + ed := it.FEditer; + if ed then begin - ed := it.FEditer; - if ed then - begin - ed.ExecuteCommand(ed.ecPaste); - end - //it.FEditer.ReadOnly := not(o.Checked); + ed.ExecuteCommand(ed.ecPaste); end - return; - end else - if pos("剪切",cp)=1 then + end + end + function do_cut_page();//剪切 + begin + it := GetCurrentItem(); + if it then begin - it := GetCurrentItem(); - if it then + ed := it.FEditer; + if ed then begin - ed := it.FEditer; - if ed then - begin - ed.ExecuteCommand(ed.ecCut); - end - //it.FEditer.ReadOnly := not(o.Checked); + ed.ExecuteCommand(ed.ecCut); end - return; - end else - if pos("定位",cp)=1 then + end + end + function do_goto_line();//定位 + begin + center_popup_wnd(FGotoLineWnd,true);//InitShowWndPos(FGotoLineWnd,"g",200,200); + FGotoLineWnd.ShowGoto(); + end + function do_to_win_lf();//win 行结尾 + begin + it := GetCurrentItem(); + it.scripttype := 0; + SavePageItem(it,1); + end + function do_goto_func(o);//查看函数 + begin + cs := o.Caption; + if length(cs)<6 then return; + s :=(o.Caption)[6:]; + GetCurrentEditer().Tryjump(s); + end + function do_read_only(o);//只读 + begin + it := GetCurrentItem(); + if it then begin - center_popup_wnd(FGotoLineWnd,true);//InitShowWndPos(FGotoLineWnd,"g",200,200); - FGotoLineWnd.ShowGoto(); - return; - end else - if pos("查看",cp)=1 then - begin - cs := o.Caption; - if length(cs)<6 then return; - s :=(o.Caption)[6:]; - GetCurrentEditer().Tryjump(s); - return; - end else - if pos("只读",cp)=1 then - begin - it := GetCurrentItem(); - if it then - begin - it.FEditer.ReadOnly := not(o.Checked); - end - return; - end else - if pos("执行",cp)=1 then - begin - it := GetCurrentItem(); - ExecutePageItem(it); - return; - end else - if pos("停止",cp)=1 then - begin - if FEchoWnd.Exeing()then FEchoWnd.EndExe(); - return; - end else - if cp = "转换为大写" then - begin - upperorlowercase(1); - end else - if cp = "转换为小写" then - begin - upperorlowercase(0); - end else - if cp = "删除尾空白" then - begin - seltrimright(); - end + it.FEditer.ReadOnly := not(o.Checked); + end end + function do_execute_page();//执行 + begin + it := GetCurrentItem(); + ExecutePageItem(it); + end + function do_execute_stop();//停止执行 + begin + if FEchoWnd.Exeing()then FEchoWnd.EndExe(); + end + function do_upper_case();//转大写 + begin + upperorlowercase(1); + end + function do_lower_case();//转大写 + begin + upperorlowercase(0); + end + function do_del_line_end();//删除行尾空白 + begin + seltrimright(); + end + /////////////////////////////////////////////////////////// function PageEditerOnRClick(o,e); begin o.popupMenu := nil; @@ -2921,28 +2977,92 @@ type TEditer=class(TCustomcontrol) // begin FPageEditerMenu := new TPopUpMenu(self); FPageEditerMenus := array(); - for i,v in array("查看","复制(C)","粘贴(V)","剪切(X)","定位(G)","只读","转换为大写","转换为小写","删除尾空白","文档格式","执行(F9)","停止执行","另存为") do - begin - it := new TMenu(self); - it.Caption := v; - - it.parent := FPageEditerMenu; - if "文档格式"=v then - begin - for j,vj in array("转unix(LF)","转windows(CR LF)") do - begin - subit := new TMenu(self); - FPageEditerMenus[vj]:= subit; - subit.Caption := vj ; - subit.Parent := it; - subit.OnClick := thisfunction(PageEditerMenuClick); - end - FPageEditerMenus[v] := it; - continue; - end - FPageEditerMenus[v]:= it; - it.OnClick := thisfunction(PageEditerMenuClick); - end + + it := new TMenu(self); + it.Caption := "查看"; + it.parent := FPageEditerMenu; + FPageEditerMenus["查看"] := it; + it.OnClick := thisfunction(do_goto_func); + + subit := new TMenu(self); + subit.Caption := "文档格式"; + subit.Parent := FPageEditerMenu; + it := new TMenu(self); + it.Caption := "转unix(LF)"; + it.parent := subit; + FPageEditerMenus["转unix(LF)"] := it; + it.OnClick := thisfunction(do_to_unix_lf); + + it := new TMenu(self); + it.Caption := "转windows(CR LF)"; + it.parent := subit; + FPageEditerMenus["转windows(CR LF)"] := it; + it.OnClick := thisfunction(do_to_win_lf); + + it := new TMenu(self); + it.Caption := "复制(C)"; + it.parent := FPageEditerMenu; + FPageEditerMenus["复制(C)"] := it; + it.OnClick := thisfunction(do_copy_page); + + it := new TMenu(self); + it.Caption := "粘贴(V)"; + it.parent := FPageEditerMenu; + FPageEditerMenus["粘贴(V)"] := it; + it.OnClick := thisfunction(do_past_page); + + it := new TMenu(self); + it.Caption := "剪切(X)"; + it.parent := FPageEditerMenu; + FPageEditerMenus["剪切(X)"] := it; + it.OnClick := thisfunction(do_cut_page); + + it := new TMenu(self); + it.Caption := "定位(G)"; + it.parent := FPageEditerMenu; + FPageEditerMenus["定位(G)"] := it; + it.OnClick := thisfunction(do_goto_line); + + it := new TMenu(self); + it.Caption := "只读"; + it.parent := FPageEditerMenu; + FPageEditerMenus["只读"] := it; + it.OnClick := thisfunction(do_read_only); + + it := new TMenu(self); + it.Caption := "转换为大写"; + it.parent := FPageEditerMenu; + FPageEditerMenus["转换为大写"] := it; + it.OnClick := thisfunction(do_upper_case); + + it := new TMenu(self); + it.Caption := "转换为小写"; + it.parent := FPageEditerMenu; + FPageEditerMenus["转换为小写"] := it; + it.OnClick := thisfunction(do_lower_case); + + it := new TMenu(self); + it.Caption := "删除尾空白"; + it.parent := FPageEditerMenu; + FPageEditerMenus["删除尾空白"] := it; + it.OnClick := thisfunction(do_del_line_end); + + it := new TMenu(self); + it.Caption := "执行(F9)"; + it.parent := FPageEditerMenu; + FPageEditerMenus["执行(F9)"] := it; + it.OnClick := thisfunction(do_execute_page); + + it := new TMenu(self); + it.Caption := "停止执行"; + it.parent := FPageEditerMenu; + FPageEditerMenus["停止执行"] := it; + it.OnClick := thisfunction(do_execute_stop); + it := new TMenu(self); + it.Caption := "另存为"; + it.parent := FPageEditerMenu; + FPageEditerMenus["另存为"] := it; + it.OnClick := thisfunction(do_save_page_as); end iflx := GetCurrentItem().scripttype = 1; FPageEditerMenus["转unix(LF)"].Enabled := not iflx; diff --git a/designer/utslcodeformat.tsf b/designer/utslcodeformat.tsf index 924fd47..35528f7 100644 --- a/designer/utslcodeformat.tsf +++ b/designer/utslcodeformat.tsf @@ -152,6 +152,7 @@ type TFormatParser = class begin FSynParser2.add(v); end + fmreadword := array("return":1,"rdo":1,"rdo2":1,"echo":1); FHtmlParser := NEW TTire(); FHtmlParser.Add("0 then begin i := 1; - self.ColumnWidth(1) := w; + self.ColumnWidth(1) := w; end end end @@ -2090,7 +2119,6 @@ type TPropEditGrid = class(TPropGrid) // function Create(AOwner); begin inherited; - FobjProptype := p_properys; end function getneedpublished(v);virtual; begin @@ -2106,7 +2134,6 @@ type TEventEditGrid = class(TPropEditGrid) // function Create(AOwner); begin inherited; - FobjProptype := p_evnets; OndblClick := thisfunction(GridCellDblClick); end function getneedpublished(v);override; @@ -2212,6 +2239,7 @@ type TDesignertoolbars = class(TPageControl) // FToolsheets := array(); ftoolbars := array(); inherited; + autosize := true; //ParentFont := false; align := alClient; @@ -2227,6 +2255,7 @@ type TDesignertoolbars = class(TPageControl) // if not st then begin st := new TTabSheet(self); + st.autosize := true; st.caption := t; if t<>"隐藏" then begin @@ -2340,6 +2369,7 @@ type TViewBitmap = class(TvcForm) lb := new TLabel(self); FLB := lb; lb.caption := "浏览图片:"; + lb.autosize := true; lb.left := 650; lb.top := 20; lb.width := 200; diff --git a/designer/utslvcldpropertytypes.tsf b/designer/utslvcldpropertytypes.tsf index 132881e..e1ec81d 100644 --- a/designer/utslvcldpropertytypes.tsf +++ b/designer/utslvcldpropertytypes.tsf @@ -604,9 +604,6 @@ type TPropGrid = class(TTSLDataGrid) @explan(说明)属性编辑器 %% **} protected - FobjProptype; - static const p_properys="peopery"; - static const p_evnets="pevents"; FDesigner; private FCellEditers; @@ -701,6 +698,7 @@ type TPropGrid = class(TTSLDataGrid) bkfc := FComponent; FComponent := nil; SetComponent(bkfc); + InvalidateRect(rec,true); end else begin rec := GetSubItemRect(i,j); diff --git a/designer/utslvclsyntaxparser.tsf b/designer/utslvclsyntaxparser.tsf index 4b4a4fa..91d63d5 100644 --- a/designer/utslvclsyntaxparser.tsf +++ b/designer/utslvclsyntaxparser.tsf @@ -75,6 +75,28 @@ type tslparser = class(tslparserbase) // begin return FTokener.tslstr; end + function format_c_inherited(pa); + begin + lenpa := length(pa); + if lenpa<2 then return ; + npa := array(pa[0]); + npai := 0; + pa_i := 1; + while pa_ipa then pa := npa; + end public function create(); begin @@ -117,6 +139,8 @@ type tslparser = class(tslparserbase) // if tk="," then continue; else inh[length(inh)]:= tk; end + format_c_inherited(inh); + r["inherited"]:= inh; end while true do @@ -233,8 +257,11 @@ type tslparser = class(tslparserbase) // r["inheritedendpos"] := pos; break; end - if tk <> "," then pa[length(pa)]:= tk; + if tk <> "," then pa[length(pa)]:= tk; end + ////////20251106/////////////////////////////////// + format_c_inherited(pa); + ////////////////////////////////////// r["inherited"]:= pa; end else begin diff --git a/editor-install.exe b/editor-install.exe index 5970aa2..255b046 100644 Binary files a/editor-install.exe and b/editor-install.exe differ diff --git a/funcext/tvclib/tcontrol.tsf b/funcext/tvclib/tcontrol.tsf index 00ccfc5..276f3b9 100644 --- a/funcext/tvclib/tcontrol.tsf +++ b/funcext/tvclib/tcontrol.tsf @@ -115,7 +115,7 @@ type tcontrol = class(tcomponent) end if ifnil(Value)then begin - if FActionLink then + if (FActionLink is class(TActionLink) ) then begin FActionLink.SetAction(nil); end @@ -124,7 +124,7 @@ type tcontrol = class(tcomponent) if Value is class(TBasicAction)then begin includestate(FControlStyle,csActionClient); - if ifnil(FActionLink)then FActionLink := createobject(GetActionLinkClass(),self); + if not(FActionLink is class(TActionLink) )then FActionLink := createobject(GetActionLinkClass(),self); FActionLink.Action := Value; FActionLink.Onchange := thisfunction(DoActionChange); ActionChange(Value,csLoading in Value.ComponentState); @@ -145,7 +145,7 @@ type tcontrol = class(tcomponent) begin return FActionLink; end - if FActionLink then + if FActionLink is class(TActionLink) then begin return FActionLink.Action; end @@ -298,7 +298,6 @@ type tcontrol = class(tcomponent) @ignore 忽略 %% @explan(说明) 绑定处理函数到消息id %% **} - if not ifarray(FMessagehandle)then FMessagehandle := array(); if ifnumber(id)and (iffuncptr(func))then FMessagehandle[id]:= func; end private //事件绑定处理 @@ -335,6 +334,10 @@ type tcontrol = class(tcomponent) if v["access"]in array(2,3)then continue; fstring := v["functionname"]; if not ifstring(fstring)then continue; + vpms := v["parameter"]; + if not ifarray(vpms) then continue; + lvpms := length(vpms); + if lvpms=1 then continue; //f := findfunction(fstring,o); returntype := v["returntype"]; try @@ -664,14 +667,14 @@ type tcontrol = class(tcomponent) end end } end - function MouseHover(o,e);virtual; + function MouseEnter(o,e);virtual; begin if not FMouseEntereded then begin DoMouseEnter(o,e); FMouseEntereded := true; end - end + end function MouseLeave(o,e);virtual; begin if FMouseEntereded then @@ -845,14 +848,7 @@ type tcontrol = class(tcomponent) CallMessgeFunction(FOnMouseDown,o,e); MouseDown(o,e); end - function WMMOUSEHOVER(o,e):WM_MOUSEHOVER;virtual; - begin - MouseHover(o,e); - end - function WMMOUSELEAVE(o,e):WM_MOUSELEAVE;virtual; - begin - MouseLeave(o,e); - end + function WMMouseMove(o,e):LM_MOUSEMOVE;virtual; begin CallMessgeFunction(FOnMouseMove,o,e); @@ -1073,8 +1069,24 @@ type tcontrol = class(tcomponent) if SetTempCursor(cr)then e.skip := true; end end + function CMMouseEnter(o,e):CM_MOUSEENTER;virtual; + begin + MouseEnter(o,e); + end + function CMMouseLeave(o,e):CM_MOUSELEAVE;virtual; + begin + MouseLeave(o,e); + end public //暂时不用的消息 { + function WMMOUSEHOVER(o,e):WM_MOUSEHOVER;virtual; + begin + MouseHover(o,e); + end + function WMMOUSELEAVE(o,e):WM_MOUSELEAVE;virtual; + begin + MouseLeave(o,e); + end function WMWindowPosChanged(o,e):LM_WINDOWPOSCHANGED;virtual; begin end @@ -1096,12 +1108,7 @@ type tcontrol = class(tcomponent) function CMHitTest(o,e):CM_HITTEST;virtual; begin end - function CMMouseEnter(o,e):CM_MOUSEENTER;virtual; - begin - end - function CMMouseLeave(o,e):CM_MOUSELEAVE;virtual; - begin - end + function CMHintShow(o,e):CM_HINTSHOW;virtual; begin end @@ -1199,6 +1206,7 @@ type tcontrol = class(tcomponent) end function create(aOwner);override; //构造函数 begin + FMessagehandle := array(); inherited; fignore_childsizing := false; FControlFlags := array(); @@ -1363,7 +1371,7 @@ type tcontrol = class(tcomponent) @param(e)(tuieventbase) 消息类及其子类 %% **} id := e.Msg; - if ifnumber(id) and FMessagehandle then + if (id>0 or id<0) and FMessagehandle then begin func := FMessagehandle[id]; if func then call(func,o,e); @@ -1622,8 +1630,8 @@ type tcontrol = class(tcomponent) @param(OnPopupMenu)(function[TControl,TMMouse]) 弹出菜单回调函数 %% @param(OnMouseDown)(function[TControl,TMMouse]) 鼠标按下回调函数 %% @param(OnMouseUp)(function[TControl,TMMouse]) 鼠标松开回调函数 %% - @param(OnClick)(function[TControl,TMMouse]) 鼠标点击回调函数 %% - @param(OnDblClick)(function[TControl,TMMouse]) 鼠标双击回调函数 %% + @param(OnClick)(function[TControl]) 鼠标点击回调函数 %% + @param(OnDblClick)(function[TControl]) 鼠标双击回调函数 %% @param(PopupMenu)(tpopupmenu) 弹出菜单%% @param(Parent)(tcontrol) 父控件 %% @param(Visible)(bool) 是否可见 %% @@ -1660,16 +1668,16 @@ type tcontrol = class(tcomponent) property ControlFlags read fControlFlags ; property Color:color read getcolor write SetColor;//FColor; property BKBitmap:tbitmap read FBKBitmap write SetBitmap; - //property OnMouseEnter:eventhandler read FOnMouseEnter write FOnMouseEnter; - //property OnMouseLeave:eventhandler read FOnMouseLeave write FOnMouseLeave; + property OnMouseEnter:eventhandler read FOnMouseEnter write FOnMouseEnter; + property OnMouseLeave:eventhandler read FOnMouseLeave write FOnMouseLeave; property Controls read FControls; property Canvas: TCanvas read FCanvas; property ignore_childsizing read fignore_childsizing write fignore_childsizing; //忽略 {** @param(Canvas)(TCanvas) 画布对象 %% @param(Controls)(TFpList of tcontrol) 子组件 %% - @param(OnMouseLeave)(function[TControl,tuieventbase]) 鼠标离开回调 %% - @param(OnMouseEnter)(function[TControl,tuieventbase]) 鼠标进入回调 %% + @param(OnMouseLeave)(function[TControl]) 鼠标离开回调 %% + @param(OnMouseEnter)(function[TControl]) 鼠标进入回调 %% @param(Color)(integer) 背景色 %% **} function isCustomPaint(); //提供给gtk使用 diff --git a/funcext/tvclib/tcustomcontrol.tsf b/funcext/tvclib/tcustomcontrol.tsf index 7a7a28e..14ba8ee 100644 --- a/funcext/tvclib/tcustomcontrol.tsf +++ b/funcext/tvclib/tcustomcontrol.tsf @@ -90,104 +90,104 @@ type tcustomcontrol=class(TWinControl) begin return DoHScroll(o,e); end - - function WMLButtonDown(o,e);override;//拖拽释放 - begin - if fhassplitter<1 then return inherited; - if csDesigning in ComponentState then exit; - case fcurspltype of - alLeft,alRight: - begin - drgidx := 1; - end - alTop,alBottom: - begin - drgidx := 0; - end - else - begin - return inherited; - end - end ; - if fsplitterwilldrag then - begin - cimgst(); - fsplitterwilldrag := false; - fsplitterdraging := true; - nxy := clienttowindow(e.xpos,e.ypos); - _wapi.ImageList_BeginDrag(fsplitterdragimglist.Handle,drgidx,12,12); - _wapi.ImageList_DragEnter(self.Handle,nxy[0],nxy[1]); - crect := clientrect; - ps := array(clienttoscreen(crect[0],crect[1]),clienttoscreen(crect[2],crect[3])); - _wapi.clipcursor(ps); - splitterenabled(false); - return ; - end - //end - inherited; - end - function WMLBUTTONUP(o,e);override;//拖拽实现 - begin - if fhassplitter<1 then return inherited; - if csDesigning in ComponentState then return ; - if fsplitterdraging then - begin - cimgst(); - _wapi.ImageList_DragLeave(self.Handle); - _wapi.ImageList_EndDrag(); - splitterenabled(true); - fsplitterwilldrag := true; - fsplitterdraging := false; - sizeprive(e.pos); - _wapi.clipcursor(0); - return ; - end - return inherited; - end - function WMMouseMove(o,e);override; //移动 + function MainWndProc(hwnd,message,wparam,lparam);override; begin if fhassplitter<1 then return inherited; if csDesigning in ComponentState then return inherited; - if fsplitterdraging then - begin - cimgst(); - nxy := clienttowindow(e.xpos,e.ypos); - _wapi.ImageList_DragMove(nxy[0],nxy[1]); - return ; - end else - begin - xy := e.pos(); - fcurspltype := nil; - fcursplitterid := -1; - fcursplitter := nil; - for i,v in Controls.data do - begin - if (v is class(tcustomsplitter)) and (v.Visible) and (v.enabled) and pointinrect(xy,v.BoundsRect) and (v<>fcursplitter) then //拖拽 + case message of + WM_MOUSEMOVE: //移动 + begin + e := new unit(utslvclevent).TMMouse(message,wparam,lparam,hwnd); + if fsplitterdraging then begin - va := v.Align; - if va in array(alLeft,alRight) then - begin - cursor := OCR_SIZEWE; - fcurspltype := va; - fcursplitter := v; - fcursplitterid := i; - return ; - end else - if va in array(alTop,alBottom) then + cimgst(); + nxy := clienttowindow(e.xpos,e.ypos); + _wapi.ImageList_DragMove(nxy[0],nxy[1]); + return ; + end else + begin + xy := e.pos(); + fcurspltype := nil; + fcursplitterid := -1; + fcursplitter := nil; + for i,v in Controls.data do begin - cursor := OCR_SIZENS; - fcurspltype := va; - fcursplitter := v; - fcursplitterid := i; - return ; + if (v is class(tcustomsplitter)) and (v.Visible) and (v.enabled) and pointinrect(xy,v.BoundsRect) and (v<>fcursplitter) and (v.Align in array(alLeft,alRight,alTop,alBottom)) then //拖拽 + begin + va := v.Align; + if va in array(alLeft,alRight) then + begin + cursor := OCR_SIZEWE; + fcurspltype := va; + fcursplitter := v; + fcursplitterid := i; + return ; + end else + if va in array(alTop,alBottom) then + begin + cursor := OCR_SIZENS; + fcurspltype := va; + fcursplitter := v; + fcursplitterid := i; + return ; + end + end end - - end + cursor := OCR_NORMAL; + end end - cursor := OCR_NORMAL; + WM_LBUTTONDOWN: //按下 + begin + case fcurspltype of + alLeft,alRight: + begin + drgidx := 1; + end + alTop,alBottom: + begin + drgidx := 0; + end + else + begin + return inherited; + end + end ; + if fsplitterwilldrag then + begin + e := new unit(utslvclevent).TMMouse(message,wparam,lparam,hwnd); + cimgst(); + fsplitterwilldrag := false; + fsplitterdraging := true; + nxy := clienttowindow(e.xpos,e.ypos); + _wapi.ImageList_BeginDrag(fsplitterdragimglist.Handle,drgidx,12,12); + _wapi.ImageList_DragEnter(self.Handle,nxy[0],nxy[1]); + crect := clientrect; + ps := array(clienttoscreen(crect[0],crect[1]),clienttoscreen(crect[2],crect[3])); + _wapi.clipcursor(ps); + splitterenabled(false); + return ; + end + end + WM_LBUTTONUP: + begin + if fsplitterdraging then + begin + e := new unit(utslvclevent).TMMouse(message,wparam,lparam,hwnd); + cimgst(); + _wapi.ImageList_DragLeave(self.Handle); + _wapi.ImageList_EndDrag(); + splitterenabled(true); + fsplitterwilldrag := true; + fsplitterdraging := false; + sizeprive(e.pos); + _wapi.clipcursor(0); + return ; + end + end + end - return inherited; - end + return inherited; + end property OnPaint:eventhandler read FOnPaint write FOnPaint; {** @param(OnPaint)(function[TCustomControl,tuieventbase]) 窗口关闭消息回调 %% diff --git a/funcext/tvclib/tcustomsplitter.tsf b/funcext/tvclib/tcustomsplitter.tsf index 947aa7b..f447ca0 100644 --- a/funcext/tvclib/tcustomsplitter.tsf +++ b/funcext/tvclib/tcustomsplitter.tsf @@ -13,15 +13,22 @@ type tcustomsplitter = class(tgraphiccontrol) function paint();override; begin //inherited; + p := parent; + if not p then return ; r := ClientRect; dc := Canvas; if Border then begin dc.pen.color := 0; dc.pen.Width := 2; - dc.draw("polygon",array(r[0:1],r[array(2,1)],r[array(2,3)],r[array(0,3)],r[0:1])); + dc.draw("polyline",array(r[0:1],r[array(2,1)],r[array(2,3)],r[array(0,3)],r[0:1])); end - clr := 0x123232; + ////////////点的颜色///////////////////////// + if TRANSPARENT then c := p.color; + else + c := color; + //////////////////////////// + clr := sys_complementar_color(c); x := integer(r[0]+(r[2]-r[0])/2); y := integer(r[1]+(r[3]-r[1])/2); sz := 4; @@ -39,8 +46,18 @@ type tcustomsplitter = class(tgraphiccontrol) end end end - function SetAlign(a);override; + private + function sys_complementar_color(c); + begin + uses utslvclauxiliary; + if (c .& 0xff000000) then + begin + return complementary_color( _wapi.GetSysColor(c .& 0x00ffffff)); + end + return complementary_color(c); + end + {function SetAlign(a);override; begin inherited; - end + end } end diff --git a/funcext/tvclib/tslvcl.tsf b/funcext/tvclib/tslvcl.tsf index 51982eb..194ab61 100644 --- a/funcext/tvclib/tslvcl.tsf +++ b/funcext/tvclib/tslvcl.tsf @@ -313,6 +313,11 @@ type tapplication=class(tcomponent) fexitdolist.Push(f); end end + function DoBeforeMouseMessage(ctl); + begin + UpdateMouseControl(ctl); + end + published property color read getcolor write setcolor; property font read getfont write setfont; property Visible read FVisible write SetVisible; @@ -321,6 +326,25 @@ type tapplication=class(tcomponent) property MainForm read Fmainform write SetMainForm; private fexitdolist; + [weakref]FMouseControl;//鼠标所在的控件 + private + function UpdateMouseControl(ctl); + begin + if FMouseControl=ctl then return ; + if FMouseControl then + begin + FMouseControl.Perform(new tuieventbase(CM_MOUSELEAVE,0,0,0)); // + end + FMouseControl := ctl; + //////////////处理提示/////////////////// + + //////////////////////////////////// + if FMouseControl then + begin + FMouseControl.Perform(new tuieventbase(CM_MOUSEENTER,0,0,0)); + end + + end function exitloopdo(); begin if fexitdolist then diff --git a/funcext/tvclib/twincontrol.tsf b/funcext/tvclib/twincontrol.tsf index 834bf6b..fad69bf 100644 --- a/funcext/tvclib/twincontrol.tsf +++ b/funcext/tvclib/twincontrol.tsf @@ -27,7 +27,6 @@ type TWinControl = class(tcontrol) FWMNCHITTEST; FImageList; fchildsizing; - //FTRACKMOUSEEVENT; FHandle:HWND; //窗口句柄 private //窗口相关 FBorderStyle; @@ -325,6 +324,23 @@ type TWinControl = class(tcontrol) end UpdateControlState(); end + function Hitcontrol(p); + begin + {** + @explan(说明) 命中自绘制控件 %% + **} + for i := ControlCount-1 downto 0 do + begin + it := Controls[i]; + if it is class(TGraphicControl)then + begin + if it.Enabled and it.Visible and pointinrect(p,it.GetBoundsRect)then + begin + return it; + end + end + end + end protected function SetParentFont(v:bool);override; begin @@ -607,82 +623,43 @@ type TWinControl = class(tcontrol) end } end end - function Hitcontrol(p); - begin - {** - @explan(说明) 命中控件 %% - **} - for i := ControlCount-1 downto 0 do - begin - it := Controls[i]; - if it is class(TGraphicControl)then - begin - if it.Enabled and it.Visible and pointinrect(p,it.GetBoundsRect)then - begin - return it; - end - end - end - end - function MouseHover(O,e);override; - begin - inself := true; - initem := 0; - for i := ControlCount-1 downto 0 do - begin - it := FControls[i]; - if(it is class(TGraphicControl))and it.visible then - begin - if inself and pointinrect(array(e.lolparamsigned,e.hilparamsigned),it.GetBoundsRect)and it.Enabled then - begin - initem := it; - inself := false; - end else - begin - it.Perform(messagecreater(nil,WM_MOUSELEAVE,0,0)); - end - end - end - if inself then return inherited; - else self.Perform(messagecreater(nil,WM_MOUSELEAVE,0,0)); - if initem then initem.Perform(messagecreater(nil,WM_MOUSEHOVER,0,0)); - end + public //消息绑定函数 function WMMouseMove(o,e):LM_MOUSEMOVE;override; begin - it := Hitcontrol(e.pos); + {it := Hitcontrol(e.pos); if it then begin return it.WMMouseMove(it,new TMMouse(LM_MOUSEMOVE,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top))); //return it.Perform(new TMMouse(LM_MOUSEMOVE,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top))); - end + end} inherited; end function WMLButtonUp(o,e):LM_LBUTTONUP;override; begin - it := Hitcontrol(e.pos); + {it := Hitcontrol(e.pos); if it then begin return it.WMLButtonUp(it,new TMMouse(LM_LBUTTONUP,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top))); - end + end} inherited; end function WMRButtonUp(o,e):LM_RBUTTONUP;override; begin - it := Hitcontrol(e.pos); + {it := Hitcontrol(e.pos); if it then begin return it.WMRButtonUp(it,new TMMouse(LM_RBUTTONUP,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top))); - end + end} inherited; end function WMMButtonUp(o,e):LM_MBUTTONUP;override; begin - it := Hitcontrol(e.pos); + {it := Hitcontrol(e.pos); if it then begin return it.WMMButtonUp(it,new TMMouse(LM_MBUTTONUP,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top))); - end + end} inherited; end function WMContextMenu(o,e):LM_CONTEXTMENU;override; @@ -701,39 +678,39 @@ type TWinControl = class(tcontrol) end function WMLButtonDown(o,e):LM_LBUTTONDOWN;override; begin - it := Hitcontrol(e.pos); + {it := Hitcontrol(e.pos); if it then begin return it.WMLButtonDown(it,new TMMouse(LM_LBUTTONDOWN,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top))); - end + end} inherited; end function WMRButtonDown(o,e):LM_RBUTTONDOWN;override; begin - it := Hitcontrol(e.pos); + {it := Hitcontrol(e.pos); if it then begin return it.WMRButtonDown(it,new TMMouse(LM_RBUTTONDOWN,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top))); //return it.Perform(new TMMouse(LM_MOUSEMOVE,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top))); - end + end} inherited; end function WMMButtonDown(o,e):LM_MBUTTONDOWN;override; begin - it := Hitcontrol(e.pos); + {it := Hitcontrol(e.pos); if it then begin return it.WMMButtonDown(it,new TMMouse(LM_MBUTTONDOWN,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top))); - end + end} inherited; end function WMLButtonDBLCLK(o,e):LM_LBUTTONDBLCLK;override; begin - it := Hitcontrol(e.pos); + {it := Hitcontrol(e.pos); if it then begin return it.WMLButtonDBLCLK(it,new TMMouse(LM_LBUTTONDBLCLK,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top))); - end + end} inherited; end public //设计器相关杂项 @@ -1040,10 +1017,7 @@ type TWinControl = class(tcontrol) rc.right := rc.right - wd; end end - function WMMOUSEHOVER(o,e):WM_MOUSEHOVER;virtual; - begin - MouseHover(o,e); - end + function WMMOUSELEAVE(o,e):WM_MOUSELEAVE;virtual; begin MouseLeave(o,e); @@ -1986,7 +1960,6 @@ type TWinControl = class(tcontrol) FUpDateCount := 0; FTabStop := false; FBorderStyle := bsNone; - //FTRACKMOUSEEVENT := NEW TTRACKMOUSEEVENT(); FWsPopUp := false; FWsSysMenu := false; FWsCapton := false; @@ -2202,12 +2175,6 @@ type TWinControl = class(tcontrol) factivated := false; if HandleAllocated()then begin - {FTRACKMOUSEEVENT.hwndtrack := handle; - if OnMouseEnter or OnMouseLeave then - begin - FTRACKMOUSEEVENT.dwflags := TME_CANCEL .| TME_HOVER .| TME_LEAVE; - _wapi.TrackMouseEvent(FTRACKMOUSEEVENT._getptr_); - end } bv := FVisible; _wapi.DestroyWindow(self.Handle); FVisible := bv; @@ -2347,8 +2314,31 @@ type TWinControl = class(tcontrol) @explan(说明)窗口主循环 %% **} //if message=0x85 and not( WsCaption or border or WsDlgModalFrame) then return ; - e := messagecreater(hwnd,message,wparam,lparam); - e.sender := self(true); + if message=WM_NCMOUSEMOVE then + begin + app := class(tUIglobalData).uigetdata("tuiapplication"); + if app then app.DoBeforeMouseMessage(nil); + end + e := messagecreater(hwnd,message,wparam,lparam); + e.sender := self(true); + case message of + LM_MOUSEFIRST to LM_MOUSELAST, + LM_MOUSEFIRST2 to LM_RBUTTONQUADCLK, + LM_XBUTTONTRIPLECLK to LM_MOUSELAST2 : + begin + ht := Hitcontrol(e.pos); + app := class(tUIglobalData).uigetdata("tuiapplication"); + if app then app.DoBeforeMouseMessage(ht?:self(true)); + msgs := array(LM_LBUTTONDBLCLK:1,LM_MBUTTONDOWN:1,LM_MOUSEMOVE:1,LM_LBUTTONUP:1 + ,LM_RBUTTONUP:1,LM_MBUTTONUP:1,LM_LBUTTONDOWN:1,LM_RBUTTONDOWN:1); + if ht and msgs[message] then + begin + ee := new TMMouse(message,e.wparam,makelong(e.xpos-ht.left,e.ypos-ht.top)); + ht.dispatch(ht,ee); + return defaulthandler(e); + end ; + end + end; if message = WM_SYSKEYDOWN or message = WM_KEYDOWN then //快捷键实现 begin WndProc(const e); @@ -2435,13 +2425,6 @@ type TWinControl = class(tcontrol) //if message = WM_MOUSEMOVE then if message=WM_NCHITTEST then // begin - {if OnMouseEnter or OnMouseLeave then - begin - FTRACKMOUSEEVENT.hwndtrack := hwnd; - FTRACKMOUSEEVENT.dwflags := TME_HOVER .| TME_LEAVE; - FTRACKMOUSEEVENT.dwhovertime := 600; - _wapi.TrackMouseEvent(FTRACKMOUSEEVENT._getptr_); - end } end else if message=WM_STYLECHANGED then begin @@ -2453,52 +2436,11 @@ type TWinControl = class(tcontrol) __wstyle := e.stylenew; end end - (**else - if message = WM_NCCALCSIZE then - begin - if e.wparam=1 then - begin - dt := new tNCCALCSIZE_PARAMS(e.lparam)._getvalue_("rgrc"); - if dt[0]=-32000 then - begin - //echo "\r\n隐藏到工具栏"; - end - else if dt[4] = -32000 then - begin - //echo "\r\n从工具栏弹出"; - end - else - begin - //rect1 := dt[0:3]; - //rect2 := dt[4:7]; - //rect3 := dt[8:]; - {dx := dt[2]-dt[0]-(dt[6]-dt[4]); - dy := dt[3]-dt[1]-(dt[7]-dt[5]); - __clientsize := array(dt[10]-dt[8]+dx,dt[11]-dt[9]+dy); - x := __clientsize[0]; - dxsize := x-FClientWdith; - if FClientWdith<> x then FClientWdith := x; - y := __clientsize[1]; - dysize := y-FClientHeight; - if FClientHeight <> y then FClientHeight := y; - DoControlAnchor(array(dxsize,dysize)); - DoControlAlign(array(0,0,x,y));} - //__oldclientsize := array(dt[10]-dt[8],dt[11]-dt[9]); - end - - end - else - begin - //echo "\r\n++++calc:",caption,tostn(new tcrect(e.lparam)._getdata_); - end - //echo "\r\ncalcsize:",o.caption,"****",e.wparam; - //echo "\r\nleft:", new tcrect(e.lparam).left; - end - **) WndProc(const e); if not(e.skip)then begin - ret := defaulthandler(e); + if ifnil(e.Result) then ret := defaulthandler(e); + else ret := e.Result; end else begin {$ifdef linuxgtk} @@ -2552,10 +2494,6 @@ type TWinControl = class(tcontrol) begin e.Result := hit; e.skip := true; - {if (csDesigning in ComponentState) then - begin - if al <> alNone then _send_(WM_USER,1644,1644,1); - end} end end end @@ -2566,64 +2504,44 @@ type TWinControl = class(tcontrol) procedure WndProc(e);override; //type_twinctrol begin //WM_NCHITTEST + msg := e.msg; if (csDesigning in ComponentState) then begin - msg := e.msg; - if msg = WM_NCHITTEST then - begin - - r := FWMNCHITTEST.hitstyle(self(true),e); - if r<>HTCLIENT then - begin - HitWindowborder(self(true),e,r); - end else - begin - return e.Result := Wnddefaulthandler(e); - end - end else - if msg= WM_LBUTTONDOWN then - begin - if not(WsCaption) and DesigningMove() and (Align=alNone) then - begin - _Send_(WM_NCLBUTTONDOWN,HTCAPTION,0,0); - e.skip := true; - end - CallMessgeFunction(FOnDesinedsel,self(true),e); - //保留原有的点击消息 - {if DesigningClick() then + case msg of + WM_NCHITTEST: begin - CallMessgeFunction(FOnMouseUp,self(true),e); - end } - end else - if msg = WM_LBUTTONDBLCLK then - begin - CallMessgeFunction(FOnDesigDBLClick,self(true),e); - end else - if msg = WM_RBUTTONDOWN then - begin - CallMessgeFunction(FOnDesinedRclick,self(true),e); - end else - if msg = WM_USER then - begin - if e.wparam=1644 and e.lparam=1644 then - begin - //Align=alNone; - {al := Align; - - if al in array(alLeft,alRight,alTop,alBottom) then + r := FWMNCHITTEST.hitstyle(self(true),e); + if r<>HTCLIENT then begin - bs := UnAlignBounds; - bs2 := BoundsRect; - if bs <> bs2 then - begin - Align := alNone; - Align := al; - end - end - } - end - - end + HitWindowborder(self(true),e,r); + end else + begin + return e.Result := Wnddefaulthandler(e); + end + end + WM_LBUTTONDOWN: + begin + if not(WsCaption) and DesigningMove() and (Align=alNone) then + begin + _Send_(WM_NCLBUTTONDOWN,HTCAPTION,0,0); + e.skip := true; + end + CallMessgeFunction(FOnDesinedsel,self(true),e); + //保留原有的点击消息 + {if DesigningClick() then + begin + CallMessgeFunction(FOnMouseUp,self(true),e); + end } + end + WM_LBUTTONDBLCLK: + begin + CallMessgeFunction(FOnDesigDBLClick,self(true),e); + end + WM_RBUTTONDOWN: + begin + CallMessgeFunction(FOnDesinedRclick,self(true),e); + end + end end inherited; end; @@ -2867,13 +2785,14 @@ type TWinControl = class(tcontrol) it := Controls[I]; if it then begin - it.WindowProc(e); - if e.skip then Exit; - if not ifnil(e.Result)then Exit; + it.WndProc(e); + //if e.skip then Exit; + //if not(ifnil(e.Result) or (e.Result =0))then Exit; + if e.Result then Exit; end end; end; - procedure NotifyControls(Msg); //type_twinctrol + procedure NotifyControls(Msg:Integer); //type_twinctrol begin ToAllMessage := new tuieventbase(msg,0,0,0); Broadcast(ToAllMessage); diff --git a/funcext/tvclib/ugtkinterface.tsf b/funcext/tvclib/ugtkinterface.tsf index 4f74708..599cb86 100644 --- a/funcext/tvclib/ugtkinterface.tsf +++ b/funcext/tvclib/ugtkinterface.tsf @@ -178,6 +178,10 @@ type tsgtkapi = class(tgtkapis) function MessageBoxA(hwnd :pointer;txt:string;cap:string;flag:integer); begin return gtk_MessageBoxA(hwnd,txt,cap,flag); + end + function IsIconic(); //最小化 + begin + end function IsWindow(h); begin @@ -1164,6 +1168,11 @@ type tsgtkapi = class(tgtkapis) if not dc then return ; if ifnumber(x) and ifnumber(y) then begin + cairo_rectangle(dc,x-0.5,y-0.5,1,1); + gtk_rgb_color_rgb(colr,r,g,b); + cairo_set_source_rgb(dc,r,g,b); + cairo_fill(dc); + return 1; pc := colr; MoveToEx(dc,x,y); pc := gtk_object_get_data(dc,"pen.color"); @@ -5854,6 +5863,17 @@ fi return ##_f_(f); end procedure gtk_widget_show_all(window:pointer); + begin + _f_ := static procedure(window:pointer);cdecl;external getfuncptrbyname(0,functionname()); + return ##_f_(window); + end + + function gtk_window_is_maximized(window:pointer):integer; + begin + _f_ := static function(window:pointer):integer;cdecl;external getfuncptrbyname(0,functionname()); + return ##_f_(window); + end + procedure gtk_window_unmaximize(window:pointer); begin _f_ := static procedure(window:pointer);cdecl;external getfuncptrbyname(0,functionname()); return ##_f_(window); @@ -7863,7 +7883,12 @@ type tgtk_ctl_object = class(_gtkeventtype) end end end - case mn of + case mn of + GS_LEAVE_NOTIFY_EVENT: //离开 + begin + id := a.handle; + AddMessageToGtkMessageQueue(id,_const.WM_NCMOUSEMOVE,0,0); + end GS_ENTER_NOTIFY_EVENT: begin fwindow_cursor := 0; @@ -7926,7 +7951,7 @@ type tgtk_ctl_object = class(_gtkeventtype) function GtkBaseEventName();virtual; //绑定的消息 begin //return array("destroy","map","button-press-event","motion-notify-event","button-release-event","key-press-event","key-release-event","event"); //,"set-focus-child" - return array(GS_DESTROY,GS_BUTTON_PRESS_EVENT,GS_MOTION_NOTIFY_EVENT,GS_BUTTON_RELEASE_EVENT,GS_KEY_PRESS_EVENT,GS_KEY_RELEASE_EVENT,GS_FOCUS_IN_EVENT,GS_FOCUS_OUT_EVENT,GS_WINDOW_STATE_EVENT,GS_EVENT,GS_ENTER_NOTIFY_EVENT); //,"set-focus-child" + return array(GS_DESTROY,GS_BUTTON_PRESS_EVENT,GS_MOTION_NOTIFY_EVENT,GS_BUTTON_RELEASE_EVENT,GS_KEY_PRESS_EVENT,GS_KEY_RELEASE_EVENT,GS_FOCUS_IN_EVENT,GS_FOCUS_OUT_EVENT,GS_WINDOW_STATE_EVENT,GS_EVENT,GS_ENTER_NOTIFY_EVENT,GS_LEAVE_NOTIFY_EVENT); //,"set-focus-child" end function CreateWnd(dwExStyle,lpClassName,lpWindowName,dwStyle,x,y,nwidth,nheight,hwndparent,hmenu,hinstance,lpParam);virtual; //构造窗口 begin diff --git a/funcext/tvclib/utslmemo.tsf b/funcext/tvclib/utslmemo.tsf index fb73536..42a6721 100644 --- a/funcext/tvclib/utslmemo.tsf +++ b/funcext/tvclib/utslmemo.tsf @@ -3149,6 +3149,9 @@ type tcustomsynhighlighter = class(TSynHighLighter) function create(AOwner); begin inherited; + fkeywords := array(); + fsysfuncs := array(); + fsymbols := array(); fsymcolor := 0xa000a0; fnumbercolor := 0x666666; fkeywordcolor := 0x0000ff; @@ -3330,6 +3333,7 @@ type tcustomsynhighlighter = class(TSynHighLighter) end inherited; end + published property keywordcolor:color read fkeywordcolor write fkeywordcolor; property sysfuncolor:color read fsysfuncolor write fsysfuncolor; property stringcolor:color read fstringcolor write fstringcolor; @@ -3337,6 +3341,9 @@ type tcustomsynhighlighter = class(TSynHighLighter) property symcolor:color read fsymcolor write fsymcolor; property numbercolor:color read fnumbercolor write fnumbercolor; property ignorecase:bool read fignorecase write setignorecase; + property keywords:strings read fkeywords write setkeyword; + property sysfuncs:strings read fsysfuncs write setsysfun; + property symbols:strings read fsymbols write setsyms; private function setignorecase(i); begin @@ -3528,9 +3535,14 @@ type tcustomsynhighlighter = class(TSynHighLighter) function setkeyword(ws); //设置关键字 begin st := new TTire(); + fkeywords := array(); for i,v in ws do begin - if v and ifstring(v) then st.add(v); + if v and ifstring(v) then + begin + st.add(v); + fkeywords[length(fkeywords)] := v; + end end fkeystires := array(st); end @@ -3575,12 +3587,14 @@ type tcustomsynhighlighter = class(TSynHighLighter) begin st := new TTire(); fsysfuntires := array(st); + fsysfuncs := array(); if not ifarray(d) then return ; for i,v in d do begin if ifstring(v) and v then begin st.add(v); + fsysfuncs[length(fsysfuncs)] := v; end end end @@ -3588,11 +3602,13 @@ type tcustomsynhighlighter = class(TSynHighLighter) begin st := new TTire(); fsymstires := array(st); + fsymbols := array(); for i,v in d do begin if ifstring(v) and v then begin st.add(v); + fsymbols[length(fsymbols)] := v; end end end @@ -3716,8 +3732,10 @@ type tcustomsynhighlighter = class(TSynHighLighter) FSates; //当前状态 FTokens; fdolastline; //已经处理到行 - - + //////////////////////////////////// + fkeywords; //关键字 + fsysfuncs; //系统函数 + fsymbols; //符号 ///////tire树///////////// fkeystires; fstrstires; diff --git a/funcext/tvclib/utslvclaction.tsf b/funcext/tvclib/utslvclaction.tsf index 6a32098..9f203d7 100644 --- a/funcext/tvclib/utslvclaction.tsf +++ b/funcext/tvclib/utslvclaction.tsf @@ -32,7 +32,7 @@ type TBasicAction=class(TComponent) {** @param(FClients)( TFpList of TActionLink) 关联的组件 %% **} - procedure Change;virtual; + procedure Change();virtual; begin if iffuncptr(FOnChange) then call(FOnChange,self); end @@ -155,6 +155,7 @@ type TCustomAction=class(TContainedAction) @explan(说明) action类 %% **} private + fimageid:Integer; FCaption:string; FChecked:Boolean; FChecking:Boolean; @@ -199,6 +200,15 @@ type TCustomAction=class(TContainedAction) FVisible := nValue; Change(); end + procedure Setimageid(Value:Integer); + begin + if not ifnumber(Value) then return ; + nValue := Integer(Value); + if nValue=fimageid then exit; + for I := 0 to FClients.Count-1 do FClients[I].setimageid(nValue); + fimageid := nValue; + Change(); + end function getShortCut(); begin return formatshortcut(FShortCut); @@ -230,7 +240,7 @@ type TCustomAction=class(TContainedAction) if Dest=Self then exit; if Dest is class(TCustomAction)then begin - ps := array("checked","caption","visible","enabled","shortcut"); + ps := array("checked","caption","visible","enabled","shortcut","imageid"); for i,v in ps do invoke(Dest,v,1,invoke(self,v)); end else inherited; @@ -242,6 +252,7 @@ type TCustomAction=class(TContainedAction) @explan(说明) 构造 %% **} inherited; + fimageid := -1; FEnabled := True; FVisible := True; end @@ -275,6 +286,7 @@ type TCustomAction=class(TContainedAction) property Checked:bool read FChecked write SetChecked; property Enabled:bool read FEnabled write SetEnabled; property Visible:bool read FVisible write SetVisible; + property imageid:Integer read fimageid write setimageid; property ShortCut:string read getshortcut write SetShortCut; end; type TCustomactionlist=class(TComponent) @@ -350,7 +362,7 @@ type TBasicActionLink=class(TSLUIBASE) procedure AssignClient(AClient:TObject);virtual; begin end - procedure Change;virtual; + procedure Change();virtual; begin if iffuncptr(FOnChange) then call(OnChange,FAction); end @@ -432,6 +444,9 @@ type TActionLink=class(TBasicActionLink) procedure SetVisible(Value:Boolean);virtual; begin end + procedure setimageid(value:Integer);virtual; + begin + end function create(AClient);override; begin inherited; @@ -461,6 +476,10 @@ type TActionLink=class(TBasicActionLink) begin return Action is CLASS(TCustomAction); end + function IsImageIndexLinked():Boolean;virtual; + begin + return false; + end end; type TControlActionLink=class(TActionLink) diff --git a/funcext/tvclib/utslvclauxiliary.tsf b/funcext/tvclib/utslvclauxiliary.tsf index df1059b..0fbfea0 100644 --- a/funcext/tvclib/utslvclauxiliary.tsf +++ b/funcext/tvclib/utslvclauxiliary.tsf @@ -1815,7 +1815,7 @@ type TNode = class() // end function node_insert_check(it);virtual; begin - return (it is class(TNode))and(not it.Parent); + return (it is class(TNode))and(not it.Parent) and ckchild(it); end function Expand();virtual; //展开 begin @@ -1904,6 +1904,16 @@ type TNode = class() // FCurrentDeleteNode; FCurrentAddNode; FExpanded; + function ckchild(c); //检查子节点 + begin + sf := self(true); + while sf do + begin + if sf=c then return false; + sf := sf.Parent; + end + return true; + end function SetExpand(v);virtual; //已经展开 begin if v then Expanded(); @@ -3450,9 +3460,8 @@ end; ////////////////////////////////////// function iffuncptr(fn); begin - return datatype(fn) in array(7,37); - //return datatype(fn)=7; - //return fn and ifobj(fn); + dt := datatype(fn); + return ((dt=7) or (dt=37)); end function includestate(u,s); begin @@ -3776,18 +3785,6 @@ begin end else return tostn(d); end - -function DeleteItemsByIndexs(r,dxs); -begin - {** - @explan(说明) 删除数组下标, %% - @param(r)(array) 待删除下标的数组,采用字符串下标的数组,变参返回%%; - **} - if not ifarray(r)then exit; - rdx := array(); - for i,v in dxs do rdx[v]:= nil; - return reindex(r,rdx); -end function HexHash(); begin c := array("A","B","C","D","E","F"); @@ -4362,7 +4359,7 @@ begin len := length(data); while (i <= len) do begin - ordi := ord(data[i]); + ordi := ord(data[i]); if (ordi <= 0x7f) then begin //编码小于等于127,只有一个字节的编码，兼容ASCII @@ -4370,13 +4367,12 @@ begin continue; end else begin + if i>=len then return false; //加入判断避免越界 ordi2 := ord(data[i + 1]); //大于127的使用双字节编码 - if (ordi >= 0x81 and - ordi <= 0xfe and - ordi2 >= 0x40 and - ordi2 <= 0xfe and - ordi2 <> 0x7f) then + if ( ordi >= 0x81 and ordi <= 0xfe) and + (ordi2 >= 0x40 and ordi2 <= 0xfe) and + (ordi2 <> 0x7f) then begin i += 2; continue; diff --git a/funcext/tvclib/utslvclbase.tsf b/funcext/tvclib/utslvclbase.tsf index 0aeba0c..3f60c2a 100644 --- a/funcext/tvclib/utslvclbase.tsf +++ b/funcext/tvclib/utslvclbase.tsf @@ -49,7 +49,8 @@ uses uwindowsinterface; mh := MonitorFromRect(r1,2); info := new TMONITORINFO(); GetMonitorInfoA(mh,info._getptr_); - return info.rcmonitor; + //return info.rcmonitor; + return info.rcwork; end rc := new tcrect(); SystemParametersInfoA(0x30,0,rc._getptr_(),0); diff --git a/funcext/tvclib/utslvclmenu.tsf b/funcext/tvclib/utslvclmenu.tsf index 28852ab..5255bf6 100644 --- a/funcext/tvclib/utslvclmenu.tsf +++ b/funcext/tvclib/utslvclmenu.tsf @@ -358,6 +358,11 @@ private protected function SetAction(Value);virtual; begin + if csDesigning in ComponentState then + begin + FActionLink := Value; + return; + end if ifnil(Value)then begin if FActionLink then @@ -369,7 +374,7 @@ private if Value is class(TBasicAction)then begin includestate(FControlStyle,csActionClient); - if ifnil(FActionLink)then FActionLink := createobject(GetActionLinkClass(),self); + if not(FActionLink is class(TActionLink) ) then FActionLink := createobject(GetActionLinkClass(),self); FActionLink.Action := Value; FActionLink.Onchange := thisfunction(DoActionChange); ActionChange(Value,csLoading in Value.ComponentState); @@ -382,7 +387,7 @@ private end function GetAction();virtual; begin - if FActionLink then + if FActionLink is class(TActionLink) then begin return FActionLink.Action; end diff --git a/funcext/tvclib/utslvclpage.tsf b/funcext/tvclib/utslvclpage.tsf index 3871e2b..f395f47 100644 --- a/funcext/tvclib/utslvclpage.tsf +++ b/funcext/tvclib/utslvclpage.tsf @@ -22,7 +22,8 @@ type tcustomtabsheet = class(TCustomControl) // public function AdjustSize();override; begin - class(tcontrol).AdjustSize(); + //class(tcontrol).AdjustSize(); + inherited; end function paint();override; //设计器模式下绘制网格 begin @@ -817,8 +818,8 @@ type tcustompagecontrol = class(tcustomtabcontrol) h := height; return ; end - w := 100; - h := 100; + w := 25; + h := 25; for i:= 0 to len-1 do begin FTabItems[i].PageSheet.GetPreferredSize(wi,hi); diff --git a/funcext/tvclib/utslvclstdctl.tsf b/funcext/tvclib/utslvclstdctl.tsf index c36b281..bdc4eb2 100644 --- a/funcext/tvclib/utslvclstdctl.tsf +++ b/funcext/tvclib/utslvclstdctl.tsf @@ -3780,7 +3780,7 @@ type TcustomListBox=class(TCustomListBoxbase) nh := min(h,16); nnh := integer((h-nh)/2); rc2 := array(rc[0]+2,rc[1]+nnh,rc[0]+nh+2,rc[3]-nnh); - if fcheckbox=2 then + if FMultisel=0 then begin cvs.Draw("framecontrol",array(rc2[0:1],rc2[2:3]),DFC_BUTTON,DFCS_BUTTONRADIO); if r then @@ -5139,9 +5139,14 @@ type TcustomToolButton=class(tcomponent) protected //action function SetAction(Value);virtual; begin + if csDesigning in ComponentState then + begin + FActionLink := Value; + return; + end if ifnil(Value)then begin - if FActionLink then + if FActionLink is class(TActionLink) then begin FActionLink.SetAction(nil); end @@ -5150,7 +5155,7 @@ type TcustomToolButton=class(tcomponent) if Value is class(TBasicAction)then begin includestate(FControlStyle,csActionClient); - if ifnil(FActionLink)then FActionLink := createobject(GetActionLinkClass(),self); + if not(FActionLink is class(TActionLink) ) then FActionLink := createobject(GetActionLinkClass(),self); FActionLink.Action := Value; FActionLink.Onchange := thisfunction(DoActionChange); ActionChange(Value,csLoading in Value.ComponentState); @@ -5163,7 +5168,7 @@ type TcustomToolButton=class(tcomponent) end function GetAction();virtual; begin - if FActionLink then + if FActionLink is class(TActionLink) then begin return FActionLink.Action; end @@ -5184,6 +5189,7 @@ type TcustomToolButton=class(tcomponent) if(not CheckDefaults)or(Caption='')or(Caption=Name)then Caption := NewAction.Caption; if(not CheckDefaults)then ShortCut := NewAction.ShortCut; if(not CheckDefaults)or Enabled then Enabled := NewAction.Enabled; + if(not CheckDefaults) then imageid := NewAction.imageid; //if not CheckDefaults or FChecked then Checked := NewAction.Checked; end; end @@ -5471,7 +5477,11 @@ type TcustomToolBar=class(TCustomControl) FButtons.swap(i,i+1); end end - if Btn.Visible then InvalidateRect(nil,false); + if Btn.Visible then + begin + CalcButtonsRect(); + InvalidateRect(nil,false); + end return cidx; end function InsertButton(btn,idx); @@ -5496,10 +5506,11 @@ type TcustomToolBar=class(TCustomControl) if nidx >= 0 then SetBtnIndex(btn,nidx); if btn.Visible then begin - IncPaintLock(); + CalcButtonsRect(); + //IncPaintLock(); InvalidateRect(nil,false); FWillModifyToolbar := true; - DecPaintLock(); + //DecPaintLock(); end end function DeleteButton(btn); //删除按钮 @@ -5518,10 +5529,11 @@ type TcustomToolBar=class(TCustomControl) FButtons.splice(idx,1); if btn.Visible then begin - IncPaintLock(); + CalcButtonsRect(); + //IncPaintLock(); InvalidateRect(nil,false); FWillModifyToolbar := true; - DecPaintLock(); + //DecPaintLock(); end end function GetItemRect(btn); //获得按钮区域 @@ -6113,12 +6125,12 @@ type TcustomStatusBar=class(TCustomControl) end function GetPreferredSize(w,h);override; begin - class(tcontrol).GetPreferredSize(w,h); - if iffuncptr(onGetPreferredSize) then return ; - bs := BoundsRect; - cs := ClientRect; - dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2; - h+=dh; + if ControlCount>0 then class(TWinControl).GetPreferredSize(w,h); + if iffuncptr(onGetPreferredSize) then return inherited; + ft := Font; + if not ft then return; + c := caption; + h := max(h,ft.Height+4); w := Width; end published @@ -8177,6 +8189,10 @@ type TtoolbuttonActionLink=class(TControlActionLink) begin return FClient and(Action is CLASS(TCustomAction)); end + function IsImageIndexLinked():Boolean;override; + begin + return true; + end function IsCheckedLinked():Boolean;override; begin return false; @@ -8186,6 +8202,10 @@ type TtoolbuttonActionLink=class(TControlActionLink) begin if IsshortcutLinked() then return FClient.ShortCut := Value; end + procedure setImageid(value:Integer);override; + begin + if IsImageIndexLinked() and FClient then FClient.imageid := value; + end function create(AOwner);override; begin inherited; diff --git a/funcext/tvclib/utslvcltree.tsf b/funcext/tvclib/utslvcltree.tsf index a5c1d4e..65a1de2 100644 --- a/funcext/tvclib/utslvcltree.tsf +++ b/funcext/tvclib/utslvcltree.tsf @@ -80,7 +80,7 @@ type ttreelistwnd = class(TCustomScrollControl) x := FColWidth *(0-xPos); cvs := Canvas; cvs.Font := font; - PaintRect(cvs,yPos,FItemHeight,FirstLine,LastLine,xPos,FColWidth,FirstCol,LastCol); + PaintRect(cvs,yPos,FItemHeight,FirstLine,LastLine,xPos,FColWidth,FirstCol,LastCol); end function GetClientItemIndexs(); begin @@ -102,6 +102,8 @@ type ttreelistwnd = class(TCustomScrollControl) public //常用方法 function Create(AOwner);override; begin + fshowseparators := false; + fseparatorcolor := 0; inherited; end function AfterConstruction();override; @@ -383,12 +385,29 @@ type ttreelistwnd = class(TCustomScrollControl) x := wd *(0-xPos); rc := ClientRect; PrevPaint(FirstLine,LastLine); + ls := array(); for i := FirstLine to LastLine do begin nrc := GetIndexRect(i); it := FItems[i]; it.paint(cvs,x,nrc[1],rc[2]-rc[1]-x,ht); + if fshowseparators then + begin + ls[i] :=array(nrc[array(0,3)],nrc[array(2,3)]); + end end + if fshowseparators then + begin + cf := cvs.pen; + cf.style := 0; + cf.Width := 1; + cf.color := fseparatorcolor; + for i,v in ls do + begin + cvs.MoveTo(v[0]); + cvs.LineTo(v[1]); + end + end end function SetTopLine(idx);virtual; begin @@ -469,10 +488,14 @@ type ttreelistwnd = class(TCustomScrollControl) property ItemHeight read FItemHeight write SetItemHeight; property ItemMaxWidth read FxClientMax; property ItemMinWidth read FItemMinWidth write SetItemMinWidth; + property showseparators:bool read fshowseparators write setshowseparators; + property separatorcolor:color read fseparatorcolor write setseparatorcolor; {** @param(Items)(array of TcustomTreeCtlNode) 项 %% @param(ItemMaxWidth)(integer) 最大宽度 %% @param(ItemHeight)(integer) 项高度 %% + @param(showseparators)(bool) 显示分割线 %% + @param(separatorcolor)(color) 分割线颜色 %% **} private //其他中间函数 function GetIndexClientRect(idx);virtual; @@ -485,8 +508,26 @@ type ttreelistwnd = class(TCustomScrollControl) rc[3]:= rc[1]+FItemHeight; return rc; end + end + function setseparatorcolor(v); + begin + if (v<>fseparatorcolor) and (v>0 or v<=0) then + begin + fseparatorcolor := v; + end end + function setshowseparators(v); + begin + nv := v?true:false; + if nv<>fshowseparators then + begin + fshowseparators := nv; + InvalidateRect(nil,false); + end + end private //属性变量 + fshowseparators;//分割线 + fseparatorcolor; FHashItems; FItemHeight; //项高 FColCount; //列数 @@ -822,7 +863,11 @@ type TcustomTreeCtlNode = class(tsluibase) // //cvs.Pen.style := PS_SOLID; //cvs.Pen.width := 1; inv := 3; - BasePos := FBasePos+x; + /////////////处理最顶层///////////////////////////// + if Hierarchy=0 then BasePos := x; + else + BasePos := FBasePos+x; + /////////////////////////////////// FCheckPos := BasePos; fitemcountflg := ItemCount or FDirtype; for i := 1 to Hierarchy do @@ -865,17 +910,19 @@ type TcustomTreeCtlNode = class(tsluibase) // begin if(ifsel and FSelImgId >= 0)or(FImgId >= 0)or(FExpandImgId >= 0 and fitemcountflg>0 and FExpanded)then //绘制selimage begin + imh := img.Height; + dimh := integer((h-imh)/2); if(FExpandImgId >= 0)and fitemcountflg>0 and FExpanded then begin - img.Draw(FExpandImgId,cvs,BasePos,y+1,nil); + img.Draw(FExpandImgId,cvs,BasePos,y+1+dimh,nil); end else if(ifsel and FSelImgId >= 0)then begin - img.Draw(FSelImgId,cvs,BasePos,y+1,nil); + img.Draw(FSelImgId,cvs,BasePos,y+1+dimh,nil); end else if FImgId >= 0 then begin - img.Draw(FImgId,cvs,BasePos,y+1,nil); + img.Draw(FImgId,cvs,BasePos,y+1+dimh,nil); end BasePos += img.Height; BasePos += inv; @@ -1167,6 +1214,7 @@ type TcustomTreeCtlNode = class(tsluibase) // begin if(it is class(TcustomTreeCtlNode))and(not it.Parent)then begin + if not ckchild(it) then continue; odexp := it.Expanded; it.UnExpand(); FItems.InsertBefor(it,idx0); @@ -1198,6 +1246,7 @@ type TcustomTreeCtlNode = class(tsluibase) // **} if(it is class(TcustomTreeCtlNode))and(not it.Parent)then begin + if not ckchild(it) then return false; if idx<0 then idx := 0; if idx>FItems.Count then idx := FItems.Count; if not(idx >= 0)then idx := 0; @@ -1491,6 +1540,16 @@ type TcustomTreeCtlNode = class(tsluibase) // FChecked; //选择 static fnodehandlebase; ////// private //普通属性设置 + function ckchild(c); //检查子节点 + begin + sf := self(true); + while sf do + begin + if sf=c then return false; + sf := sf.Parent; + end + return true; + end function initnodehandle();//给当前节点分配一个id begin if not(fnodehandlebase>0) then fnodehandlebase:= 0xff; @@ -1891,7 +1950,7 @@ type TcustomTreeCtl = class(ttreelistwnd) end return inherited; end - published //属性 + published //属性输出 property CurrentNode read FCurrentNode write setcurrentnode; //20221118 加上写 property selectionColor:color read FselectionColor write SetselectionColor; property CheckBox:bool read FCheckBox write SetCheckBox; diff --git a/funcext/tvclib/utvclgraphics.tsf b/funcext/tvclib/utvclgraphics.tsf index 3a68dd9..b13afa4 100644 --- a/funcext/tvclib/utvclgraphics.tsf +++ b/funcext/tvclib/utvclgraphics.tsf @@ -6,6 +6,7 @@ uses utslvclauxiliary; //20240204 添加说明 //20240220 三维绘图功能 //20240614 添加消息 +//20250925 ffigure中添加color_map, { tg_const 常量类型，作为所有类型的基类，提供常量别名 tg_canvas 绘图画布对象，该对象以窗口中的canvas为父类，并增加了辅助函数 @@ -32,7 +33,7 @@ uses utslvclauxiliary; nodecount 获取子节点数量 GetNodeByIndex 通过序号获取子节点 set_node_index(nd,idx) 设置子节点的序号 - 基础功能： + 基础功能： markinfo 标记信息 tg_mark_info 类型 lineinfo 画笔信息 tg_line_info 类型 line_mode 是否画线 @@ -46,6 +47,11 @@ uses utslvclauxiliary; addEventListener(etype,fun(e),ifCapture) //添加消息处理 removeEventListener(etype,fun(e),ifCapture) //移除消息处理 dispatchEvent(evt) ;//分发消息 + onhittest:function(array("cvsx":x,"cvsy":y)):bool; //回调,命中判断, + hittest:bool//是否处理鼠标命中 + default_hittest(array("cvsx":x,"cvsy":y)):bool;virtual; 默认处理命中 + oncreate_contextmenu(tg_base):tcustommenu;回调返回tcustommenu + contextmenu:tcustommenu 弹出菜单 tg_figure //坐标容器类，可以在上面放坐标系，设置坐标系的位置信息 add_axes(axes) 添加坐标系 @@ -152,33 +158,35 @@ fg := new tg_picture(800,800); //////////设置坐标轴属性//////////////////////// axs := new tg_axes(); axs.box := false; -axs.figure := fg; -axs.title.text := "hello pie "; -axs.axises(1).visible:=false; +axs.figure := fg; //设置坐标系到picture +axs.title.text := "hello pie "; //设置标题 +axs.axises(1).visible:=false; //隐藏坐标轴 axs.axises(0).visible:= false; -axs.data_bounds(0) := array(-0.1,2.1); +axs.data_bounds(0) := array(-0.1,2.1); //设置数据范围 axs.data_bounds(1) := array(-0.1,2.1); axs.data_bounds(2) := array(-0.5,0.5); +//////////////根据角度构造线条数据////////////////////////////// args := array( (pi()/4,pi()/3,0x0000ff), (pi()/3,pi()/2,0x00ff00), (pi()/2,pi()*3/2,0xff0000), (pi()*3/2,pi()*9/4,0xff00ff) - ); prominentidx := 0; //凸显的块 prominentrate := 0.1; //凸显的块 for i,v in args do begin line := new tg_Polyline(); - line.polyline_style := line.tgc_LS_filled; + line.polyline_style := line.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); line.lineinfo.bkcolor := v[2]; line.parent := axs; -end -fg.save_png(%% D:\test\ppt2.png%%); //保存 +end +/////////////////////////////////////// +fg.save_png(%% D:\test\ppt2.png%%); //保存 +/////////////////构造饼图线条//////////////////////////// function get_pie_lines(arg1,arg2,prominent,prominentrate); begin stp := pi()/180; @@ -200,7 +208,7 @@ begin end end return r; -end +end //////////////////线图范例////////////////////////// uses tslvcl,utvclgraphics; app := initializeapplication(); @@ -211,6 +219,7 @@ type tfm = class(tvcform,tg_const) function create(aowner); begin inherited; + ////////窗口作为picture/////////// Caption := "line"; fg := new tg_WinControl(self); fg.Caption := "hello1"; @@ -219,25 +228,29 @@ type tfm = class(tvcform,tg_const) //////////设置坐标轴属性//////////////////////// axs := new tg_axes(); axs.figure := fg; + ///设置标题 axs.title.text := "你好 plot "; axs.title.fontinfo.size := 15; axs.title.fontinfo.color := 0xff0000; - axs.x_label.text := "x fanli "; + axs.x_label.text := "x fanli "; //x轴标签 + ///////Y轴的属性设置 axs.axises(1).tics_color := 0x0000ff; axs.axises(1).fontinfo.size := 8; axs.axises(1).lineinfo.color := 0x00ff00; + ////设置平行网格线 axs.grid(0).Width := 2; axs.grid(0).color := 0x0ff0f0; //设置线型属性 - line := new tg_Polyline(); - line.lineinfo.style := 4; - line.lineinfo.color := 0xff0000; - line.markinfo.bkcolor := 0x00ff00; - line.markinfo.color := 0x0000ff; - line.mark_mode := tgc_on; + line := new tg_Polyline(); //线图 + line.lineinfo.style := 4; //线宽 + line.polyline_style := tgc_LS_staircase; //线型 + line.lineinfo.color := 0xff0000; //颜色 + line.markinfo.bkcolor := 0x00ff00; //点颜色 + line.markinfo.color := 0x0000ff; + line.markinfo.style := tgc_mks_pentagram; line.markinfo.size := 30; - line.markinfo.style := tgc_mks_pentagram; - line.polyline_style := tgc_LS_staircase; + line.mark_mode := tgc_on; //显示点 + //////////构造数据/////////////////////////////// d := array(); idx := 0; for i:= -pi() to pi() step 0.2 do @@ -246,10 +259,11 @@ type tfm = class(tvcform,tg_const) idx++; end line.graph_data := d; - line.parent := axs; + //////////////////////////////////// + line.parent := axs; //设置线到坐标系 end fg; -end +end //////////////////表面图范例/////////////////////////////////////// uses tslvcl,utvclgraphics; app := initializeapplication(); @@ -261,6 +275,7 @@ type tfm = class(tvcform,tg_const) begin inherited; Caption := "surface"; + /////////////窗口picture对象////////////////////////// fg := new tg_WinControl(self); fg.Caption := "hello1"; fg.parent := self; @@ -269,16 +284,17 @@ type tfm = class(tvcform,tg_const) axs := new tg_axes(); t := pi()*60/180; a := pi()*70/180; - axs.set_trans(a,t); - axs.box := true; + axs.set_trans(a,t); //旋转坐标轴 + axs.box := true; //坐标轴边框 axs.figure := fg.figure; axs.title.text := "你好 surface "; axs.title.fontinfo.size := 15; axs.title.fontinfo.color := 0xff0000; + ///Y轴信息///////// axs.axises(1).tics_color := 0x0000ff; axs.axises(1).fontinfo.size := 8; axs.axises(1).lineinfo.color := 0x00ff00; - sf := new tg_my_surf(); + sf := new tg_my_surf(); //表面图对象 sf.lineinfo.color := 0x0000ff; sf.lineinfo.style := tgc_BS_SOLID; sf.graph_data := get_surf_data(); @@ -323,7 +339,7 @@ type tg_my_surf = class(tg_graph) // inherited; lineinfo.bkcolor := 0x00f0f0; end - function get_data_bounds();override; + function get_data_bounds();override; //数据上下界 begin d := graph_data; r := array((inf,-inf),(inf,-inf),(inf,-inf)); @@ -395,6 +411,7 @@ type tfm = class(tvcform,tg_const) caption := "pie"; width := 800; Height := 800; + ///////////picture对象//////////////////////////// fg := new tg_WinControl(self); fg.Caption := "hello1"; fg.parent := self; @@ -406,15 +423,16 @@ type tfm = class(tvcform,tg_const) axs.title.text := "hello pie "; axs.axises(1).tics_color := 0x0000ff; axs.axises(1).fontinfo.size := 8; + //////////数据范围//////////////// axs.data_bounds(0) := array(-0.1,2.1); axs.data_bounds(1) := array(-0.1,2.1); axs.data_bounds(2) := array(-0.5,0.5); + ////////////根据线构造数据/////////////////// args := array( (pi()/4,pi()/3,0x0000ff), (pi()/3,pi()/2,0x00ff00), (pi()/2,pi()*3/2,0xff0000), - (pi()*3/2,pi()*9/4,0xff00ff) - + (pi()*3/2,pi()*9/4,0xff00ff) ); prominentidx := 0; //凸显的块 prominentrate := 0.1; //凸显的块 @@ -424,11 +442,12 @@ type tfm = class(tvcform,tg_const) 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); + line.graph_data := 1+get_pie_lines(v[0],v[1],i=prominentidx,prominentrate);//构造图 line.lineinfo.bkcolor := v[2]; line.parent := axs; end end + ////////////根据角度构造数据/////////////////// function get_pie_lines(arg1,arg2,prominent,prominentrate); begin stp := pi()/180; @@ -453,7 +472,7 @@ type tfm = class(tvcform,tg_const) end fg; end -///////////////////////////消息处理/////////////////////////////////////////////////// +///////////////////////////消息处理,鼠标,菜单/////////////////////////////////////////////////// uses tslvcl,utvclgraphics; app := initializeapplication(); app.createform(class(tfm),fm); @@ -464,25 +483,28 @@ type tfm = class(tvcform,tg_const) begin inherited; fgwnd := new tg_WinControl(self); - fgwnd.Caption := "hello event"; + fgwnd.Caption := "绘图交互"; fgwnd.parent := self; fgwnd.Align := alClient; - fg := fgwnd.figure; - axs := new tg_axes(); - axs.figure := fg; - axs.title.text := "你好 event "; + fg := fgwnd.figure; //figure + axs := new tg_axes(); //坐标系 + axs.figure := fgwnd; + axs.title.text := "交互范例"; //标题 + //////////////线对象//////////////////////////////////////// line := new tg_Polyline(); + line.line_mode := true; + line.polyline_style := tgc_LS_interpolated;//"bar"; line.parent := axs; line.lineinfo.Width := 3; - line.lineinfo.bkcolor := 0xff00f0; + line.lineinfo.bkcolor := 0xff00f0; //颜色 line.lineinfo.color := 0xff0000; - line.markinfo.bkcolor := 0x00ff00; - line.markinfo.color := 0x0000ff; - line.line_mode := 1; - line.markinfo.size := 20; - line.mark_mode := true; - line.markinfo.style := line.tgc_mks_pentagram; - line.polyline_style := line.tgc_LS_interpolated;//"bar"; + line.mark_mode := true; //mark信息 + line.markinfo.bkcolor := 0x00ff00; + line.markinfo.color := 0x0000ff; + line.markinfo.size := 30; + line.markinfo.style := line.tgc_mks_pentagram; + line.closed := true; //封闭线条 + //////////////设置数据/////////////////////////// d2 := array(); idx := 0; for i:= -pi() to pi() step 0.3 do @@ -490,47 +512,51 @@ type tfm = class(tvcform,tg_const) d2[idx++] := array(i,sin(i+pi()/2)); end line.graph_data := d2; - + /////////////文本对象/////////////////////////////// gtx := new tg_text(); gtx.font_angle := pi()/4; - //////////////命中处理/////////////// - gtx.onhit_at := function(o,d)begin - x := d["cvsx"]; - y := d["cvsy"]; - return o.ExecuteCommand("point_in_text",array(x,y)); - end gtx.lineinfo.bkcolor := 0x00ff00; gtx.parent :=line; gtx.text := array("按住鼠标左键","移动我"); - gtx.data := array(0.3,0.2); - //处理鼠标按下 + gtx.data := array(0.3,0.2); + /////////////处理文本对象的鼠标消息///////////////////////////////// gtx.addEventListener(evt_mouse_down,function(e)begin - fdragtext := e.target; + if e.button<>mbLeft then return ; + if fdragtext<>e.target then return ; + fdraging := true; ftextinitpos := fdragtext.data; x := e.cvsx;y := e.cvsy; - fdragtext.xyz_to_zoom(x,y,0,x1,y1); - fmousedownpos := array(x1,y1); + fdragtext.xyz_to_zoom(x,y,0,x1,y1,z1);//转换屏幕坐标到坐标系 + fmousedownpos := array(x1,y1,z1); end); - //移动标签 + gtx.addEventListener(evt_mouse_in,function(e)begin + fdragtext := e.target; + fdragtext.line_mode := true; + end); + gtx.addEventListener(evt_mouse_out,function(e)begin + if fdragtext then fdragtext.line_mode := false; + end); + ///////////在figure层处理文本的跟随鼠标移动/////////////////////// fg.addEventListener(evt_mouse_move,function(e)begin - if fdragtext then + if fdragtext and fdraging then begin e.stoppropagation(); x := e.cvsx; y := e.cvsy; - fdragtext.xyz_to_zoom(x,y,0,x1,y1); - dxdata := ftextinitpos+ array(x1-fmousedownpos[0],y1-fmousedownpos[1]); + fdragtext.xyz_to_zoom(x,y,0,x1,y1,z1);//转换屏幕坐标到坐标系 + dxdata := ftextinitpos+ array(x1-fmousedownpos[0],y1-fmousedownpos[1],z1-fmousedownpos[2]); fdragtext.data := dxdata; end - end ,true); + end ,true); //处理鼠标松开 - fg.addEventListener(evt_mouse_up,function(e)begin - if fdragtext then + fg.addEventListener(evt_mouse_up,function(e)begin + if fdragtext and fdraging then begin e.stoppropagation(); - fdragtext := nil; + fdraging := false; end end ); + //////////////////////////////////////////////// //构造提示标签 fmovetip := new tg_tips(); fmovetip.Visible := false; @@ -539,15 +565,8 @@ type tfm = class(tvcform,tg_const) fmovetip.data_idx := 5; fmovetip.fontinfo.size := 12; fmovetip.box_mode := true;//false; - fmovetip.fontinfo.color := 0xff00ff; - //设置提示数据点 - line.onhit_at := function(o,d)begin - x := d["cvsx"]; - y := d["cvsy"]; - r := o.ExecuteCommand("hit_point",array(x,y)); - fhitidx := r; - return r>=0; - end + fmovetip.fontinfo.color := 0xff00ff; + ///////////////处理提示标签的显示和隐藏////////////////////////////////// line.addEventListener(evt_mouse_out,function(e)begin if e.eventPhase<>2 then return ; fmovetip.Visible := false; @@ -557,24 +576,34 @@ type tfm = class(tvcform,tg_const) begin if e.eventPhase<>2 then return ; e.stoppropagation(); - x := e.cvsx; - y := e.cvsy; - if fhitidx>=0 then - begin + ifo := e.target.ExecuteCommand(cmd_hit_test_info); + if ifarray(ifo) and ifo["type"]="mark" then + begin fmovetip.Visible := true; - return fmovetip.data_idx := fhitidx; - end else fmovetip.Visible := false; + fmovetip.data_idx := ifo["idx"]; + end end,true); + ///////////////////////////////////////////// + /////////////////////////////////////菜单 + mu := new TMenu(self); + mu1 := new TMenu(self); + mu1.Caption := "test menu"; + mu1.parent := mu; + line.contextmenu := mu; + mu1.onclick := function(o)begin + echo "\r\nclick:",o.Caption,"===",o._tag; + end ; end - fhitidx; - fdragtext; - ftextinitpos; - fmousedownpos; - fmovetip; + fdraging; //拖动文本 + fdragtext; //移动文本 + ftextinitpos; //鼠标按下时的文本位置 + fmousedownpos; //鼠标按下的位置 + fmovetip;//数据提示 fgwnd; - fg; + gtx; end } +function hit_line(p1,p2,p,ds=5,straight=0); //命中线 function point_in_rgn(p,rgn_,method); //判断点是否在区域中 function graph_paint_lines(cvs,linestyle,xys,closed,ifo); //根据给定点绘制线 function graph_paint_points(mk,cvs,xys); //根据点信息绘制点 @@ -583,10 +612,12 @@ function graph_paint_rec_to_points(rec); function r_2_a(arg); function a_2_r(arg); function d2angle(v1,v2); +function hot_color_map(n); //熱力顏色 type tg_picture = class(tcustommemcanvas,tg_figure_container) //绘图对象 uses utslvclgdi; function create(w,h); begin + fauto_margins := false; class(tcustommemcanvas).create(w,h); class(tg_figure_container).create(); frect := array(0,0,w,h); @@ -594,17 +625,37 @@ type tg_picture = class(tcustommemcanvas,tg_figure_container) // return frect; end end - function save_png(fn); + property auto_margins:bool read fauto_margins write setauto_margins; //自动空白区域 + function save_png(fn);//保存图片 begin paint(); savepng(fn); end private - frect; + frect; + fauto_margins; + function setauto_margins(v); + begin + nv := v?true:false; + if nv<> fauto_margins then fauto_margins := nv; + end + function doauto_margins(); + begin + if ffigure and fauto_margins then + begin + arg := ffigure.get_optimal_margins()+10; + rec := frect; + w := rec[2]-rec[0]; + h := rec[3]-rec[1]; + mgs := array(arg[0]/w,arg[1]/h,arg[2]/w,arg[3]/h); + ffigure.executecommand("set_margins",mgs); + end + end function paint(); //绘制 begin brush.color := 0xffffff; FillRect(frect); + doauto_margins(); ffigure.paint_pre(self); end end @@ -634,7 +685,6 @@ type tg_metafile = class(tcustommetacanvas,tg_figure_container) // ffigure.paint_pre(self); end end } -//tcustommetacanvas type tg_WinControl = class(tcustomcontrol,tg_figure_container) //绘图窗口 function create(AOwner); begin @@ -646,6 +696,7 @@ type tg_WinControl = class(tcustomcontrol,tg_figure_container) // class(tcustomcontrol).create(AOwner); width := 300; height := 300; + fauto_margins := false; class(tg_figure_container).create(); fg_timer := new unit(utslvclstdctl).tcustomtimer(self); fg_timer.Interval := s_flush_interval; @@ -672,7 +723,8 @@ type tg_WinControl = class(tcustomcontrol,tg_figure_container) // end function paint();override; //绘制 begin - fg_timer.stop(); + fg_timer.stop(); + doauto_margins(); cvs := canvas; f_validate_doing := true; ffigureprepared := false; @@ -689,19 +741,29 @@ type tg_WinControl = class(tcustomcontrol,tg_figure_container) // begin if ffigure then begin + if fg_timer.Enabled then figure_need_fresh(fg_timer); + fmouseisdown := false; d := e_2_array(e,evt_mouse_up); - if ffigure.executecommand(evt_mouse_up,d)=1 then e.skip := true; - end + if ffigure.executecommand(evt_mouse_up,d)=1 then e.skip := true; + if e.button=mbRight then e.skip := false; + if fg_timer.Enabled then figure_need_fresh(fg_timer); + end end function MouseDown(o,e);override; begin if ffigure then begin + if fg_timer.Enabled then figure_need_fresh(fg_timer); d := e_2_array(e,evt_mouse_down); - if ffigure.executecommand(evt_mouse_down,d)=1 then e.skip := true; + fmouseisdown := true; + if ffigure.executecommand(evt_mouse_down,d)=1 then + begin + fmouseisdown := false; + e.skip := true; + end SetFocus(); - end - //echo "\r\n",functionname(),tostn(array(xy,bt,sh)); + if fg_timer.Enabled then figure_need_fresh(fg_timer); + end end function KeyDown(o,e);override; begin @@ -727,16 +789,45 @@ type tg_WinControl = class(tcustomcontrol,tg_figure_container) // if ffigure.executecommand(evt_key_press,d)=1 then e.skip := true; end end + function ContextMenu(o,e);override;//TWinControl + begin + uses utslvclmenu; + if ffigure then + begin + [x,y] := ScreenToClient(e.lolparamsigned,e.hilparamsigned); + r := ffigure.executecommand("hit_nodes",array("cvsx":x,"cvsy":y)); + for i,v in r do + begin + mu := v.create_contextmenu(); + if not(mu is class(TcustomMenu)) then mu := v.ContextMenu ; + if mu is class(TcustomMenu) then + begin + set_mutag(mu,v); + TrackPopupMenu(mu,x,y); + break; + end + end + e.skip := true; + end + end function MouseMove(o,e);override; begin if ffigure then - begin + begin fmovecnt++; - if fmovecnt>4 then fmovecnt := 0; - if fmovecnt<>2 then return ; + fmovecnt := fmovecnt mod 5; + if not(fmouseisdown) then //没有按下,减少移动处理 + begin + if fmovecnt<>0 then + begin + return ; + end + end + if fg_timer.Enabled then figure_need_fresh(fg_timer); d := e_2_array(e,evt_mouse_move); - if ffigure.executecommand(evt_mouse_move,d)=1 then e.skip := true; - end + if ffigure.executecommand(evt_mouse_move,d)=1 then e.skip := true; + if fg_timer.Enabled then figure_need_fresh(fg_timer); + end end function DoMouseWheel(o,e);override; begin @@ -754,9 +845,12 @@ type tg_WinControl = class(tcustomcontrol,tg_figure_container) // function DoWMSIZE(o,e);override; begin inherited; - if ffigure then + if ffigure then + begin ffigure.executecommand(cmd_figure_changed); - end + end + end + function Recycling();override; begin ffigure:=nil; @@ -782,7 +876,26 @@ type tg_WinControl = class(tcustomcontrol,tg_figure_container) // end end property flush_interval read get_interval write set_interval; //当前窗口的刷新间隔 + published + property auto_margins:bool read fauto_margins write setauto_margins; //自动空白区域 private + fauto_margins; + function setauto_margins(v); + begin + nv := v?true:false; + if nv<> fauto_margins then fauto_margins := nv; + end + function set_mutag(mu,tg); + begin + if mu then + begin + mu._tag := tg; + for i := 0 to mu.ItemCount-1 do + begin + set_mutag(mu.GetItemByIndex(i),tg); + end + end + end function get_interval(); begin return fg_timer.Interval; @@ -795,9 +908,21 @@ type tg_WinControl = class(tcustomcontrol,tg_figure_container) // begin o.stop(); if not ffigureprepared then return ; //没有准备好 - if f_validate_doing then return; + if f_validate_doing then return; InvalidateRect(nil,false); end + function doauto_margins(); + begin + if ffigure and fauto_margins then + begin + arg := ffigure.get_optimal_margins()+10; + rec := clientrect; + w := rec[2]-rec[0]; + h := rec[3]-rec[1]; + mgs := array(arg[0]/w,arg[1]/h,arg[2]/w,arg[3]/h); + ffigure.executecommand("set_margins",mgs); + end + end function ek_2_array(e,tp); begin d := array(); @@ -832,6 +957,7 @@ type tg_WinControl = class(tcustomcontrol,tg_figure_container) // private static s_flush_interval; static ftgwindows; + fmouseisdown; fmovecnt; fg_timer; f_validate_doing; @@ -865,6 +991,20 @@ type tg_figure = class(tg_evet_conainter) // function executecommand(cmd,p); begin case cmd of + "set_margins": + begin + for i,v in faxeses.data do + begin + v.margins := p; + end + end + "move_axes_top": + begin + if faxeses.set_node_index(p,faxeses.NodeCount) then // + begin + + end + end evt_key_down: begin return cmd_key_event(evt_key_down,p); @@ -882,6 +1022,10 @@ type tg_figure = class(tg_evet_conainter) // fresh(); return ; end + "hit_nodes": + begin + return hit_nodes(p); + end evt_mouse_wheel: begin r := cmd_mouse_event(evt_mouse_wheel,p); @@ -926,7 +1070,8 @@ type tg_figure = class(tg_evet_conainter) // if get_axes_idx(axs)>=0 then return ; if fwilladdaxs and fwilladdaxs=axs then begin - faxeses.unshift(axs); + //faxeses.unshift(axs); + faxeses.push(axs); fwilladdaxs := nil; axs.figure := self(true); return ; @@ -959,9 +1104,23 @@ type tg_figure = class(tg_evet_conainter) // r := array(0,0,200,200); if frect_getter then r := call(frect_getter); return r; - end + end + function get_optimal_margins(); + begin + r := array(0,0,0,0); + for i,v in faxeses.data do + begin + ri := v.get_optimal_margins(); + for j,vj in ri do + begin + r[j] := max(r[j],ri[j]); + end + end + return r; + end property rec_getter read frect_getter write frect_getter; //区域获取 property fresh_caller read ffresh_caller write ffresh_caller; //刷新回调 + property color_map read fcolor_map write setcolor_map; public function dispatchEvent(evt,nd); begin @@ -977,7 +1136,9 @@ type tg_figure = class(tg_evet_conainter) // begin nds[idx] := p; idx++; - p := p.parent; + tp := p.parent; + if not tp then tp := p.host; + p := tp; end end tg := nds[0]; @@ -1017,6 +1178,10 @@ type tg_figure = class(tg_evet_conainter) // end end private + function setcolor_map(v); + begin + fcolor_map := v; + end function get_axes_idx(axs); begin for i ,v in faxeses.data do @@ -1049,54 +1214,65 @@ type tg_figure = class(tg_evet_conainter) // while nnd do begin onds[length(onds)] := nnd; - nnd := nnd.parent; + tnnd := nnd.parent; + if not tnnd then tnnd := nnd.host; + nnd := tnnd; end evt := new tg_evt_key(evtname,d); dispatchEvent(evt,onds); return evt.stoppropagationed or evt.defaultPrevented; //是否停止 - end - function cmd_mouse_event(evtname,p); + end + function hit_nodes(p); //cvsx cvsy begin - d := p; - for i,v in inverse_array(faxeses.data) do + ases := inverse_array(faxeses.data); + for i,v in ases do begin - nds := node_hit_list(v,d); + nds := node_hit_list(v,p); if nds then begin break; end + end + return nds; + end + function cmd_mouse_event(evtname,p); + begin + d := p; + nds := hit_nodes(p); + if not ifarray( nds ) then + begin + return ; end - if not ifarray( nds ) then return ; d["istrusted"] := true; d["bubbles"] := true; case evtname of evt_mouse_move : begin - ninnode := nds[0]; - if ninnode then - begin - if fMouseOnOBJ<> ninnode then //鼠标进入不同的控件 + ninnode := nds[0]; + if fMouseOnOBJ<> ninnode then //鼠标进入不同的控件 + begin + if fMouseOnOBJ then //旧控件 处理move out begin - if fMouseOnOBJ then //旧控件 处理move out + onds := array(); + nnd := fMouseOnOBJ; + while nnd do begin - onds := array(); - nnd := fMouseOnOBJ; - while nnd do - begin - onds[length(onds)] := nnd; - nnd := nnd.parent; - end - evt := new tg_evt_mouse(evt_mouse_out,d); - dispatchEvent(evt,onds); - end - fMouseOnOBJ := ninnode; + onds[length(onds)] := nnd; + tnnd := nnd.parent; + if not tnnd then tnnd := nnd.host; + nnd := tnnd; + end + evt := new tg_evt_mouse(evt_mouse_out,d); + dispatchEvent(evt,onds); + end + fMouseOnOBJ := ninnode; + if ninnode then + begin evt := new tg_evt_mouse(evt_mouse_in,d); //处理mouse in dispatchEvent(evt,nds); - return true; - end - end else - begin - end + end + return true; + end end end evt := new tg_evt_mouse(evtname,d); @@ -1109,7 +1285,8 @@ type tg_figure = class(tg_evet_conainter) // [weakref] fMouseOnOBJ; fwilladdaxs; fwilldelaxs; - faxeses; + faxeses; + fcolor_map; end type tg_axes = class(tg_base) //坐标系 private @@ -1142,15 +1319,15 @@ type tg_axes = class(tg_base) // if not ifarray(pm) then return ; p0 := pm["cvsx"]; p1 := pm["cvsy"]; + if not xy_in_paint_rect(p0,p1) then + begin + return true; + end for i := 0 to 2 do begin a0 := fzoom_box[i,0]; b0 := fzoom_box[i,1]; - if not xy_in_paint_rect(p0,p1) then - begin - return true; - //continue; - end + if not xyz_to_zoom(p0,p1,fzoom_box[2,0],x,y,z) then continue ; dx := ((pm["delta"]>0)?(1.05):(1/1.05)); if not zoom_bound_op(a0,b0,dx,array(x,y,z)[i],a,b) then continue ; @@ -1282,13 +1459,28 @@ type tg_axes = class(tg_base) // cvs.axesvector := get_top_outer_points(); //paint(cvs); cvs.executecommand("painter",self(true)); + cvs.axesclip(); paint_grid(cvs); inherited; cvs.axesunclip(); - for i,v in faxes_objects do //绘制坐标 + if fminister_axse and (fminister_axse.visible =tgc_on) then begin - v.paint_pre(cvs); - end + pl := fminister_axse.polar; + end else + pl := fpolar; + if pl=tgc_on then + begin + cvs.axesclip(); + paint_polar(cvs); + cvs.axesunclip(); + faxes_objects[2].paint_pre(cvs); //Y轴 + end else + begin + for i,v in faxes_objects do //绘制坐标 + begin + v.paint_pre(cvs); + end + end modify_label_position(); ftitle.paint_pre(cvs); if fbox = tgc_on then @@ -1298,6 +1490,13 @@ type tg_axes = class(tg_base) // end cvs.axesunclip(); end + function move_to_top();override; // + begin + if fFigure then + begin + return fFigure.executecommand("move_axes_top",self(true)); + end + end function axes_changed();//改变 begin if not fFigure then return ; @@ -1307,13 +1506,31 @@ type tg_axes = class(tg_base) // fr := fFigure.rect(); w := fr[2]-fr[0]; h := fr[3]-fr[1]; - wa := w*(1-fmargins[0]-fmargins[2]); - ha := h*(1-fmargins[1]-fmargins[3]); - p_left := fr[0]+w*fmargins[0]+wa*faxes_bounds[0]; - p_top := fr[1]+h*fmargins[1]+wa*faxes_bounds[1]; - p_width := wa*(faxes_bounds[2]-faxes_bounds[0]); - p_height := ha*(faxes_bounds[3]-faxes_bounds[1]); - if fsqured=tgc_on then + if fminister_axse and (fminister_axse.visible=tgc_on) then + begin + mgs := fminister_axse.margins; + axb := fminister_axse.axes_bounds; + end else + begin + mgs := fmargins; + axb := faxes_bounds; + end + wa := w*(1-mgs[0]-mgs[2]); + ha := h*(1-mgs[1]-mgs[3]); + p_left := fr[0]+w*mgs[0]+wa*axb[0]; + p_top := fr[1]+h*mgs[1]+wa*axb[1]; + p_width := wa*(axb[2]-axb[0]); + p_height := ha*(axb[3]-axb[1]); + if fminister_axse and(fminister_axse.visible=tgc_on) then + begin + sqd := fminister_axse.squred; + pol := fminister_axse.polar; + end else + begin + sqd := fsqured; + pol := fpolar; + end + if (sqd=tgc_on) or (pol=tgc_on) then begin ts := min(p_width,p_height); p_width := ts; @@ -1321,27 +1538,57 @@ type tg_axes = class(tg_base) // end fcvs_bounds := array(p_left,p_top,p_left+p_width,p_top+p_height); if (f_changed .& c_g_data_changed)=c_g_data_changed then - begin - tbds := fdata_bounds; - for i,v in get_node_data_bounds_format(self(true)) do - begin - if not fdata_bounds_locked[i] then + begin + //tbds := fdata_bounds; + tbds := get_node_data_bounds_format(self(true)); + if fminister_axse and (fminister_axse.visible=tgc_on) then //主轴 + begin + tbds[0] := (fminister_axse.data_bounds)[0]; + for i,v in tbds do begin - new_bounds(v[0],v[1],a_,b_); - tbds[i] := array(a_,b_);//v*1.05; - end - end + if not(fdata_bounds_locked[i]) and i>0 then + begin + new_bounds(v[0],v[1],a_,b_); + tbds[i] := array(a_,b_);//v*1.05; + end + end + end else + begin + if fdeputy_axse and (fdeputy_axse.visible=tgc_on) then + begin + bdss2 := get_node_data_bounds_format(fdeputy_axse); + tbds[0,0] := min(tbds[0,0],bdss2[0,0]); + tbds[0,1] := max(tbds[0,1],bdss2[0,1]); + end + for i := 0 to 2 do + begin + if not fdata_bounds_locked[i] then + begin + new_bounds(tbds[i,0],tbds[i,1],a_,b_); + tbds[i] := array(a_,b_);//v*1.05; + end + end + end fdata_bounds := tbds; fzoom_box := tbds*1.05; fzoom_bounds := fzoom_box; end /////////////计算旋转矩阵////////////////////////// if (f_changed .& c_g_rote_changed)=c_g_rote_changed then - begin - c := cos(falpha); - s := sin(falpha); - c1 := cos(ftheta); - s1 := sin(ftheta); + begin + if fminister_axse and (fminister_axse.visible=tgc_on) then + begin + c := cos(fminister_axse.alpha); + s := sin(fminister_axse.alpha); + c1 := cos(fminister_axse.theta); + s1 := sin(fminister_axse.theta); + end else + begin + c := cos(falpha); + s := sin(falpha); + c1 := cos(ftheta); + s1 := sin(ftheta); + end frote_mt := array((0,1,0),(1,0,0),(0,0,1)):*array((c,s,0),(-s,c,0),(0,0,1)):*array((1,0,0),(0,c1,s1),(0,-s1,c1)); end //////////////////////////////////////// @@ -1355,6 +1602,57 @@ type tg_axes = class(tg_base) // end f_changed := 0; end + function get_optimal_margins(); //获取最优的边界 + begin + axes_changed(); + auto_set_axis(); + r := array(10,10,10,10); + s := ftitle.text; + sz := ftitle.fontinfo.size; + if s then r[1]+=sz*2+5; //标题宽度 + xa := faxes_objects[0]; + ya := faxes_objects[1]; + if fx_location=tgc_top then //在上面 + begin + r[1]+= xa.fontinfo.size*2+3; + if fx_label.text then + begin + r[1]+=fx_label.fontinfo.size*2+3; + end + end else + if fx_location=tgc_bottom then //在下面 + begin + r[3]+= xa.fontinfo.size*2+3; + if fx_label.text then + begin + r[3]+=fx_label.fontinfo.size*2+3; + end + end + s := ya.tics_labels;//tic 标签宽度 + len := 0; + for i,v in s do + begin + if v then + len := max(length(v),len); + end + if fy_location=tgc_left then + begin + r[0]+=ya.fontinfo.size*len+5; + if fy_label.text then + begin + r[0]+=fy_label.fontinfo.size*2+3; + end + end else + if fy_location=tgc_right then + begin + r[2]+=ya.fontinfo.size*len+5; + if fy_label.text then + begin + r[2]+=fy_label.fontinfo.size*2+3; + end + end + return r; + end private //////////长宽高//////////////////// fbounds_center; //中心 @@ -1394,6 +1692,7 @@ type tg_axes = class(tg_base) // begin f_changed := 0; fsqured := tgc_off; + fpolar := tgc_off; inherited; ftheta := 0; falpha := 0; @@ -1442,11 +1741,15 @@ type tg_axes = class(tg_base) // fz_location := tgc_right; fy_location := tgc_left; faxes_objects := array(); + ftitle := new tg_label_axes(); + attachments_add(ftitle); for i := 0 to 2 do begin axi := new tg_axis_main(); + attachments_add(axi); axi.tics_style := tgc_tics_v;//tgc_tics_r; lbl := new tg_label_axis(); + lbl.axes := self(true); case i of 0: begin @@ -1467,11 +1770,10 @@ type tg_axes = class(tg_base) // end end ; axi.axis_label := lbl; + attachments_add(lbl); faxes_objects[i] := axi; axi.axes := self(true); - end - - ftitle := new tg_label_axes(); + end ftitle.axes := self(true); ftitle.location := tgc_by_axes; fauto_ticks := array(tgc_on,tgc_on,tgc_on); @@ -1485,7 +1787,85 @@ type tg_axes = class(tg_base) // //rectangle_properties, champ_properties, axis_properties, polyline_properties, segs_properties, //grayplot_properties, surface_properties, fec_properties, text_properties, legend_properties) end - published + /////////////////副坐标系设置//////////////////////// + private //副坐标系 + [weakref]fdeputy_axse; + [weakref]fminister_axse; + fwilldel_duptyaxes; + fwilladd_duptyaxes; + fwilladd_ministeraxes; + fwilldel_ministeraxes; + function set_minister_axse(v); //添加主axes + begin + if axs=self(true) then return ; + if v=fminister_axse then return ; + if fwilladd_ministeraxes and fwilladd_ministeraxes=v then + begin + fwilladd_ministeraxes := nil; + fminister_axse := v; + v.add_dupty_axes(self(true)); + f_changed .|= c_g_paint_rect; + return ; + end + if fwilldel_ministeraxes and fwilldel_ministeraxes=tp then + begin + fwilldel_ministeraxes := nil; + fminister_axse := nil; + v.del_dupty_axes(self(true)); + return ; + end + tp := fminister_axse; + if tp then //删除 + begin + fwilldel_ministeraxes := tp; + tp.del_dupty_axes(self(true)); + fwilldel_ministeraxes := nil; + end + if v is class(tg_axes) then //添加 + begin + fwilladd_ministeraxes := v; + v.add_dupty_axes(self(true)); + fwilladd_ministeraxes := nil; + end else + begin + fminister_axse := nil; + end + end + protected //副坐标系 + function add_dupty_axes(axs);//添加副axes + begin + if axs=self(true) then return ; + if axs = fdeputy_axse then return ; + if fwilladd_duptyaxes and fwilladd_duptyaxes=axs then + begin + fdeputy_axse := axs; + fwilladd_duptyaxes := nil; + axs.minister_axse := self(true); + return ; + end + if not(axs is class(tg_axes)) then return ; + fwilladd_duptyaxes := axs; + axs.minister_axse := self(true); + end + function del_dupty_axes(axs); //移除副axes + begin + if not(fdeputy_axse=axs) then return ; + if fwilldel_duptyaxes and fwilldel_duptyaxes = axs then + begin + fwilldel_duptyaxes := nil; + fdeputy_axse:=nil; + axs.minister_axse := nil; + return ; + end + fwilldel_duptyaxes := axs; + axs.minister_axse := nil; + end + //////////////////////////////////// + + published + property alpha read falpha; + property theta read ftheta; + property minister_axse read fminister_axse write set_minister_axse; property figure read fFigure write SetFigure; //图容器 property axises read get_axises;//axes_visible ;//= ["on","on","on"] property axes_reverse read gs_axes_reverse write gs_axes_reverse;//axes_reverse ;//= ["off","off","off"] @@ -1506,6 +1886,7 @@ type tg_axes = class(tg_base) // property squred read fsqured write set_squred; //绘制区域是否采用等长宽，默认 property data_bounds read gs_data_bounds write gs_data_bounds; //数据边界 property zoom_box read gs_zoom_box write gs_zoom_box; //视图范围 + property polar read fpolar write set_polar; //极坐标系 //在窗口中的区域 //网格线 property grid read get_grid; @@ -1522,10 +1903,10 @@ type tg_axes = class(tg_base) // //ticks_format ;//= ["","",""] //ticks_st ;//= [1,1,1;0,0,0] //sub_ticks ;//= [1,1] - font_style ;//= 6 - font_size ;//= 1 - font_color ;//= -1 - fractional_font ;//= "off" + //font_style ;//= 6 + //font_size ;//= 1 + //font_color ;//= -1 + //fractional_font ;//= "off" //isoview ;//= "off" //cube_scaling ;//= "off" @@ -1560,6 +1941,7 @@ type tg_axes = class(tg_base) // return self(true); end private //variable + fpolar; Fpainting; fgrid; faxes_objects; @@ -1580,15 +1962,83 @@ type tg_axes = class(tg_base) // fz_location; fbox; faxes_reverse; - private + private //figure 处理 fwilldelfigure; fwilladdfigure; + function set_polar(v); + begin + if tg_boolen_value(v,nv) then + begin + if nv<>fpolar then + begin + fpolar := nv; + if fpolar=tgc_on then + begin + for i,v in faxes_objects[0:1] do + begin + attachments_remove(v); + attachments_remove(v.axis_label); + end + end else + begin + for i,v in faxes_objects[0:1] do + begin + attachments_add(v); + attachments_add(v.axis_label); + end + end + prop_changed("axes_bounds",idx); + end + end + end + function paint_polar(cvs); //绘制极坐标系 + begin + r1 := max(abs(fzoom_box[0,0]),abs(fzoom_box[0,1])); + r2 := max(abs(fzoom_box[1,0]),abs(fzoom_box[1,1])); + r := min(r1,r2); + tks := array(r/4,r/2,r*3/4,r); + set_lineinfo_to_canvas(cvs,faxes_objects[0].lineinfo); + for i,v in tks do + begin + lastv := nil; + if vfzoom_box[s,1] then continue; + for ri := 0 to 2*pi() step 0.02 do + begin + x := v*sin(ri); + y := v*cos(ri); + if not zoom_to_xyz(x,y,0,_x2,_y2) then continue; + if lastv then + begin + cvs.moveto(lastv); + cvs.lineto(_x2,_y2); + end + lastv := array(_x2,_y2); + end + end + set_lineinfo_to_canvas(cvs,faxes_objects[1].lineinfo); + r := max(r1,r2); + zoom_to_xyz(0,0,0,_x0,_y0); + for i := 0 to pi()*2 step pi()/6 do + begin + x := r*sin(i); + y := r*cos(i); + if not zoom_to_xyz(x,y,0,_x2,_y2) then continue; + cvs.moveto(array(_x0,_y0)); + cvs.lineto(array(_x2,_y2)); + end + set_fontinfo_to_canvas(cvs,faxes_objects[1].fontinfo); + for j,vj in tks do + begin + zoom_to_xyz(0,vj,0,_x2,_y2); + cvs.textout(tostn(vj,2),array(_x2,_y2)); + end + end function paint_grid(cvs);//绘制表格 begin xg := fgrid[0]; if xg.width>0 and ifnumber(xg.color) then begin - set_lineinfo_to_canvas(cvs,xg); + set_lineinfo_to_canvas(cvs,xg); for i,v in faxes_objects[0].executecommand("get_tics_value") do begin if vfzoom_box[0,1] then continue; @@ -1613,7 +2063,7 @@ type tg_axes = class(tg_base) // cvs.moveto(array(_x1,_y1)); cvs.lineto(array(_x2,_y2)); end - end + end end end function paint_box(cvs); @@ -1771,10 +2221,12 @@ type tg_axes = class(tg_base) // r[i] := array(_x0,_y0,_z0); end axx := faxes_objects[0]; + if fminister_axse and (fminister_axse.visible=tgc_on) then tt := fminister_axse.theta; + else tt := ftheta; case loc of tgc_bottom: begin - if like_0(ftheta) then + if like_0(tt) then begin if faxes_reverse[1]=tgc_on then idx := 2; else @@ -1804,7 +2256,7 @@ type tg_axes = class(tg_base) // end tgc_top: begin - if like_0(ftheta) then + if like_0(tt) then begin if faxes_reverse[1]=tgc_on then idx := 0; else @@ -1866,10 +2318,12 @@ type tg_axes = class(tg_base) // r[i] := array(_x0,_y0,_z0); end axy := faxes_objects[1]; + if fminister_axse and (fminister_axse.visible=tgc_on) then tt := fminister_axse.theta; + else tt := ftheta; case loc of tgc_left: begin - if like_0(ftheta) then + if like_0(tt) then begin if faxes_reverse[0]=tgc_on then idx := 2; else @@ -1899,7 +2353,7 @@ type tg_axes = class(tg_base) // end tgc_right: begin - if like_0(ftheta) then + if like_0(tt) then begin if faxes_reverse[0]=tgc_on then idx := 0; else @@ -1948,7 +2402,15 @@ type tg_axes = class(tg_base) // end function modify_z_position(loc); begin - if like_0(ftheta_a) then return ; + if fminister_axse then + begin + tta := r_2_a(fminister_axse.theta); + end else + begin + tta := ftheta_a; + end + + if like_0(tta) then return ; get_duan_dian(x0,y0,z0,x1,y1,z1,x2,y2,z2); axz := faxes_objects[2]; pz := array(); @@ -1986,16 +2448,23 @@ type tg_axes = class(tg_base) // return ; axz.ytics_coord := array(idxv[0],idxv[1],"z"); - if ftheta_a>180 or ftheta_a<0 then axz.tics_direction :=tgc_direct_asc ; + if tta>180 or tta<0 then axz.tics_direction :=tgc_direct_asc ; else axz.tics_direction := tgc_direct_desc ; end function modify_coordinate_position();//修正坐标轴位置 - begin - - ////////////////y轴/////////////////////////////////// - modify_y_position(fy_location); - ///////////////x/////////////////////////////// - modify_x_position(fx_location); + begin + ////////////////y轴/////////////////////////////////// + ///////////////x/////////////////////////////// + if fpolar=tgc_on then + begin + modify_y_position(tgc_origin); + modify_x_position(tgc_origin); + end + else + begin + modify_y_position(fy_location); + modify_x_position(fx_location); + end //////z-axis modify_z_position(fz_location); end @@ -2493,6 +2962,16 @@ type tg_canvas = class(TcustomCanvas) // ffigurergn := nil; faxesrgntemp :=nil; end + function true_color(c); //如果有colormap,采用id获取真实的颜色值 + begin + if not(c>0) then return c; + if not ffigure then return c; + cp := ffigure.color_map ; + if not cp then return c; + clen := length(cp); + idc := c mod clen; + return cp[idc]; + end property figure:tg_figure read ffigure; //绘制区域 property axesvector read faxesvector write set_clip_vector; //坐标系区域 property axesrec read FaxesRec write set_clip_rect; //坐标系矩形区域 @@ -2582,13 +3061,29 @@ type tg_axis_main = class(tg_axis) // end end type tg_label_axis = class(tg_base) //坐标轴标签 - public + public function create(pms); begin inherited; ftext := ""; ffont_angle := 0; end + function executecommand(cmd,p);override; + begin + case cmd of + "label_rgn": return (visible=tgc_on)?flabel_rgn:nil; //标签的区域 + "set_label_rgn": flabel_rgn:=p; + end; + return inherited; + end + function default_hittest(d);override; + begin + if not ifarray(d) then return false; + x := d["cvsx"]; + y := d["cvsy"]; + r := (visible=tgc_on and flabel_rgn)? point_in_rgn(array(x,y),flabel_rgn):false; + return r; + end published property font_angle read ffont_angle write set_font_angle;//90 property text read ftext write set_text; @@ -2596,9 +3091,19 @@ type tg_label_axis = class(tg_base) // function SetParent(V);override; begin end + function get_axes();override; + begin + return faxes; + end + function set_axes(axs);override; + begin + if axs is class(tg_axes) then faxes := axs; + end private + [weakref] faxes; ffont_angle; ftext; + flabel_rgn; private function set_font_angle(ag); begin @@ -2676,9 +3181,31 @@ type tg_axis = class(tg_base) // return array(xarg,ifh,sz); end end; - end + end + function default_hittest(d);override; + begin + if not ifarray(d) then return false; + if visible<>tgc_on then return false; + //if not ftics_recs then return false; + x := d["cvsx"]; + y := d["cvsy"]; + p := array(x,y); + if ftics_recs then + begin + for i,v in ftics_recs do //刻度 + begin + if pointinrect(p,v) then return true; + end + end + if fzhouyinfo then //轴线 + begin + return hit_line(fzhouyinfo[0],fzhouyinfo[1],array(x,y)); + end + return 0; + end function paint(cvs);override; begin + if not fzoom_bounds then return ; if visible<>tgc_on then return ; if clip_state=tgc_on then cvs.axesclip(); else cvs.axesunclip(); @@ -2724,6 +3251,7 @@ type tg_axis = class(tg_base) // property tics_labels read ftics_labels write set_tics_labels; // 刻度标签 = ["2","3","4","5","6","7"] property axis_label read flabel write flabel; //轴标签 private + fzhouyinfo; flabel_rgn; ftics_recs; fzoom_bounds; @@ -2883,14 +3411,13 @@ type tg_axis = class(tg_base) // v_to_cvs(tpax,v,x,y); tkxys[i] := array(x,y); end - ///////////////////轴线//////////////////////////////// - + ///////////////////轴线//////////////////////////////// + v_to_cvs(tpax,fzoom_bounds[0],x1,y1); + v_to_cvs(tpax,fzoom_bounds[1],x2,y2); if ftics_segment=tgc_on then begin if fzoom_bounds then - begin - v_to_cvs(tpax,fzoom_bounds[0],x1,y1); - v_to_cvs(tpax,fzoom_bounds[1],x2,y2); + begin cvs.moveto(array(x1,y1)); cvs.lineto(array(x2,y2)); x3 := (x1+x2)/2; @@ -2907,13 +3434,16 @@ type tg_axis = class(tg_base) // end end end - + fzhouyinfo := array(); + fzhouyinfo[0] := array(x1,y1); + fzhouyinfo[1] := array(x2,y2); ///////////////////////////////////////////////////// //////////////////刻度线以及刻度值/////////////////////////////////////// - ts_size := array(fontinfo.size+4,fontinfo.size*2+4); + tklsz := fontinfo.size; //刻度标签宽度 + ts_size := array(tklsz+4,tklsz*2+4); tcsinfo := array(); get_tic_to(ftics_direction,tksize,xarg,_xticlen,_yticklen); - if ifnumber(ftics_color) then cvs.pen.color := ftics_color; + if ifnumber(ftics_color) then cvs.pen.color := cvs.true_color(ftics_color); ftics_recs := array(); for i,vi in fxtics_coord_v do begin @@ -2931,7 +3461,8 @@ type tg_axis = class(tg_base) // sz := nil; if lbi then begin - sz := array((length(lbi))*fontinfo.size+4,fontinfo.size*2+4) ;//cvs.GetTextExtent(lbi); + //sz := array((length(lbi))*tklsz+4,tklsz*2+4) ;//cvs.GetTextExtent(lbi); + sz := array((length(lbi))*tklsz,tklsz*2) ;//cvs.GetTextExtent(lbi); end if sz then begin @@ -2949,6 +3480,7 @@ type tg_axis = class(tg_base) // end end else //y begin + //ts_size[1] := max(ts_size[1],sz[0]); ts_size[1] := max(ts_size[1],sz[0]); rec := array(0,y1-sz[1]/2,0,y1+sz[1]/2); if _xticlen>0 then @@ -2961,6 +3493,11 @@ type tg_axis = class(tg_base) // rec[2] := x1-tic_space; end end + //////////////避免标签重叠////////////////////////////////// + c_out := orec and intersectrect(orec,rec); + if c_out then continue; + orec := rec ; + //////////////////////////////////////// tcsinfo[length(tcsinfo)] := array(lbi,rec,"h"); ftics_recs[i] := rec; end @@ -3004,13 +3541,20 @@ type tg_axis = class(tg_base) // nxarg := (r_2_a(xarg) mod 180);//abs()*pi()); //echo "\r\narg:",r_2_a(xarg),"===",nxarg; nxarg := nxarg*pi()/180; - if _y<0 then _y-=ts_size[0]+tic_space+sz*bs; - else _y+=ts_size[0]+tic_space+sz*bs; + bs2 := 0.5; + if _y<0 then _y-=ts_size[0]*2+tic_space+sz*bs; + else _y+=ts_size[0]*2+tic_space+sz*bs2; if _x<0 then _x -= sz*bs+ts_size[1]+tic_space; - else _x+=sz*bs+ts_size[1]+tic_space; + else _x+=sz*bs2+ts_size[1]+tic_space; + { + if _y<0 then _y-=ts_size[0]+tic_space+tklsz*bs; + else _y+=ts_size[0]+tic_space+tklsz*bs; + if _x<0 then _x -= tklsz*bs+ts_size[1]+tic_space; + else _x+=tklsz*bs+ts_size[1]+tic_space; + } nx := x1+_x;//ax_pos[4]+_x; ny := y1+_y;//ax_pos[5]+_y; - t_rec := array(nx,ny,nx+slen,ny+lbft.size); + t_rec := array(nx,ny,nx+slen,ny+lbft.size*2); flabel_rgn := rec_to_points(t_rec); if like_0(nxarg) then begin @@ -3022,7 +3566,8 @@ type tg_axis = class(tg_base) // cvs.trans(-nxarg,nx,ny); cvs.textout(t,array(0,0)); cvs.RestoreDC(); - end + end + flabel.executecommand("set_label_rgn",flabel_rgn); end end function set_zoom_bounds(v); @@ -3248,6 +3793,13 @@ type tg_text = class(tg_base) end ; return inherited; end + function default_hittest(d);override; + begin + if not ifarray(d) then return false; + x := d["cvsx"]; + y := d["cvsy"]; + return ExecuteCommand("point_in_text",array(x,y)); + end published property text read ftext write set_text; //一维字符串数组 property data read fdata write set_data; //位置 x.y @@ -3355,11 +3907,12 @@ type tg_label =class(tg_base) // if not zoom_to_xyz(p[0],p[1],0,x_,y_) then return ; end end - txtw := length(ftext)*fontinfo.size; - txth := fontinfo.size; + fw := fontinfo.size; + txtw := length(ftext)*fw; + txth := fw*2; modify_text_pos(x_,y_,txtw,txth,ftextalign);//修正位置 rec := array(x_,y_,x_+txtw,y_+txth); - flabel_rgn := rec_to_points(rec)[0:3]; + flabel_rgn := rec_to_points(rec)[0:3]; if ffont_angle<>0 then begin rgn_points_trans(flabel_rgn,-ffont_angle); @@ -3369,7 +3922,16 @@ type tg_label =class(tg_base) // cvs.RestoreDC(); end else cvs.textout(ftext,array(x_,y_)); + end + function default_hittest(d);override; + begin + if not ifarray(d) then return false; + x := d["cvsx"]; + y := d["cvsy"]; + r := (visible=tgc_on and flabel_rgn)? point_in_rgn(array(x,y),flabel_rgn):false; + return r; + end function executecommand(cmd,p);override; begin case cmd of @@ -3378,7 +3940,8 @@ type tg_label =class(tg_base) // fauto_position_value := p; return ; end - "label_rgn": return (visible=tgc_on)?flabel_rgn:nil; //标签的区域 + "label_rgn": return (visible=tgc_on)?flabel_rgn:nil; //标签的区域 + "set_label_rgn": flabel_rgn:=p; end; return inherited; end @@ -3521,6 +4084,17 @@ type tg_tips = class(tg_base) // end end end + function default_hittest(d);override; + begin + if not FPaintrect then return 0; + if not ifarray(d) then return 0; + if (visible<>tgc_on) then return 0; + x := d["cvsx"]; + y := d["cvsy"]; + p := array(x,y); + r := pointinrect(p,FPaintrect); + return r; + end function paint(cvs);override; begin FPaintrect := array(); @@ -3552,7 +4126,7 @@ type tg_tips = class(tg_base) // ws := max(ws,length(v)*w+w); hs[i] := h+4; end - zoom_to_xyz(f_ps[0],f_ps[1],z,x_,y_); + zoom_to_xyz(f_ps[0],f_ps[1],ifnil(f_ps[2])?0:f_ps[2],x_,y_); sz := array(ws,sum(hs)); if mark_mode = tgc_on then begin @@ -3576,7 +4150,7 @@ type tg_tips = class(tg_base) // cvs.draw_rect.rect(rec).draw(); end b_x := rec[0]; - b_y := rec[1]; + b_y := rec[1]; set_fontinfo_to_canvas(cvs); for i,v in ss do begin @@ -3626,7 +4200,8 @@ type tg_tips = class(tg_base) // begin px := d[0]; py := d[1]; - ps := array(px,py); + pz := d[2]; + ps := array(px,py,pz); txts := array(); for i := 1 to length(fdisplay_components) do begin @@ -3640,6 +4215,10 @@ type tg_tips = class(tg_base) // begin txts[length(txts)] := vi+format(":%f",py); end + "z","Z": + begin + txts[length(txts)] := vi+format(":%f",pz); + end end ; end end @@ -3836,7 +4415,7 @@ type tg_legend = class(tg_base) //图 b_y := rc[1]; flegend_rec := rc; set_fontinfo_to_canvas(cvs); - flegend_sub_recs := array(); + flegend_sub_recs := array(); for i,v in objs do begin hi := hs[i]; @@ -3844,8 +4423,9 @@ type tg_legend = class(tg_base) //图 begin rci := array(b_x,b_y,b_x+ws[0],b_y+hi); v.paint_legend(cvs,rci); - end - flegend_sub_recs[i] := rci; + flegend_sub_recs[i,0] := rci; + flegend_sub_recs[i,1] := v; + end si := ss[i]; if si then begin @@ -3865,15 +4445,40 @@ type tg_legend = class(tg_base) //图 x := p[0];y := p[1]; for i,v in flegend_sub_recs do begin - if pointinrect(p,v) then return i; + if pointinrect(p,v[0]) or pointinrect(p,v[1]) then return i; end return -1; end "legend_rec":return (visible=tgc_on)? flegend_rec:nil; //整个图例区域 "legend_sub_recs":return (visible=tgc_on)? flegend_sub_recs:nil; //各个图像的区域 + cmd_hit_test_info: + begin + return fhit_test_info; + end end return inherited; end + function default_hittest(d);override; + begin + if not ifarray(d) then return 0; + if (visible<>tgc_on) then return 0; + if not flegend_rec then return 0; + fhit_test_info := array(); + x := d["cvsx"]; + y := d["cvsy"]; + p := array(x,y); + for i,v in flegend_sub_recs do + begin + if pointinrect(p,v[0]) then + begin + fhit_test_info["idx"] := i; + fhit_test_info["object"] := v[1]; + return true; + end + end + r := pointinrect(p,flegend_rec); + return r; + end published property location read flocation write set_location; //相对位置类型 property position read fposition write set_position; //位置 @@ -3891,6 +4496,7 @@ type tg_legend = class(tg_base) //图 fposition; flegend_rec; flegend_sub_recs; + fhit_test_info; //text ;//= "y1" //font_style ;//= 6 //font_size ;//= 1 @@ -4074,32 +4680,34 @@ type tg_Polyline = class(tg_graph) // begin if tgc_on<> visible then return ; bx := axes.zoom_box; - tempbarw := 0; + tempbarw := array(4,4); z0 := bx[2,0]; fface_rgn := array(); if clip_state=tgc_on then begin - //cvs.axesclip(); - fface_rgn := array(); + cvs.axesclip(); + {fface_rgn := array(); for i,v in rec_to_points( array(bx[0,0],bx[1,0],bx[0,1],bx[1,1])) do begin zoom_to_xyz(v[0],v[1],z0,x,y); fface_rgn[i] := array(x,y); end - cvs.clip_rgn(fface_rgn); + cvs.clip_rgn(fface_rgn);} end else begin cvs.axesunclip(); end xys := array(); ys := array(); + setbwd := true; for i,v in fgraph_data do begin - if not zoom_to_xyz(v[0],v[1],z0,x,y) then return ; - if not(tempbarw) and fbar_width>0 then ////////处理bar的宽度/////// + if not zoom_to_xyz(v[0],v[1],(fhasz?v[2]:z0),x,y) then return ; + if setbwd and fbar_width>0 then ////////处理bar的宽度/////// begin + setbwd := false; b := get_abs_barwidth(); - zoom_to_xyz((v[0]+b/2),v[1],z0,xtemp,ytemp); + zoom_to_xyz((v[0]+b/2),v[1],(fhasz?v[2]:z0),xtemp,ytemp); xtemp-=x; ytemp-=y; tempbarw := array(); @@ -4116,6 +4724,7 @@ type tg_Polyline = class(tg_graph) // end; end fline_points_in_canvas := xys; + fbar_base_points := ys; pinfo := array("line_mode":line_mode,"bar_width":tempbarw,"color":lineinfo.color,"bkcolor":lineinfo.bkcolor,"xy0":ys,"bar_rgns",array()); set_lineinfo_to_canvas(cvs); paint_lines(cvs,fpolyline_style,xys,fclosed,pinfo); @@ -4130,6 +4739,10 @@ type tg_Polyline = class(tg_graph) // function executecommand(cmd,p);override; begin case cmd of + cmd_hit_test_info: + begin + return fhit_test_info; + end "hit_point": begin if not(fface_rgn and point_in_rgn(p,fface_rgn)) then return -1; @@ -4190,12 +4803,94 @@ type tg_Polyline = class(tg_graph) // xys := array((rec[0]+dis*2,y0),(rec[0]+3*dis,y0)); paint_marks(mk,cvs,xys); end - end + end + function p_out_clip(p); + begin + return fface_rgn and not(point_in_rgn(p,fface_rgn)); + end + function default_hittest(d);override; + begin + fhit_test_info := nil; + if not(ifarray(fline_points_in_canvas) and fline_points_in_canvas) then return false; + if not ifarray(d) then return false; + if visible<>tgc_on then return false; + x := d["cvsx"]; + y := d["cvsy"]; + p := array(x,y); + if p_out_clip(p) then return false; + if (line_mode=tgc_off) or (mark_mode=tgc_on) then //没有线条 + begin + ds := markinfo.size+2; + for i,v in fline_points_in_canvas do + begin + if hit_line(v,v,p,ds) then + begin + fhit_test_info := array("type":"mark","idx":i); + return true; + end + end + if line_mode=tgc_off then return false; + end + case polyline_style of + tgc_LS_bar,tgc_ls_Bar2: //柱状图 + begin + for i,v in fline_bar_rgn do + begin + if point_in_rgn(p,v) then + begin + fhit_test_info := array("type":"line","idx":i); + return true; + end + end + end + tgc_LS_barplot: + begin + for i,v in fbar_base_points do + begin + if hit_line(fline_points_in_canvas[i],v,p) then + begin + fhit_test_info := array("type":"line","idx":i); + return true; + end + end + end else + begin + for i,v in fline_points_in_canvas do + begin + if i=0 then + begin + last := v; + end else + begin + vi := v; + if polyline_style=tgc_LS_staircase then vi[1] := last[0]; //梯状图 + if hit_line(last,vi,p) then + begin + fhit_test_info := array("type":"line","idx":i); + return true; + end + last := v; + end + end + if closed=tgc_on and polyline_style=tgc_LS_interpolated then //封闭 + begin + if point_in_rgn(p,fline_points_in_canvas) then + begin + fhit_test_info := array("type":"area"); + return true; + end + end + end + end + end property closed read fclosed write set_line_closed;//= "off" 封闭 property polyline_style read fpolyline_style write set_polyline_style;//= "0" 线型 property bar_width read fbar_width write set_bar_width;//= "0" 柱状宽度 - private + private + fhasz; + fhit_test_info; fline_points_in_canvas; + fbar_base_points; fline_bar_rgn; fface_rgn; fdata_bounds; @@ -4227,12 +4922,27 @@ type tg_Polyline = class(tg_graph) // begin if d<>fgraph_data then begin - fx := d[:,0]; - fy := d[:,1]; - fdata_bounds[0,0] := minvalue(fx); - fdata_bounds[1,0] := minvalue(fy); - fdata_bounds[0,1] := maxvalue(fx); - fdata_bounds[1,1] := maxvalue(fy); + fhasz := false; + if ifarray(fgraph_data) then + begin + fx := d[:,0]; + fy := d[:,1]; + fz := d[:,2]; + fdata_bounds[0,0] := minvalue(fx); + fdata_bounds[1,0] := minvalue(fy); + fdata_bounds[0,1] := maxvalue(fx); + fdata_bounds[1,1] := maxvalue(fy); + if all((fz.>=0 or fz.<0)) then + begin + fdata_bounds[2,0] := minvalue(fz); + fdata_bounds[2,1] := maxvalue(fz); + fhasz := true; + end else + begin + fdata_bounds[2,0] := 0; + fdata_bounds[2,1] := 1; + end + end inherited; end end @@ -4275,10 +4985,10 @@ type tg_Polyline = class(tg_graph) // end end type tg_gdi = class(tg_const) //gdi对象基类 - function create(awner); + function create(ahost); begin fpdata := array(); - FOwner := awner; + Fhost := ahost; end function clone();//克隆信息 begin @@ -4298,7 +5008,7 @@ type tg_gdi = class(tg_const) //gdi if flinker then begin flinker.ParentFont := false; - if flinker<>FOwner then + if flinker<>Fhost then begin ft := flinker.fontinfo; ft.info := d; @@ -4306,7 +5016,7 @@ type tg_gdi = class(tg_const) //gdi end end { - if (flinker and flinker<>FOwner) then + if (flinker and flinker<>Fhost) then begin flinker.ParentFont := false; ft := flinker.fontinfo; @@ -4340,7 +5050,7 @@ type tg_gdi = class(tg_const) //gdi end fpdata; //数据 private - [weakref]FOwner; + [weakref]Fhost; end type tg_line_info = class(tg_gdi) //线型信息 function create(awer); @@ -4475,6 +5185,7 @@ type tg_base = class(TNode,tg_evet_conainter) // public function create(pms); begin + fattachments := array(); class(TNode).create(); class(tg_evet_conainter).create(); fchange_locked := false; @@ -4484,6 +5195,7 @@ type tg_base = class(TNode,tg_evet_conainter) // fline_mode := tgc_off; fmark_mode := tgc_off; fParentFont := tgc_on; + fhittest := tgc_on; flineinfo := new tg_line_info(self(true)); fmarkinfo := new tg_mark_info(self(true)); ffontinfo := new tg_font_info(self(true)); @@ -4536,11 +5248,17 @@ type tg_base = class(TNode,tg_evet_conainter) // end for i,vi in lgns do vi.paint_pre(cvs); end - function hit_at(info):bool; //命中处理,鼠标信息 + function hit_at(info):bool;//命中处理,鼠标信息 begin - if fonhit_at then return call(fonhit_at,self(true),info) ; - return false; + if fhittest=tgc_off then return false; + if fenabled=tgc_off then return false; + if iffuncptr(fonhit_at) then return call(fonhit_at,self(true),info) ; + return default_hittest(info); end + function default_hittest(info);virtual; //默认鼠标命中 default_hittest + begin + return false; + end function set_lineinfo_to_canvas(cvs,info); //设置线条信息到画布 begin if info is class(tg_line_info) then li := info; @@ -4552,7 +5270,7 @@ type tg_base = class(TNode,tg_evet_conainter) // cp.style := li.style; if ifnumber(cl) then begin - cp.color := cl; + cp.color := cvs.true_color(cl); end else begin cp.Style := tgc_BS_NULL; @@ -4561,7 +5279,7 @@ type tg_base = class(TNode,tg_evet_conainter) // cb := cvs.brush; if ifnumber(bcl) then begin - cb.color := bcl; + cb.color := cvs.true_color(bcl); cb.Style := tgc_BS_SOLID; end else @@ -4577,14 +5295,14 @@ type tg_base = class(TNode,tg_evet_conainter) // cf := cvs.font; if ifnil(fi.bkcolor) then cf.bkmode := 1; else cf.bkmode := 2; - bc := fi.bkcolor; + bc := cvs.true_color(fi.bkcolor); cf.bkcolor := bc; if fi.color =tgc_complementary_color then begin if ifnil(bc) then cf.color := 0; else cf.color := calc_complementary_color(bc); - end else cf.color := fi.color; + end else cf.color := cvs.true_color(fi.color); cf.width := fi.size; cf.height := fi.size*2; end @@ -4600,7 +5318,9 @@ type tg_base = class(TNode,tg_evet_conainter) // p := p.figure; break; end - p := p.parent; + tp := p.parent; + if not tp then tp := p.host; + p := tp; end if not p then return 0; return p.dispatchEvent(evt,tg); @@ -4619,6 +5339,52 @@ type tg_base = class(TNode,tg_evet_conainter) // begin fg.executecommand("figure_need_fresh",p); end + end + function attachments_add(o); //添加附属 + begin + if o is class(tg_base) then + begin + o.host := self(true); + for i,v in fattachments do + begin + if v=o then return fattachments; + end + fattachments[length(fattachments)] := o; + end + return fattachments; + end + function attachments_remove(o); + begin + r := array(); + cg := false; + for i,v in fattachments do + begin + if o=v then + begin + o.host := nil; //移除host + cg := true; + continue; + end + r[length(r)] := v; + end + if cg then fattachments := r; + end + function move_to_top();virtual; + begin + if host then return false; + p := parent; + if p then + begin + r := p.set_node_index(self(true),p.NodeCount); + return (p.move_to_top()) or r; + end + end + function create_contextmenu(); + begin + if iffuncptr( foncreate_contextmenu) then + begin + return call(foncreate_contextmenu,self(true)); + end end published property line_mode read fline_mode write set_line_mode; @@ -4632,8 +5398,12 @@ type tg_base = class(TNode,tg_evet_conainter) // property fontinfo read getfontinfo; property ParentFont read fParentFont write setParentFont; property change_locked read fchange_locked write fchange_locked; - property onhit_at read fonhit_at write fonhit_at; + property onhittest read fonhit_at write fonhit_at; + property hittest read fhittest write set_hittest; + property ContextMenu read fpopupmenu write fpopupmenu; + property oncreate_contextmenu read foncreate_contextmenu write foncreate_contextmenu; public + [weakref] host; tgtype; //类型名称 user_data; tag; @@ -4677,6 +5447,10 @@ type tg_base = class(TNode,tg_evet_conainter) // ffontinfo; private [weakref]fonhit_at; + [weakref]fpopupmenu; + [weakref]foncreate_contextmenu; + [weakref]fattachments; + fhittest; fclip_state; fline_mode; fmark_mode; @@ -4714,7 +5488,14 @@ type tg_base = class(TNode,tg_evet_conainter) // fclip_state := nv; prop_changed("clip_state",nv); end - end + end + function set_hittest(v); + begin + if tg_boolen_value(v,nv) and (nv<>fhittest) then + begin + fhittest := nv; + end + end function set_line_mode(v); begin if tg_boolen_value(v,nv) and (nv<>fline_mode) then @@ -4839,6 +5620,7 @@ type tg_const = class() static const AT_TARGET = 2; static const BUBBLING_PHASE = 3; /////////////////////////// + static const cmd_hit_test_info = "hit_test_info"; static const cmd_zoom_inc = "zoom_inc"; static const cmd_figure_changed = "figure_changed"; static const cmd_data_changed = "data_changed"; @@ -4944,8 +5726,7 @@ type tg_evt_mouse = class(tg_evt_custom) // property cvsy read fcvsy; property shift read fshift; property ctrl read fctrl; - property delta read fdelta; - + property delta read fdelta; property double read fdouble; property button read fbutton; private @@ -4999,10 +5780,10 @@ type tevent_list = class() // function add(n,f); //添加 begin if not(ifstring(n) and n) then return 0; - if not ifobj(f) then return 0; + if not iffuncptr(f) then return 0; for i,v in FItems do begin - if (v.ename=n and v.efunc=f) then return ; + if (v.ename=n and v.efunc=f) then return 0; end FItems[length(FItems)] := new tevent_item(n,f); return true; @@ -5039,6 +5820,28 @@ type tevent_list = class() // end FItems; end +function hot_color_map(n); //熱力顏色 +begin + n1 := integer(3/8*n); + if n1<3 then return array(); + n2 := n1; + n3 := n-n1-n2; + idx := 0; + r := array(); + for i,v in array(1/n1,1/n1)->1 do + begin + r[idx++] := rgb(int(v*255),0,0);//array(v,0,0); + end + for i,v in array(1/n1,1/n1)->1 do + begin + r[idx++] := rgb(255,int(v*255),0);//array(1,v,0); + end + for i,v in array(1/n3,1/n3)->1 do + begin + r[idx++] := rgb(255,255,int(v*255));//array(1,1,v); + end + return r; +end function node_hit_list(nd,info); //节点命中 begin nnd := node_hit_at(nd,info); @@ -5049,7 +5852,9 @@ begin idx := 1; while nnd do begin - nnd := nnd.parent; + tnnd := nnd.parent; + if not tnnd then tnnd := nnd.host; + nnd := tnnd; if nnd then r[idx] := nnd; idx++; end @@ -5069,6 +5874,11 @@ begin if hnod then return hnod; end end + for i,v in nd.attachments_add() do + begin + hnod := node_hit_at(v,info) ; + if hnod then return hnod; + end if nd.hit_at(info) then return nd; return 0; end @@ -5134,7 +5944,7 @@ begin paint_lines(cvs,o.tgc_LS_interpolated,xys,cls,ifo); end o.tgc_LS_bar,o.tgc_ls_bar2: - begin + begin b_w_x := integer(ifo["bar_width"][0]/2); b_w_y := integer(ifo["bar_width"][1]/2); //cvs.brush.color := ifo["bkcolor"]; @@ -5221,9 +6031,9 @@ begin b := max(a,(sz-a)); a := b; dc.pen.Style := 0; - dc.pen.color := mk.color; + dc.pen.color := dc.true_color(mk.color); dc.brush.style := 0; - dc.brush.color := mk.bkcolor; + dc.brush.color := dc.true_color(mk.bkcolor); case tp of o.tgc_mks_pentagram: begin @@ -5321,7 +6131,7 @@ begin o.tgc_mks_dot,o.tgc_mks_circle,o.tgc_mks_square: begin if tp=o.tgc_mks_dot then - dc.brush.color := mk.color; + dc.brush.color := dc.true_color(mk.color); if tp=o.tgc_mks_square then pse := dc.draw_rect(); else pse := dc.draw_ellipse(); @@ -5435,6 +6245,11 @@ begin if vi is class(tg_graph_base) then begin bds := vi.get_data_bounds(); + for j := 0 to 2 do + begin + if not ifnumber(bds[j,0]) then bds[j,0] := 0; + if not ifnumber(bds[j,1]) then bds[j,1] := 1; + end if i=0 then begin d := bds; @@ -5443,7 +6258,7 @@ begin end else if v is class(tg_axis) then begin - echo "\r\n axis"; + //echo "\r\n axis"; end end return d; @@ -5607,6 +6422,7 @@ begin end function point_in_polygon(point, polygon);//射线法 begin + if not ifarray(polygon) then return false; x0 := point[0]; y0 := point[1]; ct := 0; @@ -5624,7 +6440,7 @@ begin end return (ct % 2) =1; end -function rgn_points_trans(pts,ag); +function rgn_points_trans(pts,ag); //旋转区域 begin x := pts[0,0]; y := pts[0,1]; @@ -5644,6 +6460,28 @@ begin end ; return nidx; end +function hit_line(p1,p2,p,ds,straight); //命中线 +begin + if not(ds>1) then ds:=5; + pdd := vectorsize(p1-p2); + if pddpdd1 and pdd>pdd2 then return true; + end +end /////////////////////////////////////// function calc_complementary_color(c);//补色计算 begin diff --git a/tsleditor.exe b/tsleditor.exe index e1d849d..cfa4d5b 100644 Binary files a/tsleditor.exe and b/tsleditor.exe differ diff --git a/tslvcltool.exe b/tslvcltool.exe index 2c5735c..e479f9e 100644 Binary files a/tslvcltool.exe and b/tslvcltool.exe differ