界面库

优化
This commit is contained in:
JianjunLiu 2022-11-02 17:17:35 +08:00
parent eb4da18fa4
commit 4519cff2a0
4 changed files with 138 additions and 167 deletions

View File

@ -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<rc[2] then
dc.SetPixel(array(x1,y),0);
end
end
end
end
function Recycling();override;
begin
if FDRageimglist then _wapi.ImageList_Destroy(FDRageimglist);
FSides := nil;
inherited;
end
property Position:integer read GetPosition write SetPosition;

View File

@ -134,6 +134,26 @@ type TCharDiscrimi=class()
end
return 0;
end
class function IsLowercaseVariableName(s);
begin
if ifstring(s)and length(s)>= 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();

View File

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

View File

@ -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();