sgr_data.pas

一个delphi的好用的画二维曲线的控件Simple Graph v2.3

   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.