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

编辑器 

才分设计器,以及修正编辑器反撤销问题
This commit is contained in:
JianjunLiu 2022-09-23 15:48:14 +08:00
parent 930f4a87d1
commit 831166df5f
8 changed files with 8118 additions and 8428 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8243
designer/tslvcldesigner.tsf
View File

File diff suppressed because it is too large Load Diff

3478
designer/utslvcldcomponents.tsf Normal file
View File

File diff suppressed because it is too large Load Diff

4330
designer/utslvcldpropertytypes.tsf Normal file
View File

File diff suppressed because it is too large Load Diff

3
funcext/tvclib/tcomponent.tsf
View File

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

197
funcext/tvclib/tslvcl.tsf
View File

@ -6781,204 +6781,21 @@ type tlogincontrol=class(tpanel)
end
type TIniFileExta=class()
type TIniFileExta=class(TIniFileExter)
{**
@explan(说明) ini文件读写封装 %%
**}
private
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;
**}
function create(al,Fname);
begin
{**
@explan(说明) 构造函数 %%
@param(al)(string) 别名 %%
@param(name)(string) 文件名 %%
**}
if ifstring(al)and ifstring(Fname)then
begin
FIni := new TIniFile(al,Fname);
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;
inherited create();
filename := fname;
Alias := al;
end
end
type TCreateProcessA = class()

55
funcext/tvclib/utslmemo.tsf
View File

@ -254,16 +254,17 @@ type TTslMenoUndoList=class() //undolist
PushItem(CreateATslMemoUndoItem(AReason,AStart,AEnd,ChangeText,SelMode));
end;
end
procedure Clear;
procedure Clear();
begin
fItems.splices(nil,nil,array());
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,11 +1214,11 @@ 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
//¸Ä±ä
//¸Ä±ä
end
function DoCaretPosChanged();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);

234
funcext/tvclib/utslvclauxiliary.tsf
View File

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

6
funcext/tvclib/utslvclcoolbar.tsf
View File

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