From 0a3bcb40ef1b96a3d98040a5ad49016327c860b2 Mon Sep 17 00:00:00 2001 From: JianjunLiu Date: Wed, 9 Nov 2022 11:20:00 +0800 Subject: [PATCH] =?UTF-8?q?=E8=AE=BE=E8=AE=A1=E5=99=A8?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 浼樺寲浣撻獙 --- designer/tslvcldesigner.tsf | 24 +++++-- designer/udesignerproject.tsf | 17 +++++ designer/utslcodeeditor.tsf | 13 +++- funcext/tvclib/tcustomscrollcontrol.tsf | 19 ++++-- funcext/tvclib/utslmemo.tsf | 38 ++++++++--- funcext/tvclib/utslvclcoolbar.tsf | 25 +++----- funcext/tvclib/utslvcltree.tsf | 34 +++++----- .../tvclib/uvcpropertytypespersistence.tsf | 63 ++++++++++++++----- 8 files changed, 162 insertions(+), 71 deletions(-) diff --git a/designer/tslvcldesigner.tsf b/designer/tslvcldesigner.tsf index 52fcc5c..132a7fa 100644 --- a/designer/tslvcldesigner.tsf +++ b/designer/tslvcldesigner.tsf @@ -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; diff --git a/designer/udesignerproject.tsf b/designer/udesignerproject.tsf index 7ed447b..8f8e47d 100644 --- a/designer/udesignerproject.tsf +++ b/designer/udesignerproject.tsf @@ -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) diff --git a/designer/utslcodeeditor.tsf b/designer/utslcodeeditor.tsf index 1e62982..365a54f 100644 --- a/designer/utslcodeeditor.tsf +++ b/designer/utslcodeeditor.tsf @@ -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); diff --git a/funcext/tvclib/tcustomscrollcontrol.tsf b/funcext/tvclib/tcustomscrollcontrol.tsf index dbe6aec..c70d380 100644 --- a/funcext/tvclib/tcustomscrollcontrol.tsf +++ b/funcext/tvclib/tcustomscrollcontrol.tsf @@ -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 \ No newline at end of file diff --git a/funcext/tvclib/utslmemo.tsf b/funcext/tvclib/utslmemo.tsf index 0a65e7a..a864e6f 100644 --- a/funcext/tvclib/utslmemo.tsf +++ b/funcext/tvclib/utslmemo.tsf @@ -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 diff --git a/funcext/tvclib/utslvclcoolbar.tsf b/funcext/tvclib/utslvclcoolbar.tsf index 93b507a..e98b077 100644 --- a/funcext/tvclib/utslvclcoolbar.tsf +++ b/funcext/tvclib/utslvclcoolbar.tsf @@ -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 diff --git a/funcext/tvclib/utslvcltree.tsf b/funcext/tvclib/utslvcltree.tsf index eef8d14..49c22f2 100644 --- a/funcext/tvclib/utslvcltree.tsf +++ b/funcext/tvclib/utslvcltree.tsf @@ -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; diff --git a/funcext/tvclib/uvcpropertytypespersistence.tsf b/funcext/tvclib/uvcpropertytypespersistence.tsf index b4b1fd8..fb34785 100644 --- a/funcext/tvclib/uvcpropertytypespersistence.tsf +++ b/funcext/tvclib/uvcpropertytypespersistence.tsf @@ -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);