diff --git a/funcext/tvclib/tcomponent.tsf b/funcext/tvclib/tcomponent.tsf index 1d16ef5..58468c0 100644 --- a/funcext/tvclib/tcomponent.tsf +++ b/funcext/tvclib/tcomponent.tsf @@ -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,8 +209,8 @@ public //通知 end ow := nw; end - if ow<>ac then - ow.Notification(ac,Operation); + //if ow<>ac then + ow.Notification(ac,Operation); end function Notification(AComponent,Operation);virtual; //通知 begin @@ -299,6 +300,7 @@ public // function create(AOwner);virtual; begin class(TSLUIBASE).create(); + FCharDiscrimi := new TCharDiscrimi(); FChangedProperties := array(); FChangedinheritedProperties := array(); FComponents := NEW TFpList(); diff --git a/funcext/tvclib/twincontrol.tsf b/funcext/tvclib/twincontrol.tsf index 4567025..09f595a 100644 --- a/funcext/tvclib/twincontrol.tsf +++ b/funcext/tvclib/twincontrol.tsf @@ -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 diff --git a/funcext/tvclib/utslvclauxiliary.tsf b/funcext/tvclib/utslvclauxiliary.tsf index 7e0a135..6f556d2 100644 --- a/funcext/tvclib/utslvclauxiliary.tsf +++ b/funcext/tvclib/utslvclauxiliary.tsf @@ -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 @@ -495,7 +496,7 @@ type tarray1dlk=class // ret :=-1; if lx then begin - for i := length(_data)downto 0 do + for i := length(_data) downto 0 do begin if CallCompare(_data[i],v1,func)then return i; end @@ -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 diff --git a/funcext/tvclib/utslvclstdctl.tsf b/funcext/tvclib/utslvclstdctl.tsf index 9ee67de..70c2287 100644 --- a/funcext/tvclib/utslvclstdctl.tsf +++ b/funcext/tvclib/utslvclstdctl.tsf @@ -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; diff --git a/funcext/tvclib/utslvcltree.tsf b/funcext/tvclib/utslvcltree.tsf index 49c22f2..246f580 100644 --- a/funcext/tvclib/utslvcltree.tsf +++ b/funcext/tvclib/utslvcltree.tsf @@ -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; @@ -1243,7 +1248,7 @@ type TVirtualList = class(TVirtualListFixed) begin if item=FItems[i]then return i; end - return-1; + return -1; return FItems.Indexof(item); end function GetItemRect(item); @@ -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)); @@ -1875,7 +1874,7 @@ type TcustomTreeCtl = class(TVirtualList) //property NodeHierarchyWidth read FNodeHierarchyWidth write SetNodeHierarchyWidth; property RootNode read GetRootNode; //property MulSelected read FMulSelected write FMulSelected; - property SingleExpand read FSingleExpand write FSingleExpand; + property SingleExpand read FSingleExpand write FSingleExpand; property OnSelChanged:eventhandler read FOnSelChanged write FOnSelChanged; property OnSelChanging:eventhandler read FOnSelChanging write FOnSelChanging; property onEmptyNodeExapanding read FonEmptyNodeExapanding write FonEmptyNodeExapanding; diff --git a/funcext/tvclib/uvcpropertytypespersistence.tsf b/funcext/tvclib/uvcpropertytypespersistence.tsf index 73e124f..baef6df 100644 --- a/funcext/tvclib/uvcpropertytypespersistence.tsf +++ b/funcext/tvclib/uvcpropertytypespersistence.tsf @@ -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 FCurrent0)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"; - end - return r; + inherited; + FCharDiscrimi := new TCharDiscrimi(); + FCurrent := 0; + FTokens := array(); + FParsers := new TTmfParserToken(); 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(); @@ -697,9 +585,8 @@ type TTmfParser = class(TTmfParserbase) end return r; end - end - - function TSLasItem(d); + end + 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; {**