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

设计器 

优化体验
This commit is contained in:
JianjunLiu 2022-11-09 11:20:00 +08:00
parent c23b5d8522
commit 0a3bcb40ef
8 changed files with 162 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
designer/tslvcldesigner.tsf
View File

@ -1196,12 +1196,24 @@ type TVclDesigner = class(tvcform)
begin
v._tag := array(thisfunction(saveCurrentForm),v.onclick);
v.onclick := function(o,e)
begin
for i,v in o._tag do
begin
CallDataFunction(v,o,e);
end
end
begin
for i,v in o._tag do
begin
CallDataFunction(v,o,e);
end
end
end
ebtn := FProjectManager.FTslEditer.gettoolbarbtn((3->13));//´¦ÀíÆäËûµÄ¹¤¾ß°´Å¥
for i,v in ebtn do
begin
v._tag := array(function(o,e)begin FProjectManager.ShowEditor(); end ,v.onclick);
v.onclick := function(o,e)
begin
for i,v in o._tag do
begin
CallDataFunction(v,o,e);
end
end
end
tlbar.Align := alLeft;
tlbar.width :=450;

17
designer/udesignerproject.tsf
View File

@ -489,6 +489,7 @@ type TProjectView = class(TVCForm) //
FOpenMenu.OnClick := thisfunction(OpenTreeNode);
FOpenMenu.parent := fpm;
FTree.OnSelChanged := thisfunction(TreeNodeChanged);
ftree.OnSelChanging := thisfunction(treenodechanging);
FTree.OnDblClick := function(o,e)
begin
OpenTreeNode();
@ -499,6 +500,7 @@ type TProjectView = class(TVCForm) //
end
function setnodesel(nd);
begin
if fopenbuzy then return ;
ftree.setsel(nd);
end
function OpenTreeNode(); //打开当前节点
@ -517,8 +519,16 @@ type TProjectView = class(TVCForm) //
OpenFileByName(cn.FName);
end
end
function treenodechanging(o,e);
begin
if fopenbuzy then
begin
e.skip := true;
end
end
function TreeNodeChanged(o,e); //节点切换
begin
if FTree.PopUpMenu then
begin
it := e.itemnew;
@ -772,6 +782,7 @@ type TProjectView = class(TVCForm) //
function OpenFileByName(n); //打开文件
begin
if fopenbuzy then return ;
fio := ioFileseparator();
if not(n and ifstring(n)) then return FDesigner.ExecuteCommand("hiddrennode",nil);;
nopend := FTree.NameInTree(n,nil,true);
@ -784,6 +795,7 @@ type TProjectView = class(TVCForm) //
begin
return 0;
end
FCurrentOpend := nopend;
case FCurrentOpend["type"]of
"tsl","tsf":
@ -816,6 +828,8 @@ type TProjectView = class(TVCForm) //
return messageboxa("非窗口类,或者该文件已经损坏","错误",0,self);
end
//打开界面
fopenbuzy := true;
FDesigner.caption := "TVCL界面设计器 "+FprojName+"->"+FCurrentOpend["name"];
FTmfParser.fssourdirs := FCurrentOpend.gettmfdirs();
tfm := FCurrentOpend.gettmfname();
@ -833,6 +847,7 @@ type TProjectView = class(TVCForm) //
FDesigner.LoadTreeNode(FTmfParser,inh,FCurrentOpend);
FDesigner.EditerCodeChanged();
end
fopenbuzy := false;
end else
begin
FDesigner.ExecuteCommand("hiddrennode",nil);
@ -842,6 +857,7 @@ type TProjectView = class(TVCForm) //
return;
end
end
fopenbuzy := false;
end
function getwindowinherited2(fn);
begin
@ -1667,6 +1683,7 @@ end
FTslEditer;
property tree read ftree;
private
fopenbuzy;
end
type TTslEditer = class(TEditer)

13
designer/utslcodeeditor.tsf
View File

