编辑器

才分设计器,以及修正编辑器反撤销问题

funcext/tvclib/tcomponent.tsf

@@ -12,6 +12,7 @@ uses utslvclauxiliary,UVCPropertyTypesPersistence,utslvclbase;
     	@param(FComponentStyle)( array of integer) ½ÚµãÑùʽ %%	
     	@param(FFreeNotifies)( TFpList) Ïú»Ù֪ͨ½Úµã %%	
     **}
+    fasdomain;
     FOwner;
     FName;
     FComponents;
@@ -303,6 +304,7 @@ public
     end
     function RootOwner();
     begin
+        if fasdomain then return self(true);
         if not(FOwner is class(TComponent))then return self(true);
         return FOwner.RootOwner();
     end
@@ -648,5 +650,6 @@ public
     property ComponentStyle read FComponentStyle;
     property Name:string read FName write SetName;
     property Parent read ComponentGetParent write ComponentSetParent;
+    property asdomain read fasdomain write fasdomain;
     property Loader read GetLoader;
 end

funcext/tvclib/tslvcl.tsf

@@ -6781,204 +6781,21 @@ type tlogincontrol=class(tpanel)
 end
 
 
-type TIniFileExta=class()
+type TIniFileExta=class(TIniFileExter)
     {**
     @explan(说明) ini文件读写封装 %%
     **}   
-    private
+    function create(al,Fname);
-    FTStringa;
-    Fini;
-    FVtype;
-    FLowerKey;
-    FLowerValue;
-    function CheckSK(s,k);
-    begin
-        return ifstring(s) and s and ifstring(k) and k;
-    end
-    function ChangeV(V);
-    begin
-        vv := v;
-        case Vtype of
-            1:vv := vv="0"?false:true;
-            2:vv := StrToIntDef(vv,0);
-            else
-            begin
-                if FLowerValue then vv := lowercase(vv);
-            end
-        end
-        return vv;
-    end
-    function STNVA();
-    begin
-        {**
-        @explan(说明) 转换为name,value 列的二维数组 %%
-        **}
-        r := array();
-        for i := 0 to FTStringa.Count-1 do
-        begin
-            n := FTStringa.Names(i);
-            if n then
-            begin
-                if FLowerKey then n := lowercase(n);
-                vv := FTStringa.Values(n);
-                r[length(r)]:= array("name":n,"value":ChangeV(vv));
-            end
-        end
-        FTStringa.Clear();
-        return r;
-    end
-    function STNV();
-    begin
-        {**
-        @explan(说明) 转换为name:value 一维数组 %%
-        **}
-        nr := STNVA();
-        r := array();
-        for i,v in nr do
-        begin
-            r[v["name"]]:= v["value"];
-        end
-        return r;
-    end
-    function STA();
-    begin
-        {**
-        @explan(说明) 转换为一维数组 %%
-        **}
-        r := array();
-        for i := 0 to FTStringa.Count-1 do
-        begin
-            vi := FTStringa.Strings(i);
-            r[i]:= FLowerKey?lowercase(vi):vi;
-        end
-        FTStringa.Clear();
-        return r;
-    end
-    public
-    function create(al,Fname);override;
     begin
         {**
         @explan(说明) 构造函数 %%
         @param(al)(string) 别名 %%
         @param(name)(string) 文件名 %%
         **}
-        if ifstring(al)and ifstring(Fname)then
+        inherited create();
-        begin
+        filename := fname;
-            FIni := new TIniFile(al,Fname);
+        Alias := al;
-            FTStringa := new TStringlist();
-        end else
-        raise "ini对象读写构造参数错误";
     end  
-    function readSection(sn);virtual;
-    begin
-        {**
-        @explan(说明) 读取section 下面key %%
-        **}
-        if ifstring(sn)and sn then Fini.readSection(sn,FTStringa);
-        return STA();
-    end
-    function ReadSections();virtual;
-    begin
-        {**
-        @explan(说明) 读取所有section名字 %%
-        **}
-        FIni.ReadSections(FTStringa);
-        return STA();
-    end
-    function ReadSectionValues(sn);virtual;
-    begin
-        {**
-        @explan(说明) 读取section下面的所有key:value %%
-        **}
-        if ifstring(sn)and sn then FIni.ReadSectionValues(sn,FTStringa);
-        return STNV();
-    end
-    function RenameSection(sn1,sn2);virtual;
-    begin
-        {**
-        @explan(说明) 重命名section %%
-        @param(sn1)(string) 旧名字 %%
-        @param(sn2)(string) 新名字 %%
-        **}
-        if not(sn1 and sn2 and ifstring(sn1))and ifstring(sn2)then exit;
-        vs1 := ReadSectionValues(sn1);
-        EraseSection(sn1);
-        for i,v in vs1 do
-        begin
-            WriteKey(sn2,i,v);
-        end
-    end
-    function RenameKey(sec,k1,k2);virtual;
-    begin
-        {**
-        @explan(说明) 重命名key %%
-        @param(sec)(string) section名称 %%
-        @param(k1)(string) 旧名字 %%
-        @param(k2)(string) 新名字 %%
-        **}
-        if(sec and k2 and k1 and ifstring(sec)and ifstring(k1)and ifstring(k2))then exit;
-        v := ReadKey(sec,k1);
-        DeleteKey(sec,k1);
-        WriteKey(sec,k2,v);
-    end
-    function ReadSectionValues2(sn);
-    begin
-        {**
-        @explan(说明) 获得section 数据,二维表,name,value 列
-        **}
-        if ifstring(sn)and sn then FIni.ReadSectionValues(sn,FTStringa);
-        return STNVA();
-    end
-    function ReadSectionValues3(sn);
-    begin
-        {**
-        @explan(说明) 获得section 数据,二维表,0列为key,1列为value
-        **}
-        d := ReadSectionValues2(sn);
-        r := array();
-        for i,v in d do
-        begin
-            r[length(r)]:= array(v["name"],v["value"]);
-        end
-        return r;
-    end
-    function ReadKey(sn,key,def);virtual;
-    begin
-        {**
-        @explan(说明) 读取key %%
-        **}
-        if CheckSK(sn,key)then return FIni.ReadString(sn,key,ifstring(def)?def:"");
-        return nil;
-    end
-    function WriteKey(sn,key,v);virtual;
-    begin
-        {**
-        @explan(说明) 写入key %%
-        **}
-        if ifnil(v)then v := "";
-        if CheckSK(sn,key)then return FIni.WriteString(sn,key,ifstring(v)?v:tostn(v));
-        return 0;
-    end
-    function DeleteKey(sn,key);virtual;
-    begin
-        if CheckSK(sn,key)then return FIni.DeleteKey(sn,key);
-    end
-    function EraseSection(sn);virtual;
-    begin
-        {**
-        @explan(说明)删除section %%
-        **}
-        if ifstring(sn)and sn then return FIni.EraseSection(sn);
-    end
-    function Destroy();virtual;
-    begin
-        FIni := nil;
-        FTStringa := nil;
-    end
-    property VType read FVtype write FVtype;
-    property LowerKey read FLowerKey write FLowerKey;
-    property LowerValue read FLowerValue write FLowerValue;
-    _tag;
 end
 
 type TCreateProcessA = class()

funcext/tvclib/utslmemo.tsf

@@ -254,16 +254,17 @@ type TTslMenoUndoList=class() //undolist
             PushItem(CreateATslMemoUndoItem(AReason,AStart,AEnd,ChangeText,SelMode));
         end;
     end
-    procedure Clear;
+    procedure Clear();
     begin
+        if fItems.length()>0 then 
             fItems.splices(nil,nil,array());
         fFullUndoImposible := FALSE;
     end
-    procedure Lock;
+    procedure Lock();
     begin
         fLockCount++;
     end
-    procedure Unlock;
+    procedure Unlock();
     begin
         if fLockCount>0 then fLockCount--;
         return fLockCount;
@@ -302,6 +303,7 @@ type TTslMenoUndoList=class() //undolist
             pit.FLinkItem := it;
         end
     end
