sgr_def.pas

图形控件,画实时曲线,等操作方便

 end;
 procedure DrawAxises;
 var co,ce:word; x,y:integer;                     
 begin
  DCanvas.Brush.Style:=bsClear;
  with RA.LineAttr do
   if Visible  then ce:=Width else ce:=0;                                  
  TA.DrawLine(DCanvas,0,ce);
  with BA.LineAttr do
   if Visible  then co:=Width else co:=0;
  RA.DrawLine(DCanvas,co,0);
  with LA.LineAttr do
   if Visible  then co:=Width else co:=0;                          
  BA.DrawLine(DCanvas,co,0);
  with TA.LineAttr do
   if Visible  then ce:=Width else ce:=0;;
  LA.DrawLine(DCanvas,0,ce);
  with DCanvas.Pen do
  begin
    Mode:=pmCopy;
    Style:=psSolid;
    Color:=Font.Color;
    Width:=1;
  end;
  DCanvas.Font:=(Font);
  TA.DrawTicks(DCanvas);
  RA.DrawTicks(DCanvas);
  LA.DrawTicks(DCanvas);
  BA.DrawTicks(DCanvas);
  with DCanvas do
  begin
    if BA.fDrawCaption then with BA do
    begin
     Font.Style:=Font.Style+[fsBold];     
     x:=(FieldRect.Right+FieldRect.Left-TextWidth(fCaption)) div 2;
     y:=fDHeight-Margin;
     TextOut(x,y,fCaption)
    end;
    if TA.fDrawCaption then with TA do
    begin
     x:=(FieldRect.Right+FieldRect.Left-TextWidth(fCaption)) div 2;
     y:=Margin-1-TextHeight('8');
     TextOut(x,y,fCaption)
    end;
    if LA.fDrawCaption or RA.fDrawCaption then
    begin
     DCanvas.Font.Assign(VFont);
     if LA.fDrawCaption then with LA do
     begin
      y:=(FieldRect.Bottom+FieldRect.Top+TextWidth(fCaption)) div 2;
      x:=Margin-1-TextHeight('8');
      TextOut(x,y,fCaption)
     end;
     if RA.fDrawCaption then with RA do
     begin
      y:=(FieldRect.Bottom+FieldRect.Top+TextWidth(fCaption)) div 2;
      x:=fDWidth-Margin;
      TextOut(x,y,fCaption)
     end;
     DCanvas.Font:=Font;
    end;
  end;
 end;
begin                      
 ClearBack;
 DrawAxises;
 DrawBorder;
end;                       
procedure Tsp_XYPlot.DrawBorder;
var R:TRect;
begin
 R:=Rect(0,0,dWidth,dHeight);
 with DCanvas do
 begin
   Brush.style:= bsClear;
   with Pen do begin
     Style:= psSolid;                      
     Mode:=pmCopy;
   end;
   with R do rectangle(left+1, top+1, right-1, bottom-1);
    case fFrameStyle of
      bs_None: with R do begin
         Pen.Color:= Self.Color;
         rectangle(left, top, right, bottom);
         rectangle(left+1, top+1, right-1, bottom-1);
       end;
      bs_Raised : with R do begin
         Frame3D(DCanvas, R, clBtnHighlight, clBtnShadow,1);
         Pen.Color:= Self.Color;
         rectangle(left, top, right, bottom);
        end;
      bs_Lowered: with R do begin
         Frame3D(DCanvas, R, clBtnShadow, clBtnHighlight,1);
         Pen.Color:= Self.Color;
         rectangle(left, top, right, bottom);
        end;
      bs_Gutter : with R do begin
         Pen.Color := clBtnHighlight;
         rectangle(left + 1, top + 1, right, bottom);
         Pen.Color := clBtnShadow;
         rectangle(left, top, right - 1, bottom - 1);
        end;
      bs_BlackRect: with R do begin
         Pen.Color := clBlack;
         rectangle(left, top, right, bottom);
         Pen.Color:= Self.Color;
         rectangle(left+1, top+1, right-1, bottom-1);
        end;
      bs_BoldRect: with R do begin
         Pen.Color := clBlack;
         rectangle(left, top, right, bottom);
         rectangle(left+1, top+1, right-1, bottom-1);
        end;
      bs_FocusRect: begin
         Brush.Style:= bsSolid;  Brush.Color:= clWhite;
         Pen.Style  := psDot;    Pen.Color  := clBlack;
         with R do polyline([point(left,top),point(right-2,top),
                  point(right-2,bottom-1),point(left+1,bottom-1),point(left+1,top)]);
         with R do polyline([point(left+1,top+1),point(right-1,top+1),
                  point(right-1,bottom-2),point(left,bottom-2),point(left,top)]);
        end;
    end;
 end;
end;             
procedure Tsp_XYPlot.DoOnFieldDraw;
begin
 if Assigned(fFieldDraw) then fFieldDraw(Self);
