设计器

更新设计器

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;

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

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
+            getclipboard();
-            begin
-                FCopyer := new TcustomClipBoard(self);
-            end
             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
+        getclipboard();
-        begin
-            FCopyer := new TcustomClipBoard(self);
-        end
         //s := FCopyer.Text;
         //echo length(s),"\r\n";
         if SelAvail then SelText := FCopyer.Text;