+    property LockCount read fLockCount;
     property CanUndo:boolean read GetCanUndo;
     property ItemCount:integer read GetItemCount;
     property MaxUndoActions:integer read fMaxUndoActions write SetMaxUndoActions;
@@ -630,6 +632,8 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
     @explan(说明) 带滚动条的编辑控件 %%
     **}
     private
+    fundoing;
+    fredoing;
     fselectbkcolor;//rgb(192,192,192);
     fcurrentLineColor;//rgb(232,232,255);
     fguttercolor;
@@ -1095,6 +1099,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
     end
     function MouseDown(o,e);override;
     begin
+        if class(tmemlocker).haslocker then return ;
         inherited;
         if e.skip then return ;
         IncPaintLock();
@@ -1141,6 +1146,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
     end
     function MouseUp(o,e);override;
     begin
+        if class(tmemlocker).haslocker then return ;
         inherited;
         if e.skip then return;
         UnClipCursor();
@@ -1167,6 +1173,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
     end
     function keypress(o,e);override;
     begin
+        if class(tmemlocker).haslocker then return ;
         if e.skip then return;
         c := e.wparam;
         if ReadOnly then return;
@@ -1207,7 +1214,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
         fUndoList.AddChange(crInsert,bb,r,s,0);
         SetCaretXY(r);
         UpdateCaret();
-        DoTextChanged(bb);
+        memtextchanged(bb);
     end
     function DoTextChanged(p);virtual;
     begin
@@ -1228,18 +1235,23 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
         FSelBegin := array(1,1);
         FSelEnd := array(1,1);
         ClearUndo();
-        DoTextChanged(array(1,1));
+        memtextchanged(array(1,1));
     end
     function Undo();
     begin
         if fUndoList.CanUndo then
         begin
+            lk := new tmemlocker();
             UndoItem();
         end
     end
     function Redo();
     begin
-        if fRedoList.CanUndo then RedoItem();
+        if fRedoList.CanUndo then 
+        begin
+            lk := new tmemlocker();
+            RedoItem();
+        end 
     end
     function CharInput(c);virtual;
     begin
@@ -1663,7 +1675,14 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
         return array(cy,cx+(ci?(0):1));
     end
     private 
-    
+    function memtextchanged(p);
+    begin
+        if not(fundoing or fredoing) then 
+        begin
+            fRedoList.Clear();
+        end 
+        return DoTextChanged(p);
+    end 
     function  setcurrentLineColor(c);
     begin
         if ifnumber(c) and c<>fcurrentLineColor then 
@@ -1860,6 +1879,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
             end
         end
         fUndoList.Lock();
+        fundoing := true;
         for i := length(tarr)-1 downto 0 do
         begin
             item := tarr[i];
@@ -1881,6 +1901,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
             end
         end
         fUndoList.UnLock();
+        fundoing := false;
         DecPaintLock();
         //处理
     end
@@ -1897,6 +1918,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
             item := item.FLinkItem;
             idx++;
         end
+        fredoing := true;
         for i := length(tarr)-1 downto 0 do
         begin
             item := tarr[i];
@@ -1918,6 +1940,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
                 fUndoList.MergeReplaceItem();
             end
         end
+        fredoing := false;
         DecPaintLock();
     end
     function GetLineText();
@@ -2235,7 +2258,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
             //if up then UpDateScroll();
             //UpDateCaret();
             DecPaintLock();
-            DoTextChanged(bb);
+            memtextchanged(bb);
         end
     end
     function DeleteSel(); //删除选择
@@ -3466,6 +3489,7 @@ type TSynCustomMemo = class(TCustomMemo)
 **}
     function DoTextChanged(p);override;//文本改变
     begin	
+        inherited;
         if Highlighter then 
     		        Highlighter.SetInValidateIndex(p[0]);
     end
@@ -3994,6 +4018,17 @@ type TSynMemoNorm = class(TsynCustomMemo) //
     FSheetTabFlage;   
 end 
 Implementation
+type tmemlocker = class() //Ëø¶¨¶ÔÏó
+    static haslocker;
+    function create();
+    begin
+        haslocker++;  
+    end 
+    function destroy();
+    begin
+        haslocker--;
+    end 
+end 
 function CreateATslMemoUndoItem(AReason,AStart,AEnd,ChangeText,SelMode);
 begin
     return new TTslMemoUndoItem(AReason,AStart,AEnd,ChangeText,SelMode);

