?? sgr_scale.pas
字號(hào):
begin
if (fFlags and sdfVertical)=0 then
for j:=0 to rTksCount-1 do fTksPos[j]:=fOPos+round(fLen*fTksDbl[j])
else
for j:=0 to rTksCount-1 do fTksPos[j]:=fOPos-round(fLen*fTksDbl[j])
end;
begin
if fTicksCount<1 then begin rTksCount:=fTicksCount; Exit end;
if (fFlags and (sdfNoTicksLabel or sdfNotAjustedTicks))=0 then LbldTicks
else NoLbldTicks;
end;
procedure Tsp_Scale.ShiftScaleBy(pixel:boolean; idelta:double; fdelta:double);
procedure ShiftMinMax(delta:double);
begin
fMin:=fMin+delta;
fMax:=fMin+fInterval;
if (fFlags and sdfInversed)=0 then fOVal:=fMin else fOVal:=fMax;
IMin:=Ceil(fMin*IntFactor);
IMax:=Floor(fMax*IntFactor);
end;
procedure SLbldTicksVal(delta:double);
var id:extended; j:integer;
begin
id:=Frac((fTksDbl[0]*IntFactor-fOVal*IntFactor)/IStep);
if ((fFlags and sdfInversed)=0) then
begin
if id<0 then id:=id+1;
id:=fOVal*IntFactor+id*IStep;
rTksCount:=Trunc((fMax*IntFactor-id)/IStep)+1;
if rTksCount>MaxTicksCount then rTksCount:=MaxTicksCount;
for j:=0 to rTksCount do fTksDbl[j]:=(id+IStep*j)/IntFactor;
end else begin
if id>0 then id:=id-1;
id:=fOVal*IntFactor+id*IStep;
rTksCount:=Trunc((id-fMin*IntFactor)/IStep)+1;
if rTksCount>MaxTicksCount then rTksCount:=MaxTicksCount;
for j:=0 to rTksCount do fTksDbl[j]:=(id-IStep*j)/IntFactor;
end
end;
procedure STicksVal(delta:double);
var id,step:double; j:integer;
begin
if fTicksCount>1 then step:=1/(fTicksCount-1) else step:=1;
if (fFlags and sdfVertical)<>0 then delta:=-delta;
id:=Frac((fTksDbl[0]*fLen-delta)/(fLen*step));
if id<0 then id:=id+1;
rTksCount:=Trunc(1/step-id)+1;
id:=id*step;
if rTksCount>MaxTicksCount then rTksCount:=MaxTicksCount;
for j:=0 to rTksCount-1 do fTksDbl[j]:=id+step*j;
end;
begin
if pixel then fdelta:=idelta/fM else idelta:=fdelta*fM;
if fdelta=0 then Exit;
ShiftMinMax(fdelta);
if abs(fdelta)>fInterval then CalcTicksVal
else begin
if (fFlags and (sdfNoTicksLabel or sdfNotAjustedTicks))=0 then SLbldTicksVal(fdelta)
else STicksVal(idelta);
end;
CalcTicksPos;
end;
function Tsp_Scale.TickLabel(tickNum: integer): string;
begin
if ((fFlags and sdfLabelAsDate)<>0) then
Result:=FormatDateTime(fLabelFormat, TksDbl(tickNum))
else
Result:=FormatFloat(fLabelFormat, TksDbl(tickNum));
end;
function Tsp_Scale.GetTicksCount:byte;
begin
Result:=rTksCount;
end;
procedure Tsp_Scale.SetFlagBit(const BN:integer; const On:boolean);
var Mask:integer;
begin
Mask:=1 shl BN;
if On then
begin
if ((fFlags and Mask)=0) then begin
fFlags:=fFlags or Mask;
FlagsChanged(BN, On);
end;
end else
if ((fFlags and Mask)<>0) then begin
fFlags:=fFlags and Not Mask;
FlagsChanged(BN, On);
end
end;
procedure Tsp_Scale.ReSetFlagBit(const BN:integer; const Off:boolean);
begin
SetFlagBit(BN,Not(Off));
end;
function Tsp_Scale.NotFlagBit(const BN:integer):boolean;
begin
Result:=(fFlags and (1 shl BN))=0;
end;
function Tsp_Scale.GetFlagBit(const BN:integer):boolean;
begin
Result:=(fFlags and (1 shl BN))<>0;
end;
procedure Tsp_Scale.FlagsChanged(const BN:integer; const On:boolean);
begin
end;
constructor Tsp_Scale.Create(Flags:integer);
begin
inherited Create;
fLineAttr:=Tsp_LineAttr.Create;
fTicksCount:=5;
fFlags:=Flags;
fLabelFormat:='###0.##';
fO.x:=10; fO.y:=30; fLen:=25;
ChangeMinMax(dblDfltAxisMin, dblDfltAxisMax);
end;
destructor Tsp_Scale.Destroy;
begin
if Assigned(fLineAttr) then fLineAttr.Free;
inherited Destroy;
end;
procedure Tsp_Scale.SetLine(oX, oY, lLen:integer);
begin
if (fO.x<>oX) or (fO.y<>oY) or (lLen<>fLen) then
begin
fO.x:=oX; fO.y:=oY;
if lLen=0 then inc(lLen) else if lLen<0 then lLen:=-lLen;
fLen:=lLen;
CalcMetr;
CalcTicksPos;
end;
end;
procedure Tsp_Scale.ChangeMinMax(aMin,aMax:double);
begin
FixMinMax(aMin, aMax);
CalcMetr;
CalcTicksVal;
CalcTicksPos;
end;
procedure Tsp_Scale.ScrollBy(delta:integer);
begin
ShiftScaleBy(True, delta, 0);
end;
function Tsp_Scale.V2P(const V:double):integer;
var rr:double;
begin
rr:=fOPos+(fM*(V-fOVal));
if rr>16383 then Result:=16383
else if rr<-16383 then Result:=-16383
else Result:=round(rr);
end;
function Tsp_Scale.P2V(const V:integer):double;
begin
Result:=fOVal+(V-fOPos)/fM;
end;
Const
TickOfs=0;
MnTick=1;
MjTick=4;
LblOfs=1;
function Tsp_Scale.BandWidth(FntWidth, FntHeight:integer):integer;
var j, tw:integer;
begin
Result:=fLineAttr.Width;
if (FFlags and sdfVertical)=0 then
begin
if (rTksCount>0) then begin
if ((FFlags and sdfNoTicksLabel)=0) then
inc(Result, TickOfs+MjTick+LblOfs+FntHeight)
else if (FFlags and sdfNoTicks)=0 then inc(Result, TickOfs+MjTick);
end;
end else
begin
Result:=fLineAttr.Width;
if (rTksCount>0) then begin
if ((FFlags and sdfNoTicksLabel)=0) then
begin
tw:=Length(TickLabel(0));
for j:=1 to rTksCount-1 do
if tw < Length(TickLabel(j)) then
tw:=Length(TickLabel(j));
inc(Result, TickOfs+MjTick+LblOfs+tw*FntWidth);
end
else if (FFlags and sdfNoTicks)=0 then inc(Result, TickOfs+MjTick);
end;
end;
end;
function Tsp_Scale.OrgIndent(FntWidth, FntHeight:integer):integer;
var tp:integer;
begin
if (rTksCount>0) and ((FFlags and sdfNoTicksLabel)=0) then
begin
tp:=abs(round((fOVal-TksDbl(0))*fM));
if (FFlags and sdfVertical)=0 then
Result:=FntWidth*Length(TickLabel(0)) div 2-tp
else Result:=FntHeight div 2-tp;
if Result<0 then Result:=0;
end else Result:=0;
end;
function Tsp_Scale.EndIndent(FntWidth, FntHeight:integer):integer;
var tp:integer;
begin
if (rTksCount>0) and ((FFlags and sdfNoTicksLabel)=0) then
begin
if (fFlags and sdfInversed)=0
then tp:=abs(round((fMax-TksDbl(rTksCount-1))*fM))
else tp:=abs(round((fMin-TksDbl(rTksCount-1))*fM));
if (FFlags and sdfVertical)=0 then
Result:=FntWidth*Length(TickLabel(rTksCount-1)) div 2 - tp
else
Result:=FntHeight div 2-tp;
if Result<0 then Result:=0;
end else Result:=0;
end;
function Tsp_Scale.CalcDrawBounds(fCanvas:TCanvas):TRect;
var j, ti:integer;
begin
with Result do with fCanvas do
begin
if (FFlags and sdfVertical)=0 then
begin
ti:=fLineAttr.Width;
if (rTksCount>0) and ((FFlags and sdfNoTicksLabel)=0) then
begin
inc(ti, TickOfs+MjTick+LblOfs+TextHeight('8'));
Left:=fTksPos[0]-TextWidth(TickLabel(0)) div 2;
Right:=fTksPos[rTksCount-1]+TextWidth(TickLabel(rTksCount-1)) div 2;
end
else if (FFlags and sdfNoTicks)=0 then inc(ti, TickOfs+MjTick);
if (FFlags and sdfLabelAtTop)=0 then Top:=fO.y else Top:=fO.y-ti+1;
Bottom:=Top+ti;
if Left>fO.x then Left:=fO.x;
if Right<fO.x+fLen then Right:=fO.x+fLen+1;
end else
begin
ti:=fLineAttr.Width;
if (rTksCount>0) and ((FFlags and sdfNoTicksLabel)=0) then
begin
ti:=TextWidth(TickLabel(0));
for j:=1 to rTksCount-1 do
if ti< TextWidth(TickLabel(j)) then
ti:=TextWidth(TickLabel(j));
inc(ti, TickOfs+MjTick+LblOfs);
Top:=fTksPos[rTksCount-1]-TextHeight('8')div 2;
Bottom:=fTksPos[0]+TextHeight('8')div 2;
end
else if (FFlags and sdfNoTicks)=0 then inc(ti, TickOfs+MjTick);
if (FFlags and sdfLabelOnRight)=0 then Left:=fO.x-ti+1 else Left:=fO.x;
Right:=Left+ti;
if Top>(fO.y-fLen) then Top:=fO.y-fLen;
if Bottom<fO.y then Bottom:=fO.y+1;
end;
end;
end;
procedure Tsp_Scale.DrawLine;
var j,st, w,b,e: integer;
begin
with fLineAttr do if Visible then with fCanvas do
begin
Pen.Color:=fLineAttr.Color;
Pen.Style:=Style;
Pen.Width:=1;
Pen.Mode:=pmCopy;
if (fFlags and sdfRevertTicks)=0 then st:=1 else st:=-1;
if (FFlags and sdfVertical)=0 then
begin
w:=fO.y;
b:=fO.x-odec; e:=fO.x+fLen+1+einc;
for j:=1 to Width do begin
MoveTo(b, w);
LineTo(e, w);
inc(w, st);
end;
end
else
begin
w:=fO.x;
e:=fO.y+1+odec; b:=fO.y-fLen-einc;
for j:=1 to Width do begin
MoveTo(w, b);
LineTo(w, e);
dec(w, st);
end;
end;
end;
end;
procedure Tsp_Scale.DrawTicks;
procedure DrawVert;
var j:word;
x,l:integer;
LS:String; LW:integer;
begin
with fCanvas do
begin
if ((FFlags and sdfNoTicks)=0) and (rTksCount>0)then
begin
if (FFlags and sdfLabelOnRight)=0 then begin
x:=fO.x-TickOfs-fLineAttr.Width; l:=x-MjTick;
end else begin
x:=fO.x+TickOfs+fLineAttr.Width; l:=x+MjTick;
end;
for j:=0 to rTksCount-1 do begin
MoveTo(x, fTksPos[j]);
LineTo(l, fTksPos[j]);
end;
end;
if ((FFlags and sdfNoTicksLabel)=0) and (rTksCount>0) then
begin
l:=TextHeight('8') div 2;
if (FFlags and sdfLabelOnRight)=0 then
begin
x:=fO.x-TickOfs-fLineAttr.Width-MjTick-LblOfs;
for j:=0 to rTksCount-1 do begin
LS:=TickLabel(j);
LW:=TextWidth(LS);
TextOut(x-LW, fTksPos[j]-l, LS);
end;
end
else
begin
x:=fO.x+TickOfs+fLineAttr.Width+MjTick+LblOfs;
for j:=0 to rTksCount-1 do begin
TextOut(x, fTksPos[j]-l, TickLabel(j));
end;
end;
end;
end;
end;
procedure DrawHoriz;
var j:word;
y,l:integer;
LS:String; LW:integer;
begin
with fCanvas do
begin
if ((FFlags and sdfNoTicks)=0) and (rTksCount>0)then
begin
if (FFlags and sdfLabelAtTop)=0 then begin
y:=fO.y+TickOfs+fLineAttr.Width; l:=y+MjTick;
end else begin
y:=fO.y-TickOfs-fLineAttr.Width; l:=y-MjTick;
end;
for j:=0 to rTksCount-1 do begin
MoveTo(fTksPos[j], y);
LineTo(fTksPos[j], l);
end;
end;
if ((FFlags and sdfNoTicksLabel)=0) and (rTksCount>0)then
begin
if (FFlags and sdfLabelAtTop)=0 then
y:=fO.y+TickOfs+fLineAttr.Width+MjTick+LblOfs
else y:=fO.y-TickOfs-fLineAttr.Width-MjTick-LblOfs-TextHeight('8');
for j:=0 to rTksCount-1 do begin
LS:=TickLabel(j);
LW:=TextWidth(LS);
TextOut(fTksPos[j]-LW div 2, y, LS);
end;
end;
end;
end;
begin
if (fFlags and sdfLineOnly)=sdfLineOnly then Exit;
if (FFlags and sdfVertical)=0 then DrawHoriz
else DrawVert;
end;
END.
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -