diff --git a/designer/udesignerproject.tsf b/designer/udesignerproject.tsf index 8f8e47d..ffc0f22 100644 --- a/designer/udesignerproject.tsf +++ b/designer/udesignerproject.tsf @@ -1060,6 +1060,7 @@ type TProjectView = class(TVCForm) // begin r := format(%% type %s=class(%s) + uses tslvcl; function create(AOwner); begin inherited; diff --git a/designer/utslvcldcomponents.tsf b/designer/utslvcldcomponents.tsf index 2ce7154..643bb70 100644 --- a/designer/utslvcldcomponents.tsf +++ b/designer/utslvcldcomponents.tsf @@ -448,6 +448,195 @@ type TDComponent = class() **} fiscontainerdcmp := true; feventnametable := array(); + + ev := array( + "event":"onmouseup", + "name":"ms_up", + "virtual":true, + "param":array("o","e"), + "body": +" {** + @explan(说明) 鼠标按下 %% + @param(o)(control)控件 %% + @param(e)(TMMouse) 鼠标消息对象 %% + **} + if e.button()=mbLeft then + begin + echo '\\r\\n:左键'; + end else + if e.button()=mbRight then + begin + echo '\\r\\n:右键'; + end else + if e.button()=mbMiddle then + begin + echo '\\r\\n:滚轮'; + end + echo '\\r\\npos:',e.xpos,'===',e.ypos; + inherited; +" + ); + SetDefalutEvent(ev,true); + + ev := array( + "event":"onmousedown", + "name":"ms_down", + "virtual":true, + "param":array("o","e"), + "body": +" {** + @explan(说明) 鼠标按下 %% + @param(o)(control)控件 %% + @param(e)(TMMouse) 鼠标消息对象 %% + **} + if e.button()=mbLeft then + begin + echo '\\r\\n:左键'; + end else + if e.button()=mbRight then + begin + echo '\\r\\n:右键'; + end else + if e.button()=mbMiddle then + begin + echo '\\r\\n:滚轮'; + end + if e.shiftdouble() then + begin + echo '\\r\\n:双击'; + end + echo '\\r\\npos:',e.xpos,'===',e.ypos; + inherited; +" + ); + SetDefalutEvent(ev,true); + ev := array( + "event":"onmousemove", + "name":"ms_move", + "virtual":true, + "param":array("o","e"), + "body": +" {** + @explan(说明) 鼠标移动 %% + @param(o)(control)控件 %% + @param(e)(TMMouse) 鼠标消息对象 %% + **} + echo '\\r\\npos:',e.xpos,'===',e.ypos; + inherited; +" + ); + SetDefalutEvent(ev,true); + ev := array( + "event":"onkeyup", + "name":"keyup", + "virtual":true, + "param":array("o","e"), + "body": +" {** + @explan(说明) 按键弹起 %% + @param(o)(control)控件 %% + @param(e)(TMKEY) 按键消息对象 %% + **} + echo '\\r\\nchar:',e.char; + echo '\\r\\nascii:',e.charcode; + if ssShift in e.shiftstate then + begin + echo '\\r\\nshift 按键'; + end + if ssAlt in e.shiftstate then + begin + echo '\\r\\nalt 按键'; + end + if ssCtrl in e.shiftstate then + begin + echo '\\r\\nctrl 按键'; + end + inherited;" + ); + SetDefalutEvent(ev,true); + ev := array( + "event":"onkeydown", + "name":"keydown", + "virtual":true, + "param":array("o","e"), + "body": +" {** + @explan(说明) 按键按下 %% + @param(o)(control)控件 %% + @param(e)(TMKEY) 按键消息对象 %% + **} + echo '\\r\\nchar:',e.char; + echo '\\r\\nascii:',e.charcode; + if ssShift in e.shiftstate then + begin + echo '\\r\\nshift 按键'; + end + if ssAlt in e.shiftstate then + begin + echo '\\r\\nalt 按键'; + end + if ssCtrl in e.shiftstate then + begin + echo '\\r\\nctrl 按键'; + end + inherited;" + ); + SetDefalutEvent(ev,true); + ev := array( + "event":"onkeypress", + "name":"keypress", + "virtual":true, + "param":array("o","e"), + "body": +" {** + @explan(说明) 字符消息 %% + @param(o)(control)控件 %% + @param(e)(TMKEY) 按键消息对象 %% + **} + echo '\\r\\nchar:',e.char; + echo '\\r\\nascii:',e.charcode; + if ssShift in e.shiftstate then + begin + echo '\\r\\nshift 按键'; + end + if ssCtrl in e.shiftstate then + begin + echo '\\r\\nctrl 按键'; + end + inherited;" + ); + SetDefalutEvent(ev,true); + ev := array( + "event":"onnotification", + "name":"note", + "virtual":true, + "param":array("o","e"), + "body": +" {** + @explan(说明) 通知消息 %% + @param(o)(control)控件 %% + @param(e)(tuieventbase) 消息对象,msg成员为通知内容, + 该消息可以通过组件 relnotification(消息内容) + 发送到所有组件,需要处理该消息的组件可以处理 %% + **} + + inherited;" + ); + SetDefalutEvent(ev,true); + ev :=array( + "event":"onclick", + "name":"clk", + "param":array("o","e"), + "virtual":true, + "body": +" {** + @explan(说明) 点击回调 %% + @param(o)(tcontrol)选择按钮 %% + @param(e)(tuievent) 消息对象 %% + **} + inherited;" + ); + SetDefalutEvent(ev,true); if not(AOwner is class(TComponent)) then exit; c := WndClass(); if c is class(TComponent) then @@ -455,8 +644,7 @@ type TDComponent = class() FCwnd := createobject(c,AOwner); FCwnd.SetDesigning(true); end - else raise "类型错误!"; - + else raise "类型错误!"; end function GetChangedPropertiesn(n); begin @@ -629,8 +817,8 @@ type TDComponent = class() format(" {** @explan(说明) %s消息回调 %% - @param(e)(tuievent) 消息对象 %% @param(o)(tcomponent) 组件 %% + @param(e)(tuievent) 消息对象 %% **} inherited; ",n); @@ -3054,16 +3242,14 @@ type TDCheckBtn=class(TDComponent) "param":array("o","e"), "virtual":true, "body": -" - {** +" {** @explan(说明) 点击回调 %% @param(e)(tuievent) 消息对象 %% @param(o)(tcheckbtn)选择按钮 %% **} MessageBoxA(((o.checked)?'选中':'没选中'),'提示',0,o); inherited; -" - ); +"); end function bitmapinfo();override;begin return "0502000000060400000074797065000203000000696D670006040000006461746 diff --git a/funcext/tvclib/utslmemo.tsf b/funcext/tvclib/utslmemo.tsf index a864e6f..0476254 100644 --- a/funcext/tvclib/utslmemo.tsf +++ b/funcext/tvclib/utslmemo.tsf @@ -1685,6 +1685,13 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) // return array(cy,cx+(ci?(0):1)); end private //属性设置函数 + function getclipboard();//获得clipbord + begin + if not FCopyer then + begin + FCopyer := new TcustomClipBoard(self); + end + end function memtextchanged(p); begin if not(fundoing or fredoing) then @@ -1819,10 +1826,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) // r := GetSelText(); if r then begin - if not FCopyer then - begin - FCopyer := new TcustomClipBoard(self); - end + getclipboard(); FCopyer.text := r; return true; end @@ -1830,10 +1834,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) // function PasteFromClipboard(); begin //if ReadOnly then return ; - if not FCopyer then - begin - FCopyer := new TcustomClipBoard(self); - end + getclipboard(); //s := FCopyer.Text; //echo length(s),"\r\n"; if SelAvail then SelText := FCopyer.Text;