funcext/tvclib/utslvclauxiliary.tsf

@@ -1773,6 +1773,240 @@ type tpairstate =class //
     FType;
 
 end 
+type TIniFileExter=class()
+    {**
+    @explan(说明) ini文件读写封装 %%
+    **}
+    private
+    FTStringa;
+    FVtype;
+    FLowerKey;
+    FLowerValue;
+    function CheckSK(s,k);
+    begin
+        return ifstring(s) and s and ifstring(k) and k;
+    end
+    function ChangeV(V);
+    begin
+        vv := v;
+        case Vtype of
+            1:vv := vv="0"?false:true;
+            2:vv := StrToIntDef(vv,0);
+            else
+            begin
+                if FLowerValue then vv := lowercase(vv);
+            end
+        end
+        return vv;
+    end
+    function STNVA();
+    begin
+        {**
+        @explan(说明) 转换为name,value 列的二维数组 %%
+        **}
+        r := array();
+        for i := 0 to FTStringa.Count-1 do
+        begin
+            n := FTStringa.Names(i);
+            if n then
+            begin
+                if FLowerKey then n := lowercase(n);
+                vv := FTStringa.Values(n);
+                r[length(r)]:= array("name":n,"value":ChangeV(vv));
+            end
+        end
+        FTStringa.Clear();
+        return r;
+    end
+    function STNV();
+    begin
+        {**
+        @explan(说明) 转换为name:value 一维数组 %%
+        **}
+        nr := STNVA();
+        r := array();
+        for i,v in nr do
+        begin
+            r[v["name"]]:= v["value"];
+        end
+        return r;
+    end
+    function STA();
+    begin
+        {**
+        @explan(说明) 转换为一维数组 %%
+        **}
+        r := array();
+        for i := 0 to FTStringa.Count-1 do
+        begin
+            vi := FTStringa.Strings(i);
+            r[i]:= FLowerKey?lowercase(vi):vi;
+        end
+        FTStringa.Clear();
+        return r;
+    end
+    public
+    function create();
+    begin
+        {**
+        @explan(说明) 构造函数 %%
+        @param(al)(string) 别名 %%
+        @param(name)(string) 文件名 %%
+        **}
+        FTStringa := new TStringlist();
+        FAlias := "";
+        ffilename := "";
+        
+    end
+    function readSection(sn);virtual;
+    begin
+        {**
+        @explan(说明) 读取section 下面key %%
+        **}
+        if ifstring(sn)and sn then Fini.readSection(sn,FTStringa);
+        return STA();
+    end
+    function ReadSections();virtual;
+    begin
+        {**
+        @explan(说明) 读取所有section名字 %%
+        **}
+        FIni.ReadSections(FTStringa);
+        return STA();
+    end
+    function ReadSectionValues(sn);virtual;
+    begin
+        {**
+        @explan(说明) 读取section下面的所有key:value %%
+        **}
+        if ifstring(sn)and sn then FIni.ReadSectionValues(sn,FTStringa);
+        return STNV();
+    end
+    function RenameSection(sn1,sn2);virtual;
+    begin
+        {**
+        @explan(说明) 重命名section %%
+        @param(sn1)(string) 旧名字 %%
+        @param(sn2)(string) 新名字 %%
+        **}
+        if not(sn1 and sn2 and ifstring(sn1))and ifstring(sn2)then exit;
+        vs1 := ReadSectionValues(sn1);
+        EraseSection(sn1);
+        for i,v in vs1 do
+        begin
+            WriteKey(sn2,i,v);
+        end
+    end
+    function RenameKey(sec,k1,k2);virtual;
+    begin
+        {**
+        @explan(说明) 重命名key %%
+        @param(sec)(string) section名称 %%
+        @param(k1)(string) 旧名字 %%
+        @param(k2)(string) 新名字 %%
+        **}
+        if(sec and k2 and k1 and ifstring(sec)and ifstring(k1)and ifstring(k2))then exit;
+        v := ReadKey(sec,k1);
+        DeleteKey(sec,k1);
+        WriteKey(sec,k2,v);
+    end
+    function ReadSectionValues2(sn);
+    begin
+        {**
+        @explan(说明) 获得section 数据,二维表,name,value 列
+        **}
+        if ifstring(sn)and sn then FIni.ReadSectionValues(sn,FTStringa);
+        return STNVA();
+    end
+    function ReadSectionValues3(sn);
+    begin
+        {**
+        @explan(说明) 获得section 数据,二维表,0列为key,1列为value
+        **}
+        d := ReadSectionValues2(sn);
+        r := array();
+        for i,v in d do
+        begin
+            r[length(r)]:= array(v["name"],v["value"]);
+        end
+        return r;
+    end
+    function ReadKey(sn,key,def);virtual;
+    begin
+        {**
+        @explan(说明) 读取key %%
+        **}
+        if CheckSK(sn,key)then return FIni.ReadString(sn,key,ifstring(def)?def:"");
+        return nil;
+    end
+    function WriteKey(sn,key,v);virtual;
+    begin
+        {**
+        @explan(说明) 写入key %%
+        **}
+        if ifnil(v)then v := "";
+        if CheckSK(sn,key)then return FIni.WriteString(sn,key,ifstring(v)?v:tostn(v));
+        return 0;
+    end
+    function DeleteKey(sn,key);virtual;
+    begin
+        if CheckSK(sn,key)then return FIni.DeleteKey(sn,key);
+    end
+    function EraseSection(sn);virtual;
+    begin
+        {**
+        @explan(说明)删除section %%
+        **}
+        if ifstring(sn)and sn then return FIni.EraseSection(sn);
+    end
+    function Destroy();virtual;
+    begin
+        finiobj := nil;
+        FTStringa := nil;
+    end
+    property VType read FVtype write FVtype;
+    property LowerKey read FLowerKey write FLowerKey;
+    property LowerValue read FLowerValue write FLowerValue;
+    property Alias read FAlias write setalias;   //目录别名
+    property filename read ffilename write setfilename; //文件名
+    _tag;
+    private 
+    property Fini read getiniobj write finiobj;
+    private     
+    function getiniobj();
+    begin
+        if not(finiobj) then 
+        begin
+            if ifstring(FAlias) and ifstring(ffilename) then 
+            begin
+                finiobj := new TIniFile(FAlias,ffilename);
+            end else 
+            begin
+                raise "ini读写文件错误";
+            end 
+        end 
+        return finiobj;
+    end 
+    function setfilename(v);
+    begin
+        if ifstring(v) and v<>ffilename then 
+        begin
+            ffilename := v;   
+            finiobj := nil; 
+        end   
+    end 
+    function setalias(v);
+    begin
+        if ifstring(v) and v<>FAlias then 
+        begin
+            FAlias := v;   
+            finiobj := nil; 
+        end     
+    end 
+    FAlias;
+    ffilename;
+    finiobj;
+end
 implementation
 function includestate(u,s);
 begin

funcext/tvclib/utslvclcoolbar.tsf

@@ -31,7 +31,7 @@ type tcustomcoolbar=class(tcustomcontrol)
     function Notification(o,op);override;
     begin
         r := inherited;
-        if  class(tflag).haslocker then  return r;
+        if  class(tcoolbarlocker).haslocker then  return r;
         if (o is class(TWinControl)) and o.WsPopUp then return r;
         if HandleAllocated() and ifarray(op) and (op["type"]="possize") then //位置大小发送变化 
         begin 
@@ -182,7 +182,7 @@ type tcustomcoolbar=class(tcustomcontrol)
                 return ;
             end 
         end 
-        lk := new tflag();
+        lk := new tcoolbarlocker();
         for i,v in fcoolbands.data2 do 
         begin
             x := 0;   
@@ -663,7 +663,7 @@ type tcoolbarlines = class() //
     end 
     flines;
 end
-type tflag = class() //锁定对象
+type tcoolbarlocker = class() //锁定对象
     static haslocker;
     function create();
     begin