编辑器

整理代码,以及优化编辑器提示

designer/udesignerproject.tsf

@@ -3441,5 +3441,40 @@ E92946FC545E8EA1D20B8952E9954CA9F452AA3011854AAEE58A2A123445AF6A8
 1CB3C87955C3470000000049454E44AE42608200";
     return r ;
 end 
+function GetPathFromFullName(fullname,fname,ftype);
+begin
+    {**
+    @explan(说明) 获得当前执行tsl文件的所在路径 %%
+    @param(fullname)(string) 全名 %%
+    @param(fname)(string) 文件名 ,变参返回%%
+    @param(ftype)(string) 文件类型 ,变参返回%%
+    @return(string) 路径 %%
+    **}
+    ph := fullname;
+    n := "";
+    rp := "";
+    fname := "";
+    ftype := "";
+    firstd := true;
+    iofp := ioFileseparator();
+    for i := length(ph)downto 1 do
+    begin
+        vi := ph[i];
+        if vi="." and firstd then
+        begin
+            ftype := n;
+            n := "";
+            firstd := false;
+        end else
+        if vi=iofp then
+        begin
+            rp := ph[1:i-1];
+            break;
+        end else
+        n := vi+n;
+    end
+    FName := n;
+    return rp;
+end
 
 end.

designer/utslsynmemo.tsf

@@ -1595,6 +1595,54 @@ type TTsfFileParser = class //
                 return getprojecttsfs();
             end 
             "parserstring":
+            begin
+                mtic;
+                r := parserstring(o,d);
+                return r;
+            end 
+        end 
+    end     
+    private
+    function getinheriteds(r,m,dounits,us,uso,cs,cso);
+    begin
+        if not ifarray(us) then  us := array();
+        if not ifarray(uso) then  uso := array();
+        if not ifarray(cs) then  cs := array();
+        if not ifarray(cso) then  cso := array();
+        for i,v in r["units"] do 
+        begin
+            vfn := checknamespacename(v);                    
+            if m=(lowercase(vfn)+".tsf") then continue;    
+            vi := LoadByName(vfn);  
+            if vi then 
+            begin 
+                if vi["msg"] in dounits then 
+                begin
+                    continue;
+                end
+                dounits[length(dounits)] := vi["msg"] ;
+                us[length(us)] := vfn;
+                uso[length(uso)] := vi;
+                getinheriteds(vi,m,dounits,us,uso,cs,cso);               
+            end                           
+        end  
+        for i,v in r["class"] do 
+        begin
+            vfn := checknamespacename(v);
+            if m=(lowercase(vfn)+".tsf") then continue;
+            vi := LoadByName(vfn);
+            if vi then 
+            begin
+                if vi["msg"] in dounits then continue;
+                dounits[length(dounits)] := vi["msg"]; 
+                cs[length(cs)] := vfn;
+                cso[length(cso)] := vi;
+                getinheriteds(vi,m,dounits,us,uso,cs,cso);
+            end                           
+        end       
+    
+    end 
+    function parserstring(o,d);
     begin
         rti := 0;
         rt := array();  
@@ -1602,7 +1650,6 @@ type TTsfFileParser = class //
         if ifstring(m) then m := lowercase(m);
         filechanged(m);
         FormatFile(rti,FCacheS,rt,3,m);         
-                
         if m and ifarray(FCacheS) then 
         begin 
             r := FCacheS[m];    
@@ -1628,148 +1675,28 @@ type TTsfFileParser = class //
         FormatBlocks(rti,r["blcks"],rt,"",nil,ext,1);
         FormatWords(rti,r["words"],rt,"",ext,1); 
         dounits := array(vmsg); 
-                uout := array();
+        getinheriteds(r,m,dounits,us,uso,cs,cso);
-                for i,v in r["units"] do //单元
+        for i,v in us do //µ¥Ôª
         begin                     
