?? sgr_data.pas
字號:
begin
fLineAttr.SetPenAttr(Pen);
Brush.Style:=bsClear;
with pa[0] do
begin
x:=XA.V2P(pxa^[0]); y:=V2P(pya^[0]);
if (x<-16000) or (y<-16000) or (x>16000) or (y>16000) then is_out:=op_out
else is_out:=0;
end;
for j:=1 to Count-1 do
begin
with pa[1] do
begin
x:=XA.V2P(pxa^[j]); y:=V2P(pya^[j]);
if (x<-16000) or (y<-16000) or (x>16000) or (y>16000) then
is_out:=is_out or ep_out;
end;
//draw line if at least one point inside
if (is_out and both_out)<>both_out then PolyLine(pa);
is_out:=is_out shl 1;
pa[0]:=pa[1];
end;
end;
end; //DrawLines
procedure DrawPoints(const pxa, pya : pDbls; const XA, YA : Tsp_Axis);
var
j:integer; p:TPoint;
begin
with fCanvas, YA do
begin
fPA.SetPenAttr(Pen);
Brush.Assign(fPA);
if (fPA.Kind=ptCustom) then begin
if Assigned(fOnDrawCustomPoint) then
for j:=0 to Count-1 do with p do
begin
x:=XA.V2P(pxa^[j]); y:=V2P(pya^[j]);
if PtInRect(fPlot.FieldRect, p) then
fOnDrawCustomPoint(Self,pxa^[j],pya^[j],x,y);
end;
end else
for j:=0 to Count-1 do with p do
begin
x:=XA.V2P(pxa^[j]); y:=V2P(pya^[j]);
if PtInRect(fPlot.FieldRect, p) then DrawPointProc(x,y);
end;
end;
end; //DrawPoints
begin //Draw
if (Count<1) or Not Assigned(fPlot) or
Not(fPA.fVisible or ((fLineAttr.Visible) and (Count>1)))then Exit;
with Plot do begin
fCanvas:=DCanvas; //assign canvas to where draw
if XAxis=dsxBottom then XA:=BottomAxis else XA:=TopAxis;
GetXMin(i); GetXMax(a);
if (i>XA.Max) or (a<XA.Min) then Exit;
GetYMin(i); GetYMax(a);
if YAxis=dsyLeft then YA:=LeftAxis else YA:=RightAxis;
if (i>YA.Max) or (a<YA.Min) then Exit;
end;
pdx:=VarArrayLock(XV);
pdy:=VarArrayLock(YV);
try
if (Count>1) and fLineAttr.Visible and (fLineAttr.Style<>psClear)
then DrawLines(pdx,pdy,XA,YA);
if fPA.fVisible then DrawPoints(pdx,pdy,XA,YA);
finally
VarArrayUnlock(YV);
VarArrayUnlock(XV);
end;
end;
procedure Tsp_XYLine.DrawLegendMarker(const LCanvas:TCanvas; MR:TRect);
var OP:TPen; OB:TBrush; x,y:integer;
begin
if (fLineAttr.Visible or fPA.Visible) then
begin
fDLM:=True; //note that drawing legend marker
fCanvas:=LCanvas;
OP:=TPen.Create; OP.Assign(fCanvas.Pen); //save pen
OB:=TBrush.Create; OB.Assign(fCanvas.Brush); //save brush
with MR do y:=(Bottom+Top) div 2;
if fLineAttr.Visible then with fCanvas do begin
fLineAttr.SetPenAttr(fCanvas.Pen);
Brush.Style:=bsClear;
with MR do PolyLine([Point(Left+1, y), Point(Right, y)]);
end;
if fPA.Visible then with fCanvas do begin
fPA.SetPenAttr(Pen);
Brush.Assign(fPA);
with MR do x:=(Left+Right) div 2;
if (fPA.Kind=ptCustom) and Assigned(fOnDrawCustomPoint) then
fOnDrawCustomPoint(Self, 0,0, x,y)
else DrawPointProc(x,y);
end;
fCanvas.Brush.Assign(OB); OB.Free; //restore brush
fCanvas.Pen.Assign(OP); OP.Free; //restore pen
fDLM:=False;
end;
end;
function Tsp_XYLine.GetX(i:integer):double;
begin
Result:=XV[i];
end;
function Tsp_XYLine.GetY(i:integer):double;
begin
Result:=YV[i];
end;
procedure Tsp_XYLine.QuickAddXY(aX,aY:double);
//don't spends time to update Plot, instead simply draw next segment,
//therefore AutoMin and AutoMax are ignored
var l,e:TPoint; A:Tsp_Axis; inside:boolean;
begin
if fPN >= fCapacity //has free space in series data storage?
then Expand; //if no then expand data storage
XV[fPN]:=aX; YV[fPN]:=aY; //add values to data storage
TryUpdateMinMax(aX,aY); //serve data min & max
inc(fPN); //points nubmer was increased
//instead InvalidatePlot(rsDataChanged) we simply draw line segment;
//but first check if we can draw
if CanPlot and Active //has parent plot, can invalidate it & series is active?
then with Plot do
begin
//if plot painted through draw buffer, then mark buffer as invalid
if BufferedDisplay
then BufferIsInvalid; //draw buffer will be freshed on next Paint
with FieldRect do IntersectClipRect(DCanvas.Handle, Left, Top, Right, Bottom);
if fLineAttr.Visible and (fPN>1) then
begin
if XAxis=dsxBottom then A:=BottomAxis else A:=TopAxis;
with A do begin //ask horiz. axis for the scaling
l.x:=V2P(XV[fPN-2]);
e.x:=V2P(XV[fPN-1]); //find x pos new line segment
end;
if YAxis=dsyLeft then A:=LeftAxis else A:=RightAxis;
with A do begin //ask vert. axis for the scaling
l.y:=V2P(YV[fPN-2]);
e.y:=V2P(YV[fPN-1]); //find y pos new line segment
end;
inside:=PtInRect(FieldRect, e);
if (PtInRect(FieldRect, l) or inside) then with DCanvas do begin
fLineAttr.SetPenAttr(DCanvas.Pen); //set line draw attributes
if DCanvas.Brush.Style<>bsClear then DCanvas.Brush.Style:=bsClear;
MoveTo(l.x,l.y);
LineTo(e.x,e.y); //draw line
end;
end
else
begin
if XAxis=dsxBottom then A:=BottomAxis else A:=TopAxis;
with A do e.x:=V2P(XV[fPN-1]); //find x pos new line segment
if YAxis=dsyLeft then A:=LeftAxis else A:=RightAxis;
with A do e.y:=V2P(YV[fPN-1]); //find y pos new line segment
inside:=PtInRect(FieldRect, e);
end;
if fPA.fVisible and inside then begin
fCanvas:=DCanvas;
with fCanvas do begin
// if not (Pen.Style in [psSolid, psClear]) then Pen.Style:=psSolid;
fPA.SetPenAttr(Pen);
Brush.Assign(fPA);
end;
if (fPA.Kind=ptCustom) and Assigned(fOnDrawCustomPoint) then
fOnDrawCustomPoint(Self, XV[fPN-1],YV[fPN-1], e.x,e.y)
else DrawPointProc(e.x,e.y);
end;
end;
end;
{*** Tsp_SpectrLines ***}
constructor Tsp_SpectrLines.Create(AOwner:TComponent);
begin
Inherited Create(AOwner);
fBLVisible:=True;
fLabelFormat:='###0.##';
fLFont:=TFont.Create;
fLFont.OnChange:=AtrributeChanged;
end;
destructor Tsp_SpectrLines.Destroy;
begin
if Assigned(fLFont) then fLFont.Free;
inherited;
end;
procedure Tsp_SpectrLines.SetBaseValue(V:double);
begin
if fBaseValue<>V then
begin
fBaseValue:=V;
AtrributeChanged(Self);
end;
end;
procedure Tsp_SpectrLines.SetYOrigin(V:Tsp_YOrigin);
begin
if fYOrigin<>V then
begin
fYOrigin:=V;
AtrributeChanged(Self);
end;
end;
procedure Tsp_SpectrLines.SetWhatValues(V:Tsp_WhatValues);
begin
if fWhatValues<>V then
begin
fWhatValues:=V;
AtrributeChanged(Self);//if CanPlot then PLot.Invalidate;
end;
end;
procedure Tsp_SpectrLines.SetLabelFormat(const V:string);
begin
if fLabelFormat<>V then
begin
fLabelFormat:=V;
AtrributeChanged(Self);//if CanPlot then PLot.Invalidate;
end;
end;
procedure Tsp_SpectrLines.SetLFont(V:TFont);
begin
fLFont.Assign(V);
end;
procedure Tsp_SpectrLines.SetLVisible(const V:boolean);
begin
if fLVisible<>V then
begin
fLVisible:=V;
AtrributeChanged(Self);//if CanPlot then PLot.Invalidate;
end;
end;
procedure Tsp_SpectrLines.SetBLVisible(const V:boolean);
begin
if fBLVisible<>V then
begin
fBLVisible:=V;
AtrributeChanged(Self);//if CanPlot then PLot.Invalidate;
end;
end;
procedure Tsp_SpectrLines.Draw;
var ps:pLP;
pdx, pdy:pDbls;
XA,YA:Tsp_Axis; i,a:double;
by:integer; j:integer;
procedure DrawBars(ps:pLP; by:integer);
var j,lx,rx:integer;
begin
with Plot do
begin
lx:=fLineAttr.Width div 2; rx:=fLineAttr.Width-lx;
//begin darw
if fLineAttr.Width=1 then begin //draw line if BarWidth=1
fLineAttr.SetPenAttr(fCanvas.Pen);
for j:=0 to Count-1 do with DCanvas, ps^[j] do begin
if y<by then begin MoveTo(x, by); LineTo(x, y); end
else begin MoveTo(x, y); LineTo(x, by); end
end
end
else begin //draw rectangle if BarWidth=1
with fCanvas do begin
Brush.Color:=fLineAttr.Color;
Brush.Style:=bsSolid;
Pen.Style:=psClear;
end;
inc(rx);
for j:=0 to Count-1 do with fCanvas, ps^[j] do begin
if y<by then Rectangle(x-lx, y-1, x+rx, by+1)
else Rectangle(x-lx, by, x+rx, y+1);
end;
end;
end; //with
end; //DrawBars
procedure DrawLabels(pdx,pdy:pDbls; ps:pLP);
var j,lx,ly:integer; LS:string;
begin
lx:=fLineAttr.Width-fLineAttr.Width div 2;
with fCanvas do begin
Brush.Style:=bsClear;
Font:=fLFont;
ly:=TextHeight('8') div 2;
end;
if fWhatValues=wvYValues then
for j:=0 to Count-1 do with fCanvas, ps^[j] do begin
LS:=FormatFloat(fLabelFormat,pdy[j]);
if Assigned(fOnGetLabel) then fOnGetLabel(Self, j, pdx^[j], pdy^[j], LS);
TextOut(x+lx, y-ly,LS);
end
else
for j:=0 to Count-1 do with fCanvas, ps^[j] do begin
LS:=FormatFloat(fLabelFormat,pdx[j]);
if Assigned(fOnGetLabel) then fOnGetLabel(Self, j, pdx^[j], pdy^[j], LS);
TextOut(x+lx, y-ly,LS);
end;
end; //DrawLabels(pdx,pdy,ps);
begin
if (Count<1) or Not Assigned(Plot) then Exit;
with Plot do begin
fCanvas:=Plot.DCanvas;
if XAxis=dsxBottom then XA:=BottomAxis else XA:=TopAxis;
GetXMin(i); GetXMax(a);
if (i>XA.Max) or (a<XA.Min) then Exit;
end;
GetMem(ps, Count*SizeOf(TPoint));
pdx:=VarArrayLock(XV);
pdy:=VarArrayLock(YV);
try
with Plot do begin
//find where begin draw bar
if YAxis=dsyLeft then YA:=LeftAxis else YA:=RightAxis;
if YOrigin=yoBaseLine then begin
with YA do by:=V2P(fBaseValue);
if by>BottomAxis.OY then by:=BottomAxis.OY+2
else if by<TopAxis.OY then by:=TopAxis.OY-2;
end
else begin //if YAxis min at top then from top and vice versa
if YA.Inversed then by:=TopAxis.OY-2 else by:=BottomAxis.OY+2
end;
//calc coordinate
for j:=0 to Count-1 do with ps^[j], XA do begin
x:=V2P(pdx^[j]);
end;
for j:=0 to Count-1 do with ps^[j], YA do begin
y:=V2P(pdy^[j]);
end;
if fLineAttr.Visible then DrawBars(ps, by);
//draw base line
if fBLVisible and (YOrigin=yoBaseLine) then
begin
with fCanvas, FieldRect do
begin
fLineAttr.SetPenAttr(Pen);
Pen.Width:=1;
MoveTo(Left, by);
LineTo(Right+1,by);
end;
end;
//darw value label
if fLVisible then DrawLabels(pdx,pdy,ps);
end;
finally
FreeMem(ps, Count*SizeOf(TPoint));
VarArrayUnlock(YV);
VarArrayUnlock(XV);
end;
end;
function Tsp_SpectrLines.GetYMin;
begin
Result:=inherited GetYMin(V);
if Not(Result) then Exit;
if YOrigin=yoBaseLine then
begin
if V>fBaseValue then V:=fBaseValue
end else
begin
if V>0 then V:=0
end;
end;
function Tsp_SpectrLines.GetYMax;
begin
Result:=GetYMax(V);;
if Not(Result) then Exit; // V:=inherited GetYMax(V);
if YOrigin=yoBaseLine then
begin
if V<fBaseValue then V:=fBaseValue
end else
begin
if V<0 then V:=0
end;
end;
END.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -