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

更新界面库

Browse Source
This commit is contained in:
liujianjun
2026-01-06 16:43:22 +08:00
parent db909b5520
commit 91f0c75959
39 changed files with 2891 additions and 1670 deletions
Download Patch File Download Diff File Expand all files Collapse all files
funcext/tvclib/tcontrol.tsf
+35 -27
View File
@@ -115,7 +115,7 @@ type tcontrol = class(tcomponent)
end
if ifnil(Value)then
begin
if FActionLink then
if (FActionLink is class(TActionLink) ) then
begin
FActionLink.SetAction(nil);
end
@@ -124,7 +124,7 @@ type tcontrol = class(tcomponent)
if Value is class(TBasicAction)then
begin
includestate(FControlStyle,csActionClient);
if ifnil(FActionLink)then FActionLink := createobject(GetActionLinkClass(),self);
if not(FActionLink is class(TActionLink) )then FActionLink := createobject(GetActionLinkClass(),self);
FActionLink.Action := Value;
FActionLink.Onchange := thisfunction(DoActionChange);
ActionChange(Value,csLoading in Value.ComponentState);
@@ -145,7 +145,7 @@ type tcontrol = class(tcomponent)
begin
return FActionLink;
end
if FActionLink then
if FActionLink is class(TActionLink) then
begin
return FActionLink.Action;
end
@@ -298,7 +298,6 @@ type tcontrol = class(tcomponent)
@ignore 忽略 %%
@explan(说明) 绑定处理函数到消息id %%
**}
if not ifarray(FMessagehandle)then FMessagehandle := array();
if ifnumber(id)and (iffuncptr(func))then FMessagehandle[id]:= func;
end
private //事件绑定处理
@@ -335,6 +334,10 @@ type tcontrol = class(tcomponent)
if v["access"]in array(2,3)then continue;
fstring := v["functionname"];
if not ifstring(fstring)then continue;
vpms := v["parameter"];
if not ifarray(vpms) then continue;
lvpms := length(vpms);
if lvpms=1 then continue;
//f := findfunction(fstring,o);
returntype := v["returntype"];
try
@@ -664,14 +667,14 @@ type tcontrol = class(tcomponent)
end
end }
end
function MouseHover(o,e);virtual;
function MouseEnter(o,e);virtual;
begin
if not FMouseEntereded then
begin
DoMouseEnter(o,e);
FMouseEntereded := true;
end
end
end
function MouseLeave(o,e);virtual;
begin
if FMouseEntereded then
@@ -845,14 +848,7 @@ type tcontrol = class(tcomponent)
CallMessgeFunction(FOnMouseDown,o,e);
MouseDown(o,e);
end
function WMMOUSEHOVER(o,e):WM_MOUSEHOVER;virtual;
begin
MouseHover(o,e);
end
function WMMOUSELEAVE(o,e):WM_MOUSELEAVE;virtual;
begin
MouseLeave(o,e);
end
function WMMouseMove(o,e):LM_MOUSEMOVE;virtual;
begin
CallMessgeFunction(FOnMouseMove,o,e);
@@ -1073,8 +1069,24 @@ type tcontrol = class(tcomponent)
if SetTempCursor(cr)then e.skip := true;
end
end
function CMMouseEnter(o,e):CM_MOUSEENTER;virtual;
begin
MouseEnter(o,e);
end
function CMMouseLeave(o,e):CM_MOUSELEAVE;virtual;
begin
MouseLeave(o,e);
end
public //暂时不用的消息
{
function WMMOUSEHOVER(o,e):WM_MOUSEHOVER;virtual;
begin
MouseHover(o,e);
end
function WMMOUSELEAVE(o,e):WM_MOUSELEAVE;virtual;
begin
MouseLeave(o,e);
end
function WMWindowPosChanged(o,e):LM_WINDOWPOSCHANGED;virtual;
begin
end
@@ -1096,12 +1108,7 @@ type tcontrol = class(tcomponent)
function CMHitTest(o,e):CM_HITTEST;virtual;
begin
end
function CMMouseEnter(o,e):CM_MOUSEENTER;virtual;
begin
end
function CMMouseLeave(o,e):CM_MOUSELEAVE;virtual;
begin
end
function CMHintShow(o,e):CM_HINTSHOW;virtual;
begin
end
@@ -1199,6 +1206,7 @@ type tcontrol = class(tcomponent)
end
function create(aOwner);override; //构造函数
begin
FMessagehandle := array();
inherited;
fignore_childsizing := false;
FControlFlags := array();
@@ -1363,7 +1371,7 @@ type tcontrol = class(tcomponent)
@param(e)(tuieventbase) 消息类及其子类 %%
**}
id := e.Msg;
if ifnumber(id) and FMessagehandle then
if (id>0 or id<0) and FMessagehandle then
begin
func := FMessagehandle[id];
if func then call(func,o,e);
@@ -1622,8 +1630,8 @@ type tcontrol = class(tcomponent)
@param(OnPopupMenu)(function[TControl,TMMouse]) 弹出菜单回调函数 %%
@param(OnMouseDown)(function[TControl,TMMouse]) 鼠标按下回调函数 %%
@param(OnMouseUp)(function[TControl,TMMouse]) 鼠标松开回调函数 %%
@param(OnClick)(function[TControl,TMMouse]) 鼠标点击回调函数 %%
@param(OnDblClick)(function[TControl,TMMouse]) 鼠标双击回调函数 %%
@param(OnClick)(function[TControl]) 鼠标点击回调函数 %%
@param(OnDblClick)(function[TControl]) 鼠标双击回调函数 %%
@param(PopupMenu)(tpopupmenu) 弹出菜单%%
@param(Parent)(tcontrol) 父控件 %%
@param(Visible)(bool) 是否可见 %%
@@ -1660,16 +1668,16 @@ type tcontrol = class(tcomponent)
property ControlFlags read fControlFlags ;
property Color:color read getcolor write SetColor;//FColor;
property BKBitmap:tbitmap read FBKBitmap write SetBitmap;
//property OnMouseEnter:eventhandler read FOnMouseEnter write FOnMouseEnter;
//property OnMouseLeave:eventhandler read FOnMouseLeave write FOnMouseLeave;
property OnMouseEnter:eventhandler read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave:eventhandler read FOnMouseLeave write FOnMouseLeave;
property Controls read FControls;
property Canvas: TCanvas read FCanvas;
property ignore_childsizing read fignore_childsizing write fignore_childsizing; //忽略
{**
@param(Canvas)(TCanvas) 画布对象 %%
@param(Controls)(TFpList of tcontrol) 子组件 %%
@param(OnMouseLeave)(function[TControl,tuieventbase]) 鼠标离开回调 %%
@param(OnMouseEnter)(function[TControl,tuieventbase]) 鼠标进入回调 %%
@param(OnMouseLeave)(function[TControl]) 鼠标离开回调 %%
@param(OnMouseEnter)(function[TControl]) 鼠标进入回调 %%
@param(Color)(integer) 背景色 %%
**}
function isCustomPaint(); //提供给gtk使用
funcext/tvclib/tcustomcontrol.tsf
+90 -90
View File
@@ -90,104 +90,104 @@ type tcustomcontrol=class(TWinControl)
begin
return DoHScroll(o,e);
end
function WMLButtonDown(o,e);override;//拖拽释放
begin
if fhassplitter<1 then return inherited;
if csDesigning in ComponentState then exit;
case fcurspltype of
alLeft,alRight:
begin
drgidx := 1;
end
alTop,alBottom:
begin
drgidx := 0;
end
else
begin
return inherited;
end
end ;
if fsplitterwilldrag then
begin
cimgst();
fsplitterwilldrag := false;
fsplitterdraging := true;
nxy := clienttowindow(e.xpos,e.ypos);
_wapi.ImageList_BeginDrag(fsplitterdragimglist.Handle,drgidx,12,12);
_wapi.ImageList_DragEnter(self.Handle,nxy[0],nxy[1]);
crect := clientrect;
ps := array(clienttoscreen(crect[0],crect[1]),clienttoscreen(crect[2],crect[3]));
_wapi.clipcursor(ps);
splitterenabled(false);
return ;
end
//end
inherited;
end
function WMLBUTTONUP(o,e);override;//拖拽实现
begin
if fhassplitter<1 then return inherited;
if csDesigning in ComponentState then return ;
if fsplitterdraging then
begin
cimgst();
_wapi.ImageList_DragLeave(self.Handle);
_wapi.ImageList_EndDrag();
splitterenabled(true);
fsplitterwilldrag := true;
fsplitterdraging := false;
sizeprive(e.pos);
_wapi.clipcursor(0);
return ;
end
return inherited;
end
function WMMouseMove(o,e);override; //移动
function MainWndProc(hwnd,message,wparam,lparam);override;
begin
if fhassplitter<1 then return inherited;
if csDesigning in ComponentState then return inherited;
if fsplitterdraging then
begin
cimgst();
nxy := clienttowindow(e.xpos,e.ypos);
_wapi.ImageList_DragMove(nxy[0],nxy[1]);
return ;
end else
begin
xy := e.pos();
fcurspltype := nil;
fcursplitterid := -1;
fcursplitter := nil;
for i,v in Controls.data do
begin
if (v is class(tcustomsplitter)) and (v.Visible) and (v.enabled) and pointinrect(xy,v.BoundsRect) and (v<>fcursplitter) then //拖拽
case message of
WM_MOUSEMOVE: //移动
begin
e := new unit(utslvclevent).TMMouse(message,wparam,lparam,hwnd);
if fsplitterdraging then
begin
va := v.Align;
if va in array(alLeft,alRight) then
begin
cursor := OCR_SIZEWE;
fcurspltype := va;
fcursplitter := v;
fcursplitterid := i;
return ;
end else
if va in array(alTop,alBottom) then
cimgst();
nxy := clienttowindow(e.xpos,e.ypos);
_wapi.ImageList_DragMove(nxy[0],nxy[1]);
return ;
end else
begin
xy := e.pos();
fcurspltype := nil;
fcursplitterid := -1;
fcursplitter := nil;
for i,v in Controls.data do
begin
cursor := OCR_SIZENS;
fcurspltype := va;
fcursplitter := v;
fcursplitterid := i;
return ;
if (v is class(tcustomsplitter)) and (v.Visible) and (v.enabled) and pointinrect(xy,v.BoundsRect) and (v<>fcursplitter) and (v.Align in array(alLeft,alRight,alTop,alBottom)) then //拖拽
begin
va := v.Align;
if va in array(alLeft,alRight) then
begin
cursor := OCR_SIZEWE;
fcurspltype := va;
fcursplitter := v;
fcursplitterid := i;
return ;
end else
if va in array(alTop,alBottom) then
begin
cursor := OCR_SIZENS;
fcurspltype := va;
fcursplitter := v;
fcursplitterid := i;
return ;
end
end
end
end
cursor := OCR_NORMAL;
end
end
cursor := OCR_NORMAL;
WM_LBUTTONDOWN: //按下
begin
case fcurspltype of
alLeft,alRight:
begin
drgidx := 1;
end
alTop,alBottom:
begin
drgidx := 0;
end
else
begin
return inherited;
end
end ;
if fsplitterwilldrag then
begin
e := new unit(utslvclevent).TMMouse(message,wparam,lparam,hwnd);
cimgst();
fsplitterwilldrag := false;
fsplitterdraging := true;
nxy := clienttowindow(e.xpos,e.ypos);
_wapi.ImageList_BeginDrag(fsplitterdragimglist.Handle,drgidx,12,12);
_wapi.ImageList_DragEnter(self.Handle,nxy[0],nxy[1]);
crect := clientrect;
ps := array(clienttoscreen(crect[0],crect[1]),clienttoscreen(crect[2],crect[3]));
_wapi.clipcursor(ps);
splitterenabled(false);
return ;
end
end
WM_LBUTTONUP:
begin
if fsplitterdraging then
begin
e := new unit(utslvclevent).TMMouse(message,wparam,lparam,hwnd);
cimgst();
_wapi.ImageList_DragLeave(self.Handle);
_wapi.ImageList_EndDrag();
splitterenabled(true);
fsplitterwilldrag := true;
fsplitterdraging := false;
sizeprive(e.pos);
_wapi.clipcursor(0);
return ;
end
end
end
return inherited;
end
return inherited;
end
property OnPaint:eventhandler read FOnPaint write FOnPaint;
{**
@param(OnPaint)(function[TCustomControl,tuieventbase]) 窗口关闭消息回调 %%
funcext/tvclib/tcustomsplitter.tsf
+21 -4
View File
@@ -13,15 +13,22 @@ type tcustomsplitter = class(tgraphiccontrol)
function paint();override;
begin
//inherited;
p := parent;
if not p then return ;
r := ClientRect;
dc := Canvas;
if Border then
begin
dc.pen.color := 0;
dc.pen.Width := 2;
dc.draw("polygon",array(r[0:1],r[array(2,1)],r[array(2,3)],r[array(0,3)],r[0:1]));
dc.draw("polyline",array(r[0:1],r[array(2,1)],r[array(2,3)],r[array(0,3)],r[0:1]));
end
clr := 0x123232;
////////////点的颜色/////////////////////////
if TRANSPARENT then c := p.color;
else
c := color;
////////////////////////////
clr := sys_complementar_color(c);
x := integer(r[0]+(r[2]-r[0])/2);
y := integer(r[1]+(r[3]-r[1])/2);
sz := 4;
@@ -39,8 +46,18 @@ type tcustomsplitter = class(tgraphiccontrol)
end
end
end
function SetAlign(a);override;
private
function sys_complementar_color(c);
begin
uses utslvclauxiliary;
if (c .& 0xff000000) then
begin
return complementary_color( _wapi.GetSysColor(c .& 0x00ffffff));
end
return complementary_color(c);
end
{function SetAlign(a);override;
begin
inherited;
end
end }
end
funcext/tvclib/tslvcl.tsf
+24
View File
@@ -313,6 +313,11 @@ type tapplication=class(tcomponent)
fexitdolist.Push(f);
end
end
function DoBeforeMouseMessage(ctl);
begin
UpdateMouseControl(ctl);
end
published
property color read getcolor write setcolor;
property font read getfont write setfont;
property Visible read FVisible write SetVisible;
@@ -321,6 +326,25 @@ type tapplication=class(tcomponent)
property MainForm read Fmainform write SetMainForm;
private
fexitdolist;
[weakref]FMouseControl;//鼠标所在的控件
private
function UpdateMouseControl(ctl);
begin
if FMouseControl=ctl then return ;
if FMouseControl then
begin
FMouseControl.Perform(new tuieventbase(CM_MOUSELEAVE,0,0,0)); //
end
FMouseControl := ctl;
//////////////处理提示///////////////////
////////////////////////////////////
if FMouseControl then
begin
FMouseControl.Perform(new tuieventbase(CM_MOUSEENTER,0,0,0));
end
end
function exitloopdo();
begin
if fexitdolist then
funcext/tvclib/twincontrol.tsf
+101 -182
View File
@@ -27,7 +27,6 @@ type TWinControl = class(tcontrol)
FWMNCHITTEST;
FImageList;
fchildsizing;
//FTRACKMOUSEEVENT;
FHandle:HWND; //窗口句柄
private //窗口相关
FBorderStyle;
@@ -325,6 +324,23 @@ type TWinControl = class(tcontrol)
end
UpdateControlState();
end
function Hitcontrol(p);
begin
{**
@explan(说明) 命中自绘制控件 %%
**}
for i := ControlCount-1 downto 0 do
begin
it := Controls[i];
if it is class(TGraphicControl)then
begin
if it.Enabled and it.Visible and pointinrect(p,it.GetBoundsRect)then
begin
return it;
end
end
end
end
protected
function SetParentFont(v:bool);override;
begin
@@ -607,82 +623,43 @@ type TWinControl = class(tcontrol)
end }
end
end
function Hitcontrol(p);
begin
{**
@explan(说明) 命中控件 %%
**}
for i := ControlCount-1 downto 0 do
begin
it := Controls[i];
if it is class(TGraphicControl)then
begin
if it.Enabled and it.Visible and pointinrect(p,it.GetBoundsRect)then
begin
return it;
end
end
end
end
function MouseHover(O,e);override;
begin
inself := true;
initem := 0;
for i := ControlCount-1 downto 0 do
begin
it := FControls[i];
if(it is class(TGraphicControl))and it.visible then
begin
if inself and pointinrect(array(e.lolparamsigned,e.hilparamsigned),it.GetBoundsRect)and it.Enabled then
begin
initem := it;
inself := false;
end else
begin
it.Perform(messagecreater(nil,WM_MOUSELEAVE,0,0));
end
end
end
if inself then return inherited;
else self.Perform(messagecreater(nil,WM_MOUSELEAVE,0,0));
if initem then initem.Perform(messagecreater(nil,WM_MOUSEHOVER,0,0));
end
public //消息绑定函数
function WMMouseMove(o,e):LM_MOUSEMOVE;override;
begin
it := Hitcontrol(e.pos);
{it := Hitcontrol(e.pos);
if it then
begin
return it.WMMouseMove(it,new TMMouse(LM_MOUSEMOVE,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
//return it.Perform(new TMMouse(LM_MOUSEMOVE,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
end}
inherited;
end
function WMLButtonUp(o,e):LM_LBUTTONUP;override;
begin
it := Hitcontrol(e.pos);
{it := Hitcontrol(e.pos);
if it then
begin
return it.WMLButtonUp(it,new TMMouse(LM_LBUTTONUP,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
end}
inherited;
end
function WMRButtonUp(o,e):LM_RBUTTONUP;override;
begin
it := Hitcontrol(e.pos);
{it := Hitcontrol(e.pos);
if it then
begin
return it.WMRButtonUp(it,new TMMouse(LM_RBUTTONUP,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
end}
inherited;
end
function WMMButtonUp(o,e):LM_MBUTTONUP;override;
begin
it := Hitcontrol(e.pos);
{it := Hitcontrol(e.pos);
if it then
begin
return it.WMMButtonUp(it,new TMMouse(LM_MBUTTONUP,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
end}
inherited;
end
function WMContextMenu(o,e):LM_CONTEXTMENU;override;
@@ -701,39 +678,39 @@ type TWinControl = class(tcontrol)
end
function WMLButtonDown(o,e):LM_LBUTTONDOWN;override;
begin
it := Hitcontrol(e.pos);
{it := Hitcontrol(e.pos);
if it then
begin
return it.WMLButtonDown(it,new TMMouse(LM_LBUTTONDOWN,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
end}
inherited;
end
function WMRButtonDown(o,e):LM_RBUTTONDOWN;override;
begin
it := Hitcontrol(e.pos);
{it := Hitcontrol(e.pos);
if it then
begin
return it.WMRButtonDown(it,new TMMouse(LM_RBUTTONDOWN,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
//return it.Perform(new TMMouse(LM_MOUSEMOVE,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
end}
inherited;
end
function WMMButtonDown(o,e):LM_MBUTTONDOWN;override;
begin
it := Hitcontrol(e.pos);
{it := Hitcontrol(e.pos);
if it then
begin
return it.WMMButtonDown(it,new TMMouse(LM_MBUTTONDOWN,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
end}
inherited;
end
function WMLButtonDBLCLK(o,e):LM_LBUTTONDBLCLK;override;
begin
it := Hitcontrol(e.pos);
{it := Hitcontrol(e.pos);
if it then
begin
return it.WMLButtonDBLCLK(it,new TMMouse(LM_LBUTTONDBLCLK,e.wparam,makelong(e.xpos-it.left,e.ypos-it.top)));
end
end}
inherited;
end
public //设计器相关杂项
@@ -1040,10 +1017,7 @@ type TWinControl = class(tcontrol)
rc.right := rc.right - wd;
end
end
function WMMOUSEHOVER(o,e):WM_MOUSEHOVER;virtual;
begin
MouseHover(o,e);
end
function WMMOUSELEAVE(o,e):WM_MOUSELEAVE;virtual;
begin
MouseLeave(o,e);
@@ -1986,7 +1960,6 @@ type TWinControl = class(tcontrol)
FUpDateCount := 0;
FTabStop := false;
FBorderStyle := bsNone;
//FTRACKMOUSEEVENT := NEW TTRACKMOUSEEVENT();
FWsPopUp := false;
FWsSysMenu := false;
FWsCapton := false;
@@ -2202,12 +2175,6 @@ type TWinControl = class(tcontrol)
factivated := false;
if HandleAllocated()then
begin
{FTRACKMOUSEEVENT.hwndtrack := handle;
if OnMouseEnter or OnMouseLeave then
begin
FTRACKMOUSEEVENT.dwflags := TME_CANCEL .| TME_HOVER .| TME_LEAVE;
_wapi.TrackMouseEvent(FTRACKMOUSEEVENT._getptr_);
end }
bv := FVisible;
_wapi.DestroyWindow(self.Handle);
FVisible := bv;
@@ -2347,8 +2314,31 @@ type TWinControl = class(tcontrol)
@explan(说明)窗口主循环 %%
**}
//if message=0x85 and not( WsCaption or border or WsDlgModalFrame) then return ;
e := messagecreater(hwnd,message,wparam,lparam);
e.sender := self(true);
if message=WM_NCMOUSEMOVE then
begin
app := class(tUIglobalData).uigetdata("tuiapplication");
if app then app.DoBeforeMouseMessage(nil);
end
e := messagecreater(hwnd,message,wparam,lparam);
e.sender := self(true);
case message of
LM_MOUSEFIRST to LM_MOUSELAST,
LM_MOUSEFIRST2 to LM_RBUTTONQUADCLK,
LM_XBUTTONTRIPLECLK to LM_MOUSELAST2 :
begin
ht := Hitcontrol(e.pos);
app := class(tUIglobalData).uigetdata("tuiapplication");
if app then app.DoBeforeMouseMessage(ht?:self(true));
msgs := array(LM_LBUTTONDBLCLK:1,LM_MBUTTONDOWN:1,LM_MOUSEMOVE:1,LM_LBUTTONUP:1
,LM_RBUTTONUP:1,LM_MBUTTONUP:1,LM_LBUTTONDOWN:1,LM_RBUTTONDOWN:1);
if ht and msgs[message] then
begin
ee := new TMMouse(message,e.wparam,makelong(e.xpos-ht.left,e.ypos-ht.top));
ht.dispatch(ht,ee);
return defaulthandler(e);
end ;
end
end;
if message = WM_SYSKEYDOWN or message = WM_KEYDOWN then //快捷键实现
begin
WndProc(const e);
@@ -2435,13 +2425,6 @@ type TWinControl = class(tcontrol)
//if message = WM_MOUSEMOVE then
if message=WM_NCHITTEST then //
begin
{if OnMouseEnter or OnMouseLeave then
begin
FTRACKMOUSEEVENT.hwndtrack := hwnd;
FTRACKMOUSEEVENT.dwflags := TME_HOVER .| TME_LEAVE;
FTRACKMOUSEEVENT.dwhovertime := 600;
_wapi.TrackMouseEvent(FTRACKMOUSEEVENT._getptr_);
end }
end else
if message=WM_STYLECHANGED then
begin
@@ -2453,52 +2436,11 @@ type TWinControl = class(tcontrol)
__wstyle := e.stylenew;
end
end
(**else
if message = WM_NCCALCSIZE then
begin
if e.wparam=1 then
begin
dt := new tNCCALCSIZE_PARAMS(e.lparam)._getvalue_("rgrc");
if dt[0]=-32000 then
begin
//echo "\r\n隐藏到工具栏";
end
else if dt[4] = -32000 then
begin
//echo "\r\n从工具栏弹出";
end
else
begin
//rect1 := dt[0:3];
//rect2 := dt[4:7];
//rect3 := dt[8:];
{dx := dt[2]-dt[0]-(dt[6]-dt[4]);
dy := dt[3]-dt[1]-(dt[7]-dt[5]);
__clientsize := array(dt[10]-dt[8]+dx,dt[11]-dt[9]+dy);
x := __clientsize[0];
dxsize := x-FClientWdith;
if FClientWdith<> x then FClientWdith := x;
y := __clientsize[1];
dysize := y-FClientHeight;
if FClientHeight <> y then FClientHeight := y;
DoControlAnchor(array(dxsize,dysize));
DoControlAlign(array(0,0,x,y));}
//__oldclientsize := array(dt[10]-dt[8],dt[11]-dt[9]);
end
end
else
begin
//echo "\r\n++++calc:",caption,tostn(new tcrect(e.lparam)._getdata_);
end
//echo "\r\ncalcsize:",o.caption,"****",e.wparam;
//echo "\r\nleft:", new tcrect(e.lparam).left;
end
**)
WndProc(const e);
if not(e.skip)then
begin
ret := defaulthandler(e);
if ifnil(e.Result) then ret := defaulthandler(e);
else ret := e.Result;
end else
begin
{$ifdef linuxgtk}
@@ -2552,10 +2494,6 @@ type TWinControl = class(tcontrol)
begin
e.Result := hit;
e.skip := true;
{if (csDesigning in ComponentState) then
begin
if al <> alNone then _send_(WM_USER,1644,1644,1);
end}
end
end
end
@@ -2566,64 +2504,44 @@ type TWinControl = class(tcontrol)
procedure WndProc(e);override; //type_twinctrol
begin
//WM_NCHITTEST
msg := e.msg;
if (csDesigning in ComponentState) then
begin
msg := e.msg;
if msg = WM_NCHITTEST then
begin
r := FWMNCHITTEST.hitstyle(self(true),e);
if r<>HTCLIENT then
begin
HitWindowborder(self(true),e,r);
end else
begin
return e.Result := Wnddefaulthandler(e);
end
end else
if msg= WM_LBUTTONDOWN then
begin
if not(WsCaption) and DesigningMove() and (Align=alNone) then
begin
_Send_(WM_NCLBUTTONDOWN,HTCAPTION,0,0);
e.skip := true;
end
CallMessgeFunction(FOnDesinedsel,self(true),e);
//保留原有的点击消息
{if DesigningClick() then
case msg of
WM_NCHITTEST:
begin
CallMessgeFunction(FOnMouseUp,self(true),e);
end }
end else
if msg = WM_LBUTTONDBLCLK then
begin
CallMessgeFunction(FOnDesigDBLClick,self(true),e);
end else
if msg = WM_RBUTTONDOWN then
begin
CallMessgeFunction(FOnDesinedRclick,self(true),e);
end else
if msg = WM_USER then
begin
if e.wparam=1644 and e.lparam=1644 then
begin
//Align=alNone;
{al := Align;
if al in array(alLeft,alRight,alTop,alBottom) then
r := FWMNCHITTEST.hitstyle(self(true),e);
if r<>HTCLIENT then
begin
bs := UnAlignBounds;
bs2 := BoundsRect;
if bs <> bs2 then
begin
Align := alNone;
Align := al;
end
end
}
end
end
HitWindowborder(self(true),e,r);
end else
begin
return e.Result := Wnddefaulthandler(e);
end
end
WM_LBUTTONDOWN:
begin
if not(WsCaption) and DesigningMove() and (Align=alNone) then
begin
_Send_(WM_NCLBUTTONDOWN,HTCAPTION,0,0);
e.skip := true;
end
CallMessgeFunction(FOnDesinedsel,self(true),e);
//保留原有的点击消息
{if DesigningClick() then
begin
CallMessgeFunction(FOnMouseUp,self(true),e);
end }
end
WM_LBUTTONDBLCLK:
begin
CallMessgeFunction(FOnDesigDBLClick,self(true),e);
end
WM_RBUTTONDOWN:
begin
CallMessgeFunction(FOnDesinedRclick,self(true),e);
end
end
end
inherited;
end;
@@ -2867,13 +2785,14 @@ type TWinControl = class(tcontrol)
it := Controls[I];
if it then
begin
it.WindowProc(e);
if e.skip then Exit;
if not ifnil(e.Result)then Exit;
it.WndProc(e);
//if e.skip then Exit;
//if not(ifnil(e.Result) or (e.Result =0))then Exit;
if e.Result then Exit;
end
end;
end;
procedure NotifyControls(Msg); //type_twinctrol
procedure NotifyControls(Msg:Integer); //type_twinctrol
begin
ToAllMessage := new tuieventbase(msg,0,0,0);
Broadcast(ToAllMessage);
funcext/tvclib/ugtkinterface.tsf
+27 -2
View File
@@ -178,6 +178,10 @@ type tsgtkapi = class(tgtkapis)
function MessageBoxA(hwnd :pointer;txt:string;cap:string;flag:integer);
begin
return gtk_MessageBoxA(hwnd,txt,cap,flag);
end
function IsIconic(); //×îС»¯
begin
end
function IsWindow(h);
begin
@@ -1164,6 +1168,11 @@ type tsgtkapi = class(tgtkapis)
if not dc then return ;
if ifnumber(x) and ifnumber(y) then
begin
cairo_rectangle(dc,x-0.5,y-0.5,1,1);
gtk_rgb_color_rgb(colr,r,g,b);
cairo_set_source_rgb(dc,r,g,b);
cairo_fill(dc);
return 1;
pc := colr;
MoveToEx(dc,x,y);
pc := gtk_object_get_data(dc,"pen.color");
@@ -5854,6 +5863,17 @@ fi
return ##_f_(f);
end
procedure gtk_widget_show_all(window:pointer);
begin
_f_ := static procedure(window:pointer);cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(window);
end
function gtk_window_is_maximized(window:pointer):integer;
begin
_f_ := static function(window:pointer):integer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(window);
end
procedure gtk_window_unmaximize(window:pointer);
begin
_f_ := static procedure(window:pointer);cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(window);
@@ -7863,7 +7883,12 @@ type tgtk_ctl_object = class(_gtkeventtype)
end
end
end
case mn of
case mn of
GS_LEAVE_NOTIFY_EVENT: //À뿪
begin
id := a.handle;
AddMessageToGtkMessageQueue(id,_const.WM_NCMOUSEMOVE,0,0);
end
GS_ENTER_NOTIFY_EVENT:
begin
fwindow_cursor := 0;
@@ -7926,7 +7951,7 @@ type tgtk_ctl_object = class(_gtkeventtype)
function GtkBaseEventName();virtual; //°ó¶¨µÄÏûÏ¢
begin
//return array("destroy","map","button-press-event","motion-notify-event","button-release-event","key-press-event","key-release-event","event"); //,"set-focus-child"
return array(GS_DESTROY,GS_BUTTON_PRESS_EVENT,GS_MOTION_NOTIFY_EVENT,GS_BUTTON_RELEASE_EVENT,GS_KEY_PRESS_EVENT,GS_KEY_RELEASE_EVENT,GS_FOCUS_IN_EVENT,GS_FOCUS_OUT_EVENT,GS_WINDOW_STATE_EVENT,GS_EVENT,GS_ENTER_NOTIFY_EVENT); //,"set-focus-child"
return array(GS_DESTROY,GS_BUTTON_PRESS_EVENT,GS_MOTION_NOTIFY_EVENT,GS_BUTTON_RELEASE_EVENT,GS_KEY_PRESS_EVENT,GS_KEY_RELEASE_EVENT,GS_FOCUS_IN_EVENT,GS_FOCUS_OUT_EVENT,GS_WINDOW_STATE_EVENT,GS_EVENT,GS_ENTER_NOTIFY_EVENT,GS_LEAVE_NOTIFY_EVENT); //,"set-focus-child"
end
function CreateWnd(dwExStyle,lpClassName,lpWindowName,dwStyle,x,y,nwidth,nheight,hwndparent,hmenu,hinstance,lpParam);virtual; //¹¹Ôì´°¿Ú
begin
funcext/tvclib/utslmemo.tsf
+21 -3
View File
@@ -3149,6 +3149,9 @@ type tcustomsynhighlighter = class(TSynHighLighter)
function create(AOwner);
begin
inherited;
fkeywords := array();
fsysfuncs := array();
fsymbols := array();
fsymcolor := 0xa000a0;
fnumbercolor := 0x666666;
fkeywordcolor := 0x0000ff;
@@ -3330,6 +3333,7 @@ type tcustomsynhighlighter = class(TSynHighLighter)
end
inherited;
end
published
property keywordcolor:color read fkeywordcolor write fkeywordcolor;
property sysfuncolor:color read fsysfuncolor write fsysfuncolor;
property stringcolor:color read fstringcolor write fstringcolor;
@@ -3337,6 +3341,9 @@ type tcustomsynhighlighter = class(TSynHighLighter)
property symcolor:color read fsymcolor write fsymcolor;
property numbercolor:color read fnumbercolor write fnumbercolor;
property ignorecase:bool read fignorecase write setignorecase;
property keywords:strings read fkeywords write setkeyword;
property sysfuncs:strings read fsysfuncs write setsysfun;
property symbols:strings read fsymbols write setsyms;
private
function setignorecase(i);
begin
@@ -3528,9 +3535,14 @@ type tcustomsynhighlighter = class(TSynHighLighter)
function setkeyword(ws); //设置关键字
begin
st := new TTire();
fkeywords := array();
for i,v in ws do
begin
if v and ifstring(v) then st.add(v);
if v and ifstring(v) then
begin
st.add(v);
fkeywords[length(fkeywords)] := v;
end
end
fkeystires := array(st);
end
@@ -3575,12 +3587,14 @@ type tcustomsynhighlighter = class(TSynHighLighter)
begin
st := new TTire();
fsysfuntires := array(st);
fsysfuncs := array();
if not ifarray(d) then return ;
for i,v in d do
begin
if ifstring(v) and v then
begin
st.add(v);
fsysfuncs[length(fsysfuncs)] := v;
end
end
end
@@ -3588,11 +3602,13 @@ type tcustomsynhighlighter = class(TSynHighLighter)
begin
st := new TTire();
fsymstires := array(st);
fsymbols := array();
for i,v in d do
begin
if ifstring(v) and v then
begin
st.add(v);
fsymbols[length(fsymbols)] := v;
end
end
end
@@ -3716,8 +3732,10 @@ type tcustomsynhighlighter = class(TSynHighLighter)
FSates; //当前状态
FTokens;
fdolastline; //已经处理到行
////////////////////////////////////
fkeywords; //关键字
fsysfuncs; //系统函数
fsymbols; //符号
///////tire树/////////////
fkeystires;
fstrstires;
funcext/tvclib/utslvclaction.tsf
+22 -3
View File
@@ -32,7 +32,7 @@ type TBasicAction=class(TComponent)
{**
@param(FClients)( TFpList of TActionLink) 关联的组件 %%
**}
procedure Change;virtual;
procedure Change();virtual;
begin
if iffuncptr(FOnChange) then call(FOnChange,self);
end
@@ -155,6 +155,7 @@ type TCustomAction=class(TContainedAction)
@explan(说明) action类 %%
**}
private
fimageid:Integer;
FCaption:string;
FChecked:Boolean;
FChecking:Boolean;
@@ -199,6 +200,15 @@ type TCustomAction=class(TContainedAction)
FVisible := nValue;
Change();
end
procedure Setimageid(Value:Integer);
begin
if not ifnumber(Value) then return ;
nValue := Integer(Value);
if nValue=fimageid then exit;
for I := 0 to FClients.Count-1 do FClients[I].setimageid(nValue);
fimageid := nValue;
Change();
end
function getShortCut();
begin
return formatshortcut(FShortCut);
@@ -230,7 +240,7 @@ type TCustomAction=class(TContainedAction)
if Dest=Self then exit;
if Dest is class(TCustomAction)then
begin
ps := array("checked","caption","visible","enabled","shortcut");
ps := array("checked","caption","visible","enabled","shortcut","imageid");
for i,v in ps do invoke(Dest,v,1,invoke(self,v));
end else
inherited;
@@ -242,6 +252,7 @@ type TCustomAction=class(TContainedAction)
@explan(说明) 构造 %%
**}
inherited;
fimageid := -1;
FEnabled := True;
FVisible := True;
end
@@ -275,6 +286,7 @@ type TCustomAction=class(TContainedAction)
property Checked:bool read FChecked write SetChecked;
property Enabled:bool read FEnabled write SetEnabled;
property Visible:bool read FVisible write SetVisible;
property imageid:Integer read fimageid write setimageid;
property ShortCut:string read getshortcut write SetShortCut;
end;
type TCustomactionlist=class(TComponent)
@@ -350,7 +362,7 @@ type TBasicActionLink=class(TSLUIBASE)
procedure AssignClient(AClient:TObject);virtual;
begin
end
procedure Change;virtual;
procedure Change();virtual;
begin
if iffuncptr(FOnChange) then call(OnChange,FAction);
end
@@ -432,6 +444,9 @@ type TActionLink=class(TBasicActionLink)
procedure SetVisible(Value:Boolean);virtual;
begin
end
procedure setimageid(value:Integer);virtual;
begin
end
function create(AClient);override;
begin
inherited;
@@ -461,6 +476,10 @@ type TActionLink=class(TBasicActionLink)
begin
return Action is CLASS(TCustomAction);
end
function IsImageIndexLinked():Boolean;virtual;
begin
return false;
end
end;
type TControlActionLink=class(TActionLink)
funcext/tvclib/utslvclauxiliary.tsf
+18 -22
View File
@@ -1815,7 +1815,7 @@ type TNode = class() //
end
function node_insert_check(it);virtual;
begin
return (it is class(TNode))and(not it.Parent);
return (it is class(TNode))and(not it.Parent) and ckchild(it);
end
function Expand();virtual; //展开
begin
@@ -1904,6 +1904,16 @@ type TNode = class() //
FCurrentDeleteNode;
FCurrentAddNode;
FExpanded;
function ckchild(c); //检查子节点
begin
sf := self(true);
while sf do
begin
if sf=c then return false;
sf := sf.Parent;
end
return true;
end
function SetExpand(v);virtual; //已经展开
begin
if v then Expanded();
@@ -3450,9 +3460,8 @@ end;
//////////////////////////////////////
function iffuncptr(fn);
begin
return datatype(fn) in array(7,37);
//return datatype(fn)=7;
//return fn and ifobj(fn);
dt := datatype(fn);
return ((dt=7) or (dt=37));
end
function includestate(u,s);
begin
@@ -3776,18 +3785,6 @@ begin
end else
return tostn(d);
end
function DeleteItemsByIndexs(r,dxs);
begin
{**
@explan(说明) 删除数组下标, %%
@param(r)(array) 待删除下标的数组,采用字符串下标的数组,变参返回%%;
**}
if not ifarray(r)then exit;
rdx := array();
for i,v in dxs do rdx[v]:= nil;
return reindex(r,rdx);
end
function HexHash();
begin
c := array("A","B","C","D","E","F");
@@ -4362,7 +4359,7 @@ begin
len := length(data);
while (i <= len) do
begin
ordi := ord(data[i]);
ordi := ord(data[i]);
if (ordi <= 0x7f) then
begin
//编码小于等于127,只有一个字节的编码，兼容ASCII
@@ -4370,13 +4367,12 @@ begin
continue;
end else
begin
if i>=len then return false; //加入判断避免越界
ordi2 := ord(data[i + 1]);
//大于127的使用双字节编码
if (ordi >= 0x81 and
ordi <= 0xfe and
ordi2 >= 0x40 and
ordi2 <= 0xfe and
ordi2 <> 0x7f) then
if ( ordi >= 0x81 and ordi <= 0xfe) and
(ordi2 >= 0x40 and ordi2 <= 0xfe) and
(ordi2 <> 0x7f) then
begin
i += 2;
continue;
funcext/tvclib/utslvclbase.tsf
+2 -1
View File
@@ -49,7 +49,8 @@ uses uwindowsinterface;
mh := MonitorFromRect(r1,2);
info := new TMONITORINFO();
GetMonitorInfoA(mh,info._getptr_);
return info.rcmonitor;
//return info.rcmonitor;
return info.rcwork;
end
rc := new tcrect();
SystemParametersInfoA(0x30,0,rc._getptr_(),0);
funcext/tvclib/utslvclmenu.tsf
+7 -2
View File
@@ -358,6 +358,11 @@ private
protected
function SetAction(Value);virtual;
begin
if csDesigning in ComponentState then
begin
FActionLink := Value;
return;
end
if ifnil(Value)then
begin
if FActionLink then
@@ -369,7 +374,7 @@ private
if Value is class(TBasicAction)then
begin
includestate(FControlStyle,csActionClient);
if ifnil(FActionLink)then FActionLink := createobject(GetActionLinkClass(),self);
if not(FActionLink is class(TActionLink) ) then FActionLink := createobject(GetActionLinkClass(),self);
FActionLink.Action := Value;
FActionLink.Onchange := thisfunction(DoActionChange);
ActionChange(Value,csLoading in Value.ComponentState);
@@ -382,7 +387,7 @@ private
end
function GetAction();virtual;
begin
if FActionLink then
if FActionLink is class(TActionLink) then
begin
return FActionLink.Action;
end
funcext/tvclib/utslvclpage.tsf
+4 -3
View File
@@ -22,7 +22,8 @@ type tcustomtabsheet = class(TCustomControl) //
public
function AdjustSize();override;
begin
class(tcontrol).AdjustSize();
//class(tcontrol).AdjustSize();
inherited;
end
function paint();override; //设计器模式下绘制网格
begin
@@ -817,8 +818,8 @@ type tcustompagecontrol = class(tcustomtabcontrol)
h := height;
return ;
end
w := 100;
h := 100;
w := 25;
h := 25;
for i:= 0 to len-1 do
begin
FTabItems[i].PageSheet.GetPreferredSize(wi,hi);
funcext/tvclib/utslvclstdctl.tsf
+35 -15
View File
@@ -3780,7 +3780,7 @@ type TcustomListBox=class(TCustomListBoxbase)
nh := min(h,16);
nnh := integer((h-nh)/2);
rc2 := array(rc[0]+2,rc[1]+nnh,rc[0]+nh+2,rc[3]-nnh);
if fcheckbox=2 then
if FMultisel=0 then
begin
cvs.Draw("framecontrol",array(rc2[0:1],rc2[2:3]),DFC_BUTTON,DFCS_BUTTONRADIO);
if r then
@@ -5139,9 +5139,14 @@ type TcustomToolButton=class(tcomponent)
protected //action
function SetAction(Value);virtual;
begin
if csDesigning in ComponentState then
begin
FActionLink := Value;
return;
end
if ifnil(Value)then
begin
if FActionLink then
if FActionLink is class(TActionLink) then
begin
FActionLink.SetAction(nil);
end
@@ -5150,7 +5155,7 @@ type TcustomToolButton=class(tcomponent)
if Value is class(TBasicAction)then
begin
includestate(FControlStyle,csActionClient);
if ifnil(FActionLink)then FActionLink := createobject(GetActionLinkClass(),self);
if not(FActionLink is class(TActionLink) ) then FActionLink := createobject(GetActionLinkClass(),self);
FActionLink.Action := Value;
FActionLink.Onchange := thisfunction(DoActionChange);
ActionChange(Value,csLoading in Value.ComponentState);
@@ -5163,7 +5168,7 @@ type TcustomToolButton=class(tcomponent)
end
function GetAction();virtual;
begin
if FActionLink then
if FActionLink is class(TActionLink) then
begin
return FActionLink.Action;
end
@@ -5184,6 +5189,7 @@ type TcustomToolButton=class(tcomponent)
if(not CheckDefaults)or(Caption='')or(Caption=Name)then Caption := NewAction.Caption;
if(not CheckDefaults)then ShortCut := NewAction.ShortCut;
if(not CheckDefaults)or Enabled then Enabled := NewAction.Enabled;
if(not CheckDefaults) then imageid := NewAction.imageid;
//if not CheckDefaults or FChecked then Checked := NewAction.Checked;
end;
end
@@ -5471,7 +5477,11 @@ type TcustomToolBar=class(TCustomControl)
FButtons.swap(i,i+1);
end
end
if Btn.Visible then InvalidateRect(nil,false);
if Btn.Visible then
begin
CalcButtonsRect();
InvalidateRect(nil,false);
end
return cidx;
end
function InsertButton(btn,idx);
@@ -5496,10 +5506,11 @@ type TcustomToolBar=class(TCustomControl)
if nidx >= 0 then SetBtnIndex(btn,nidx);
if btn.Visible then
begin
IncPaintLock();
CalcButtonsRect();
//IncPaintLock();
InvalidateRect(nil,false);
FWillModifyToolbar := true;
DecPaintLock();
//DecPaintLock();
end
end
function DeleteButton(btn); //删除按钮
@@ -5518,10 +5529,11 @@ type TcustomToolBar=class(TCustomControl)
FButtons.splice(idx,1);
if btn.Visible then
begin
IncPaintLock();
CalcButtonsRect();
//IncPaintLock();
InvalidateRect(nil,false);
FWillModifyToolbar := true;
DecPaintLock();
//DecPaintLock();
end
end
function GetItemRect(btn); //获得按钮区域
@@ -6113,12 +6125,12 @@ type TcustomStatusBar=class(TCustomControl)
end
function GetPreferredSize(w,h);override;
begin
class(tcontrol).GetPreferredSize(w,h);
if iffuncptr(onGetPreferredSize) then return ;
bs := BoundsRect;
cs := ClientRect;
dh := (bs[3]-bs[1])-(cs[3]-cs[1])+2;
h+=dh;
if ControlCount>0 then class(TWinControl).GetPreferredSize(w,h);
if iffuncptr(onGetPreferredSize) then return inherited;
ft := Font;
if not ft then return;
c := caption;
h := max(h,ft.Height+4);
w := Width;
end
published
@@ -8177,6 +8189,10 @@ type TtoolbuttonActionLink=class(TControlActionLink)
begin
return FClient and(Action is CLASS(TCustomAction));
end
function IsImageIndexLinked():Boolean;override;
begin
return true;
end
function IsCheckedLinked():Boolean;override;
begin
return false;
@@ -8186,6 +8202,10 @@ type TtoolbuttonActionLink=class(TControlActionLink)
begin
if IsshortcutLinked() then return FClient.ShortCut := Value;
end
procedure setImageid(value:Integer);override;
begin
if IsImageIndexLinked() and FClient then FClient.imageid := value;
end
function create(AOwner);override;
begin
inherited;
funcext/tvclib/utslvcltree.tsf
+65 -6
View File
@@ -80,7 +80,7 @@ type ttreelistwnd = class(TCustomScrollControl)
x := FColWidth *(0-xPos);
cvs := Canvas;
cvs.Font := font;
PaintRect(cvs,yPos,FItemHeight,FirstLine,LastLine,xPos,FColWidth,FirstCol,LastCol);
PaintRect(cvs,yPos,FItemHeight,FirstLine,LastLine,xPos,FColWidth,FirstCol,LastCol);
end
function GetClientItemIndexs();
begin
@@ -102,6 +102,8 @@ type ttreelistwnd = class(TCustomScrollControl)
public //常用方法
function Create(AOwner);override;
begin
fshowseparators := false;
fseparatorcolor := 0;
inherited;
end
function AfterConstruction();override;
@@ -383,12 +385,29 @@ type ttreelistwnd = class(TCustomScrollControl)
x := wd *(0-xPos);
rc := ClientRect;
PrevPaint(FirstLine,LastLine);
ls := array();
for i := FirstLine to LastLine do
begin
nrc := GetIndexRect(i);
it := FItems[i];
it.paint(cvs,x,nrc[1],rc[2]-rc[1]-x,ht);
if fshowseparators then
begin
ls[i] :=array(nrc[array(0,3)],nrc[array(2,3)]);
end
end
if fshowseparators then
begin
cf := cvs.pen;
cf.style := 0;
cf.Width := 1;
cf.color := fseparatorcolor;
for i,v in ls do
begin
cvs.MoveTo(v[0]);
cvs.LineTo(v[1]);
end
end
end
function SetTopLine(idx);virtual;
begin
@@ -469,10 +488,14 @@ type ttreelistwnd = class(TCustomScrollControl)
property ItemHeight read FItemHeight write SetItemHeight;
property ItemMaxWidth read FxClientMax;
property ItemMinWidth read FItemMinWidth write SetItemMinWidth;
property showseparators:bool read fshowseparators write setshowseparators;
property separatorcolor:color read fseparatorcolor write setseparatorcolor;
{**
@param(Items)(array of TcustomTreeCtlNode) 项 %%
@param(ItemMaxWidth)(integer) 最大宽度 %%
@param(ItemHeight)(integer) 项高度 %%
@param(showseparators)(bool) 显示分割线 %%
@param(separatorcolor)(color) 分割线颜色 %%
**}
private //其他中间函数
function GetIndexClientRect(idx);virtual;
@@ -485,8 +508,26 @@ type ttreelistwnd = class(TCustomScrollControl)
rc[3]:= rc[1]+FItemHeight;
return rc;
end
end
function setseparatorcolor(v);
begin
if (v<>fseparatorcolor) and (v>0 or v<=0) then
begin
fseparatorcolor := v;
end
end
function setshowseparators(v);
begin
nv := v?true:false;
if nv<>fshowseparators then
begin
fshowseparators := nv;
InvalidateRect(nil,false);
end
end
private //属性变量
fshowseparators;//分割线
fseparatorcolor;
FHashItems;
FItemHeight; //项高
FColCount; //列数
@@ -822,7 +863,11 @@ type TcustomTreeCtlNode = class(tsluibase) //
//cvs.Pen.style := PS_SOLID;
//cvs.Pen.width := 1;
inv := 3;
BasePos := FBasePos+x;
/////////////处理最顶层/////////////////////////////
if Hierarchy=0 then BasePos := x;
else
BasePos := FBasePos+x;
///////////////////////////////////
FCheckPos := BasePos;
fitemcountflg := ItemCount or FDirtype;
for i := 1 to Hierarchy do
@@ -865,17 +910,19 @@ type TcustomTreeCtlNode = class(tsluibase) //
begin
if(ifsel and FSelImgId >= 0)or(FImgId >= 0)or(FExpandImgId >= 0 and fitemcountflg>0 and FExpanded)then //绘制selimage
begin
imh := img.Height;
dimh := integer((h-imh)/2);
if(FExpandImgId >= 0)and fitemcountflg>0 and FExpanded then
begin
img.Draw(FExpandImgId,cvs,BasePos,y+1,nil);
img.Draw(FExpandImgId,cvs,BasePos,y+1+dimh,nil);
end else
if(ifsel and FSelImgId >= 0)then
begin
img.Draw(FSelImgId,cvs,BasePos,y+1,nil);
img.Draw(FSelImgId,cvs,BasePos,y+1+dimh,nil);
end else
if FImgId >= 0 then
begin
img.Draw(FImgId,cvs,BasePos,y+1,nil);
img.Draw(FImgId,cvs,BasePos,y+1+dimh,nil);
end
BasePos += img.Height;
BasePos += inv;
@@ -1167,6 +1214,7 @@ type TcustomTreeCtlNode = class(tsluibase) //
begin
if(it is class(TcustomTreeCtlNode))and(not it.Parent)then
begin
if not ckchild(it) then continue;
odexp := it.Expanded;
it.UnExpand();
FItems.InsertBefor(it,idx0);
@@ -1198,6 +1246,7 @@ type TcustomTreeCtlNode = class(tsluibase) //
**}
if(it is class(TcustomTreeCtlNode))and(not it.Parent)then
begin
if not ckchild(it) then return false;
if idx<0 then idx := 0;
if idx>FItems.Count then idx := FItems.Count;
if not(idx >= 0)then idx := 0;
@@ -1491,6 +1540,16 @@ type TcustomTreeCtlNode = class(tsluibase) //
FChecked; //选择
static fnodehandlebase; //////
private //普通属性设置
function ckchild(c); //检查子节点
begin
sf := self(true);
while sf do
begin
if sf=c then return false;
sf := sf.Parent;
end
return true;
end
function initnodehandle();//给当前节点分配一个id
begin
if not(fnodehandlebase>0) then fnodehandlebase:= 0xff;
@@ -1891,7 +1950,7 @@ type TcustomTreeCtl = class(ttreelistwnd)
end
return inherited;
end
published //属性
published //属性输出
property CurrentNode read FCurrentNode write setcurrentnode; //20221118 加上写
property selectionColor:color read FselectionColor write SetselectionColor;
property CheckBox:bool read FCheckBox write SetCheckBox;
funcext/tvclib/utvclgraphics.tsf
+1090 -252
View File
File diff suppressed because it is too large Load Diff