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

界面库 

整理代码
This commit is contained in:
JianjunLiu 2022-11-10 17:50:19 +08:00
parent 6d2e542ed7
commit 6fbb499871
6 changed files with 61 additions and 155 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
funcext/tvclib/tcomponent.tsf
View File

@ -21,6 +21,7 @@ uses utslvclauxiliary,UVCPropertyTypesPersistence,utslvclbase;
FComponentStyle; //ÀàÐÍ
FComponentCreated; //¹¹ÔìÍê³É
FLoader;
FCharDiscrimi;
function ComponentGetParent();virtual;
begin
@ -164,7 +165,7 @@ uses utslvclauxiliary,UVCPropertyTypesPersistence,utslvclbase;
begin
if isKeyWords(v)then return;
nv := lowercase(v);
if new TCharDiscrimi().IsVariableName(v)then
if FCharDiscrimi.IsVariableName(v)then
begin
r := RootOwner().FindComponentByName(nv);
if not r then
@ -208,7 +209,7 @@ public //֪ͨ
end
ow := nw;
end
if ow<>ac then
//if ow<>ac then
ow.Notification(ac,Operation);
end
function Notification(AComponent,Operation);virtual; //֪ͨ
@ -299,6 +300,7 @@ public //
function create(AOwner);virtual;
begin
class(TSLUIBASE).create();
FCharDiscrimi := new TCharDiscrimi();
FChangedProperties := array();
FChangedinheritedProperties := array();
FComponents := NEW TFpList();

4
funcext/tvclib/twincontrol.tsf
View File