end;
procedure Tsp_XYPlot.DrawField;
  procedure DrawFieldBack;
  var j:integer;
  begin
   with DCanvas do
   begin
    Brush.Style:=bsSolid;
    Brush.Color:=FBColor;
    if FBColor<>clNone then begin
      Brush.Style:=bsSolid;
      Brush.Color:=FBColor;
      FillRect(Rect(FR.Left,FR.Top,FR.Right,FR.Bottom));
    end;
    DoOnFieldDraw;
    Brush.Style:=bsClear;
    with LA do if GridAttr.Visible and (TicksCount>0) then
    begin
      GridAttr.SetPenAttr(Pen);
      for j:=0 to TicksCount-1 do
      with FR do if (fTksPos[j]>Top) and (fTksPos[j]<Bottom-1) then
      begin
       MoveTo(Left,fTksPos[j]);
       LineTo(Right,fTksPos[j]);
      end;
    end;
    with BA do if GridAttr.Visible and (TicksCount>0) then
    begin
      GridAttr.SetPenAttr(Pen);
      for j:=0 to TicksCount-1 do
      with FR do if (fTksPos[j]>Left) and (fTksPos[j]<Right-1) then
      begin
       MoveTo(fTksPos[j],Top);
       LineTo(fTksPos[j],Bottom);
      end;
    end;
    with RA do if GridAttr.Visible and (TicksCount>0) then
    begin
      GridAttr.SetPenAttr(Pen);
      for j:=0 to TicksCount-1 do
      with FR do if (fTksPos[j]>Top) and (fTksPos[j]<Bottom-1) then
      begin
       MoveTo(Left,fTksPos[j]);
       LineTo(Right,fTksPos[j]);
      end;
    end;
    with TA do if GridAttr.Visible and (TicksCount>0) then
    begin
      GridAttr.SetPenAttr(Pen);
      for j:=0 to TicksCount-1 do
      with FR do if (fTksPos[j]>Left) and (fTksPos[j]<Right-1) then
      begin
       MoveTo(fTksPos[j],Top);
       LineTo(fTksPos[j],Bottom);
      end;
    end;
   end;
  end;
  procedure DrawBMarkers;
  var j:integer;
  begin
   with fBSML do
    for j:=0 to Count-1 do
      with Tsp_PlotMarker(Items[j]) do if Visible then Draw;
  end;
  procedure DrawAMarkers;
  var j:integer;
  begin
   with fASML do
    for j:=0 to Count-1 do
      with Tsp_PlotMarker(Items[j]) do if Visible then Draw;
  end;
  procedure DrawSeries;
  var j:integer;
  begin
   if fSeries.Count>0 then
    for j:=0 to fSeries.Count-1 do with Tsp_DataSeries(fSeries[j]) do
     if Active then Draw;
  end;
var CR:TRect; ClipRgn: HRgn;
begin                 
 CR:=DCanvas.ClipRect;
 with FR do IntersectClipRect(DCanvas.Handle, Left, Top, Right, Bottom);
 DrawFieldBack;
 DrawBMarkers;
 DrawSeries;
 DrawAMarkers;
 begin
   ClipRgn :=CreateRectRgnIndirect(CR);
   SelectClipRgn(DCanvas.Handle, ClipRgn);
   DeleteObject(ClipRgn);
 end;
end;                     
procedure Tsp_XYPlot.DoOnDrawEnd;
begin
 if Assigned(fDrawEnd) then fDrawEnd(Self);
end;
procedure Tsp_XYPlot.pDrawPlot;
begin
 if Not ValidArrange then begin
   DCanvas.Font:=Font;
   Arrange(DCanvas.TextWidth('0'), abs(Font.Height));
 end;
 DrawAroundField;
 DrawField;
 DoOnDrawEnd;
 DrawBorder;
end;
procedure Tsp_XYPlot.DrawPlot;                                
begin
 if Not Assigned(DC) or (W<10) or (H<10) then Exit;
 fDCanvas:=DC;
 fDwidth:=W;
 fDHeight:=H;
 ValidArrange:=False;
 try
   pDrawPlot;       
 finally
   ValidArrange:=False;          
   fDwidth:=Width;
   fDHeight:=Height;
   fDCanvas:=Canvas;
 end;
end;
procedure Tsp_XYPlot.Invalidate;
begin
 ValidArrange:=False;
 ValidAround:=False;
 ValidField:=False;
 inherited;
end;
procedure Tsp_XYPlot.CustomInvalidate(Arrange, Around, Field :boolean);
begin
 if Arrange then ValidArrange:=False;
 if Around then ValidAround:=False;
 if Field then ValidField:=False;
 inherited Invalidate;
end;
procedure Tsp_XYPlot.BufferIsInvalid;
begin
 ValidAround:=False;
 ValidField:=False;
