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

设计器 

更新设计器
This commit is contained in:
JianjunLiu 2022-11-15 16:29:39 +08:00
parent 9fdecfd8a4
commit e45feaf84e
3 changed files with 203 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
designer/udesignerproject.tsf
View File

@ -1060,6 +1060,7 @@ type TProjectView = class(TVCForm) //
begin
r := format(%%
type %s=class(%s)
uses tslvcl;
function create(AOwner);
begin
inherited;

198
designer/utslvcldcomponents.tsf
View File

@ -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
@ -456,7 +645,6 @@ type TDComponent = class()
FCwnd.SetDesigning(true);
end
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

17
funcext/tvclib/utslmemo.tsf
View File

@ -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;