@ -350,7 +350,7 @@ type TWinControl = class(tcontrol)
excludestate(ControlState,csCreating);
end
end;
procedure InitializeWnd();virtual; //type_twinctrol
function InitializeWnd();virtual; //type_twinctrol
begin
{**
@explan(说明) 窗口句柄初始化,在该函数设置窗口句柄的一些信息 %%
@ -364,7 +364,7 @@ type TWinControl = class(tcontrol)
//if Align<>alNone then
Parent.DoControlAlign();
end
ImageChanged();
//ImageChanged();
// "id:",self.caption,_wapi.GetWindowLongPtrA(FHandle,GWLP_ID);
end
end

19
funcext/tvclib/utslvclauxiliary.tsf
View File

@ -75,6 +75,7 @@ type tuiglobaldata=class()
end
end
type TCharDiscrimi=class()
private
static CD_SMA;
static CD_BGA;
static CD_SMZ;
@ -87,7 +88,7 @@ type TCharDiscrimi=class()
begin
if not CD_ISOK then
begin
K := 1;
CD_ISOK := 1;
CD_SMA := ord("a");
CD_BGA := ord("A");
CD_SMZ := ord("z");
@ -95,26 +96,26 @@ type TCharDiscrimi=class()
CD_UDL := ord("_");
CD_NIN := ord("9");
CD_ZER := ord("0");
CD_ISOK := 1;
end
end
class function IsLetter(cc);
public
function IsLetter(cc);
begin
return IsUppercaseLetter(CC)OR IsLowercaseLetter(cc);
end
class function IsLowercaseLetter(cc);
function IsLowercaseLetter(cc);
begin
return(cc >= CD_SMA)and(cc <= CD_SMZ);
end
class function IsUppercaseLetter(cc);
function IsUppercaseLetter(cc);
begin
return(cc >= CD_BGA)and(cc <= CD_BGZ);
end
class function IsNumber(cc);
function IsNumber(cc);
begin
return(cc >= CD_ZER)and(cc <= CD_NIN);
end
class function IsVariableName(s);
function IsVariableName(s);
begin
if ifstring(s)and length(s)>= 1 then
begin
@ -134,7 +135,7 @@ type TCharDiscrimi=class()
end
return 0;
end
class function IsLowercaseVariableName(s);
function IsLowercaseVariableName(s);
begin
if ifstring(s)and length(s)>= 1 then
begin
@ -631,7 +632,7 @@ type tarray1dlk=class //
function dochanged(info);
begin
if onchangelock then return ;
CallMessgeFunction(fonchanged,self(true),info);
if fonchanged then CallMessgeFunction(fonchanged,self(true),info);
end
function SwapNoCheck(i,j);
begin

4
funcext/tvclib/utslvclstdctl.tsf
View File

@ -5625,9 +5625,9 @@ type TCustomSpinEdit = class(TCustomControl)
function Create(AOwner);override;
begin
inherited;
FChar := class(TCharDiscrimi);
FChar := new TCharDiscrimi();
//FLeveTimer := new TCustomTimer(self);
FChar.sinit();
//FChar.sinit();
FMaxValue := 100;
FMinValue := 0;
//FValue := 0;

13
funcext/tvclib/utslvcltree.tsf
View File

@ -758,9 +758,14 @@ type TcustomTreeCtlNode = class(TVirtualListItem)
{**
@param(ItemCount)(integer) 子节点数量 %%
@param(Hierarchy)(integer) 层级 %%
@param(Handle)(pointer) ¾ä±ú %%
@param(Expanded)(bool) 是否展开 %%
@param(Parent)(TcustomTreeCtlNode) 父节点 %%
@param(LastChild)(TcustomTreeCtlNode) 最后一个子节点 %%
@param(dirtype)(bool) 目录类型 %%
@param(Checked)(bool) 是否勾选 %%
@param(Visible)(bool) 可见 %%
@param(ModifyChildrenChecked)(bool) 勾选的时候是否修改自己的勾选状态 %%
@param(MouseCanChecked)(bool) 能否使用鼠标点击勾选 %%
**}
protected property CurrentDeleteNode read FCurrentDeleteNode write FCurrentDeleteNode;
property CurrentAddNode read FCurrentAddNode write FCurrentAddNode;
@ -1764,12 +1769,6 @@ type TcustomTreeCtl = class(TVirtualList)
end
inherited;
end
{function CreateNode();virtual;
begin
return CreateTreeNode();
r := new TcustomTreeCtlNode(self(true));
return r;
end}
function CreateTreeNode();virtual;
begin
return createobject(fnodecreator,self(true));

160
funcext/tvclib/uvcpropertytypespersistence.tsf
View File

@ -153,95 +153,7 @@ type TTmfParserToken = class(TTmfParserbase)
ct := "";
end
end
function GetNumber(len);//解析数字
begin
c := cchar();
r := "";
iffloat := false;
if c="0" then
begin
label parnb;
cc := cchar();
if cc in FNumberChar then
begin
while whileok() do
begin
cc := cchar();
if not(iffloat)and cc="." then
begin
iffloat := true;
r += ".";
continue;
end
if(cc="l" or cc="L")and not(iffloat)then
begin
if r then
begin
//长整数
strtoint(r);
return;
end
end else
if(cc="l" or cc="L")then
begin
//错误
return;
end
if not(cc in FNumberChar)then
begin
if not r then
begin
return; //错误
end
if iffloat then
begin
strtofloat(r); //实数
end else
strtoint(r); //整数
cback();
end
r += cc;
end
end else
if cc="x" or cc="X" then
begin
while whileok() do
begin
cc := cchar();
if not(cc in FHexChar)then
begin
cback();
break;
end
r += cc;
end
end else
begin
end
end else
begin
r := c;
goto parnb;
end
end
function GetBinary(len); //二进制数据
begin
r := "";
while whileok() do
begin
c := cchar();
if c="}" then
begin
delct(r,ct,len,TT_BIN);
break;
end
if c in FSplitter then
begin
continue;
end
r += c;
end
end
function gettokens();//½âÎö×Ö·û
begin
{**
@ -470,6 +382,7 @@ type TTmfParser = class(TTmfParserbase)
FTree;
ftreeobj;
FS;
FCharDiscrimi;
function SetScriptPath(fn);
begin
if ifstring(fn)then
@ -496,14 +409,8 @@ type TTmfParser = class(TTmfParserbase)
//exportfile(ftstream(),"","d:\\tst\\abc.stm",d);
end
end
public
function create();override;
begin
inherited;
FCurrent := 0;
FTokens := array();
FParsers := new TTmfParserToken();
end
//public
function whileok();
begin
return FCurrent<FTokenlen;
@ -523,7 +430,8 @@ type TTmfParser = class(TTmfParserbase)
if not(n>0)then n := 1;
FCurrent -= n;
end
function samplevalue(v);virtual;
public
function samplevalue(v);
begin
{**
@expaln(˵Ã÷) ¼ò»¯½á¹û%%
@ -570,36 +478,16 @@ type TTmfParser = class(TTmfParserbase)
end
return r;
end
private
function tablelines(str,n);
function create();override;
begin
lines := str2array(str,"\r\n");
r := "";
for i,v in lines do
begin
if not v then continue;
r += n;
r += v;
r += "\r\n";
inherited;
FCharDiscrimi := new TCharDiscrimi();
FCurrent := 0;
FTokens := array();
FParsers := new TTmfParserToken();
end
return r;
end
function totfmstr(v);
begin
if ifnil(v)then return tostn("");
if ifstring(v)and(not v)then return tostn("");
if ifstring(v)then
begin
if v in array({"item",}"end","object","inherited")then return tostn(v);
if new TCharDiscrimi().IsLowercaseVariableName(v)then
begin
return v;
end else
return tostn(v);
end else
return tostn(v);
end
public
function GetAllSubObjects(obj,r);
begin
if not obj then obj := gettree();
@ -698,8 +586,7 @@ type TTmfParser = class(TTmfParserbase)
return r;
end
end
function TSLasItem(d);
function TSLasItem(d);//tsl转换为tfm字符串格式
begin
if not ifarray(d)then return totfmstr(d);
rows := mrows(d,1);
@ -744,6 +631,22 @@ type TTmfParser = class(TTmfParserbase)
end
return r;
end
private //解析相关
function totfmstr(v);
begin
if ifnil(v)then return tostn("");
if ifstring(v)and(not v)then return tostn("");
if ifstring(v)then
begin
if v in array({"item",}"end","object","inherited")then return tostn(v);
if FCharDiscrimi.IsLowercaseVariableName(v)then
begin
return v;
end else
return tostn(v);
end else
return tostn(v);
end
function GetItem();
begin
while whileok() do
@ -1031,6 +934,7 @@ type TTmfParser = class(TTmfParserbase)
end
return r;
end
public
property Script write SetScript;
property ScriptPath write SetScriptPath;
{**