界面库

优化
This commit is contained in:
JianjunLiu 2023-02-23 17:54:28 +08:00
parent 12cba8c0ec
commit c425e0cb91
13 changed files with 34 additions and 36 deletions

View File

@ -2194,7 +2194,7 @@ type TEditer=class(TCustomcontrol) //
end
end else //±»ÆäËû³ÌÐòÐÞ¸Ä
begin
if Messageboxa(format("%s\r\n被其他程序修改是否重新加载",it.ScriptPath),"提示",1,self)=IDOK then
if Messageboxa(format("%s\r\n被其他程序修改是否重新加载",it.ScriptPath),"提示",mb_YesNo,self)=IDYES then
begin
LoadFromFile(it,true);
end else

View File

@ -1846,7 +1846,6 @@ type tcpointer=class(tcstruct,tmemoryclass)
begin
//echo "\r\nreade:",_ptr;
v := _tool.readstr(_ptr);
//echo "readv:" ,v,datatype(v);
return v;
end else
begin

View File

@ -277,7 +277,7 @@ type tcontrol = class(tcomponent)
@explan(说明) 绑定处理函数到消息id %%
**}
if not ifarray(FMessagehandle)then FMessagehandle := array();
if ifnumber(id)and (datatype(func)=7)then FMessagehandle[id]:= func;
if ifnumber(id)and (iffuncptr(func))then FMessagehandle[id]:= func;
end
private //事件绑定处理
static FClassDigestA;

View File

@ -21,7 +21,7 @@ type tcustomcontrol=class(TWinControl)
procedure Paint();override;
begin
inherited;
if datatype(FOnPaint)=7 then call(FOnPaint,self(true));
if iffuncptr(FOnPaint) then call(FOnPaint,self(true));
end
function ControlAppended(AControl);override;
begin

View File

@ -39,7 +39,7 @@ type tgraphiccontrol = class(TControl)
{**
@explan(说明)控件绘制调用 ,使用Canvas属性和PAINTSTRUCT结构体 绘制控件 %%
**}
if(datatype(FOnPaint)<> 7)or(not call(FOnPaint,self(true)))then
if(not iffuncptr(FOnPaint))or(not call(FOnPaint,self(true)))then
begin
canvas.Font := font;
Canvas.DrawText(self.caption,self.ClientRect,DT_VCENTER .| DT_SINGLELINE .| DT_CENTER .| DT_NOPREFIX);

View File

@ -3680,7 +3680,7 @@ type TListView = class(TDrawGrid)
{**
@explan(说明) 检查项目 %%
**}
if datatype(FOnCheckItem)=7 then
if iffuncptr(FOnCheckItem) then
begin
return call(FOnCheckItem,v);
end
@ -6366,7 +6366,7 @@ begin
pc := paramcount;
if pc<1 then return nil;
f := params[1];
if datatype(f)<> 7 then return nil;
if not iffuncptr(f) then return nil;
case pc of
1:return call(f);
2:return call(f,params[2]);
@ -6374,18 +6374,6 @@ begin
4:return call(f,params[2],params[3],params[4]);
end;
return nil;
{ps := params;
f := ps[0];
pms := ps[1:];
if datatype(f)<> 7 or not(ifarray(pms))then exit;
info := f.functioninfo();
pt := info["parameter"];
lpt := length(pt);
if(lpt=0)or length(pms)<= lpt then
begin
return callinarray(f,pms);
end else
return callinarray(f,pms[0:lpt-1]);}
end
function NotifyComponent(Acomponent,Act,AOwner);//通知控件
begin

View File

@ -5744,7 +5744,7 @@ type tgtk_ctl_object = class(_gtkeventtype)
begin
xxid := pms[1];
c := FConnectHandlers[inttostr(xxid)];
if datatype(c)=7 then
if iffuncptr(c) then
begin
pms2 := pms;
pms2[0] := self;

View File

@ -113,7 +113,7 @@ TYPE TMemoLineList=class(tnumindexarray) //
function DoColumnIncreased();
begin
//echo "\r\nIncreate:",FRowMaxLength;
//if Datatype(FOnMaxLengthIncrease)=7 then Call(FOnMaxLengthIncrease);
//if iffuncptr(FOnMaxLengthIncrease) then Call(FOnMaxLengthIncrease);
//echo "\r\nincrease:",FRowMaxLength;
end
FEdit;
@ -289,7 +289,7 @@ type TTslMenoUndoList=class() //undolist
begin
if fLockCount>0 then return nil;
fItems.push(Item);
if datatype(fOnAdded)=7 then call(fOnAdded,Self(true));
if iffuncptr(fOnAdded) then call(fOnAdded,Self(true));
end
public
function MergeReplaceItem(); //ºÏ²¢²Ù×÷

View File

