График реального времени

unit SO_PerfChart;

{ компонент отображения ползучего графика, как в диспетчере задач }

interface

uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    ExtCtrls, IT_VCLBase ;

type
    TSOPerfChart = class(TImage)
    private
      XCount     : Integer;
      FPlotColor : TColor;
      FOldPos    : Integer;
      FFirstValue: Boolean ;

      procedure SetBounds(Aleft, ATop, AWidth, AHeight : Integer); override;
    public
      constructor Create(aOwner: TComponent); override;
      destructor Destroy; override;
    published
      property PlotColor : TColor read FPlotColor write FPlotColor default clLime ;
      procedure Plot(Value : Integer);

      property Align ;

      procedure ReCalc ;
    end;

procedure Register ;

implementation

procedure Register ;
begin
     RegisterComponents(IT_VCL_Page_Visual, [TSOPerfChart]);
end ;

constructor TSOPerfChart.Create(aOwner: TComponent);
begin
     Inherited Create(aOwner) ;
     Width := 100 ;
     Height := 40 ;
     FPlotColor := clLime ;
     ReCalc ;
end ;

destructor TSOPerfChart.Destroy;
begin
     Inherited Destroy ;
end ;

procedure TSOPerfChart.SetBounds(Aleft, ATop, AWidth, AHeight: Integer);
begin
     inherited;
     //ReCalc ;
end;

procedure TSOPerfChart.ReCalc ;
var
   FillR : TRect;
   I : Integer;
begin
     FOldPos := Height ;
     // Залить фон
     FillR := Rect(0, 0, Width, Height) ;
     Canvas.Brush.Color := clBlack ;
     Canvas.FillRect(FillR) ;
     // нарисовать линии
     Canvas.Pen.Color := clGreen ;
     Canvas.Pen.Width := 1 ;
     Canvas.Pen.Style := psSolid ;
     // нарисовать линии - горизонтальные 
     I := 0 ;
     while I < Height do
      begin       
           Canvas.MoveTo(0,I);
           Canvas.LineTo(Width,Canvas.PenPos.Y);
           I := I + 15 ;
      end;
     // нарисовать линии - вертикальные
     I := 0 ;
     while I < Width do
      begin
           Canvas.MoveTo(I,0) ;
           Canvas.LineTo(I,Height) ;
           I := I + 15 ;
      end;
     Canvas.MoveTo(Width-1,0);
     Canvas.LineTo(Width-1,Height);
     Canvas.MoveTo(0,Height-1);
     XCount := 0 ;
end;

procedure TSOPerfChart.Plot(Value : Integer) ;
var
   I : Integer;
   FillR : TRect;
begin
     if Value < 0 then Value := 0 ;
     if Value > 100 then Value := 100 ;
     // сместить экран влево
     BitBlt(Canvas.Handle,-5,0,Width,Height,Canvas.Handle,0,0,SRCCOPY);
     // залить рабочую область
     FillR := Rect(Width-5, 0, Width, Height) ;
     Canvas.Brush.Color := clBlack ;
     Canvas.FillRect(FillR);
     // рисовать горизонтальные линии
     Canvas.Pen.Color := clGreen ;
     I := 0 ;
     while I < Height Do
      begin
           Canvas.MoveTo(0,I);
           Canvas.LineTo(Width,Canvas.PenPos.Y);
           I := I + 15 ;
      end;
     // рисовать вертикальные линии
     XCount := XCount + 5 ;
     if XCount = 15 then
      begin
          XCount := 0 ;
          Canvas.MoveTo(Width-1,0);
          Canvas.LineTo(Width-1,Height);
      end;
     // рисуем новое значение 
     Canvas.Pen.Color := FPlotColor ;
     Canvas.MoveTo(Width-6,FOldPos);
     Canvas.Pen.Style := psSolid ;                                  
     Canvas.LineTo(Width-1,(Round(Height - (Value / 100)*Height))+2 ) ;
     FOldPos := Canvas.PenPos.Y ;
end;

end.