-                    vfn := checknamespacename(v);                    
+            vfn := v;                    
-                    if m=(lowercase(vfn)+".tsf") then continue;
+            vi := uso[i];  
-                    vi := LoadByName(vfn);  
-                    if vi then 
-                    begin 
-                        if vi["msg"] =vmsg then 
-                        begin
-                            continue;
-                        end
             ext := array();
             FormatFunction(rti,vi["functions"],rt,vfn,vi["lines"],ext,4);
             FormatBlocks(rti,vi["blcks"],rt,vfn,nil,ext,4);
             FormatWords(rti,vi["words"],rt,vfn,ext,4);                                             
-                        dounits[length(dounits)] := vi["msg"];  
-                        loadunits(vi["units"],dounits,uout);                      
         end 
-                end 
+        for i,v in cs do //Àà
-                //mtic;
-                for i,v in uout do 
         begin 
-                    vfn := checknamespacename(v);                    
+            vfn := v;
-                    if m=(lowercase(vfn)+".tsf") then continue;
+            vi := cso[i];
-                    vi := LoadByName(vfn);  
-                    if vi then 
-                    begin 
-                        if vi["msg"] =vmsg then 
-                        begin
-                            continue;
-                        end
-                        ext := array();
-                        FormatFunction(rti,vi["functions"],rt,vfn,vi["lines"],ext,4);
-                    end                    
-                end 
-                uout := array();
-                //echo "\r\n other time:",mtoc;
-                dounits := array(vmsg);
-                for i,v in r["class"] do //类
-                begin 
-                    vfn := checknamespacename(v);
-                    if m=(lowercase(vfn)+".tsf") then continue;
-                    vi := LoadByName(vfn);
-                    if vi then 
-                    begin
-                        if vi["msg"] in dounits then continue;
             ext:= array();
             FormatFunction(rti,vi["functions"],rt,vfn,vi["lines"],ext,4);
             FormatWords(rti,vi["words"],rt,vfn,ext,4);
-                        //ident 文件名
-                        loadclasses(vi["class"],dounits,uout);
-                    end 
-                end 
-                for i,v in uout do 
-                begin
-                    vfn := checknamespacename(v);
-                    if m=(lowercase(vfn)+".tsf") then continue;
-                    vi := LoadByName(vfn);
-                    if vi then 
-                    begin
-                        if vi["msg"]=vmsg then continue;
-                        ext:= array();
-                        FormatFunction(rti,vi["functions"],rt,vfn,vi["lines"],ext,4);
-                        FormatWords(rti,vi["words"],rt,vfn,ext,4);
-                    end
         end 
         //FormatFile(rti,FCacheS,rt,3,m);
         return rt;        
         //return o.postmessage(r);    
     end     
-        end 
-    end 
-    private
-    function loadunitcalss(us,cs,dounits,uout,cout);
-    begin
-        if not ifarray(uout) then uout := array();
-        if not ifarray(cout) then cout := array();
-        for i,v in us do 
-        begin
-            vfn := checknamespacename(v); 
-            vi := LoadByName(vfn);
-            if  vi then 
-            begin
-                if vi["msg"] in dounits then continue;
-                dounits[length(dounits)] := vi["msg"]; 
-                uout[length(uout)] := vfn; 
-                loadunitcalss(vi["units"],vi["class"],dounits,uout,cout);
-            end 
-                             
-        end  
-        for i,v in cs do 
-        begin
-            vfn := checknamespacename(v);
-            if m=(lowercase(vfn)+".tsf") then continue;
-            vi := LoadByName(vfn);
-            if vi then 
-            begin
-                if vi["msg"] in dounits then continue;
-                dounits[length(dounits)] := vi["msg"]; 
-                //ident 文件名
-                cout[length(cout)] := vfn;
-                loadunitcalss(vi["units"],vi["class"],dounits,uout,cout);
-            end                           
-        end           
-    end 
-    function loadunits(us,dounits,uout);
-    begin
-        if not ifarray(uout) then uout := array();
-        for i,v in us do 
-        begin
-            vfn := checknamespacename(v); 
-            vi := LoadByName(vfn);
-            if  vi then 
-            begin
-                if vi["msg"] in dounits then continue;
-                dounits[length(dounits)] := vi["msg"]; 
-                uout[length(uout)] := vfn; 
-                loadunits(vi["units"],dounits,uout); 
-            end 
-                 
-        end         
-    end 
-    function loadclasses(cs,dounits,uout);
-    begin
-        if not ifarray(uout) then uout := array();
-        for i,v in cs do 
-        begin
-            vfn := checknamespacename(v);
-            if m=(lowercase(vfn)+".tsf") then continue;
-            vi := LoadByName(vfn);
-            if vi then 
-            begin
-                if vi["msg"] in dounits then continue;
-                dounits[length(dounits)] := vi["msg"]; 
-                //ident 文件名
-                uout[length(uout)] := vfn;
-                loadclasses(cs,dounits,uout); 
-            end                           
-        end    
-    end 
-        
     function checknamespacename(v);
     begin
         for ii in FCacheS do 