end;
procedure Tsp_XYPlot.InvalidateSeries(DS:Tsp_DataSeries);
var X,Y:Tsp_Axis;  B:boolean;
begin
 if Not Assigned(DS) then Exit;
 with DS do begin
   if XAxis=dsxBottom then X:=BA else X:=TA;
   if YAxis=dsyLeft then Y:=LA else Y:=RA;
 end;
 B:=DoAutoMinMax(X);
 B:=DoAutoMinMax(Y) or B;
 if B then Invalidate
 else CustomInvalidate(False, False, True);
end;                     
procedure Tsp_XYPlot.Paint;
begin
 fDWidth:=Width; fDHeight:=Height;
 if fBuffered and fDDBBuf.Valid then
 begin
   if (Width<>fDDBBuf.Width) or (Height<>fDDBBuf.Height) then
   begin
     fDDBBuf.Recreate(Width, Height);
     if Not fDDBBuf.Valid then begin pDrawPlot; Exit end;           
     ValidArrange:=False;
     ValidAround:=False; ValidField:=False;
   end;
   fDCanvas:=fDDBBuf.Canvas;
   try
     if Not ValidArrange then begin
       DCanvas.Font:=Font;
       Arrange(DCanvas.TextWidth('0'), abs(Font.Height));
     end;
     if Not ValidAround then begin
       DrawAroundField;
       ValidAround:=True;
     end;
     if Not ValidField then begin
       DrawField;
       ValidField:=True;
     end;
     DoOnDrawEnd;
     DrawBorder;
   finally
      fDCanvas:=Canvas;
   end;
   BitBlt(Canvas.Handle, 0, 0, Width, Height,
           fDDBBuf.Canvas.Handle, 0, 0, SRCCOPY)
 end else pDrawPlot;           
 DrawXCursorOnPaint;
end;
procedure Tsp_XYPlot.CopyToClipboardMetafile;
var EMF :TMetafile; MC:TMetafileCanvas;
begin
 EMF := TMetafile.Create;
 try
   EMF.Width:=Width;
   EMF.Height:=Height;
   MC:=TMetafileCanvas.Create(EMF, Canvas.Handle);
   try
     DrawPlot(MC, Width, Height);
   finally
     MC.Free;
   end;
   Clipboard.Assign(EMF);
 finally
  EMF.Free;
 end;
end;
procedure Tsp_XYPlot.CopyToClipboardBitmap;
var BMP :TBitmap;
begin
 BMP := TBitmap.Create;
 BMP.Width:=Width;
 BMP.Height:=Height;
 try
   DrawPlot(BMP.Canvas, Width, Height);
   Clipboard.Assign(BMP);
 finally
   BMP.Free;
 end;
end;
constructor Tsp_XYPlot.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 ControlStyle := [csCaptureMouse, csClickEvents,
     csSetCaption, csOpaque, csDoubleClicks];                     
 LA:=Tsp_Axis.Create(sdfVertical);
 with LA do begin
  fGrid.Visible:=True;
  fPlot:=Self;                                             
 end;
 RA:=Tsp_Axis.Create(sdfVertical or sdfRevertTicks or sdfNoTicks or sdfNoTicksLabel);
 RA.fPlot:=Self;
 BA:=Tsp_Axis.Create(0) ;
 with BA do begin
  fGrid.Visible:=True;
  fPlot:=Self;
 end;
 TA:=Tsp_Axis.Create(sdfRevertTicks or sdfNoTicks or sdfNoTicksLabel);
 TA.fPlot:=Self;
 VFont:=TFont.Create;
 fDCanvas:=Canvas;
 fBuffered:=False;
 fDDBBuf:=nil;
 fSeries:=TList.Create;
 fBSML:=TList.Create;
 fASML:=TList.Create;
 Color := clBtnFace;
 FBColor:=clWhite;                               
 fZoomEnabled:=zpdBoth;
 fPanEnabled:=zpdBoth;
 ZoomShiftKeys:=[ssShift];
 PanShiftKeys:=[ssCtrl];
 ValidAround:=False;
 ValidField:=False;
 fDWidth:=180;     fDHeight:=120;
 Width := fDWidth; Height := fDHeight;
 ValidArrange:=False;
 FreshVFont;
end;
destructor Tsp_XYPlot.Destroy;
begin
 if Assigned(fBSML) then fBSML.Free;
 if Assigned(fASML) then fASML.Free;
 if Assigned(fSeries) then fSeries.Free;
 if Assigned(fDDBBuf) then fDDBBuf.Free; 
 if Assigned(VFont) then VFont.Free;
 if Assigned(TA) then TA.Free;
 if Assigned(BA) then BA.Free;
 if Assigned(LA) then LA.Free;
 if Assigned(RA) then RA.Free;
 inherited Destroy;
end;
END.