From 4519cff2a075ccf0fe4d30658d9387ba23491bd5 Mon Sep 17 00:00:00 2001 From: JianjunLiu Date: Wed, 2 Nov 2022 17:17:35 +0800 Subject: [PATCH] =?UTF-8?q?=E7=95=8C=E9=9D=A2=E5=BA=93?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 浼樺寲 --- funcext/tvclib/tslvcl.tsf | 172 +++++++----------- funcext/tvclib/utslvclauxiliary.tsf | 20 ++ funcext/tvclib/utslvclpage.tsf | 39 ++-- .../tvclib/uvcpropertytypespersistence.tsf | 74 ++++---- 4 files changed, 138 insertions(+), 167 deletions(-) diff --git a/funcext/tvclib/tslvcl.tsf b/funcext/tvclib/tslvcl.tsf index 4b091cb..910a134 100644 --- a/funcext/tvclib/tslvcl.tsf +++ b/funcext/tvclib/tslvcl.tsf @@ -3007,33 +3007,6 @@ type TPairSplitterSide=class(TCustomControl) cursor := OCR_NORMAL; border := true; end - function CreateParams(p);override; - begin - inherited; - end - function SetParent(p);override; - begin - if(P is class(TPairSplitter))and parent <> p then - begin - oldparent := Parent; - if oldparent then - begin - oldparent.RemoveSide(self); - end - inherited; - parent.AddSide(self(true)); - end else - if not(p is class(TWincontrol))then - begin - odp := Parent; - inherited; - if odp then odp.RemoveSide(self); - end - end - function Recycling();override; - begin - inherited; - end function publishs();override; begin return array("name","border","caption","color","font","parentcolor","parentfont","popupmenu","bkbitmap","wsdlgmodalframe","onsize","onnotification"); @@ -3052,27 +3025,31 @@ type TPairSplitter=class(tcustomcontrol) // FSplitterType; Fhimgelist; FEnables; - function EnabledChild(f); + function AddSide(ASide);//添加side begin - if f then + if not(ASide is class(TPairSplitterSide))then return -1; + FSides.Push(ASide); + end + function EnabledChild(f);//enabeld + begin + if f then begin - if FEnables[0]then FSides[0].enabled := true; - if FEnables[1]then FSides[1].enabled := true; - return; - end - FEnables := array(); - s1 := FSides[0]; - S2 := FSides[1]; - if s1 then + for i,v in FEnables do + begin + if v then + begin + FSides[i].enabled := true; + end + end + end else begin - FEnables[0]:= s1.enabled; - s1.enabled := false; - end - if s2 then - begin - FEnables[1]:= s2.enabled; - s2.enabled := false; - end + FEnables := array(); + for i,v in FSides.data do + begin + FEnables[i] := v.enabled; + v.enabled := false; + end + end end Function SetSplitterType(v); begin @@ -3105,12 +3082,41 @@ type TPairSplitter=class(tcustomcontrol) // DoControlAlign(); end end - protected - function GetSides(index); + function getvisbleside(id); begin - return FSides[index]; - end + c := 0; + for i := 0 to fsides.length()-1 do + begin + v := fsides[i]; + if v.Visible then + begin + if c = id then return v; + c++; + end + end + end public + function ControlAppended(AControl);override; + begin + if not FSides then return ; + AddSide(AControl); + end + function ControlDeleted(AControl);override; + begin + if not FSides then return ; + for i,v in FSides.data do + begin + if v=AControl then + begin + FSides.splice(i,1); + return ; + end + end + end + function checknewchild(c);override; + begin + return c is class(TPairSplitterSide); + end function create(AOwner);override; begin inherited; @@ -3118,35 +3124,18 @@ type TPairSplitter=class(tcustomcontrol) // function AfterConstruction();override; begin inherited; + FSides := new tnumindexarray(); caption := "pairspliter"; width := 200; height := 200; Border := false; WsDlgModalFrame := true; - FSides := new TFpList(); FSplitterType := pstHorizontal; cursor := OCR_SIZEWE; FWill_Drag := true; Color := _wapi.GetSysColor(COLOR_MENUBAR); end - function AddSide(ASide); - begin - {** - @explan(说明) 添加side - **} - if not(ASide is class(TPairSplitterSide))then return -1; - if ASide.Parent=self then - begin - if FSides.indexof(ASide)<0 {and FSides.count<2}then - begin - FSides.add(ASide); - DoControlAlign(); - end - end else - begin - ASide.parent := self; - end - end + function MouseUp(o,e);override; begin if csDesigning in ComponentState then exit; @@ -3179,8 +3168,7 @@ type TPairSplitter=class(tcustomcontrol) // if x>(r[3]-2) then begin x := r[3]-5; - end - + end FPosition :=x; end EnabledChild(true); @@ -3231,14 +3219,7 @@ type TPairSplitter=class(tcustomcontrol) // _wapi.ImageList_DragMove(nxy[0],nxy[1]); end else begin - idx := 0; - for i:= 0 to FSides.count-1 do - begin - vi := FSides[i]; - if vi.Enabled and vi.Visible then idx++; - if idx>1 then break; - end - if idx>1 then + if getvisbleside(0) then begin if FSplitterType=pstHorizontal then begin @@ -3255,36 +3236,14 @@ type TPairSplitter=class(tcustomcontrol) // end inherited; end - function RemoveSide(ASide); - begin - {** - @explan(说明)pairsider %% - **} - id := FSides.indexof(ASide); - if id<0 then exit; - FSides.deli(id); - DoControlAlign(); - if ASide.parent=self then - begin - ASide.parent := nil; - end - end - function Notification(AComponent,Operation);override; - begin - if Operation=opRemove then - begin - RemoveSide(AComponent); - end - inherited; - end function DoControlAlign();override; begin {** @explan(说明) 对齐调整 %% **} if not HandleAllocated()then return; - sd1 := GetSides(0); - sd2 := GetSides(1); + sd1 := getvisbleside(0); + sd2 := getvisbleside(1); if not(sd1 or sd2)then return; rc := GetClientRect(); pz := GetPosition(); @@ -3308,8 +3267,8 @@ type TPairSplitter=class(tcustomcontrol) // end function paint();override; begin - sd1 := GetSides(0); - sd2 := GetSides(1); + sd1 := getvisbleside(0); + sd2 := getvisbleside(1); if not(sd1 or sd2)then return; rc := GetClientRect(); pz := GetPosition(); @@ -3334,13 +3293,12 @@ type TPairSplitter=class(tcustomcontrol) // if x1>rc[0] and x1= 1 then + begin + cc := ord(s[1]); + if IsLowercaseLetter(cc)or cc=CD_UDL then + begin + for i := 2 To length(s) do + begin + cc := ord(s[i]); + if not(IsLowercaseLetter(cc)or IsNumber(cc)or(cc=CD_UDL))then + begin + return false; + end + end + return true; + end + end + return 0; + end function create(); begin sinit(); diff --git a/funcext/tvclib/utslvclpage.tsf b/funcext/tvclib/utslvclpage.tsf index 944a1c5..3a6e227 100644 --- a/funcext/tvclib/utslvclpage.tsf +++ b/funcext/tvclib/utslvclpage.tsf @@ -11,10 +11,11 @@ type tcustomtabsheet = class(TCustomControl) // function RealSetText(s);override; begin inherited; - if ifstring(s) and Parent then + p := parent; + if ifstring(s) and p and (p is class(tcustompagecontrol)) then begin - id := parent.GetPageID(self(true)); - Parent.SetTabText(id,s); + id := p.GetPageID(self(true)); + p.SetTabText(id,s); end end public @@ -33,15 +34,10 @@ type tcustomtabsheet = class(TCustomControl) // function create(AOwner);override; begin inherited; - WsDlgModalFrame := true; + WsDlgModalFrame := true; //p.exstyle := 0x101; Caption := "tab"; Visible := false; end - {function CreateParams(p);override; - begin - inherited; - p.exstyle := 0x101; - end } end type tcustompagecontrol = class(TCustomControl) private @@ -90,7 +86,7 @@ type tcustompagecontrol = class(TCustomControl) begin pg := FTabItems[i]; ta := pg.Caption; - FTabItemswidth[i] := max(20, length(ta)*fw+8 ); + FTabItemswidth[i] := max(20, length(ta)*fw+10 ); end FMaxsize := 0; if FTabPosition in array(alLeft,alRight) then @@ -263,6 +259,7 @@ type tcustompagecontrol = class(TCustomControl) function PaintTabs(); begin dc := Canvas; + dc.font := font; for i := 0 to FTabItems.length()-1 do begin rec := FTabRects[i]; @@ -377,7 +374,13 @@ type tcustompagecontrol = class(TCustomControl) setselidx(0); end end - public + public + function FontChanged(o);override; + begin + inherited; + DoControlAlign(); + end + function getsheetrect(); //获得sheet begin {** @@ -548,16 +551,11 @@ type tcustompagecontrol = class(TCustomControl) @param(Value)(string)文本 %%; **} it := FTabItems[i]; - if it then + if it and value<>it.caption then begin - if Value = it.caption then - begin - CalcTabs(); - InvalidateRect(nil,false); - end else - begin - it.Caption := Value; - end + it.Caption := Value; + DoControlAlign(); + InvalidateRect(nil,false); end end function SetTabIndex(AIndex,AIndexnew); @@ -627,7 +625,6 @@ type tcustomtabitem = class() // if ifstring(s) and s<>FCaption then begin FCaption := s; - psztext := FCaption; if PageSheet is class(tcustomtabsheet) then PageSheet.Caption := s; end end diff --git a/funcext/tvclib/uvcpropertytypespersistence.tsf b/funcext/tvclib/uvcpropertytypespersistence.tsf index 98e8ded..b4b1fd8 100644 --- a/funcext/tvclib/uvcpropertytypespersistence.tsf +++ b/funcext/tvclib/uvcpropertytypespersistence.tsf @@ -532,12 +532,12 @@ type TTmfParser = class(TTmfParserbase) if ifstring(v)and(not v)then return tostn(""); if ifstring(v)then begin - if v in array({"item",}"end","object")then return tostn(v); - if new TCharDiscrimi().IsVariableName(v)then - begin + if v in array({"item",}"end","object","inherited")then return tostn(v); + if new TCharDiscrimi().IsLowercaseVariableName(v)then + begin return v; end else - return tostn(v); + return tostn(v); end else return tostn(v); end @@ -659,9 +659,9 @@ type TTmfParser = class(TTmfParserbase) r := "<\r\n"; for i,v in d do begin - if ifstring(i)then si := i; - else si := tostn(i); - r += tablelines(si+"="+call(thisfunction,v)," "); + //if ifstring(i)then si := i; + //else si := tostn(i); + r += tablelines(totfmstr(i)+"="+call(thisfunction,v)," "); //r+="\r\n"; end r += " >\r\n"; @@ -841,7 +841,14 @@ type TTmfParser = class(TTmfParserbase) r["parent"] := tv; end end else - PError("其他错误",1); + if tt=TT_STR then + begin + if not pp then + begin + pp := tv; + end + end else + PError("其他错误",1); end return r; end @@ -1503,12 +1510,13 @@ type TPropertyFileFilter=class(TPropertyType) end function FormatTMF(d);override; begin - r := "{ "+TslToHexFormatStr(d)+" }"; - return r; + if dataisnotsample(d) then return ""; + return TmfParser.tslasItem(d); end function TmfToNode(d);override; begin - return HexFormatStrToTSL(d); + return d; + //return HexFormatStrToTSL(d); end end type TPropertyLazyInteger=class(TPropertyInteger) @@ -1917,41 +1925,17 @@ type tpropertytsl=class(TPropertyType) end function TmfToNode(d);override; begin - if ifstring(d)then - begin - r := HexFormatStrToTsl(d); - return r; - end + return d; end function FormatTMF(d);override; begin - if datanotok(d) then return ""; - reti := TSlToHexFormatStr(d); - ret := "{ "; - ret += reti; - ret += " }"; - return ret; + if dataisnotsample(d) then return ""; + return TmfParser.tslasItem(d); end function ReadTMF(d,o);override; begin - if d and ifstring(d) then - begin - return HexFormatStrToTsl(d); - end + return d; end - private - function datanotok(d);// - begin - if ifobj(d) then return true; - if ifarray(d) then - begin - for i ,v in d do - begin - if (datanotok(v)) then return true; - end - end - return false; - end end type tpropertylazytsl = class(tpropertytsl) Function EditType();override; @@ -2423,6 +2407,18 @@ function InitLib(); begin static Sinitlib(); end +function dataisnotsample(d);// +begin + if ifobj(d) then return true; + if ifarray(d) then + begin + for i ,v in d do + begin + if (dataisnotsample(v)) then return true; + end + end + return false; +end Initialization InitLib();