@@ -2056,7 +1983,7 @@ type TTsfFileParser = class //
                     ScriptDelBlocks(r["blcks"],str2array(rdd,"\n"),cls);
                     r["blcks"] := cls;
                     if not ifarray(FCacheS) then FCacheS := array();
-                    FCacheS[fn] := r;
+                    FCacheS[fn] := r;//new tparserdobject( r);
                     FFilePaths[fn] := pfn;
                     WriteParseredFile(fn,r,fl[0,"Time"]);
                 end
@@ -2102,7 +2029,7 @@ type TTsfFileParser = class //
             fn := FCacheDir+ioFileseparator()+ModifyFname(n)+".p";
             if importfile(ftstream(),"",fn,d)=1 and ifarray(d) then
             begin
-                FCacheS[lowercase(n)] := new tparserdobject(d);
+                FCacheS[lowercase(n)] := r;//new tparserdobject(d);
                 FFilePaths[lowercase(n)] := d["fullpath"];
                 return d;
             end
@@ -2157,6 +2084,7 @@ end
 type tparserdobject = class
     function create(d);
     begin
+        echo "\r\n create f object===";
         if ifarray(d) then 
             FData := d;
     end 

funcext/tvclib/tslvcl.tsf

@@ -33,22 +33,20 @@ Function tslcstructure(data,dsize,pack,ptr);
 
 //function CompareRect(orect,nrect);
 function calldatafunction();
-//function CallMessgeFunction(f,o,e);
+function CallMessgeFunction(f,o,e);
 //////////////////////执行tsl脚本代码////////////////////
 //function TSL_Check(func,funclen,oResult);
 function CheckTslCode(code,err);              //检查tsl语法
 //function SysExecWait(handle,exe,cmd,dir,fui); //执行 win32 程序
-function TS_ModulePath();
+//function TS_ModulePath();
-function TS_ExecPath();
+//function TS_ExecPath();
-function TS_GetAppPath();
+//function TS_GetAppPath();
 function TS_GetUserProfileHome();
-function TS_GetIniPath(hometype,IniName);
+//function TS_GetIniPath(hometype,IniName);
 function CopyUsedTslDllToNewDir(p);      
 /////////////////////////////////////////////
 function DeleteAllFiles(path);
 function CreateDirWithFileName(fname);
-function GetPathFromFullName(fullname,fname,ftype);
-
 //************************
 //*******************************
 function MessageBoxA(txt,title,flag,hd);
@@ -57,6 +55,9 @@ function _twinproc_(hwnd,message,wparam,lparam);//win32
 function _MessgeHook_a(hwnd,message,wparam,lparam);
 function remotetslcallback(data);
 //********其他辅助函数*******
+function TslToHexFormatStr(tsl);
+function HexFormatStrToTsl(D);
+function GetTextWidthAndHeightWidthFont(s,f,mul);
 //**********操作系统相关函数*********************
 function initlib();
 ////////////////////////////////////
@@ -10369,45 +10370,6 @@ type TDragManager=class(TComponent)
     property DragThreshold:Integer read FDragThreshold write FDragThreshold; // default 5;
 end;
 
-
-
-
-function GetPathFromFullName(fullname,fname,ftype);
-begin
-    {**
-    @explan(说明) 获得当前执行tsl文件的所在路径 %%
-    @param(fullname)(string) 全名 %%
-    @param(fname)(string) 文件名 ,变参返回%%
-    @param(ftype)(string) 文件类型 ,变参返回%%
-    @return(string) 路径 %%
-    **}
-    ph := fullname;
-    n := "";
-    rp := "";
-    fname := "";
-    ftype := "";
-    firstd := true;
-    iofp := ioFileseparator();
-    for i := length(ph)downto 1 do
-    begin
-        vi := ph[i];
-        if vi="." and firstd then
-        begin
-            ftype := n;
-            n := "";
-            firstd := false;
-        end else
-        if vi=iofp then
-        begin
-            rp := ph[1:i-1];
-            break;
-        end else
-        n := vi+n;
-    end
-    FName := n;
-    return rp;
-end
-
 function GetAndDispatchMessageA(hwnd,minm,maxm);
 begin
     {**
@@ -10778,11 +10740,11 @@ function TSL_NewObject():pointer;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$
 function TSL_InterpGetLFromWrap(L:pointer):pointer;cdecl;external "TSSVRAPI.dll"  name "TSL_InterpGetLFromWrap";
 function TS_GetGlobalL():pointer;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}  name "TS_GetGlobalL";
 function TSL_FreeObj(L:pointer;v:pointer);cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}   name "TSL_FreeObj";
-function TS_ModulePath():string;cdecl;external  {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}  name "TS_ModulePath";
+//function TS_ModulePath():string;cdecl;external  {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}  name "TS_ModulePath";
-function TS_ExecPath():string;cdecl;external  {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}   name "TS_ExecPath";
+//function TS_ExecPath():string;cdecl;external  {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}   name "TS_ExecPath";
-function TS_GetAppPath():string;cdecl;external  {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}  name "TS_ExecPath";
+//function TS_GetAppPath():string;cdecl;external  {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}  name "TS_ExecPath";
 function TS_GetUserProfileHome():string;cdecl;external  {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}   name "TS_GetUserProfileHome";
-function TS_GetIniPath(hometype:integer; var IniName:string):string;cdecl;external  {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}   name "TS_GetIniPath";
+//function TS_GetIniPath(hometype:integer; var IniName:string):string;cdecl;external  {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}   name "TS_GetIniPath";
 function TSL_Check(func:string;funclen:integer;oResult:pointer):integer;cdecl;external  {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif}  name "TSL_Check";
 procedure tslprocessmessages();begin {echo "\r\n processmessage";}end;
 function RunWorkerThreadLoop();
@@ -10800,71 +10762,12 @@ begin
 end
 function CreateDirWithFileName(fname);
 begin
-    {**
+    return unit(utslvclauxiliary).CreateDirWithFileName(fname);
-    @explan(说明) 根据文件全名构造目录 %%
-    **}
-    if not(ifstring(fname)and(length(fname)>4))then exit;
-    info := FileList("",fname);
-    if info then exit;
-    len := length(fname);
-    iofp := ioFileseparator();
-    for i := len downto 1 do
-    begin
-        vi := fname[i];
-        if vi=iofp then
-        begin
-            ffname := fname[1:i];
-            break;
-        end
-    end
-    if not ffname then exit;
-    nct := 4;
-    {$ifdef linux}
-    nct := 1;
-    {$endif}
-    ph := ffname[1:nct];
-    for i := nct+1 to length(ffname) do
-    begin
-        vi := ffname[i];
-        if vi=iofp then
-        begin
-            if not FileList("",ph)then
-            begin
-                CreateDir("",ph);
-            end
-        end
-        ph += vi;
-    end
 end
 
 function DeleteAllFiles(path);
 begin