@ -32,7 +32,7 @@ type TBasicAction=class(TComponent)
**}
procedure Change;virtual;
begin
if datatype(FOnChange)=7 then call(FOnChange,self);
if iffuncptr(FOnChange) then call(FOnChange,self);
end
procedure SetOnExecute(Value:TNotifyEvent);virtual;
begin
@ -81,7 +81,7 @@ type TBasicAction=class(TComponent)
if FOnExecute then
begin
e := new tuieventbase(0,0,0,0);
if datatype(FOnExecute)=7 then call(FOnExecute,self(true),e);
if iffuncptr(FOnExecute) then call(FOnExecute,self(true),e);
return true;
end
return false;
@ -355,7 +355,7 @@ type TBasicActionLink=class(TSLUIBASE)
end
procedure Change;virtual;
begin
if datatype(FOnChange)=7 then call(OnChange,FAction);
if iffuncptr(FOnChange) then call(OnChange,FAction);
end
function IsOnExecuteLinked():Boolean;virtual;
begin

View File

@ -5,6 +5,7 @@ unit utslvclauxiliary;
//20221118 抽象计数锁定对象
//20220914 移入tire树
interface
function iffuncptr(fn);
function includestate(u,s);
function excludestate(u,s);
function makelong(low,high,ptrl);
@ -357,8 +358,8 @@ type tarray1dlk=class //
end
function CallCompare(v1,v2,f);
begin
if datatype(f)=7 then return call(f,v1,v2);
if datatype(FCompareValue)=7 then return call(FCompareValue,v1,v2);
if iffuncptr(f) then return call(f,v1,v2);
if iffuncptr(FCompareValue)then return call(FCompareValue,v1,v2);
return v1=v2;
end
function append(v) //追加
@ -538,7 +539,7 @@ type tarray1dlk=class //
@explan(说明) 循环所有数据 %%
@param(f)(fpointer) 处理函数 function(id,v) begin end %%
**}
if(datatype(f)<> 7)then return nil;
if not iffuncptr(f)then return nil;
for i,v in _data do
begin
ret := call(f,i,v); //## f(i,v);
@ -2250,6 +2251,11 @@ type tinstancemanager = class()
fhandles;
end
implementation
function iffuncptr(fn);
begin
//return datatype(fn)=7;
return ifobj(fn);
end
function includestate(u,s);
begin
{**
@ -2841,7 +2847,7 @@ begin
{**
@ignore(忽略)
**}
if datatype(f)=7 then return call(f,o,e);
if iffuncptr(f) then return call(f,o,e);
end
function CheckArrayIsNumbers(Value,n);
begin
@ -3010,7 +3016,7 @@ begin
//d:天软数据
//tbw : 字符串,tab 宽度
//ct 递归深度,忽略
case datatype(d)of
case datatype(d) of
0,20:return inttostr(d);
1:return floattostr(d);
2:return tostn(d);

View File

@ -1732,7 +1732,7 @@ type TCustomImageList=class(tcomponent)
{**
@explan(说明) 修改时的回调 %%;
**}
if FChanged and (datatype(FOnChange)=7) then call(FOnChange,self(true));
if FChanged and (iffuncptr(FOnChange)) then call(FOnChange,self(true));
FChanged := false;
end
function GetIconSize();

View File

@ -236,7 +236,7 @@ type TCustomTimer = class(tcomponent)//
{**
@explan(说明)启动 %%
**}
if not((datatype(FOntimer) = 7 )and FInterval)>0 then return -1;
if not(iffuncptr(FOntimer) and FInterval>0) then return -1;
if FStart then return FStart;
ret := _wapi.SetTimer(nil,Fid,FInterval,gettimerptr(2));
_kill0 := ret;

View File

@ -28,7 +28,7 @@ type tworkerclient = class(TArray)
end
function DoOnMessage(d); //执行onmessage 任务
begin
if datatype(FOnMessage)=7 then
if iffuncptr(FOnMessage) then
begin
try
return call(FOnMessage,self,d);
@ -291,7 +291,7 @@ type tworkerHost = class(TArray)
FConnectHandle := h;
if h then
begin
if datatype(FOnStart)=7 then
if iffuncptr(FOnStart) then
begin
try
call(FOnStart,self);
@ -330,7 +330,7 @@ type tworkerHost = class(TArray)
end
function DoOnError(d);//处理错误
begin
if datatype(FOnError)=7 then
if iffuncptr(FOnError) then
begin
try
return call(FOnError,self,d);
@ -340,7 +340,7 @@ type tworkerHost = class(TArray)
end
function DoOnMessage(d); //处理数据
begin
if datatype(FOnMessage)=7 then
if iffuncptr(FOnMessage) then
begin
try
return call(FOnMessage,self,d);
@ -363,5 +363,10 @@ type tworkerHost = class(TArray)
FOnStart;
FConnectHandle; //句柄
end
function iffuncptr(fn);
begin
//return datatype(fn)=7;
return ifobj(fn);
end
initialization
end.