@ -2144,8 +2144,19 @@ type TEditer=class(TCustomcontrol) //
begin
return fcoolbar;//FToolbar;
end
function gettoolbarbtn();
function gettoolbarbtn(idxs);
begin
if ifarray(idxs) then
begin
r := array();
ri := 0;
for i,v in idxs do
begin
bi := ftoolbara.getbtnbyindex(v);
if bi then r[ri++] := bi;
end
return r;
end
return array(ftoolbara.getbtnbyindex(1),ftoolbara.getbtnbyindex(2));
end
function ShowLogWnd(flg);

19
funcext/tvclib/tcustomscrollcontrol.tsf
View File

@ -1,4 +1,7 @@
type tcustomscrollcontrol = class(TCustomControl)
{**
@explan(说明)带滚动条的窗口类 %%
**}
uses utslvclmemstruct;
{**
@explan(说明) 带滚动条的自绘制窗口 %%
@ -232,7 +235,7 @@ type tcustomscrollcontrol = class(TCustomControl)
// 用户拖动滚动条
SB_THUMBTRACK:
begin
if ThumbTrack then
if FThumbTrack then
begin
FSI.nPos := FSI.nTrackPos;
end
@ -296,7 +299,7 @@ type tcustomscrollcontrol = class(TCustomControl)
// 用户拖动滚动条
SB_THUMBTRACK:
begin
if ThumbTrack then
if FThumbTrack then
begin
FSI.nPos := FSI.nTrackPos;
end
@ -364,6 +367,7 @@ type tcustomscrollcontrol = class(TCustomControl)
function AfterConstruction();override;
begin
inherited;
FThumbTrack := true;
FLocalX := 0;
FLocalY := 0;
FLocalXold := 0;
@ -372,8 +376,13 @@ type tcustomscrollcontrol = class(TCustomControl)
FSI := new TScrollinfo();
FSI.cbSize := FSI._size_;
end
property AutoScroll read FAutoScroll write SetAutoScroll;
property ThumbTrack read FThumbTrack write FThumbTrack;
property WhileStep read FWhileStep write SetWhileStep; //滚动步长
property AutoScroll:integer read FAutoScroll write SetAutoScroll;
property ThumbTrack:bool read FThumbTrack write FThumbTrack;
property WhileStep:integer read FWhileStep write SetWhileStep; //滚动步长
{**
@param(AutoScroll)(integer) 0,1,2,3 滚动条模式 %%
@param(ThumbTrack)(bool) 拖动按钮 %%
@param(WhileStep)(integer) 滚动步长 %%
**}
end

38
funcext/tvclib/utslmemo.tsf
View File

@ -632,6 +632,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
@explan(说明) 带滚动条的编辑控件 %%
**}
private
ftmemlockv;
fundoing; //清空unredo标记
fredoing; //清空unredo标记
fselectbkcolor;//rgb(192,192,192);
@ -1006,6 +1007,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
function Create(AOwner);override;
begin
inherited;
ftmemlockv := new tmemlockv();
FGutterColor := rgb(228,228,228);
fcurrentLineColor := rgb(232,232,255);
fselectbkcolor := rgb(192,192,192);
@ -1106,7 +1108,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
end
function MouseDown(o,e);override; //按下鼠标
begin
if class(tmemlocker).haslocker then return ;
if ftmemlockv.haslocker then return ;
inherited;
if e.skip then return ;
IncPaintLock();
@ -1153,7 +1155,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
end
function MouseUp(o,e);override;
begin
if class(tmemlocker).haslocker then return ;
if ftmemlockv.haslocker then return ;
inherited;
if e.skip then return;
UnClipCursor();
@ -1180,7 +1182,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
end
function keypress(o,e);override; //输入字符
begin
if class(tmemlocker).haslocker then return ;
if ftmemlockv.haslocker then return ;
if e.skip then return;
c := e.wparam;
if ReadOnly then return;
@ -1248,7 +1250,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
begin
if fUndoList.CanUndo then
begin
lk := new tmemlocker();
lk := new tmemlocker(ftmemlockv);
UndoItem();
end
end
@ -1256,7 +1258,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //
begin
if fRedoList.CanUndo then
begin
lk := new tmemlocker();
lk := new tmemlocker(ftmemlockv);
RedoItem();
end
end
@ -4094,16 +4096,32 @@ type TSynMemoNorm = class(TsynCustomMemo) //
FSheetTabFlage;
end
Implementation
type tmemlocker = class() //Ëø¶¨¶ÔÏó
static haslocker;
function create();
type tmemlockv = class()
haslocker;
function create();
begin
haslocker++;
haslocker := 0;
end
function add();
begin
haslocker++;
end
function del();
begin
haslocker--;
end
end
type tmemlocker = class() //Ëø¶¨¶ÔÏó
function create(v);
begin
flk := v;
flk.add();
end
function destroy();
begin
haslocker--;
flk.del();
end
flk;
end
function CreateATslMemoUndoItem(AReason,AStart,AEnd,ChangeText,SelMode);
begin

