界面库

整理代码

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,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();

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

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
@@ -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

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;

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;
@@ -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));

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
+    //public
-    function create();override;
+
-    begin
-        inherited;
-        FCurrent := 0;
-        FTokens := array();
-        FParsers := new TTmfParserToken();
-    end
     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");
+        inherited;
-        r := "";
+        FCharDiscrimi := new TCharDiscrimi();
-        for i,v in lines do
+        FCurrent := 0;
-        begin
+        FTokens := array();
-            if not v then continue;
+        FParsers := new TTmfParserToken();
-            r += n;
-            r += v;
-            r += "\r\n";
     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);//tsl转换为tfm字符串格式
-    function TSLasItem(d);
     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;
     {**