-    {**
+    return unit(utslvclauxiliary).DeleteAllFiles(path);
-    @explan(说明) 删除指定路径的文件或者文件夹 %% 
-    **}
-    if not ifstring(path)then return 0;
-    if not path then return 0;
-    iofp := ioFileseparator();
-    if path[length(path)]=iofp then return call(thisfunction,path[1:(length(path)-1)]);
-    info := FileList("",path); //"A"
-    if info then
-    begin
-        if pos("D",info[0]["Attr"])then
-        begin
-            fs := FileList("",path+iofp+"*");
-            for i,v in fs do
-            begin
-                n := v["FileName"];
-                if n in array(".","..")then continue;
-                call(thisfunction,path+iofp+n);
-            end
-            return RemoveDir("",path);
-        end else
-        begin
-            return FileDelete("",path);
-        end
-        return 0;
-    end
 end
 
 function LoginTslServer(usr,pwd,addr,port);
@@ -11097,6 +11000,22 @@ begin
     **}
     return(a and not(b))or(b and not(a));
 end
+function TslToHexFormatStr(tsl);
+begin
+    return unit(utslvclauxiliary).TslToHexFormatStr(tsl);
+end
+function HexFormatStrToTsl(D);
+begin
+    return unit(utslvclauxiliary).HexFormatStrToTsl(d);
+end
+function GetTextWidthAndHeightWidthFont(s,f,mul);
+begin
+    return unit(utslvclgdi).GetTextWidthAndHeightWidthFont(s,f,mul);
+end 
+function  CallMessgeFunction(f,o,e);
+begin
+    return unit(utslvclauxiliary).CallMessgeFunction(f,o,e);    
+end 
 
 
 Initialization

funcext/tvclib/utslvclauxiliary.tsf

@@ -32,6 +32,9 @@ function ParserCommandLine(s); //
 //function TslToHexStr(d);
 function TslToHexFormatStr(tsl);
 function HexFormatStrToTsl(D);
+function DeleteAllFiles(path);
+function CreateDirWithFileName(fname);
+
 type tuiglobaldata=class
     static UIData;
     class Function uisetdata(n,d);
@@ -1893,6 +1896,11 @@ begin
 end
 function TslToHexFormatStr(tsl);
 begin
+{**
+    @explan(说明) 将tsl类型转换为16进制字符串,每行长度为64,用\r\n分割 %%
+    @param(tsl)(any) tsl基础类型%%
+    @return(string) 字符串形式的16进制 %%
+**}
     s := TslToHexStr(tsl);
     r := "";
     n := length(s);
@@ -2119,6 +2127,73 @@ begin
     end
     return array(0,0);
 end
+function DeleteAllFiles(path);
+begin
+    {**
+    @explan(说明) 删除指定路径的文件或者文件夹 %% 
+    **}
+    if not ifstring(path)then return 0;
+    if not path then return 0;
+    iofp := ioFileseparator();
+    if path[length(path)]=iofp then return call(thisfunction,path[1:(length(path)-1)]);
+    info := FileList("",path); //"A"
+    if info then
+    begin
+        if pos("D",info[0]["Attr"])then
+        begin
+            fs := FileList("",path+iofp+"*");
+            for i,v in fs do
+            begin
+                n := v["FileName"];
+                if n in array(".","..")then continue;
+                call(thisfunction,path+iofp+n);
+            end
+            return RemoveDir("",path);
+        end else
+        begin
+            return FileDelete("",path);
+        end
+        return 0;
+    end
+end
+function CreateDirWithFileName(fname);
+begin
+    {**
+    @explan(说明) 根据文件全名构造目录 %%
+    **}
+    if not(ifstring(fname)and(length(fname)>4))then exit;
+    info := FileList("",fname);
+    if info then exit;
+    len := length(fname);
+    iofp := ioFileseparator();
+    for i := len downto 1 do
+    begin
+        vi := fname[i];
+        if vi=iofp then
+        begin
+            ffname := fname[1:i];
+            break;
+        end
+    end
+    if not ffname then exit;
+    nct := 4;
+    {$ifdef linux}
+    nct := 1;
+    {$endif}
+    ph := ffname[1:nct];
+    for i := nct+1 to length(ffname) do
+    begin
+        vi := ffname[i];
+        if vi=iofp then
+        begin
+            if not FileList("",ph)then
+            begin
+                CreateDir("",ph);
+            end
+        end
+        ph += vi;
+    end
+end
 
 initialization