25
funcext/tvclib/utslvclcoolbar.tsf
View File

@ -13,6 +13,7 @@ type tcustomcoolbar=class(tcustomcontrol)
fcoolbands := new tcoolbarlines();
fbtnwidth := 20;
fautosize := true;
fdoaligncount :=0;
inherited;
end
@ -41,15 +42,14 @@ type tcustomcoolbar=class(tcustomcontrol)
end
function Notification(o,op);override;
begin
if class(tcoolbarlocker).haslocker then return ;
if fsizelocker then return ;
if (o is class(TWinControl)) and o.WsPopUp then return ;
if HandleAllocated() and ifarray(op) and (op["type"]="possize") then //位置大小发送变化
begin
ctls := controls;
if (ctls.IndexOf(o)>=0) then //子控件大小变化
begin
doControlALign();
InvalidateRect(nil,false);
doControlALign();//InvalidateRect(nil,false);
return ;
end
end
@ -177,7 +177,7 @@ type tcustomcoolbar=class(tcustomcontrol)
y := 0;
rhs := fcoolbands.getrowheights();
bal := Align;
if autosize and ( bal =alTop or bal=alBottom) then
if fdoaligncount<5 and autosize and ( bal =alTop or bal=alBottom) then
begin
rc := ClientRect;
nh := sum(rhs);
@ -189,10 +189,12 @@ type tcustomcoolbar=class(tcustomcontrol)
Align := alNone;
Height := bw+nh;
Align := bal;
fdoaligncount++;
return ;
end
end
lk := new tcoolbarlocker();
fdoaligncount := 0;
fsizelocker := true;
for i,v in fcoolbands.data2 do
begin
x := 0;
@ -245,6 +247,7 @@ type tcustomcoolbar=class(tcustomcontrol)
end
end
fsizelocker := false;
end
function paint();override; //绘制
begin
@ -278,6 +281,7 @@ type tcustomcoolbar=class(tcustomcontrol)
property arrange:lazystr read getarrange write setarrange;
property dragbtncolor:color read fdragbtncolor write fdragbtncolor;
private
fdoaligncount;
fautosize ;
fdragbtncolor;
fsizelocker;
@ -682,17 +686,6 @@ type tcoolbarlines = class() //
end
flines;
end
type tcoolbarlocker = class() //Ëø¶¨¶ÔÏó
static haslocker;
function create();
begin
haslocker++;
end
function destroy();
begin
haslocker--;
end
end
function getmovebmp(); //移动图片
begin
return "0502000000060400000074797065000203000000696D670006040000006461746

34
funcext/tvclib/utslvcltree.tsf
View File

@ -88,7 +88,6 @@ type TcustomTreeCtlNode = class(TVirtualListItem)
FExpandWidth; //展开按钮宽度
FCheckWidth; //checkbox宽度
FFocusColor;
//FNodeHash;
FHierarchyWidth;
function DrawCheckBox(cvs,x,rec,sz,flag); //绘制checkbox
begin
@ -108,7 +107,7 @@ type TcustomTreeCtlNode = class(TVirtualListItem)
end else
if ChildChecked()then
begin
cvs.brush.color := rgb(10,10,10);
cvs.brush.color :=0x0a0a0a ;//rgb(10,10,10);
cvs.fillrect(dr[0]+8 union dr[1]-4);
ow := Owner;
if self=ow.CurrentNode then cvs.brush.color := FFocusColor[ow.hasFocus()];
@ -175,7 +174,7 @@ type TcustomTreeCtlNode = class(TVirtualListItem)
**}
ow := Owner;
if not ow then return;
cvs.Pen.Color := rgb(50,50,50);
cvs.Pen.Color := 0x323232;//rgb(50,50,50);
cvs.Pen.style := PS_SOLID;
cvs.Pen.width := 1;
inv := 3;
@ -243,11 +242,11 @@ type TcustomTreeCtlNode = class(TVirtualListItem)
cvs.drawtext(FCaption,FCaptionRect,DT_VCENTER .| DT_SINGLELINE .| DT_NOPREFIX);
if ow.HasLine then
begin
cvs.Pen.Color := rgb(150,150,150);
cvs.Pen.Color := 0x969696;
cvs.Pen.style := PS_DOT;
for i,v in ow.GetHierarchyByHandle(self.Handle) do
begin
FLG := TRUE;
//FLG := TRUE;
//nx := cbase-FHierarchyWidth*(i+1)+6;
nx := cbase+FHierarchyWidth *(i-FHierarchy-1)+6;
if nx>cbase-5 then break;
@ -265,8 +264,8 @@ type TcustomTreeCtlNode = class(TVirtualListItem)
{**
@explan(说明) 点击消息处理
**}
ps := e.pos;
px := ps[0];
//ps := e.pos;
px := e.xpos;//ps[0];
rec := o.GetIndexRect(o.GetItemIndexByYpos(e.ypos)); //获得位置
recx := rec[0];
if(FItems.Count or FDirtype)and px >= FExpandPos and px <=(FExpandPos+FExpandWidth)then //点击展开
@ -308,8 +307,7 @@ type TcustomTreeCtlNode = class(TVirtualListItem)
FVisible := true;
FMouseCanChecked := true;
FModifyChildrenChecked := true;
FFocusColor := array(rgb(230,240,250),rgb(0,192,250));
//FNodeHash := array();
FFocusColor := array(0xfaf0e6,0xfac000) ;//array(rgb(230,240,250),rgb(0,192,250));
FCheckWidth := 16;
FExpandWidth := 12;
FBasePos := 10;
@ -1657,7 +1655,7 @@ type TcustomTreeCtl = class(TVirtualList)
for i,it in its do if it is class(TcustomTreeCtlNode)then lst[lsti++]:= it;
inherited InsertItems(lst,idx);
end
function WMKEYUP(o,e):WM_KEYUP;virtual;
function WMKEYUP(o,e);override;
begin
if not FCurrentNode then return;
if e.skip then return ;
@ -1833,8 +1831,6 @@ type TcustomTreeCtl = class(TVirtualList)
end
function Recycling();override;
begin
//setprofiler(1+2+4);
//exportfile(ftstream(),"","d:\\tst\\abc.stm",getprofilerinfo(true));
flockchangedcall := true;
if FRootItem then FRootItem.Recycling();
flockchangedcall := false;
@ -1842,7 +1838,6 @@ type TcustomTreeCtl = class(TVirtualList)
FCurrentNode := nil;
FOnSelChanging := nil;
FonEmptyNodeExapanding := nil;
FNodeHierarchyWidth := 20;
//fnodecreator := nil;
inherited;
end
@ -1854,11 +1849,14 @@ type TcustomTreeCtl = class(TVirtualList)
begin
if HandleAllocated()then
begin
e := new TTreeSelCHngedEvent(self.Handle,0,0,0);
e.item := item;
e.ItemNew := item;
e.ItemOld := item;
calldatafunction(onEmptyNodeExapanding,self(true),e);
if FonEmptyNodeExapanding then
begin
e := new TTreeSelCHngedEvent(self.Handle,0,0,0);
e.item := item;
e.ItemNew := item;
e.ItemOld := item;
calldatafunction(FonEmptyNodeExapanding,self(true),e);
end
end
end
function Clean();override;

