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

跟新

Browse Source
This commit is contained in:
liujianjun
2025-07-22 17:28:43 +08:00
parent e4d6b23680
commit db909b5520
36 changed files with 2389 additions and 1094 deletions
Download Patch File Download Diff File Expand all files Collapse all files
funcext/tvclib/tcomponent.tsf
+2 -36
View File
@@ -248,7 +248,7 @@ private
if op=opRemove or op=opInsert then return 0;
if fonnotification then
begin
e := new tuieventbase(op,0,0,0);
e := new unit(utslvclevent).tmnotif(op);
e.sender := a;
CallMessgeFunction(fonnotification,self(true),e);
return e.skip;
@@ -258,7 +258,7 @@ private
begin
if foninqurequit then
begin
e := new tuieventbase(0,0,0,0);
e := new unit(utslvclevent).tminqurequit();//tuieventbase(0,0,0,0);
CallMessgeFunction(foninqurequit,self(true),e);
return e.skip;
end
@@ -335,12 +335,6 @@ public //
FEventsProperties := array();
FVariableProperties := array();
FComponentCreated := true;
return;
If AOwner is class(tcomponent)then
begin
FOwner := AOwner;
AOwner.InsertComponent(Self);
end
end
function set_loadstate(v); //设置loading状态
begin
@@ -519,30 +513,6 @@ public //
FChangedinheritedProperties;
FChangedProperties;
FVariableProperties;
{function GetPublishInfo();//属性获取
begin
r := publishs();
rr := array();
ri := 0;
for i,v in r do
begin
if ifstring(v) then rr[ri++] := lowercase(v);
end
return rr;
end }
{function OrderPublish(r,od); //排序发布的东西
begin
if od then
begin
r1 := array();
for i,v in od do
begin
vi := r[v];
if vi then r1[v]:= vi;
end
r := r1;
end
end}
public //设计器属性设置相关
function GetPublishproperties();virtual; //获得属性信息
begin
@@ -551,7 +521,6 @@ public //
**}
ps := GetPropInfo();
r := array();
//pps := GetPublishInfo();
for i,v in ps do
begin
typ := v["type"];
@@ -561,7 +530,6 @@ public //
if otype then
begin
n := v["name"];
//if pps and not(n in pps)then continue;
if typ in array("variable","popupmenu","syscursor","tmainmenu")then
begin
r[n]:= otype.FormatEdit(FVariableProperties[n],v["write"]?true:false);
@@ -676,7 +644,6 @@ public //
if ifobj(otype)then
begin
iv := otype.UnformatEdit(v); //反转换
//if FChangedProperties[n]=vi then continue; //没有改变
if FChangedProperties[n]=iv then continue; //没有改变
SetChangedPublish(n,iv,pp); //保存
if n="visible" or n="wspopup" or n="enabled" then
@@ -724,7 +691,6 @@ public //
@param(ComponentStyle)() 样式结合 %%
@param(ComponentCreated)(bool) 样式结合 %%
**}
//property DesignInfo read FDesignInfo write FDesignInfo;
property ComponentCreated read FComponentCreated;
property Components read FComponents;
property ComponentState read FComponentState write SetComponentState;
funcext/tvclib/tcontrol.tsf
+61 -37
View File
@@ -441,42 +441,66 @@ type tcontrol = class(tcomponent)
{**
@explan(说明)根据消息参数构造消息对象;
**}
if message in array(WM_MOUSEMOVE,WM_LBUTTONDOWN,
case message of
WM_CLOSE :
begin
r := new tmclose(message,wparam,lparam,hwnd);
end
WM_MOUSEMOVE :
begin
r := new tmm_move(message,wparam,lparam,hwnd);
end
WM_CONTEXTMENU :
begin
r := new tmcontextpop(message,wparam,lparam,hwnd);
end
WM_LBUTTONDOWN,
WM_RBUTTONDOWN,WM_LBUTTONUP,
WM_RBUTTONUP,WM_LBUTTONDBLCLK,
WM_RBUTTONDBLCLK,WM_MBUTTONDOWN,WM_MBUTTONUP,WM_MBUTTONDBLCLK)then
begin
r := new TMMouse(message,wparam,lparam,hwnd);
end else
if message=WM_MENUSELECT then
begin
r := new TMMENUSELECT(message,wparam,lparam,hwnd);
end else
if message=WM_MEASUREITEM then
begin
r := new TMMEASUREITEM(message,wparam,lparam,hwnd);
end else
if message in array(WM_KEYDOWN,WM_KEYUP,WM_CHAR,WM_SYSCHAR,WM_SYSKEYDOWN,WM_SYSKEYUP)THEN
begin
r := new TMKEY(message,wparam,lparam,hwnd);
end else
if message=WM_DRAWITEM then
begin
r := new TMDRAWITEM(message,wparam,lparam,hwnd);
end else
if message=WM_NOTIFY then
begin
r := new TMNOTIFY(message,wparam,lparam,hwnd);
end else
if message=WM_MOUSEWHEEL then
begin
r := new TMMOUSEWHEEL(message,wparam,lparam,hwnd);
end else
if message=WM_STYLECHANGED or message=WM_STYLECHANGING then
begin
r := new TMSTYLECHANG(message,wparam,lparam,hwnd);
end else
r := new tuieventbase(message,wparam,lparam,hwnd);
WM_RBUTTONDBLCLK,WM_MBUTTONDOWN,WM_MBUTTONUP,WM_MBUTTONDBLCLK :
begin
r := new TMMouse(message,wparam,lparam,hwnd);
end
WM_MENUSELECT :
begin
r := new TMMENUSELECT(message,wparam,lparam,hwnd);
end
WM_MEASUREITEM :
begin
r := new TMMEASUREITEM(message,wparam,lparam,hwnd);
end
WM_ACTIVATE :
begin
r := new tmactivate(message,wparam,lparam,hwnd);
end
WM_KEYDOWN,WM_KEYUP,
WM_SYSCHAR,WM_SYSKEYDOWN,WM_SYSKEYUP :
begin
r := new TMKEY(message,wparam,lparam,hwnd);
end
WM_CHAR:
begin
r := new tmk_press(message,wparam,lparam,hwnd);
end
WM_DRAWITEM :
begin
r := new TMDRAWITEM(message,wparam,lparam,hwnd);
end
WM_NOTIFY :
begin
r := new TMNOTIFY(message,wparam,lparam,hwnd);
end
WM_MOUSEWHEEL :
begin
r := new TMMOUSEWHEEL(message,wparam,lparam,hwnd);
end
WM_STYLECHANGED ,WM_STYLECHANGING :
begin
r := new TMSTYLECHANG(message,wparam,lparam,hwnd);
end
else
r := new tuieventbase(message,wparam,lparam,hwnd);
end ;
return r;
//return new tuieventbase(message,wparam,lparam,hwnd);
end
@@ -1014,7 +1038,7 @@ type tcontrol = class(tcomponent)
function WMMove(o,e):LM_MOVE;virtual;
begin
if not NoRecycled() then return ;
CallMessgeFunction(OnMove,o,e);
CallMessgeFunction(fOnMove,o,e);
if (o is class(TWinControl)) and o.WsPopUp then return ;
if (Align=alNone) then
begin
@@ -1029,7 +1053,7 @@ type tcontrol = class(tcomponent)
function WMSize(o,e):LM_SIZE;virtual;
begin
if not NoRecycled() then return ;
CallMessgeFunction(OnSize,o,e);
CallMessgeFunction(fOnSize,o,e);
DoWMSIZE(o,e);
p := Parent ;
if p and p.childsizing.layout>0 then return p.AdjustSize();
@@ -1580,7 +1604,7 @@ type tcontrol = class(tcomponent)
@param(Cursor)(tcursor 通过 member of TSystemCursor 设置) 系统鼠标 %%
**}
property Font:font read GetControlFont write SetControlFont;//write SetFont;
property OnMouseWheel read FOnMouseWheel write FOnMouseWheel;
property OnMouseWheel:eventhandler read FOnMouseWheel write FOnMouseWheel;
{**
@param(Caption)(string) 控件标题 %%
@param(Enabled)(bool) 控件是否有效 %%
funcext/tvclib/tcustomcontrol.tsf
+1
View File
@@ -18,6 +18,7 @@ type tcustomcontrol=class(TWinControl)
cvs.rcpaint := PAINTSTRUCT().rcpaint();
try
Paint();
inherited;
finally
cvs.Handle := 0;
end;
funcext/tvclib/tslvcl.tsf
+11 -7
View File
@@ -33,10 +33,10 @@ function ExitMessageLoop(); //
function NotifyComponent(Sender,Act,ToComponent); //notfiy
//////////////////////操作/////////////////////
Function tslcstructure(data,dsize,pack,ptr);
//function CompareRect(orect,nrect);
function calldatafunction();
function CallMessgeFunction(f,o,e);
function CallMessageFunction(f,o,e); //执行消息回调
//////////////////////执行tsl脚本代码////////////////////
//function TSL_Check(func,funclen,oResult);
function CheckTslCode(code,err); //检查tsl语法
@@ -1276,6 +1276,7 @@ type TpanelForm=class(tpanel) //
protected
function SetWsPopUp(v);override;
begin
if self(true).classinfo()["classname"]<>"tdcreatepanel" then return inherited;
if csDesigning in ComponentState then
begin
end else
@@ -1285,6 +1286,7 @@ type TpanelForm=class(tpanel) //
end
function GetWsPopUp();override;
begin
if self(true).classinfo()["classname"]<>"tdcreatepanel" then return inherited;
if csDesigning in ComponentState then
begin
return true;
@@ -1317,7 +1319,7 @@ type TpanelForm=class(tpanel) //
end
function SetDesigning(f,fc);override;
begin
if f then wspopup := true;
if f and (self(true).classinfo()["classname"]="tdcreatepanel") then wspopup := true;
inherited;
end
end
@@ -1489,8 +1491,7 @@ type tmemo = class(TSynMemoNorm) //
function DoTextChanged(p);override;//文本改变
begin
inherited;
if Fonchange then
calldatafunction(Fonchange,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(Fonchange,self(true));
end
function GetPreferredSize(w,h);override;
begin
@@ -3591,8 +3592,7 @@ type TListView = class(TDrawGrid)
end
function CallSelChanged();
begin
if OnSelChanged then
return calldatafunction(OnSelChanged,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(FSelectedChanged,self(true));
end
function SetCanSelected(v);
begin
@@ -5203,7 +5203,7 @@ type TQuotations=class(tcomponent)
**}
if not ifarray(d)then exit;
FData := d;
calldatafunction(FOncallBack,self(true));
CallMessgeFunction(FOncallBack,self(true));
end
public
function create(AOwner);override;
@@ -6530,6 +6530,10 @@ function GetTextWidthAndHeightWidthFont(s,f,mul);//
begin
return unit(utslvclgdi).GetTextWidthAndHeightWidthFont(s,f,mul);
end
function CallMessageFunction(f,o,e); //执行消息回调
begin
return unit(utslvclauxiliary).CallMessgeFunction(f,o,e);
end
function CallMessgeFunction(f,o,e); //执行消息回调
begin
return unit(utslvclauxiliary).CallMessgeFunction(f,o,e);
funcext/tvclib/tuieventbase.tsf
+5
View File
@@ -64,6 +64,11 @@ type tuieventbase=class(TSLUICONST)
Lparam := l;
Hwnd := h;
end
function expandinfo();virtual; //作为函数参数展开
begin
//返回二维数组,字段 name ,var,alias,type
return array();
end
function hilparam();
begin
{**
funcext/tvclib/twincontrol.tsf
+74 -12
View File
@@ -62,6 +62,7 @@ type TWinControl = class(tcontrol)
FWsDlgModalFrame;
private //模态相关
//*******showmodal******************
fmodalcenter;//模态居中
FModaling;
FModalCode;
FMinWidth;
@@ -129,6 +130,7 @@ type TWinControl = class(tcontrol)
FMSG := new TTagMSG();
msg := FMSG._getptr_;
//显示自己
center_self();
_wapi.ShowWindow(hWnd,SW_SHOW);
_wapi.BringWindowToTop(hWnd);
//disable掉父窗口
@@ -918,7 +920,7 @@ type TWinControl = class(tcontrol)
function WMACTIVATE(o,e):WM_ACTIVATE;virtual;
begin
factivated := e.wparam;
CallMessgeFunction(OnActivate,o,e);
CallMessgeFunction(fOnActivate,o,e);
if e.skip then return ;
defaulthandler(e);
if factivated and ContainsControl(factivecontrol) then
@@ -1557,6 +1559,27 @@ type TWinControl = class(tcontrol)
end
procedure PaintWindow(DC:HDC);virtual;
begin
///////////////////设计器中选中绘制/////////////////////////////////////////////
if (csDesigning in ComponentState) and FDesignSelect then //选中
begin
c := getwndclientrect();
x := (c[0]+c[2])/2;
y := (c[1]+c[3])/2;
ps := array(
(x,c[1]),
(c[0],y),
(c[2],y),
(x,c[3])
);
cvs := Canvas;
cvs.Brush.color := sys_complementar_color(Color);
sz := 4;
for i,v in ps do
begin
cvs.draw_rect().rect(array(v[0]-sz,v[1]-sz,v[0]+sz,v[1]+sz)).draw();
end
end
////////////////////////////////////////////////////
end
function SetTempCursor(Value);override;
begin
@@ -1946,6 +1969,7 @@ type TWinControl = class(tcontrol)
end
function create(aowner);override; //type_twinctrol
begin
fmodalcenter := true;
inherited;
fchildsizing := new t_children_sizer(self(true));
//fbordercolor := rgb(190,190,190);
@@ -2073,17 +2097,20 @@ type TWinControl = class(tcontrol)
dy := 20;
x := 0;
y := 0;
c := 0;
c := sys_complementar_color(color);
bbc := cv.brush.color;
cv.brush.color := c;
while y<rc[3] do
begin
y+=dx;
x := 0;
while x<rc[2] do
begin
x+=dx;
cv.SetPixel(array(x,y),c);
x+=dx;
cv.FillRect(array(x-1,y-1,x+1,y+1));
end
end
cv.brush.color := bbc;
ctls := controls;
rcs := array();
sel := -1;
@@ -2112,7 +2139,7 @@ type TWinControl = class(tcontrol)
pct := cv.pen.style;
pcw := cv.pen.width;
cv.pen.Style := PS_DOT;
cv.pen.color := 0x3f3f3f;
cv.pen.color := c;//0x3f3f3f;
for i := 0 to len do
begin
if i=sel then continue;
@@ -2294,6 +2321,14 @@ type TWinControl = class(tcontrol)
end
end
private //绘制相关成员
function sys_complementar_color(c);
begin
if (c .& 0xff000000) then
begin
return complementary_color( _wapi.GetSysColor(c .& 0x00ffffff));
end
return complementary_color(c);
end
FPaintRects;
FUpDateCount;
public
@@ -2553,7 +2588,7 @@ type TWinControl = class(tcontrol)
_Send_(WM_NCLBUTTONDOWN,HTCAPTION,0,0);
e.skip := true;
end
CallMessgeFunction(OnDesignClick,self(true),e);
CallMessgeFunction(FOnDesinedsel,self(true),e);
//保留原有的点击消息
{if DesigningClick() then
begin
@@ -2562,11 +2597,11 @@ type TWinControl = class(tcontrol)
end else
if msg = WM_LBUTTONDBLCLK then
begin
CallMessgeFunction(OnDesignDBLClick,self(true),e);
CallMessgeFunction(FOnDesigDBLClick,self(true),e);
end else
if msg = WM_RBUTTONDOWN then
begin
CallMessgeFunction(OnDesignRClick,self(true),e);
CallMessgeFunction(FOnDesinedRclick,self(true),e);
end else
if msg = WM_USER then
begin
@@ -2902,11 +2937,11 @@ type TWinControl = class(tcontrol)
property OnActivate:eventhandler read FOnActivate write FOnActivate;
property OnClose:eventhandler read FOnClose write FOnClose;
property OnKeyDown:eventhandler read FOnKeyDown write FOnKeyDown;
property OnsysKeyDown:eventhandler read FOnsysKeyDown write FOnsysKeyDown;
property OnsysKeyDown read FOnsysKeyDown write FOnsysKeyDown;
property OnKeyUp:eventhandler read FOnKeyUp write FOnKeyUp;
property OnsysKeyUp:eventhandler read FOnsysKeyUp write FOnsysKeyUp;
property OnsysKeyUp read FOnsysKeyUp write FOnsysKeyUp;
property OnKeyPress:eventhandler read FOnKeyPress write FOnKeyPress;
property OnSysKeyPress:eventhandler read FOnSysKeyPress write FOnSysKeyPress;
property OnSysKeyPress read FOnSysKeyPress write FOnSysKeyPress;
property OnDesignClick read FOnDesinedsel write FOnDesinedsel;
property OnDesignDBLClick read FOnDesigDBLClick write FOnDesigDBLClick;
property OnDesignRClick read FOnDesinedRclick write FOnDesinedRclick;
@@ -2923,7 +2958,34 @@ type TWinControl = class(tcontrol)
property ActiveControl read getactivecontrol write setactivecontrol;
property Active read factivated;//是否获活动窗口
property childsizing:tchildsizing read fchildsizing write setchildsizing;
property modalcenter read fmodalcenter write fmodalcenter; //模态时候居中
private //模态相关
function center_self();
begin
////////////////////窗口居中处理/////////////////////////////////
////////////////////wnd待居中的窗口/////////////////////////////////
////////////////////pwnd父窗口/////////////////////////////////
if not fmodalcenter then return ;
wnd := self(true);
pd := wnd.parent;
if pd and pd.Visible then
begin
while not(pd.wspopup) do
begin
npd := pd.parent;
if npd then pd := npd;
else break;
end
r := pd.ClientRect;
xy := pd.clienttoscreen(r[0],r[1]);
end else
begin
xy := array(0,0);
r := wnd._wapi.GetScreenRect();
end
wnd.Left := max(0,xy[0]+(r[2]-r[0]-wnd.width)/2) ;
wnd.top := max(0,xy[1]+(r[3]-r[1]-wnd.Height)/2);
end
property Modaling read FModaling;
{**
@param(BorderStyle)(bsNone|bsSingle) 边框样式 %%
@@ -2933,7 +2995,7 @@ type TWinControl = class(tcontrol)
@param(OnClose)(function[TWincontrol,tuieventbase]) 窗口关闭消息回调 %%
@param(OnKeyDown)(function[TWincontrol,TMKEY]) 按键按下回调 %%
@param(OnKeyUp)(function[TWincontrol,TMKEY]) 按键松开 %%
@param(OnKeyPress)(function[TWincontrol,TMKEY]) 字符消息 %%
@param(OnKeyPress)(function[TWincontrol,tmk_press]) 字符消息 %%
**}
private //ShortCut
function dispatchshortcut(c,st); //快捷键分发
funcext/tvclib/ugtkinterface.tsf
+23 -13
View File
@@ -1062,6 +1062,16 @@ type tsgtkapi = class(tgtkapis)
end
Function DrawTextExA(hdc :pointer;txt:string;len:integer;rec:array of integer;fmt:integer;lpdtp:pointer):integer;
begin
//DT_LEFT := 0;
DT_RIGHT := 0x2;
//DT_TOP := 0;
DT_BOTTOM:= 0x8;
DT_CENTER := 0x1;
DT_VCENTER:= 0x4;
DT_SINGLELINE:= 0x20;
//DT_TABSTOP:= 0x80;
fmt := (fmt>0 or fmt<0)?fmt:0;
dfs := (fmt .& DT_SINGLELINE) = DT_SINGLELINE;
slen := length( txt);
if slen<1 then return ;
ft := gtk_object_get_data(hdc,"font");
@@ -1082,23 +1092,19 @@ type tsgtkapi = class(tgtkapis)
if vi="\r" then continue;
if vi="\n" then
begin
rs++;
mxl := max(mxl,rl);
rl := 0;
if not dfs then
begin
rs++;
mxl := max(mxl,rl);
rl := 0;
end
continue;
end
rl++;
end
if dfs then slen := rl;
ht := ht*rs;
mxl := max(mxl,rl);
//DT_LEFT := 0;
DT_RIGHT := 0x2;
//DT_TOP := 0;
DT_BOTTOM:= 0x8;
DT_CENTER := 0x1;
DT_VCENTER:= 0x4;
//DT_SINGLELINE:= 0x20;
//DT_TABSTOP:= 0x80;
mxl := max(mxl,rl);
rw := rec[2]-rec[0];
nlen := min(len, min(integer(rw/wd),mxl));
sx := rec[0];
@@ -1140,7 +1146,11 @@ type tsgtkapi = class(tgtkapis)
y := 0;//gtk_object_get_data(hdc,"viewport.y");
reci := array(rec[0]+x,rec[1]+y,rec[2]+x,rec[3]+y);
cairo_clip_rec(hdc,reci);
r := TextOutexA(hdc,sx,sy-dht,txt,slen);
if dfs then
begin
r := TextOutexA(hdc,sx,sy-dht,replacetext(replacetext(txt,"\r",""),"\n",""),slen);
end else
r := TextOutexA(hdc,sx,sy-dht,txt,slen);
cairo_restore(hdc);
return r;
end
funcext/tvclib/utslmemo.tsf
+99 -20
View File
@@ -456,7 +456,9 @@ type TCustomMemoCmd=class() //
static const ecPrevBlock=0x2BE;static const ecNextJumpOut=0x2BF;static const ecPrevJumpOut=0x2C0;
static const ecUserFirst=0x3E9;static const ecFind=0x3EA;static const ecReplace=0x3EB;
static const ecSearchAgain=0x3EC;static const ecFindAll=0x3ED;static const ecString=0x3EE;
static const ecSearchUpAgain=0x3EF;
static const ecSearchUpAgain=0x3EF;
//////////////////////选择模式/////////////////////////////////
static const smNormal = 0;static const smLine = 1;static const smColumn = 2;
end
type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //编辑器基类
@@ -518,10 +520,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
static const crUnindent = 7;
static const crSilentDelete = 8;
static const crSilentDeleteAfterCursor = 9;
static const crNothing = 10;
static const smNormal = 0;
static const smLine = 1;
static const smColumn = 2;
static const crNothing = 10;
//****************
protected
@@ -693,9 +692,42 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
begin
cvs.Brush.Color := fselectbkcolor;//rgb(192,192,192);
src := r;
if FSelectionMode=smLine then
if FSelectionMode=smLine then //行选择
begin
end else
if FSelectionMode=smColumn then //块选择
begin
if bb[0]=ee[0] then
begin
src[0]+= fCharWidth *(bb[1]-1);
src[2]:= src[0]+fCharWidth *(ee[1]-bb[1]);
end
else
begin
t1 := bb;
t2 := ee;
bb := array(min(t1[0],t2[0]),min(t1[1],t2[1]));
ee := array(max(t1[0],t2[0]),max(t1[1],t2[1]));
s := FLines.GetStringByIndex(i);
ls := length(s);
dx := 0;
case bytetype(s,bb[1]) of
2:
begin
src[0]+= fCharWidth *(bb[1]);
dx := -1;
end
else src[0]+= fCharWidth *(bb[1]-1);
end ;
case bytetype(s,ee[1]-1) of
1:src[2]:= src[0]+max(0,fCharWidth *(min(ee[1],ls+1)-bb[1]+1+dx));
else src[2]:= src[0]+max(0,fCharWidth *(min(ee[1],ls+1)-bb[1]+dx));
end ;
end
end else
begin
if bb[0]=ee[0]then //同一行
begin
@@ -1027,7 +1059,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
if ftmemlockv.locked then return ;
if e.skip then return;
c := e.wparam;
if ReadOnly then return;
if ReadOnly or (FSelectionMode=smColumn) then return;
if c=13 then return CharInput("\r\n");
if c<32 and not(c in array(9))then return;
cc := e.char;
@@ -1139,7 +1171,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
end
function CharInput(c);virtual;//插入字符
begin
if not ReadOnly then return InsertChars(c);
if not(ReadOnly or (FSelectionMode=smColumn)) then return InsertChars(c);
end
function ExecuteCommand(cmd,data);override;//执行命令
begin
@@ -1801,7 +1833,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
end
function SetSelectionMode(v);
begin
if(v <> FSelectionMode)and(v in array(smNormal,smLine))then FSelectionMode := v;
if(v <> FSelectionMode)and(v in array(smNormal,smLine,smColumn))then FSelectionMode := v;
end
function MoveCaretHorz(stp,sel);
begin
@@ -2236,7 +2268,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
function GetBlockEnd();
begin
if GetSelAvail()then
begin
begin
if fBlockEnd[0]<fBlockBegin[0]or(fBlockEnd[0]=fBlockBegin[0]and fBlockEnd[1]<fBlockBegin[1])then return fBlockBegin;
else return fBlockEnd;
end
@@ -2297,6 +2329,52 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
if i<len then r += "\r\n";
end
end else
if sm=smColumn then
begin
if bb[0]=ee[0]then
begin
s := fLines[bb[0]-1].FStr;
if not s then return "";
bg := min(bb[1],ee[1]);
ed := max(bb[1],ee[1]);
if bg<ed then return s[bg:(ed-1)]; //2023078 出错
return "";
end else
begin
//第一行
r += "";
//中间
for i := bb[0]-1 to ee[0]-1 do
begin
s := fLines[i].FStr;
ls := length(s);
t1 := bb;
t2 := ee;
bb := array(min(t1[0],t2[0]),min(t1[1],t2[1]));
ee := array(max(t1[0],t2[0]),max(t1[1],t2[1]));
if bb[1]<=ls then
begin
dx := 0;
case bytetype(s,bb[1]) of
2:
begin
bx := bb[1]+1;
dx := -1;
end
else bx := bb[1];
end ;
case bytetype(s,ee[1]-1) of
1: ex := min(ee[1],ls);
else ex:= min(ee[1]-1,ls);
end ;
if bx<=ex then r += s[bx:ex];
end
if i<ee[0]-1 then r += "\r\n";
end
//最后一行
end
end else
begin
if bb[0]=ee[0]then
begin
@@ -2958,7 +3036,7 @@ type TSynHighLighter = class(TComponent) //
r := FCacheTokens[ridx];
if r then return r;
s := Flines.GetSTringByIndex(ridx);
if not ifstring(s) then return;
if not ifstring(s) then return nil;
idx := 1;
len := length(s);
tks := array();
@@ -3199,6 +3277,7 @@ type tcustomsynhighlighter = class(TSynHighLighter)
function GetLineTokens(idx);override;
begin
if idx<FSatesCount then return FTokens[idx];
return nil;
end
function SetTToken(tokens,ttk,idx,ext);override; //设置token
begin
@@ -3766,7 +3845,7 @@ type TSynCustomMemo = class(TCustomMemo)
end
function CharInput(c);override; //字符输入
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
if c="\r\n" then
begin
if FinishCompletion() then //确定键
@@ -4061,28 +4140,28 @@ type TSynMemoNorm = class(TsynCustomMemo) //
end
ord("V"):
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
ExecuteCommand(ecPaste);
end
ord("X"):
begin
//if (ssAlt in e.shiftstate) then return ExecuteCommand(ecRedo);
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
ExecuteCommand(ecCut);
end
ord("Y"),ord("L"):
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
return ExecuteCommand(ecDeleteLine);
end
ord("Z"):
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
return ExecuteCommand(ecUndo);
end
ord("U"):
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
return ExecuteCommand(ecRedo);
end
VK_LEFT:
@@ -4115,7 +4194,7 @@ type TSynMemoNorm = class(TsynCustomMemo) //
VK_TAB:
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
FSheetTabFlage := true;
return ExecuteCommand(ecShifttab,array(TabChar,"\t"," "));
end
@@ -4182,13 +4261,13 @@ type TSynMemoNorm = class(TsynCustomMemo) //
end
VK_DELETE:
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
ExecuteCommand(ecDeleteChar);
return CancelCompletion();
end
VK_BACK :
begin
if ReadOnly then return ;
if ReadOnly or (FSelectionMode=smColumn) then return ;
ExecuteCommand(ecDeleteLastChar,1);
return CancelCompletion();
end
funcext/tvclib/utslvclaction.tsf
+1 -2
View File
@@ -82,8 +82,7 @@ type TBasicAction=class(TComponent)
if csDesigning in ComponentState then return ;
if FOnExecute then
begin
e := new tuieventbase(0,0,0,0);
if iffuncptr(FOnExecute) then call(FOnExecute,self(true),e);
if iffuncptr(FOnExecute) then call(FOnExecute,self(true));
return true;
end
return false;
funcext/tvclib/utslvclauxiliary.tsf
+131 -6
View File
@@ -615,7 +615,7 @@ type tarray1dlk=class //
function dochanged(info);
begin
if onchangelock then return ;
if fonchanged then CallMessgeFunction(fonchanged,self(true),info);
if fonchanged then CallMessgeFunction(fonchanged,self(true),info);
end
function SwapNoCheck(i,j);
begin
@@ -910,7 +910,7 @@ type tstrindexarray = class() //
begin
{**
@explan(说明) 获得tsl array %%
@param(n)(bool) false 返回小写下标，true 返回原始下标 %%
@param(n)(bool) true 返回小写下标，false 返回原始下标 %%
**}
r := array();
for i,v in FData do
@@ -3450,8 +3450,9 @@ end;
//////////////////////////////////////
function iffuncptr(fn);
begin
return datatype(fn) in array(7,37);
//return datatype(fn)=7;
return fn and ifobj(fn);
//return fn and ifobj(fn);
end
function includestate(u,s);
begin
@@ -4039,12 +4040,136 @@ begin
if m in array(1,3,5,7,8,10,12) then return 31;
return 30;
end
function CallMessgeFunction2(f,o,e);
begin
{**
@ignore(忽略)
**}
if iffuncptr(f) then return call(f,o,e);
end
function get_evt_expand(e,n); //展开形式
begin
if (n=0 or n>2) and (e is class(tuieventbase)) then
begin
ps := e.expandinfo();
//echo e.Classinfo()["classname"],"\r\n";
if ps and ifarray(ps) then
begin
r := ps[0:(n-3)];
len := length(r);
n := len+2;
return r;
end
end
n := min(n,2);
return array();
end
function CallMessgeFunction(f,o,e);
begin
{**
{**
@ignore(忽略)
**}
if iffuncptr(f) then return call(f,o,e);
**}
if not iffuncptr(f) then return ;
//////////////事件信息处理//////////////
ff := f.functioninfo();
ffp := ff["parameter"];
plen := length(ffp);
ex := get_evt_expand(e,plen);
//////////////////////////////////
case plen of
1:
begin
r := call(f,o);
end
3:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
r := call(f,o,e,x0);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
end
4:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
r := call(f,o,e,x0,x1);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
if ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
end
5:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
if ifstring(ex[2,"name"]) then x2 := invoke(e,ex[2,"name"]); else x2 := nil;
r := call(f,o,e,x0,x1,x2);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
if ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
if ex[2,"var"] then invoke(e,ex[2,"name"],1,x2);
end
6:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
if ifstring(ex[2,"name"]) then x2 := invoke(e,ex[2,"name"]); else x2 := nil;
if ifstring(ex[3,"name"]) then x3 := invoke(e,ex[3,"name"]); else x3 := nil;
r := call(f,o,e,x0,x1,x2,x3);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
if ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
if ex[2,"var"] then invoke(e,ex[2,"name"],1,x2);
if ex[3,"var"] then invoke(e,ex[3,"name"],1,x3);
end
7:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
if ifstring(ex[2,"name"]) then x2 := invoke(e,ex[2,"name"]); else x2 := nil;
if ifstring(ex[3,"name"]) then x3 := invoke(e,ex[3,"name"]); else x3 := nil;
if ifstring(ex[4,"name"]) then x4 := invoke(e,ex[4,"name"]); else x4 := nil;
r := call(f,o,e,x0,x1,x2,x3,x4);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
if ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
if ex[2,"var"] then invoke(e,ex[2,"name"],1,x2);
if ex[3,"var"] then invoke(e,ex[3,"name"],1,x3);
if ex[4,"var"] then invoke(e,ex[4,"name"],1,x4);
end
8:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
if ifstring(ex[2,"name"]) then x2 := invoke(e,ex[2,"name"]); else x2 := nil;
if ifstring(ex[3,"name"]) then x3 := invoke(e,ex[3,"name"]); else x3 := nil;
if ifstring(ex[4,"name"]) then x4 := invoke(e,ex[4,"name"]); else x4 := nil;
if ifstring(ex[5,"name"]) then x5 := invoke(e,ex[5,"name"]); else x5 := nil;
r := call(f,o,e,x0,x1,x2,x3,x4,x5);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
if ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
if ex[2,"var"] then invoke(e,ex[2,"name"],1,x2);
if ex[3,"var"] then invoke(e,ex[3,"name"],1,x3);
if ex[4,"var"] then invoke(e,ex[4,"name"],1,x4);
if ex[5,"var"] then invoke(e,ex[5,"name"],1,x5);
end
9:
begin
if ifstring(ex[0,"name"]) then x0 := invoke(e,ex[0,"name"]); else x0 := nil;
if ifstring(ex[1,"name"]) then x1 := invoke(e,ex[1,"name"]); else x1 := nil;
if ifstring(ex[2,"name"]) then x2 := invoke(e,ex[2,"name"]); else x2 := nil;
if ifstring(ex[3,"name"]) then x3 := invoke(e,ex[3,"name"]); else x3 := nil;
if ifstring(ex[4,"name"]) then x4 := invoke(e,ex[4,"name"]); else x4 := nil;
if ifstring(ex[5,"name"]) then x5 := invoke(e,ex[5,"name"]); else x5 := nil;
if ifstring(ex[6,"name"]) then x6 := invoke(e,ex[6,"name"]); else x6 := nil;
r := call(f,o,e,x0,x1,x2,x3,x4,x5,x6);
if ex[0,"var"] then invoke(e,ex[0,"name"],1,x0);
if ex[1,"var"] then invoke(e,ex[1,"name"],1,x1);
if ex[2,"var"] then invoke(e,ex[2,"name"],1,x2);
if ex[3,"var"] then invoke(e,ex[3,"name"],1,x3);
if ex[4,"var"] then invoke(e,ex[4,"name"],1,x4);
if ex[5,"var"] then invoke(e,ex[5,"name"],1,x5);
if ex[6,"var"] then invoke(e,ex[6,"name"],1,x6);
end else
begin
r := call(f,o,e);
end
end ;
return r;
end
function CheckArrayIsNumbers(Value,n);
begin
funcext/tvclib/utslvclevent.tsf
+149 -2
View File
@@ -74,6 +74,13 @@ type tmmeasuresize = class(tuieventbase)
width := -1;
height := -1;
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"width","alias":"wd","type":"integer","var":true);
r[1] := array("name":"height","alias":"ht","type":"integer","var":true);
return r;
end
width;
height;
end
@@ -106,8 +113,17 @@ type TMKEY=class(tuieventbase)
function create(m,w,l,h);override;
begin
inherited;
FChar := chr(w);
if w>0 then
FChar := chr(w);
else FChar := chr(0);
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"charcode","alias":"key","type":"word");
r[1] := array("name":"shiftstate","alias":"shift","type":"tshiftstateenum");
return r;
end
property char read FChar;
property CharCode read wparam;
property shiftstate read getshiftsate;
@@ -117,6 +133,22 @@ type TMKEY=class(tuieventbase)
@param(shiftstate)(arry of TShiftStateEnum member ) ascii码 %%
**}
end
type tmk_press=class(TMKEY)
{**
@param(说明) 按键输入
**}
public
function create(m,w,l,h);override;
begin
inherited;
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"char","alias":"key","type":"string");
return r;
end
end
Type TtageDrawItem=class(tslcstructureobj)
private
@@ -265,7 +297,7 @@ type TSIFTSTATE = class(TSLUICONST)
end;
end
type TMMOUSEWHEEL=class(tuieventbase)
type tmmousewheel=class(tuieventbase)
{**
@explan(说明)鼠标滚动消息类 %%
**}
@@ -288,12 +320,26 @@ type TMMOUSEWHEEL=class(tuieventbase)
property delta read hiwparamsigned;
property ypos read hilparamsigned;
property xpos read lolparamsigned;
property pos read getpos;
function expandinfo();override;
begin
r := array();
i := 0;
r[i++] := array("name":"shiftstate","alias":"shift","type":"tshiftstateenum");
r[i++] := array("name":"delta","alias":"delta","type":"integer");
r[i++] := array("name":"pos","alias":"mousepos","type":"array of integer");
return r;
end
{**
@param(ypos)(integer)鼠标的y坐标 %%
@param(xpos)(integer)鼠标的x坐标 %%
@param(delta)(integer)运动距离 %%
**}
private
function getpos();
begin
return array(xpos,ypos);
end
FKeyState;
end
type TMMouse=class(tuieventbase)
@@ -370,9 +416,110 @@ type TMMouse=class(tuieventbase)
shiftstate();
return(ssDouble in FKeyState);
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"button","alias":"button","type":"tmousebutton");
r[1] := array("name":"shiftstate","alias":"shift","type":"tshiftstateenum");
r[2] := array("name":"xpos","alias":"x","type":"integer");
r[3] := array("name":"ypos","alias":"y","type":"integer");
return r;
end
private
FKeyState;
end
type tmm_move=class(TMMouse)
{**
@explan(说明) 鼠标移动消息类 %%
**}
public
function create(m,w,l,h);override;
begin
inherited;
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"shiftstate","alias":"shift","type":"tshiftstateenum");
r[1] := array("name":"xpos","alias":"x","type":"integer");
r[2] := array("name":"ypos","alias":"y","type":"integer");
return r;
end
end
type tmcontextpop = class(tuieventbase)
function create(m,w,l,h);
begin
inherited;
end
property mousepos read getpos; //鼠标位置
function expandinfo();override;
begin
r := array();
r[0] := array("name":"mousepos","alias":"mousepos","type":"array of integer");
return r;
end
private
function getpos();
begin
return array(lolparamsigned(),hilparamsigned());
end
end
type tmnotif = class(tuieventbase) //通知消息
function create(op);
begin
inherited create(op,0,0,0);
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"msg","alias":"msg");
r[1] := array("name":"skip","alias":"stopnotify","type":"bool","var":true);
return r;
end
end
type tmclose = class(tuieventbase) //窗口关闭
function create(m,w,l,h);
begin
inherited;
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"skip","alias":"stopclose","type":"bool","var":true);
return r;
end
end
type tminqurequit = class(tuieventbase) //退出询问
function create();
begin
inherited create(0,0,0,0);
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"skip","alias":"stopquit","type":"bool","var":true);
return r;
end
end
type tmactivate = class(tuieventbase)
function create(m,w,l,h);
begin
inherited;
end
property deactivate read getdeactivate;
function expandinfo();override;
begin
r := array();
r[0] := array("name":"deactivate","alias":"deactivate","type":"bool");
return r;
end
private
function getdeactivate();
begin
return Wparam=0;
end
end
type TMSTYLECHANG=class(tuieventbase)
{**
@explan(说明)窗口样式改变消息 %%
funcext/tvclib/utslvclgrid.tsf
+44 -2
View File
@@ -69,6 +69,12 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
// end
function GetPreferredSize(w,h);override;
begin
if csDesigning in ComponentState then
begin
w := 250;
h := 150;
return ;
end
if ongetpreferredsize then return inherited;
w := Width;
h := Height;
@@ -822,7 +828,7 @@ type TcustomGridCtl = class(tcustomscrollcontrol) //
begin
if fonhitcellsizer then
begin
e := new tuieventbase(0,r,i,0);
e := new triddragsize(0,r,i,0);
CallMessgeFunction(fonhitcellsizer,self(true),e);
return e.skip;
end
@@ -1175,11 +1181,47 @@ type tgriddrawcellevent = class(tuieventbase)
rec := rc;
canvas := cvs;
end
function expandinfo();override;
begin
r := array();
idx := 0;
r[idx++] := array("name":"canvas","alias":"cvs","type":"tcanvas");
r[idx++] := array("name":"row","alias":"rowidx","type":"integer");
r[idx++] := array("name":"col","alias":"colidx","type":"integer");
r[idx++] := array("name":"rec","alias":"arec");
return r;
end
row;
col;
rec;
canvas;
end
end
type triddragsize=class(tuieventbase)
function create(a,b,c,d);
begin
inherited;
end
function expandinfo();override;
begin
r := array();
i := 0;
r[i++] := array("name":"idx","alias":"idx","type":"integer");
r[i++] := array("name":"r_or_c","alias":"r_or_c","type":"integer");
r[i++] := array("name":"skip","alias":"stopact","type":"bool","var":true);
return r;
end
property idx read getidx;
property r_or_c read getrc;
private
function getidx();
begin
return lparam;
end
function getrc();
begin
return wparam;
end
end
implementation
type TPAINTCOUNT=class()//绘制标记
function create(v);
funcext/tvclib/utslvclmemstruct.tsf
+23
View File
@@ -1501,6 +1501,29 @@ type TMONITORINFO=class(tslcstructureobj)
property rcwork index "rcwork" read _getvalue_ write _setvalue_;
property dwflags index "dwflags" read _getvalue_ write _setvalue_;
end
type tagTRACKMOUSEEVENT=class(tslcstructureobj)
private
static SSTRUCT;
class function getstruct()
begin
if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array(
("cbsize","int",0),
("dwflags","int",0),
("hwndtrack","pointer",),
("dwhovertime","int",200)));
return SSTRUCT;
end
public
function create(ptr)
begin
inherited create(getstruct(),ptr);
cbsize := _size_();
end
property cbsize index "cbsize" read _getvalue_ write _setvalue_;
property dwFlags index "dwflags" read _getvalue_ write _setvalue_;
property hwndtrack index "hwndtrack" read _getvalue_ write _setvalue_;
property dwhovertime index "dwhovertime" read _getvalue_ write _setvalue_;
end
implementation
(*
funcext/tvclib/utslvclpage.tsf
+125 -68
View File
@@ -1,4 +1,5 @@
unit utslvclpage;
/////////20250710 tab控件添加inert_tab方法//////////////////////////////////
interface
uses utslvclauxiliary,utslvclbase,utslvclgdi;
type tcustomtabsheet = class(TCustomControl) //控件页面
@@ -71,15 +72,13 @@ type tcustomtabcontrol = class(TCustomControl)
begin
if FCurrentid<>-1 and fOnSelChanging then
begin
e := new tuieventbase(0,FCurrentid,id,0); //m,w,l,h
e := new tmtabselchanging(0,FCurrentid,id,0); //m,w,l,h
doonSelChanging(self(true),e);
if e.skip then return ;
end
FPrevid := FCurrentid;
FCurrentid := id;
InsureIdxVisible(id);
//InvalidateRect(nil,false);
//DoControlAlign();
DoControlAlign();
if FOnSelChanged then
begin
@@ -92,43 +91,6 @@ type tcustomtabcontrol = class(TCustomControl)
FCurrentid := -1;
end
end
function RemovePageTab(id);//移除sheet
begin
if not(id>=0) then return ;
FTabItems.splice(id,1);
if id = FCurrentid then
begin
if id = 0 then
begin
if FTabItems.length()=0 then
begin
FCurrentid := -1;
FPrevid := -1;
end
end
FCurrentid := -1;
FPrevid := -1;
cid := min(max(0,id-1),FTabItems.length()-1);
if cid >=0 then
begin
return setselidx(cid);
end else
begin
if FOnSelChanged then
begin
doonSelChange(self(true),new tuieventbase(0,-1,-1,0));
end
end
end else
if id<FCurrentid then
begin
FCurrentid--;
end
FPrevid := -1;
DoControlAlign();
//CalcTabs();
//InvalidateRect(nil,false);
end
function CreateTableItem(cp);
begin
r := new tcustomtabitem();
@@ -148,7 +110,7 @@ type tcustomtabcontrol = class(TCustomControl)
FTabHeight := fh+8;
end
FTabItemswidth := array();
e := new tuieventbase(0,0,0,0);
e := new tmtabmeasure(0,-1);
for i := 0 to FTabItems.length()-1 do
begin
pg := FTabItems[i];
@@ -400,7 +362,6 @@ type tcustomtabcontrol = class(TCustomControl)
begin
FirstViewIndex-- ;
DoControlAlign();//CalcTabs();
//InvalidateRect(nil,false);
end
end
function scrollnext(); //滚动到上一个
@@ -419,8 +380,6 @@ type tcustomtabcontrol = class(TCustomControl)
end
end ;
FirstViewIndex++ ;
//CalcTabs();
//InvalidateRect(nil,false);
DoControlAlign();
end
end
@@ -619,7 +578,6 @@ type tcustomtabcontrol = class(TCustomControl)
begin
it.Caption := Value;
DoControlAlign();
//InvalidateRect(nil,false);
end
end
function SetTabIndex(AIndex,AIndexnew);
@@ -646,6 +604,59 @@ type tcustomtabcontrol = class(TCustomControl)
//InvalidateRect(nil,false);
end
end
function remove_tab_byidx(id);virtual;//移除tab
begin
{**
@explan(说明) 移除标签 %%
@param(idx)(integer) 序号 %%
**}
if not(id>=0 and id<FTabItems.length()) then return ;
FTabItems.splice(id,1);
if id = FCurrentid then
begin
if id = 0 then
begin
if FTabItems.length()=0 then
begin
FCurrentid := -1;
FPrevid := -1;
end
end
FCurrentid := -1;
FPrevid := -1;
cid := min(max(0,id-1),FTabItems.length()-1);
if cid >=0 then
begin
return setselidx(cid);
end else
begin
if FOnSelChanged then
begin
doonSelChange(self(true),new tuieventbase(0,-1,-1,0));
end
end
end else
if id<FCurrentid then
begin
FCurrentid--;
end
FPrevid := -1;
DoControlAlign();
end
function insert_tab(c,idx);virtual; //插入tab
begin
{**
@explan(说明) 插入标签 %%
@param(c)(string) 标签 %%
@param(idx)(integer) 位置,默认为尾部 %%
**}
if not ifstring(c) then return 0;
cp := CreateTableItem(c);
if idx>=0 or idx<0 then FTabItems.splice(integer(idx),0,cp);
else FTabItems.Push(cp);
DoControlAlign();
return 1;
end
function Recycling();override;
begin
FOnSelChanged := nil;
@@ -656,7 +667,7 @@ type tcustomtabcontrol = class(TCustomControl)
{**
@param(cursel)(integer) 当前选中序号 %%
@param(TabCount)(integer) page数量 %%
@param(OnSelChange)(function[tcustompagecontrol,tuieventbase]) 标签已经切换 %%
@param(OnSelChanged)(function[tcustompagecontrol,tuieventbase]) 标签已经切换 %%
@param(OnSelChanging)(function[tcustompagecontrol,tuieventbase]) 标签正在切换 %%
@param(Onrclcik)(function[tcustompagecontrol,tuieventbase]) 右键点击 %%
**}
@@ -790,6 +801,11 @@ type tcustompagecontrol = class(tcustomtabcontrol)
if not (page is class(TWinControl)) then CalcTabs();
InvalidateRect(nil,false);
end
end
protected
function remove_tab_byidx(id);override;
begin
return inherited;
end
public
function GetPreferredSize(w,h);override;
@@ -837,7 +853,7 @@ type tcustompagecontrol = class(tcustomtabcontrol)
begin
if not isacceptsheettype(AControl){ not(AControl is class(tcustomtabsheet))} then return;
id := GetPageID(AControl);
RemovePageTab(id);
remove_tab_byidx(id);
//fcoolbands.deleteitem(AControl,true);
end
Function SetCurSel(id);override; //设置当前序号
@@ -946,6 +962,10 @@ type tcustompagecontrol = class(tcustomtabcontrol)
tabs;
faccepttype;
private
function insert_tab(c,idx);override; //插入tab
begin
end
function isacceptsheettype(c);
begin
for i,v in faccepttype do
@@ -953,6 +973,64 @@ type tcustompagecontrol = class(tcustomtabcontrol)
if c is v then return true;
end
end
end
type tmtabselchanging = class(tuieventbase) //改变
function create(m,w,l,h);
begin
inherited;
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"lparam","alias":"nselidx","type":"integer");
r[1] := array("name":"skip","alias":"stopchange","type":"bool","var":true);
return r;
end
end
type tmtabmeasure = class(tuieventbase)
function create(i,w);
begin
inherited create(nil,w,i,0);
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"idx","alias":"idx","type":"integer");
r[1] := array("name":"width","alias":"wid","type":"integer","var":true);
return r;
end
property idx read wparam ; //序号
property width read lparam write lparam;//宽度
end
type teventdrawtab = class(tuieventbase)
{**
@explan(说明)绘制消息对象 %%
@param(idx)(integer) 序号 %%
@param(sel)(integer) 是否选中 %%
@param(rec)(array(左上右下)) 区域 %%
@param(canvas)(TCanvas) 画布 %%
**}
function create(id,s,rc,cvs);
begin
inherited create(0,0,0,0);
idx := id;
sel := s;
rec := rc;
canvas := cvs;
end
function expandinfo();override;
begin
r := array();
i := 0;
r[i++] := array("name":"canvas","alias":"cvs","type":"tcanvas");
r[i++] := array("name":"idx","alias":"idx","type":"integer");
r[i++] := array("name":"rec","alias":"arec","type":"array of integer");
return r;
end
idx;
sel;
rec;
canvas;
end
implementation
type tcustomtabitem = class() //
@@ -990,27 +1068,6 @@ type tcustomtabitem = class() //
property PageSheet read FPageSheet Write FPageSheet;
_tag;
end
type teventdrawtab = class(tuieventbase)
{**
@explan(说明)单元格绘制消息对象 %%
@param(idx)(integer) 序号 %%
@param(sel)(integer) 是否选中 %%
@param(rec)(array(左上右下)) 区域 %%
@param(canvas)(TCanvas) 画布 %%
**}
function create(id,s,rc,cvs);
begin
inherited create(0,0,0,0);
idx := id;
sel := s;
rec := rc;
canvas := cvs;
end
idx;
sel;
rec;
canvas;
end
initialization
end.
funcext/tvclib/utslvclstdctl.tsf
+131 -42
View File
@@ -502,7 +502,7 @@ type tcustombtn = class(TCustomControl) //
3: df := DT_RIGHT
4: df := DT_LEFT .| DT_VCENTER;
6: df := DT_RIGHT .| DT_VCENTER;
7: d := DT_BOTTOM .| DT_LEFT;
7: df := DT_BOTTOM .| DT_LEFT;
8: df := DT_BOTTOM .|DT_CENTER;
9: df := DT_BOTTOM .| DT_RIGHT;
else
@@ -530,12 +530,46 @@ type tcustombtn = class(TCustomControl) //
end
function GetPreferredSize(w,h);override;
begin
class(tcontrol).GetPreferredSize(w,h);
if ongetpreferredsize then return ;
if iffuncptr(onGetPreferredSize) then return class(tcontrol).GetPreferredSize(w,h); //
bs := BoundsRect;
cs := ClientRect;
dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
h+=dh;
dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
dw := (bs[2]-bs[0])-(cs[2]-cs[0]);
c := caption;lc := length(c);
ft := font;
fw := ft.Width;
fh := ft.Height;
if FtextPosition=0 then
begin
w := fw*(lc+2);
h := fh+4;
end else
begin
rs := 1;
mlen := 0;
mmlen := 0;
for i := 1 to lc do
begin
ci := c[i];
case ci of
"\r":
begin
continue;
end
"\n":
begin
rs+=1;
mmlen := max(mmlen,mlen);
mlen := -1;
end
end ;
mlen++;
end
w := fw*(max(mmlen,mlen)+2);
h := fh*rs+4;
end
w += dw;
h += dh;
end
function FontChanged(o);override; //字体改变
begin
@@ -624,12 +658,11 @@ type tcustombtn = class(TCustomControl) //
end
function setTextPosition(n);
begin
if not ifnumber(n) or n<0 or n>9 then
n:=0;
else
n:=integer(n);
if not(n>=0 and n<=9) then return ;
n:=integer(n);
if FtextPosition=n then return ;
FtextPosition:=n;
AdjustSize();
InvalidateRect(nil,false);
end
function judgestate(o,e);
@@ -684,7 +717,10 @@ type tcustomcheckbtn=class(tcustombtn) //checkbtn
function GetPreferredSize(w,h);override;
begin
inherited;
w+=20+1;
//w+=20+1;
c := caption;
if c then w+=21;
else w := 21;
end
published
property checked:bool read FcheckState write setChecked;
@@ -2555,6 +2591,7 @@ type TcustomLabel = class(TGraphicControl)
if v <> FTextAlign then
begin
FTextAlign := v;
AdjustSize();
InvalidateRect(nil,true);
end
end
@@ -2578,6 +2615,47 @@ type TcustomLabel = class(TGraphicControl)
set_Preferre_size();
inherited;
end
function GetPreferredSize(w,h);override;
begin
if iffuncptr(onGetPreferredSize) then return class(tcontrol).GetPreferredSize(w,h); //
ft := font;
if not ft then return ;
fw := ft.Width;
fh := ft.Height;
c := caption;lc := length(c);
if FTextAlign=0 then
begin
w := fw*(lc)+2;
h := fh+3;
end else
begin
rs := 1;
mlen := 0;
mmlen := 0;
for i := 1 to lc do
begin
ci := c[i];
case ci of
"\r":
begin
continue;
end
"\n":
begin
rs+=1;
mmlen := max(mmlen,mlen);
mlen := -1;
end
end ;
mlen++;
end
w := fw*(max(mmlen,mlen))+2;
h := fh*rs+3;
end
bd := Border;
w += bd;
h += bd;
end
function FontChanged(o);override;
begin
inherited;
@@ -2768,7 +2846,7 @@ type tcustomedit=class(TCustomControl)
begin
ft := Font;
if not ft then return ;
if ongetpreferredsize then
if iffuncptr(onGetPreferredSize) then
begin
return class(tcontrol).GetPreferredSize(w,h);
end
@@ -2802,16 +2880,13 @@ type tcustomedit=class(TCustomControl)
inherited;
end
function doonmaxtext();
begin
if FOnMaxText then
CallMessgeFunction(FOnMaxText,self(true),new tuieventbase(0,0,0,0));
begin
CallMessgeFunction(FOnMaxText,self(true));
end
function DoChanged();
begin
if FOnChange then
CallMessgeFunction(FOnChange,self(true),new tuieventbase(0,0,0,0));
if FOnUpdate then
CallMessgeFunction(FOnUpdate,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(FOnChange,self(true));
CallMessgeFunction(FOnUpdate,self(true));
end
function FontChanged(sender);override;
begin
@@ -3479,6 +3554,16 @@ type TCustomListBoxbase=class(TCustomScrollControl)
begin
return FItemCount;
end
function GetPreferredSize(w,h);override;
begin
if csDesigning in ComponentState then
begin
w := 250;
h := 150;
return ;
end
return inherited;
end
published
property ItemCount read GetItemCount write SetItemCount;
property ItemHeight read GetYScrollDelta;
@@ -3530,6 +3615,15 @@ type tlistdrawevent = class(tuieventbase)
rec := r;
Canvas := c;
end
function expandinfo();override;
begin
r := array();
i := 0;
r[i++] := array("name":"canvas","alias":"cvs","type":"tcanvas");
r[i++] := array("name":"idx","alias":"idx","type":"integer");
r[i++] := array("name":"rec","alias":"ARect","type":"array of integer");
return r;
end
rec;
idx;
sel;
@@ -3707,7 +3801,7 @@ type TcustomListBox=class(TCustomListBoxbase)
end
function PaintIdexText(idx,rc,cvs);virtual;
begin
if fownerdraw and Fondrawlist then
if fownerdraw and iffuncptr( Fondrawlist) then
begin
e := new tlistdrawevent(idx,rc[4],rc,cvs);
CallMessgeFunction(Fondrawlist,self(true),e);
@@ -4263,7 +4357,7 @@ type TcustomListBox=class(TCustomListBoxbase)
end
function calllistselchengd();
begin
if FselectionChange then CallMessgeFunction(FselectionChange,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(FselectionChange,self(true));
end
private
fselbkcolor;
@@ -4316,7 +4410,7 @@ type TCustomComboBoxbase=class(TCustomControl)
function GetPreferredSize(w,h);override;
begin
class(tcontrol).GetPreferredSize(w,h);
if onGetPreferredSize then return ;
if iffuncptr(onGetPreferredSize) then return ;
bs := BoundsRect;
cs := ClientRect;
dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
@@ -4598,6 +4692,7 @@ type TcustomComboBox=class(TCustomComboBoxbase)
end
function DoControlAlign();override;
begin
if not FEdit then return ;
rc := ClientRect;
rc[2]-= 20;
FEdit.SetBoundsRect(rc);
@@ -5153,7 +5248,7 @@ type TcustomToolBar=class(TCustomControl)
begin
ft := Font;
if not ft then return ;
if ongetpreferredsize then return class(tcontrol).GetPreferredSize(w,h);
if iffuncptr(onGetPreferredSize) then return class(tcontrol).GetPreferredSize(w,h);
ftw := ft.Width;
fth := ft.Height;
brec := BoundsRect;
@@ -6019,7 +6114,7 @@ type TcustomStatusBar=class(TCustomControl)
function GetPreferredSize(w,h);override;
begin
class(tcontrol).GetPreferredSize(w,h);
if ongetpreferredsize then return ;
if iffuncptr(onGetPreferredSize) then return ;
bs := BoundsRect;
cs := ClientRect;
dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
@@ -6077,6 +6172,7 @@ type TcustomStatusBar=class(TCustomControl)
{**
@explan(说明) 设置多个项目 %%
**}
if Fitems=its then return ;
Fitems := array();
for i,v in its do
begin
@@ -6446,7 +6542,7 @@ type TCustomSpinEdit = class(TCustomControl)
function GetPreferredSize(w,h);override;
begin
class(tcontrol).GetPreferredSize(w,h);
if ongetpreferredsize then return ;
if iffuncptr(onGetPreferredSize) then return ;
ft := Font;
if not ft then return ;
h := ft.Height+4;
@@ -7026,7 +7122,7 @@ type tcustomipaddr = class(TCustomControl)
end
function DoIpChanged();
begin
return CallMessgeFunction(onAddrChange,self(true),new tuieventbase(0,0,0,0));
return CallMessgeFunction(FaddrChange,self(true));
end
function cleanAddr();
begin
@@ -7130,7 +7226,7 @@ type tcustomipaddr = class(TCustomControl)
begin
ft := Font;
if not ft then return ;
if ongetpreferredsize then
if iffuncptr(onGetPreferredSize) then
begin
return class(tcontrol).GetPreferredSize(w,h);
end
@@ -7676,9 +7772,8 @@ type tcustomtimepicker = class(tthreeEntry)
ti := strtointdef(t,0);
if ti<0 then p.text := "24";
else if ti>24 then p.text := "0";
end
if Fonselectchange then
calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0));
end
CallMessgeFunction(Fonselectchange,self(true));
end
end
end
@@ -7846,9 +7941,8 @@ type tcustomdatetimepicker = class(tthreeEntry)
ct := getmonthdates(y,m);
if d>ct then es[2].text := inttostr(ct);
end
end
if Fonselectchange then
calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0));
end
CallMessgeFunction(Fonselectchange,self(true)) ;
end
"dtadate":
begin
@@ -7860,18 +7954,15 @@ type tcustomdatetimepicker = class(tthreeEntry)
es[0].text := inttostr(y);
es[1].text := inttostr(m);
es[2].text := inttostr(d);
if Fonselectchange then
calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(Fonselectchange,self(true));
end else
begin
y := strtointdef(es[0].text,2021);
m := strtointdef(es[1].text,1);
d := strtointdef(es[2].text,1);
return array(y,m,d);
end
end
end
end
end
end
function ShowDropDown(f);virtual;
@@ -7985,8 +8076,7 @@ type tcustommonthcalendar = class(TCustomControl)
r := FCalender.ExecuteCommand("meselbypos",e.pos);
if std=3 or r="today" then
begin
if FonSelect then
CallMessgeFunction(FonSelect,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(FonSelect,self(true));
end
end
end
@@ -8034,8 +8124,7 @@ type tcustommonthcalendar = class(TCustomControl)
end
function DoDatechanged();
begin
if FonSelectChange then
CallMessgeFunction(FonSelectChange,self(true),new tuieventbase(0,0,0,0));
CallMessgeFunction(FonSelectChange,self(true));
end
function recycling();override;
begin
funcext/tvclib/utslvcltree.tsf
+80 -19
View File
@@ -114,8 +114,8 @@ type ttreelistwnd = class(TCustomScrollControl)
FItemHeight := font.height+2;
FxClientMax := fColWidth;
FItemMinWidth := FxClientMax;
height := 400;
width := 300;
height := 150;
width := 250;
border := true;
autoscroll := 3;
ThumbTrack := true;
@@ -453,6 +453,16 @@ type ttreelistwnd = class(TCustomScrollControl)
end
return r;
end
function GetPreferredSize(w,h);override;
begin
if csDesigning in ComponentState then
begin
w := 250;
h := 150;
return ;
end
return inherited;
end
published //属性
property Items read GetItems;
property ItemCount read GetItemCount;
@@ -574,23 +584,65 @@ type ttreelistwnd = class(TCustomScrollControl)
end
end
type TTreeSelCHngedEvent=class(tuieventbase)
type tm_nodeseling=class(tuieventbase)
{**
@explan(说明) 导航选择改变消息%%
@explan(说明) 节点选择正在改变%%
**}
function create(m,w,l,h);override;
function create(m,ito,itn,h);override;
begin
inherited;
ItemOld := ito;
ItemNew := itn;
item := itn;
end
function expandinfo();override;
begin
r := array();
i := 0;
r[i++] := array("name":"itemold","alias":"node","type":"tcustomtreectlnode");
r[i++] := array("name":"itemnew","alias":"nselnode","type":"tcustomtreectlnode");
r[i++] := array("name":"skip","alias":"stopchang","type":"bool","var":true);
return r;
end
ItemOld;
ItemNew;
Item;
end
type tm_nodeseled=class(tm_nodeseling)
{**
@explan(说明) 节点选择成功改变%%
**}
function create(m,ito,itn,h);override;
begin
ItemOld := ito;
ItemNew := itn;
item := itn;
end
function expandinfo();override;
begin
r := inherited;
r := r[0:length(r)-2];
return r;
end
ItemOld;
ItemNew;
Item;
Item;
end
type tm_nodechang = class(tuieventbase)
{**
@param(ItemOld)(TcustomTreeCtlNode) 旧的节点 %%
@param(ItemNew)(TcustomTreeCtlNode) 新节点 %%
@param(Item)(TcustomTreeCtlNode) 当前节点 %%
@explan(说明) 节点改变消息%%
**}
end
function create(m,w,l,h);
begin
Item := w;
end
function expandinfo();override;
begin
r := array();
r[0] := array("name":"Item","alias":"node","type":"tcustomtreectlnode");
return r;
end
Item;
end
type TcustomTreeCtlNode = class(tsluibase) //树结点
{**
@explan(说明) 树结点 %%
@@ -1617,10 +1669,7 @@ type TcustomTreeCtl = class(ttreelistwnd)
begin
if FonEmptyNodeExapanding then
begin
e := new TTreeSelCHngedEvent(0,0,0,0);
e.item := pm;
e.ItemNew := pm;
e.ItemOld := pm;
e := new tm_nodechang(0,pm,0,0);
CallMessgeFunction(FonEmptyNodeExapanding,self(true),e);
end
end
@@ -1832,6 +1881,16 @@ type TcustomTreeCtl = class(ttreelistwnd)
dc.pen.color := rgb(171,173,179);
dc.draw("polyline",ls);
end
function GetPreferredSize(w,h);override;
begin
if csDesigning in ComponentState then
begin
w := 100;
h := 125;
return ;
end
return inherited;
end
published //属性
property CurrentNode read FCurrentNode write setcurrentnode; //20221118 加上写
property selectionColor:color read FselectionColor write SetselectionColor;
@@ -1970,12 +2029,14 @@ type TcustomTreeCtl = class(ttreelistwnd)
t1 := FCurrentNode;
//if t1 then InvalidateItem(t1,false);
//InvalidateItem(it,false);
ne := new TTreeSelCHngedEvent(0,0,0,0);
ne.ItemOld := t1;
ne.ItemNew := it;
ne.Item := it;
//ne := new TTreeSelCHngedEvent(0,0,0,0);
//ne.ItemOld := t1;
//ne.ItemNew := it;
//ne.Item := it;
ne := new tm_nodeseling(nil,t1,it);
CallMessgeFunction(FOnSelChanging,self(true),ne);
if ne.Skip then return true;
ne := new tm_nodeseled(nil,t1,it);
FCurrentNode := it;
CallMessgeFunction(FOnSelChanged,self(true),ne);
end
funcext/tvclib/utvclgraphics.tsf
+181 -27
View File
@@ -207,7 +207,7 @@ app := initializeapplication();
app.createform(class(tfm),fm);
fm.show();
app.run();
type tfm = class(tvcform)
type tfm = class(tvcform,tg_const)
function create(aowner);
begin
inherited;
@@ -234,10 +234,10 @@ type tfm = class(tvcform)
line.lineinfo.color := 0xff0000;
line.markinfo.bkcolor := 0x00ff00;
line.markinfo.color := 0x0000ff;
line.mark_mode := "on";
line.mark_mode := tgc_on;
line.markinfo.size := 30;
line.markinfo.style := line.tgc_mks_pentagram;
line.polyline_style := line.tgc_LS_staircase;
line.markinfo.style := tgc_mks_pentagram;
line.polyline_style := tgc_LS_staircase;
d := array();
idx := 0;
for i:= -pi() to pi() step 0.2 do
@@ -256,7 +256,7 @@ app := initializeapplication();
app.createform(class(tfm),fm);
fm.show();
app.run();
type tfm = class(tvcform)
type tfm = class(tvcform,tg_const)
function create(aowner);
begin
inherited;
@@ -280,7 +280,7 @@ type tfm = class(tvcform)
axs.axises(1).lineinfo.color := 0x00ff00;
sf := new tg_my_surf();
sf.lineinfo.color := 0x0000ff;
sf.lineinfo.style := sf.tgc_BS_SOLID;
sf.lineinfo.style := tgc_BS_SOLID;
sf.graph_data := get_surf_data();
sf.parent := axs;
return ;
@@ -388,7 +388,7 @@ app := initializeapplication();
app.createform(class(tfm),fm);
fm.show();
app.run();
type tfm = class(tvcform)
type tfm = class(tvcform,tg_const)
function create(aowner);
begin
inherited;
@@ -402,7 +402,7 @@ type tfm = class(tvcform)
//////////设置坐标轴属性////////////////////////
axs := new tg_axes();
axs.box := true;
axs.figure := fg.figure;
axs.figure := fg;
axs.title.text := "hello pie ";
axs.axises(1).tics_color := 0x0000ff;
axs.axises(1).fontinfo.size := 8;
@@ -421,7 +421,7 @@ type tfm = class(tvcform)
for i,v in args do
begin
line := new tg_Polyline();
line.polyline_style := line.tgc_LS_filled;
line.polyline_style := tgc_LS_filled;
line.closed := true;
c := (i=2)?1.1:1;
line.graph_data := 1+get_pie_lines(v[0],v[1],i=prominentidx,prominentrate);
@@ -459,7 +459,7 @@ app := initializeapplication();
app.createform(class(tfm),fm);
fm.show();
app.run();
type tfm = class(tvcform)
type tfm = class(tvcform,tg_const)
function create(aowner);
begin
inherited;
@@ -504,7 +504,7 @@ type tfm = class(tvcform)
gtx.text := array("按住鼠标左键","移动我");
gtx.data := array(0.3,0.2);
//处理鼠标按下
gtx.addEventListener("mouse_down",function(e)begin
gtx.addEventListener(evt_mouse_down,function(e)begin
fdragtext := e.target;
ftextinitpos := fdragtext.data;
x := e.cvsx;y := e.cvsy;
@@ -512,7 +512,7 @@ type tfm = class(tvcform)
fmousedownpos := array(x1,y1);
end);
//移动标签
fg.addEventListener("mouse_move",function(e)begin
fg.addEventListener(evt_mouse_move,function(e)begin
if fdragtext then
begin
e.stoppropagation();
@@ -524,7 +524,7 @@ type tfm = class(tvcform)
end
end ,true);
//处理鼠标松开
fg.addEventListener("mouse_up",function(e)begin
fg.addEventListener(evt_mouse_up,function(e)begin
if fdragtext then
begin
e.stoppropagation();
@@ -548,12 +548,12 @@ type tfm = class(tvcform)
fhitidx := r;
return r>=0;
end
line.addEventListener("mouse_out",function(e)begin
line.addEventListener(evt_mouse_out,function(e)begin
if e.eventPhase<>2 then return ;
fmovetip.Visible := false;
e.stoppropagation();
end,true);
line.addEventListener("mouse_move",function(e)
line.addEventListener(evt_mouse_move,function(e)
begin
if e.eventPhase<>2 then return ;
e.stoppropagation();
@@ -638,18 +638,24 @@ end }
type tg_WinControl = class(tcustomcontrol,tg_figure_container) //绘图窗口
function create(AOwner);
begin
if not(s_flush_interval>9) then
begin
s_flush_interval := 150;
ftgwindows := array();
end
class(tcustomcontrol).create(AOwner);
width := 300;
height := 300;
class(tg_figure_container).create();
fg_timer := new unit(utslvclstdctl).tcustomtimer(self);
fg_timer.Interval := 300;
fg_timer.Interval := s_flush_interval;
fg_timer.Ontimer := thisfunction(figure_need_fresh);
ffigureprepared := false;
ffigure.rec_getter := function()begin
return clientrect;
end
ffigure.fresh_caller := thisfunction(flushfigure);
ftgwindows[length(ftgwindows)] := makeweakref(self(true));
end
function flushfigure();
begin
@@ -692,10 +698,35 @@ type tg_WinControl = class(tcustomcontrol,tg_figure_container) //
if ffigure then
begin
d := e_2_array(e,evt_mouse_down);
if ffigure.executecommand(evt_mouse_down,d)=1 then e.skip := true;
if ffigure.executecommand(evt_mouse_down,d)=1 then e.skip := true;
SetFocus();
end
//echo "\r\n",functionname(),tostn(array(xy,bt,sh));
end
function KeyDown(o,e);override;
begin
if ffigure then
begin
d := ek_2_array(e,evt_key_down);
if ffigure.executecommand(evt_key_down,d)=1 then e.skip := true;
end
end
function keyup(o,e);override;
begin
if ffigure then
begin
d := ek_2_array(e,evt_key_up);
if ffigure.executecommand(evt_key_up,d)=1 then e.skip := true;
end
end
function keypress(o,e);override;
begin
if ffigure then
begin
d := ek_2_array(e,evt_key_press);
if ffigure.executecommand(evt_key_press,d)=1 then e.skip := true;
end
end
function MouseMove(o,e);override;
begin
if ffigure then
@@ -729,16 +760,58 @@ type tg_WinControl = class(tcustomcontrol,tg_figure_container) //
function Recycling();override;
begin
ffigure:=nil;
for i := 0 to length(ftgwindows)-1 do
begin
if ftgwindows[i] =self then
begin
deleteindex(ftgwindows,i);
break;
end
end
inherited;
end
class function set_sys_flush_interal(itv); //设置所有窗口的刷新间隔
begin
if itv>9 and itv<>s_flush_interval then
begin
s_flush_interval := itv;
for i,v in ftgwindows do
begin
v.flash_interval := itv;
end
end
end
property flush_interval read get_interval write set_interval; //当前窗口的刷新间隔
private
function get_interval();
begin
return fg_timer.Interval;
end
function set_interval(itv);
begin
return fg_timer.Interval := itv;
end
function figure_need_fresh(o,e); //定时刷新
begin
o.stop();
if not ffigureprepared then return ; //没有准备好
if f_validate_doing then return;
InvalidateRect(nil,false);
InvalidateRect(nil,false);
end
function ek_2_array(e,tp);
begin
d := array();
st := e.shiftstate();
sft := 0x0 in st;
sctl := 0x2 in st;
d := array(
"type":tp,
"shift":sft,
"ctrl":sctl,
"key":e.char,
"keycode":e.CharCode,
);
return d;
end
function e_2_array(e,tp);
begin
@@ -757,6 +830,8 @@ type tg_WinControl = class(tcustomcontrol,tg_figure_container) //
return d;
end
private
static s_flush_interval;
static ftgwindows;
fmovecnt;
fg_timer;
f_validate_doing;
@@ -790,6 +865,18 @@ type tg_figure = class(tg_evet_conainter) //
function executecommand(cmd,p);
begin
case cmd of
evt_key_down:
begin
return cmd_key_event(evt_key_down,p);
end
evt_key_up:
begin
return cmd_key_event(evt_key_up,p);
end
evt_key_press:
begin
return cmd_key_event(evt_key_press,p);
end
"figure_need_fresh":
begin
fresh();
@@ -950,7 +1037,24 @@ type tg_figure = class(tg_evet_conainter) //
r[len-i] := v;
end
return r;
end
end
function cmd_key_event(evtname,p) ;
begin
if not fMouseOnOBJ then return ;
d := p;
d["istrusted"] := true;
d["bubbles"] := true;
onds := array();
nnd := fMouseOnOBJ;
while nnd do
begin
onds[length(onds)] := nnd;
nnd := nnd.parent;
end
evt := new tg_evt_key(evtname,d);
dispatchEvent(evt,onds);
return evt.stoppropagationed or evt.defaultPrevented; //是否停止
end
function cmd_mouse_event(evtname,p);
begin
d := p;
@@ -987,7 +1091,8 @@ type tg_figure = class(tg_evet_conainter) //
end
fMouseOnOBJ := ninnode;
evt := new tg_evt_mouse(evt_mouse_in,d); //处理mouse in
dispatchEvent(evt,nds);
dispatchEvent(evt,nds);
return true;
end
end else
begin
@@ -1176,6 +1281,7 @@ type tg_axes = class(tg_base) //
cvs.axesrec := r;
cvs.axesvector := get_top_outer_points();
//paint(cvs);
cvs.executecommand("painter",self(true));
paint_grid(cvs);
inherited;
cvs.axesunclip();
@@ -2351,7 +2457,11 @@ type tg_canvas = class(TcustomCanvas) //
ffigurergn.rect := fg.rect();
faxesrgntemp := new TRGNPOLY();//new TRGNRECT();
//ffigurergn.
end
end
function executecommand(cmd,p);override;
begin
if cmd ="painter" then fpainter := p;
end
function axesclip(); //裁剪坐标系范围
begin
if faxesrgn then
@@ -2386,6 +2496,23 @@ type tg_canvas = class(TcustomCanvas) //
property figure:tg_figure read ffigure; //绘制区域
property axesvector read faxesvector write set_clip_vector; //坐标系区域
property axesrec read FaxesRec write set_clip_rect; //坐标系矩形区域
property painter read fpainter;
////////////绘制相关//////////////////////////////////////////////
function tg_movto(x,y,z);//移动
begin
if not fpainter then return ;
if fpainter.zoom_to_xyz(x,y,z,x0,y0) then return moveto(x0,y0);
end
function tg_lineto(x,y,z);//画线
begin
if not fpainter then return ;
if fpainter.zoom_to_xyz(x,y,z,x0,y0) then return lineto(x0,y0);
end
function tg_trans(a,x,y,z);//旋转
begin
if not fpainter then return ;
if fpainter.zoom_to_xyz(x,y,z,x0,y0) then return trans(a,x0,y0);
end
private
FaxesRec;
faxesvector;
@@ -2395,6 +2522,7 @@ type tg_canvas = class(TcustomCanvas) //
faxesrgntemp;
ffigurerect;
[weakref]ffigure;
[weakref]fpainter;
private
function set_clip_rect(rec);
begin
@@ -3076,12 +3204,12 @@ type tg_text = class(tg_base)
if not zoom_to_xyz(fdata[0],fdata[1],fdata[2],x,y) then return ;
if clip_state=tgc_on or ((p:=parent) and p.clip_state=tgc_on) then
begin
bx := axes.zoom_box;
{bx := axes.zoom_box;
vj := fdata;
if vj[0]<bx[0,0] or vj[1]<bx[1,0] or vj[2]<bx[2,0] or vj[0]>bx[0,1] or vj[1]>bx[1,1] or vj[2]>bx[2,1] then
begin
return ;
end
end }
cvs.axesclip();
end
else cvs.axesunclip();
@@ -4393,7 +4521,8 @@ type tg_base = class(TNode,tg_evet_conainter) //
end
function paint_pre(cvs);virtual;
begin
begin
cvs.executecommand("painter",self(true));
paint(cvs);
lgns := array();
for i := 0 to NodeCount-1 do
@@ -4697,6 +4826,9 @@ type tg_const = class()
//static const tgc_out_lower_right = "out_lower_right";
//static const tgc_out_lower_left = "out_lower_left";
//////////////
static evt_key_down = "key_down";
static evt_key_up = "key_up";
static evt_key_press = "key_press";
static evt_mouse_down = "mouse_down";
static evt_mouse_wheel = "mouse_wheel";
static evt_mouse_move = "mouse_move";
@@ -4804,8 +4936,8 @@ type tg_evt_mouse = class(tg_evt_custom) //
fdouble := pms["double"];
fbutton := pms["button"];
fshift := pms["shift"];
fctl := pms["ctrl"];
fctl := pms["fdelta"];
fctrl := pms["ctrl"];
fdelta := pms["fdelta"];
end
end
property cvsx read fcvsx;
@@ -4825,6 +4957,28 @@ type tg_evt_mouse = class(tg_evt_custom) //
fctrl;
fbutton;
end
type tg_evt_key = class(tg_evt_custom) //key消息
function create(etyp,pms);
begin
inherited;
if ifarray(pms) then
begin
fshift := pms["shift"];
fctrl := pms["ctrl"];
fkey := pms["key"];
fkeycode := pms["keycode"];
end
end
property key read fkey;
property shift read fshift;
property ctrl read fctrl;
property keycode read fkeycode;
private
fshift;
fctrl;
fkey;
fkeycode;
end
implementation
///////////事件存储对象///////////////////////
funcext/tvclib/uvclthreadworker.tsf
+2 -1
View File
@@ -172,7 +172,7 @@ type t_worker_host = class(t_worker_base)
{**
@param(OnMessage)(function[TThreadWorker,data]) 消息回调 %%
@param(OnStart)(function[TThreadWorker]) 子线程启动 %%
@param(OnError)(function[TThreadWorker,d]) 子线程启动 %%
@param(OnError)(function[TThreadWorker,d]) 子线程运行错误%%
**}
function terminate();override;
begin
@@ -576,6 +576,7 @@ begin
end
function iffuncptr(fn);
begin
return datatype(fn) in array(7,37);
//return datatype(fn)=7;
return ifobj(fn);
end
funcext/tvclib/uvcpropertytypespersistence.tsf
+206 -156
View File
@@ -6,65 +6,39 @@ uses utslvclauxiliary;//,utslvclgdi;
**}
////////////tmf文件相关//////////////////////////////////////////////
/////////////tmf字符串解析///////////////////////
function RegComponentPropertyType(vc);
function RegComponentPropertyType(vc);
function GetComponentPropertyType(n);
type TTmfParserbase = class
{**
@explan(说明) 解析基类,提供基础类型,提供类型常量
目前使用的常量有 TT_NUM,TT_BIN,TT_STR,TT_SYM%%
**}
Static Fsok;
static TT_NUM;//数字
static TT_LLB;//大括号
static TT_RLB;//大括号
static TT_LSB; //(
static TT_RSB; //)
static TT_STR;//字符串
static TT_SYM;//符号
static TT_POI;//点 .
static TT_SIG;// : + - :< > =
static TT_BNK;//空白 \r \n \t
static TT_ITEM;
static TT_RMB;
static TT_LMB;
static TT_SET;
static TT_COLL;
static TT_LIST;
static TT_BIN;
static TT_BOOL;
static TT_IDENT;
static TT_HEX;
static TT_COMP;
static const TT_NUM = 1; //数字
static const TT_LLB = 2; //大括号
static const TT_RLB = 3; //大括号
static const TT_LSB = 4; //(
static const TT_RSB = 5; //)
static const TT_STR = 6; //字符串
static const TT_SYM = 7; //符号
static const TT_POI = 8; //点 .
static const TT_SIG = 9; // : + - :< > =
static const TT_BNK = 10; //空白 \r \n \t
static const TT_ITEM = 11;
static const TT_LMB = 12;
static const TT_RMB = 13;
static const TT_SET = 14;
static const TT_HASH = 15;
static const TT_COLL = 0x10;
static const TT_BIN = 0x11;
static const TT_BOOL = 0x12;
static const TT_LIST = 0x13;
static const TT_IDENT = 0x14;
static const TT_HEX = 0x15;
static const TT_COMP = 0x16;
public
class function sinit();virtual;
begin
if not Fsok then
begin
TT_NUM := 1; //数字
TT_LLB := 2; //大括号
TT_RLB := 3; //大括号
TT_LSB := 4; //(
TT_RSB := 5; //)
TT_STR := 6; //字符串
TT_SYM := 7; //符号
TT_POI := 8; //点 .
TT_SIG := 9; // : + - :< > =
TT_BNK := 10; //空白 \r \n \t
TT_ITEM := 11;
TT_LMB := 12;
TT_RMB := 13;
TT_SET := 14;
TT_HASH := 15;
TT_COLL := 0x10;
TT_BIN := 0x11;
TT_BOOL := 0x12;
TT_LIST := 0x13;
TT_IDENT := 0x14;
TT_HEX := 0x15;
TT_COMP := 0x16;
Fsok := true;
end
end
end
class function PError(msg,lev);
begin
//messagebox(msg,"解析错误",1);
@@ -73,7 +47,7 @@ type TTmfParserbase = class
begin
sinit();
end
end
type TTmfParserToken = class(TTmfParserbase)
{**
@@ -89,8 +63,6 @@ type TTmfParserToken = class(TTmfParserbase)
FTokens;
FSplitter; //分隔符
FSyms; //符号
FNumberChar;
FHexChar;
Function SetScript(S);//设置文本
begin
IF FScript <> S then
@@ -360,9 +332,6 @@ type TTmfParserToken = class(TTmfParserbase)
//Ffloat := FNumbers union array(".");
FSplitter := array(' ','\t',"\r","\n",";",",");
FSyms := array("=",":","(",")","<",">","[","]");
FNumberChar := inttostr(0 -> 9);
FHexChar := FNumberChar union array("a","b","c","d","e","f",
"A","B","C","D","E","F");
end
property Script read FScript write SetScript;
{**
@@ -511,26 +480,67 @@ type TTmfParser = class(TTmfParserbase)
end
function gettree2(); //获得继承关系树
begin
tx := mtic;
d := gettreeasobject();
if d then
begin
d.setinhertedpaths(fssourdirs);//设置路径
d.initinherited();
d.initinherited(); //解析继承的数据文件信息
d.addinode(d.finheritednode); //合并继承的信息
getnodelist(d,lst,dlist); //获取冲突的对象
for i,v in dlist do //删除冲突的成员
begin
try
v["p"].fobjects.deleteindex(v["n"]);
except
end;
end
return object2tree2(d);
end
end
function inheritedcoy(n,t,ht);
function getnodelist(d,lst,dlist); //获取排除对象列表,以及冲突的对象
begin
d := gettreeasobject();
if d then
begin
d.setinhertedpaths(fssourdirs);//设置路径
d.initinherited();
return d.inheritedstr(n,t,ht,0);
end
return "";
if not ifarray(lst) then lst := array();
if not ifarray(dlist) then dlist := array();
fos := d.fobjects;
for i,v in fos.IndexNames() do
begin
vd := fos[v];
if lst[v] then //父类中的优先级大于最新添加的,因为新加入的不能和原有的重名,如果积累中添加了,子类也应该被删掉
begin
if lst[v,"i"] and not(vd.ifinherited) then //删除当前这个
begin
dlist[length(dlist)] := array("p":d,"n":v);
end else
if vd.ifinherited and not(lst[v,"i"]) then //删除上一个
begin
dlist[length(dlist)] := lst[v,array("p","n")];
lst[v] := array("p":d,"nd":vd,"n":v,"i":vd.ifinherited,"ct":vd.inheritedcount);
end else
if not(vd.ifinherited) and not(lst[v,"i"]) then //删除当前
begin
dlist[length(dlist)] := array("p":d,"n":v);
end else
if vd.ifinherited<lst[v,"ct"] then //删除当前
begin
dlist[length(dlist)] := array("p":d,"n":v);
end else //删除上一个
begin
dlist[length(dlist)] := lst[v,array("p","n")];
lst[v] := array("p":d,"nd":vd,"n":v,"i":vd.ifinherited,"ct":vd.inheritedcount);
end
end else
begin
lst[v] := array("p":d,"nd":vd,"n":v,"i":vd.ifinherited,"ct":vd.inheritedcount);
end
getnodelist(vd,lst,dlist);
end
end
function inheritedcopy(n,t,ht); //构造继承的tfm文本
begin
return inheritedstr(n,t,ht);
end
function object2tree2(t); //获得继承关系
function object2tree2(t); //获得继承关系数组
begin
r := array();
r["inherited"] := t.ifinherited;
@@ -551,23 +561,21 @@ type TTmfParser = class(TTmfParserbase)
objs[v] := object2tree2(fos[v]);
end
r["property"] := ps;
r["object"] := objs;
r["object"] := objs;
return r;
end
function gettreeasobject();
function gettreeasobject();//当前tfm对象
begin
if ftreeobj then return ftreeobj;
gettree();
if FTree then
begin
//ttfmnode
ftreeobj := createndeobjects(FTree);
return ftreeobj;
end
return nil;
end
function createndeobjects(d);
function createndeobjects(d);//构造tfm对象树
begin
if ifarray(d) then
begin
@@ -661,7 +669,7 @@ type TTmfParser = class(TTmfParserbase)
end
end
end
function createobj();
function createobj(); //解析对象
begin
{**
@explan(说明) 获取对象 %%
@@ -672,13 +680,12 @@ type TTmfParser = class(TTmfParserbase)
if (tv="object" or tv="inherited") and(tt <> TT_STR) then
begin
r := getobject();
if tv="inherited" then
r["inherited"] := true;
r["inherited"] := (tv="inherited")?true:false;
return r;
end
end
end
function getobject();
function getobject();//解析对象内容
begin
{**
@explan(说明) 获得对象 %%
@@ -710,43 +717,46 @@ type TTmfParser = class(TTmfParserbase)
begin
ctoken(tv,tt);
lx := tt;
{if tv="item" and(tt <> TT_STR)then
if tt<>TT_STR then
begin
lx := TT_ITEM;
val := getabitem();
end else}
if tv="[" and(tt <> TT_STR)then
case tv of
"[":
begin
lx := TT_SET;
val := getset();
end
"<":
begin
val := getabitem(tv,fff); // getab();
if fff then lx := TT_COLL;
else lx := TT_ITEM; //TT_COLL;
end
"(":
begin
val := getsb();
lx := TT_LIST;
end
"{":
begin
val := getlb();
lx := TT_BIN;
end
"true":
begin
val := true;
lx := TT_NUM;
end
"false":
begin
val := false;
lx := TT_NUM;
end
else val := tv;
end ;
end else
begin
lx := TT_SET;
val := getset();
end else
if tv="<" and(tt <> TT_STR)then
begin
val := getabitem(tv,fff); // getab();
if fff then lx := TT_COLL;
else lx := TT_ITEM; //TT_COLL;
end else
if tv="(" and(tt <> TT_STR)then
begin
val := getsb();
lx := TT_LIST;
end else
if tv="{" and(tt <> TT_STR)then
begin
val := getlb();
lx := TT_BIN;
end else
if tv="true" and(tt <> TT_STR)then
begin
val := true;
lx := TT_NUM;
end else
if tv="false" and(tt <> TT_STR)then
begin
val := false;
lx := TT_NUM;
end else
val := tv;
val := tv;
end
end
function getmembers();
begin
@@ -821,7 +831,6 @@ type TTmfParser = class(TTmfParserbase)
begin
ctoken(tv,tt);
if tv="]" and tt <> TT_STR then return r;
//if tv="item" and tt <> TT_STR then r[rl++]:= array("value":getabitem(tv),"type":TT_ITEM);
else if tv="<" and tt <> TT_STR then
begin
v := getabitem(tv,fff);
@@ -835,7 +844,6 @@ type TTmfParser = class(TTmfParserbase)
function getabitem(tp,ifitem);
begin
if not ifstring(tp)then endtp := "end";
//else if tp="item" then endtp := "end";
else if tp="<" then endtp := ">";
else PError("dict错误",1);
r := array();
@@ -844,7 +852,7 @@ type TTmfParser = class(TTmfParserbase)
while whileok() do
begin
ctoken(tv,tt);
if tv=endtp {"end"}and tt <> TT_STR then return r;
if tv=endtp and tt <> TT_STR then return r;
p := tv;
ptt := tt;
ctoken(tv,tt);
@@ -854,13 +862,7 @@ type TTmfParser = class(TTmfParserbase)
if ifnil(val)or ifnil(lx)then PError("item无值",1);
r[rl++]:= array("name":p,"value":val,"type":lx);
end else
{if p="item" and ptt <> TT_STR and(length(r)<1)then
begin
ifitem := true;
btoken(2);
return getab();
end else}
PError("item没有=",1);
PError("item没有=",1);
end
end
function getab();
@@ -877,10 +879,6 @@ type TTmfParser = class(TTmfParserbase)
begin
return r;
end else
{if tv="item" and tt <> TT_STR then
begin
r[rl++]:= getabitem();
end else}
begin
return PError("<>内容错误",1);
end
@@ -905,8 +903,7 @@ type TTmfParser = class(TTmfParserbase)
begin
return r;
end else
{if tv="item" and tt <> TT_STR then r[rl++]:= array("value":getabitem(tv),"type":TT_ITEM);
else }if tv="<" and tt <> TT_STR then
if tv="<" and tt <> TT_STR then
begin
v := getabitem(tv,fff);
lx := fff?TT_COLL:TT_ITEM;
@@ -2275,11 +2272,67 @@ type ttfmnode = class()
end
function create(t,n);
begin
inheritedcount := 0;
fnodename := n;
fnodetype := t;
fpropertys := new tstrindexarray();
fobjects := new tstrindexarray();
finheritedpaths := array();
end
function addinode(nd);
begin
//if not nd then return ;
if nd and nd.finheritednode then nd.addinode(nd.finheritednode);
for i,v in fobjects.IndexNames() do
begin
ov := fobjects[v];
if ov.ifinherited then //继承的控件
begin
if ifobj(nd) then
begin
fd := nd.getnodebyname(v); //ov.fnodename
if fd then
begin
ov.inheritedcount++;
ov.finheritednode :=fd;
end else //不在继承源头,删除
begin
fobjects.deleteindex(v);
end
end else //不在继承源头,删除
begin
fobjects.deleteindex(v);
end
end else
begin
end
end
if nd then
begin
for i,v in nd.getnodenames() do //添加父窗口控件
begin
ov := fobjects[v];
nnd := nd.getnodebyname(v);
if not ov then
begin
fobjects[v] := nnd.copyinh(); //复制属性
end else ov.addinode(nnd); //添加属性
end
end
end
function copyinh();//继承拷贝
begin
r := new ttfmnode(fnodetype,fnodename);
for i,v in fobjects.IndexNames() do
begin
vv := fobjects[v];
vi := vv.copyinh();
r.addobject(vi);
end
r.finheritednode := self;
r.ifinherited := true;
return r;
end
function get_inherited(data);
begin
@@ -2290,9 +2343,10 @@ type ttfmnode = class()
begin
nd.setinhertedpaths(finheritedpaths);
nd.initinherited();
finheritednode := nd;
//addinheritednode(nd); 此处屏蔽
end
finheritednode := nd;
addinheritednode(nd);
end
function initinherited();
begin
@@ -2330,6 +2384,9 @@ type ttfmnode = class()
end
function addinheritednode(nd); //处理继承的节点
begin
///////////////查找空白/////////////////////////////////////
///////////////////////////////////////////////////////////////
for i,v in fobjects.IndexNames() do
begin
ov := fobjects[v];
@@ -2350,8 +2407,15 @@ type ttfmnode = class()
fobjects.deleteindex(v);
end
end
ov.addinheritednode(nd);
end
if fd then
ov.addinheritednode(fd);
end
end
function getnodenames();
begin
return fobjects.IndexNames();
end
function getnodebyname(sb);//获得节点
begin
@@ -2434,29 +2498,8 @@ type ttfmnode = class()
r[i] := fpropertys[v];
end
return r;
end
function inheritedstr(n,t,ht,h);
begin
if ifnil(n) then n := fnodename;
if ifnil(t) then t := fnodetype;
ws := "";
if not(h>=0) then h := 0;
for i:= 0 to h-1 do
begin
ws+=" ";
end
r := ws+"inherited "+n+":"+t;
if ht then r+="("+ht+")";
r+="\r\n";
for i,v in fobjects.IndexNames() do
begin
vo := fobjects[v];
r+=vo.inheritedstr(nil,nil,nil,h+1);
end
r+="\r\n";
r+=ws+"end\r\n";
return r;
end
end
inheritedcount;
ifinherited;
finheritedname;
finheritednode;
@@ -2464,10 +2507,17 @@ type ttfmnode = class()
fnodename;
fobjects;
private
fpropertys;
fpropertys;
finheritedpaths;
end
function inheritedstr(n,t,ht);
begin
r := "inherited "+n+":"+t;
if ht then r+="("+ht+")";
r+="\r\n";
r+="end\r\n";
return r;
end
function tablelines(str,n);
begin
lines := str2array(str,"\r\n");