63
funcext/tvclib/uvcpropertytypespersistence.tsf
View File

@ -84,6 +84,7 @@ type TTmfParserToken = class(TTmfParserbase)
FScriptLen;
FCurrent;
FNumbers;
FHexnumbers;
Ffloat;
FTokens;
FSplitter; //·Ö¸ô·û
@ -246,6 +247,8 @@ type TTmfParserToken = class(TTmfParserbase)
len := 0;
ct := ""; //µ±Ç°×Ö·û
pnumber := true;
kb := array(" ":1,"\t":1,"\r":1,"\n":1);
fgf := array(' ':1,'\t':1,"\r":1,"\n":1,";":1,",":1);
while whileok() do
begin
c := cchar();
@ -263,23 +266,38 @@ type TTmfParserToken = class(TTmfParserbase)
delct(r,ct,len,TT_SYM);
delct(r,Pstring(c),len,TT_STR);
end else
if c in array(' ','\t',"\r","\n",";",",")then
if fgf[c] then // in array(' ','\t',"\r","\n",";",",")
begin
if ct="0" and pnumber then delct(r,ct,len,TT_NUM);
else delct(r,ct,len,TT_SYM);
end else
if c="{" then
begin
pnumber := false;
//pnumber := false;
delct(r,ct,len,TT_SYM);
delct(r,c,len,TT_SIG);
end else
if c="}" then
begin
delct(r,ct,len,TT_SYM);
delct(r,c,len,TT_SIG);
pnumber := true;
delct(r,c,len,TT_SIG);
ct:="";
while whileok() do
begin
c := cchar();
if kb[c] then continue;
if c="}" then
begin
delct(r,ct,len,TT_BIN);
delct(r,c,len,TT_SIG);
break;
end else
begin
ct+=c;
end
end
end else
// if c="}" then
// begin
// delct(r,ct,len,TT_SYM);
// delct(r,c,len,TT_SIG);
// pnumber := true;
// end else
if c in array("=",":","(",")","<",">","[","]")then
begin
delct(r,ct,len,TT_SYM);
@ -295,7 +313,7 @@ type TTmfParserToken = class(TTmfParserbase)
delct(r,ct,len,TT_SYM);
delct(r,c+Pnumber(),len,TT_NUM);
end else
if(c in FNumbers)and pnumber and(not(ct)) {(not(ct)) and (r[len][0]="=")}then
if(FNumbers[c])and pnumber and(not(ct)) {(not(ct)) and (r[len][0]="=")}then
begin
delct(r,ct,len,TT_SYM);
v := c+Pnumber();
@ -342,14 +360,14 @@ type TTmfParserToken = class(TTmfParserbase)
**}
c := cchar();
c := lowercase(c);
its := inttostr(0 -> 9)union array("a","b","c","d","e","f");
//its := inttostr(0 -> 9)union array("a","b","c","d","e","f");
r := "";
if c="x" then
begin
while whileok() do
begin
c := lowercase(cchar());
if not(c in its)then
c := cchar();
if not(FHexnumbers[c])then
begin
cback();
break;
@ -389,8 +407,23 @@ type TTmfParserToken = class(TTmfParserbase)
function create();override;
begin
inherited;
FNumbers := inttostr(0 -> 9);
Ffloat := FNumbers union array(".");
//FNumbers := inttostr(0 -> 9);
FNumbers := array();
FHexnumbers := array();
for i := 0 to 9 do
begin
FNumbers[inttostr(i)] := true;
FHexnumbers[inttostr(i)] := true;
end
for i,v in array("A","B","C","D","E","F") do
begin
FHexnumbers[v] := true;
end
for i,v in array("a","b","c","d","e","f") do
begin
FHexnumbers[v] := true;
end
//Ffloat := FNumbers union array(".");
FSplitter := array(' ','\t',"\r","\n",";",",");
FSyms := array("=",":","(",")","<",">","[","]");
FNumberChar := inttostr(0 -> 9);