SignalDisplay component

Problem/Question/Abstract:

Ever wanted to display audio from a microphone? ever wanted to have the ability to see wave file actual samples like CoolEdit does?

Answer:

The following component allows:

Multiple data series.
Individual control over X axis and Y axis.
Paning
Zoom

and much more....

the original intention was to be able to display wave file samples like CoolEdit does, a lot of times you need to work on the data and doesn't need the graph component to hold a second copy (like in audio analysis software) so we wrote a component that doesn't hold the data but only displays it.

You can download a demo application (with source) that operates like CoolEdit in the sense it shows the actual samples of the wave file and a lot of neat options at: http://www.com-n-sense.com/ftproot/SignalDisplay.zip

(the zip file contains number of components such as: WaveFileParser and SignalDisplay and more...)

{*==============================================================================
          Copyright (C) 2002, All rights reserved, Com-N-Sense Ltd
================================================================================
File: SignalDisplay.pas
Author: Liran Shahar, Com-N-Sense Ltd
Updated: 24/03/2022
Purpose: 2D signal graph display
================================================================================
History:
  24/03/2002, Liran Shahar
  - Axis visible property at design time bug fixed.
  - Axis color property at design time bug fixed.
  - Memory leak fixed (caused by unfreed series objects).
  - Added ClearSeries procedure to clear the graph from all series (i.e data).

  08/03/2002, Liran Shahar
  - Initial release.
==============================================================================*}
unit SignalDisplay;

interface

uses
  Windows, Messages, Sysutils, Classes, Graphics, Controls, Contnrs, Forms, Math,
  SignalTypes;

const
  X_MARGIN = 10;
  Y_MARGIN = 10;
  TICK_MARGIN = 4;
  DEFAULT_WIDTH = 100;
  DEFAULT_HEIGHT = 100;

type
  TcnsBufferType = (btShortint, btByte, btSmallint, btWord, btLongint, btLongword,
    btSingle, btDouble);

  TcnsSignalDisplay = class;

  TcnsSignalDisplayObject = class(TPersistent)
  private
    FVisible: boolean;
    FColor: TColor;
    Parent: TcnsSignalDisplay;
  protected
    procedure SetVisible(AVisible: boolean); virtual;
    procedure SetColor(AColor: TColor); virtual;
    procedure InitInternalVariables; virtual;
    procedure NotifyParent; virtual; abstract;
  public
    constructor Create(AParent: TcnsSignalDisplay); virtual;
    destructor Destroy; override;
  published
    property Visible: boolean read FVisible write SetVisible default true;
    property Color: TColor read FColor write SetColor default clWhite;
  end;

  TcnsAxis = class(TcnsSignalDisplayObject)
  private
    FMin: double;
    FMax: double;
    FTicks: integer;
  protected
    procedure SetTicks(ATicks: integer); virtual;
    procedure InitInternalVariables; override;
    procedure NotifyParent; override;
  public
    procedure SetRange(AMin, AMax: double); virtual;
    procedure DrawOn(Canvas: TCanvas; WorkRect: TRect; bVertical: boolean); virtual;
    property Min: double read FMin;
    property Max: double read FMax;
  published
    property Ticks: integer read FTicks write SetTicks default 0;
  end;

  TcnsSerie = class(TcnsSignalDisplayObject)
  private
    FBufferPtr: pointer;
    FBufferType: TcnsBufferType;
    FBufferSamples: integer;
    FBufferStep: integer;
  protected
    procedure SetBufferPtr(ABufferPtr: pointer); virtual;
    procedure SetBufferType(ABufferType: TcnsBufferType); virtual;
    procedure SetBufferSamples(ABufferSamples: integer); virtual;
    procedure SetBufferStep(ABufferStep: integer); virtual;
    procedure InitInternalVariables; override;
    procedure NotifyParent; override;
    function GetSampleValue(iSample: integer): double; virtual;
  public
    procedure DrawOn(Canvas: TCanvas; WorkRect: TRect); virtual;
    procedure GetMinMax(var dMin, dMax: double); virtual;
    property BufferPtr: pointer read FBufferPtr write SetBufferPtr;
  published
    property BufferType: TcnsBufferType read FBufferType write SetBufferType default
      btByte;
    property BufferSamples: integer read FBufferSamples write SetBufferSamples default
      0;
    property BufferStep: integer read FBufferStep write SetBufferStep default 1;
  end;

  TcnsSignalDisplayMouseState = (gmsNormal, gmsZoom, gmsMove);

  TcnsSignalDisplayDrawState = set of (dsEraseBackground, dsAxises, dsSeries);

  TcnsSignalDisplayZoomKind = (zkFree, zkXAxis, zkYAxis);

  TcnsSignalDisplay = class(TGraphicControl)
  private
    FXAxis: TcnsAxis;
    FYAxis: TcnsAxis;
    FColor: TColor;
    LockCount: integer;
    Series: TObjectList;
    dXRatio: double;
    dYRatio: double;
    BackBuffer: TBitmap;
    MarkerX, MarkerY, StartX, StartY, MoveX, MoveY: integer;
    MouseState: TcnsSignalDisplayMouseState;
    XAxisRect, YAxisRect, DataRect, RubberBandRect: TRect;
    DrawState: TcnsSignalDisplayDrawState;
    ZoomKind: TcnsSignalDisplayZoomKind;
  protected
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
      override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
      override;
    procedure DrawMarker(X, Y: integer); virtual;
    procedure DrawRubberBand(StartX, StartY, EndX, EndY: integer; Kind:
      TcnsSignalDisplayZoomKind); virtual;
    procedure DrawMoveLine(X, Y: integer); virtual;
    procedure CalculateAllRange; virtual;
    procedure CalculateRects; virtual;
    procedure DrawAxises; virtual;
    procedure DrawSeries; virtual;
    procedure Paint; override;
    procedure Loaded; override;
    function GetSerie(Index: integer): TcnsSerie; virtual;
    procedure SetColor(AColor: TColor); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Lock; virtual;
    procedure Unlock; virtual;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
    function AddSerie: TcnsSerie; virtual;
    function RemoveSerie(Serie: TcnsSerie): boolean; virtual;
    procedure ClearSeries; virtual;
    procedure MouseToWorld(Mx, My: integer; var Wx, Wy: double); virtual;
    procedure WorldToMouse(Wx, Wy: double; var Mx, My: integer); virtual;
    procedure Redraw(NewDrawState: TcnsSignalDisplayDrawState = []); virtual;
    procedure DrawLine(X1, Y1, X2, Y2: double; Color: TColor); virtual;
    property Serie[Index: integer]: TcnsSerie read GetSerie;
  published
    property XAxis: TcnsAxis read FXAxis write FXAxis;
    property YAxis: TcnsAxis read FYAxis write FYAxis;
    property Color: TColor read FColor write SetColor;
    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Com-N-Sense', [TcnsSignalDisplay]);
end;

//=============================================================================
// TcnsSignalDisplayObject
//=============================================================================

constructor TcnsSignalDisplayObject.Create(AParent: TcnsSignalDisplay);
begin
  inherited Create;
  Parent := AParent;
  InitInternalVariables;
end;

destructor TcnsSignalDisplayObject.Destroy;
begin
  inherited Destroy;
end;

procedure TcnsSignalDisplayObject.SetVisible(AVisible: boolean);
begin
  if AVisible <> FVisible then
  begin
    FVisible := AVisible;
    NotifyParent;
  end; // if
end;

procedure TcnsSignalDisplayObject.SetColor(AColor: TColor);
begin
  if AColor <> FColor then
  begin
    FColor := AColor;
    NotifyParent;
  end; // if
end;

procedure TcnsSignalDisplayObject.InitInternalVariables;
begin
  FVisible := true;
  FColor := clWhite;
end;

//=============================================================================
// TcnsAxis
//=============================================================================

procedure TcnsAxis.SetTicks(ATicks: integer);
begin
  if ATicks <> FTicks then
  begin
    FTicks := ATicks;
    NotifyParent;
  end; // if
end;

procedure TcnsAxis.InitInternalVariables;
begin
  inherited InitInternalVariables;
  FMin := 0.0;
  FMax := 0.0;
  FTicks := 0;
end;

procedure TcnsAxis.NotifyParent;
begin
  Parent.Redraw([dsEraseBackground, dsAxises]);
end;

procedure TcnsAxis.SetRange(AMin, AMax: double);
begin
  if (AMin <> FMin) or (AMax <> FMax) then
  begin
    FMin := AMin;
    FMax := AMax;
    Parent.Redraw([dsEraseBackground, dsAxises, dsSeries]);
  end; // if
end;

procedure TcnsAxis.DrawOn(Canvas: TCanvas; WorkRect: TRect; bVertical: boolean);
var
  iTextWidth, iTextHeight, iLoop, iPos, iTicks: integer;
  sText: AnsiString;
  dTickDelta, dRangeDelta: double;
begin
  iTextHeight := Canvas.TextHeight('0123456789');
  Canvas.Font.Color := FColor;
  Canvas.Pen.Color := FColor;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Width := 1;
  Canvas.Pen.Mode := pmCopy;
  if not IsRectEmpty(WorkRect) then
    with WorkRect do
    begin
      Canvas.Brush.Style := bsSolid;
      Canvas.Brush.Color := Parent.Color;
      Canvas.FillRect(WorkRect);
      Canvas.Brush.Style := bsClear;
      if bVertical then
      begin
        sText := format('%f', [FMax]);
        Canvas.TextRect(WorkRect, Left + TICK_MARGIN, Top, sText);
        sText := format('%f', [FMin]);
        Canvas.TextRect(WorkRect, Left + TICK_MARGIN, Bottom - iTextHeight, sText);
        iTicks := FTicks;
        if iTicks > 0 then
        begin
          dTickDelta := (Bottom - Top + 1) / (iTicks + 1);
          dRangeDelta := (FMax - FMin) / (iTicks + 1);
          for iLoop := 1 to Ticks do
          begin
            iPos := Bottom - trunc(dTickDelta * iLoop);
            Canvas.Polyline([Point(Left, iPos), Point(Left + TICK_MARGIN, iPos)]);
            sText := format('%f', [FMin + iLoop * dRangeDelta]);
            Canvas.TextRect(WorkRect, Left + TICK_MARGIN, iPos - iTextHeight shr 1,
              sText);
          end; // for
        end; // if
        Canvas.Polyline([Point(Right, Top), Point(Left, Top), Point(Left, Bottom),
          Point(Right, Bottom)]);
      end
      else
      begin
        sText := format('%f', [FMin]);
        Canvas.TextRect(WorkRect, Left + 1, Top + TICK_MARGIN, sText);
        sText := format('%f', [FMax]);
        iTextWidth := Canvas.TextWidth(sText);
        Canvas.TextRect(WorkRect, Right - iTextWidth - 1, Top + TICK_MARGIN, sText);
        iTicks := FTicks;
        if iTicks > 0 then
        begin
          dTickDelta := (Right - Left + 1) / (iTicks + 1);
          dRangeDelta := (FMax - FMin) / (iTicks + 1);
          for iLoop := 1 to Ticks do
          begin
            iPos := Left + trunc(dTickDelta * iLoop);
            Canvas.Polyline([Point(iPos, Top), Point(iPos, Top + TICK_MARGIN)]);
            sText := format('%f', [FMin + iLoop * dRangeDelta]);
            iTextWidth := Canvas.TextWidth(sText);
            Canvas.TextRect(WorkRect, iPos - iTextWidth shr 1, Top + TICK_MARGIN,
              sText);
          end; // for
        end; // if
        Canvas.Polyline([Point(Left, Bottom), Point(Left, Top), Point(Right, Top),
          Point(Right, Bottom)]);
      end; // if/else
    end; // with
end;

//=============================================================================
// TcnsSerie
//=============================================================================

procedure TcnsSerie.SetBufferPtr(ABufferPtr: pointer);
begin
  if ABufferPtr <> FBufferPtr then
  begin
    FBufferPtr := ABufferPtr;
    NotifyParent;
  end; // if
end;

procedure TcnsSerie.SetBufferType(ABufferType: TcnsBufferType);
begin
  if ABufferType <> FBufferType then
  begin
    FBufferType := ABufferType;
    NotifyParent;
  end; // if
end;

procedure TcnsSerie.SetBufferSamples(ABufferSamples: integer);
begin
  if ABufferSamples <> FBufferSamples then
  begin
    FBufferSamples := ABufferSamples;
    NotifyParent;
  end; // if
end;

procedure TcnsSerie.SetBufferStep(ABufferStep: integer);
begin
  if ABufferStep <> FBufferStep then
  begin
    FBufferStep := ABufferStep;
    NotifyParent;
  end; // if
end;

procedure TcnsSerie.InitInternalVariables;
begin
  inherited InitInternalVariables;
  FBufferPtr := nil;
  FBufferType := btByte;
  FBufferSamples := 0;
  FBufferStep := 1;
end;

procedure TcnsSerie.NotifyParent;
begin
  Parent.Redraw([dsSeries]);
end;

function TcnsSerie.GetSampleValue(iSample: integer): double;
begin
  Result := 0;
  case FBufferType of
    btShortint: Result := PArrayShortint(FBufferPtr)^[iSample];
    btByte: Result := PArrayByte(FBufferPtr)^[iSample];
    btSmallint: Result := PArraySmallint(FBufferPtr)^[iSample];
    btWord: Result := PArrayWord(FBufferPtr)^[iSample];
    btLongint: Result := PArrayLongint(FBufferPtr)^[iSample];
    btLongword: Result := PArrayLongword(FBufferPtr)^[iSample];
    btSingle: Result := PArraySingle(FBufferPtr)^[iSample];
    btDouble: Result := PArrayDouble(FBufferPtr)^[iSample];
  end; // case
end;

procedure TcnsSerie.DrawOn(Canvas: TCanvas; WorkRect: TRect);
var
  ClippingRgn: HRGN;
  bFirst: boolean;
  iLoop, iX, iY, iHeight, iSample, iNumberOfSamples, PrevX, PrevY: integer;
  dValue: double;
begin
  PrevX := -1;
  PrevY := -1;
  ClippingRgn := CreateRectRgnIndirect(WorkRect);
  SelectClipRgn(Canvas.Handle, ClippingRgn);
  iHeight := WorkRect.Bottom - WorkRect.Top + 1;
  Canvas.Pen.Color := FColor;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Width := 1;
  bFirst := true;
  with Parent.XAxis do
    iNumberOfSamples := trunc(Max - Min);
  for iLoop := 0 to iNumberOfSamples - 1 do
  begin
    iX := trunc(Parent.dXRatio * iLoop);
    iSample := (iLoop + trunc(Parent.XAxis.Min)) * FBufferStep;
    if (iSample >= 0) and (iSample < FBufferSamples) then
    begin
      dValue := GetSampleValue(iSample);
      iY := iHeight - trunc((dValue - Parent.YAxis.Min) * Parent.dYRatio);
      if bFirst or (iX <> PrevX) or (iY <> PrevY) then
      begin
        if bFirst then
          Canvas.MoveTo(WorkRect.Left + iX, WorkRect.Top + iY)
        else
          Canvas.LineTo(WorkRect.Left + iX, WorkRect.Top + iY);
        bFirst := false;
      end; // if
      PrevX := iX;
      PrevY := iY;
    end; // if
  end; // for
  SelectClipRgn(Canvas.Handle, 0);
  DeleteObject(ClippingRgn);
end;

procedure TcnsSerie.GetMinMax(var dMin, dMax: double);
var
  iSample: integer;
  dSample: double;
begin
  for iSample := 0 to FBufferSamples - 1 do
  begin
    dSample := GetSampleValue(iSample);
    if iSample = 0 then
    begin
      dMin := dSample;
      dMax := dSample;
    end
    else
    begin
      dMin := Min(dMin, dSample);
      dMax := Max(dMax, dSample);
    end; // if/else
  end; // for
end;

//=============================================================================
// TcnsSignalDisplay
//=============================================================================
const
  Y_TICK = 4;
  X_TICK = 4;

  MARKER_X_SIZE = 8;
  MARKER_Y_SIZE = 8;

  MARKER_COLOR = clWhite;
  BAND_COLOR = clWhite;
  MOVE_LINE_COLOR = clWhite;

constructor TcnsSignalDisplay.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FXAxis := TcnsAxis.Create(Self);
  FYAxis := TcnsAxis.Create(Self);
  Width := DEFAULT_WIDTH;
  Height := DEFAULT_HEIGHT;
  LockCount := 0;
  Series := TObjectList.Create;
  Series.OwnsObjects := true;
  MarkerX := -1;
  MarkerY := -1;
  MoveX := -1;
  MoveY := -1;
  MouseState := gmsNormal;
end;

destructor TcnsSignalDisplay.Destroy;
begin
  FreeAndNil(FXAxis);
  FreeAndNil(FYAxis);
  FreeAndNil(Series);
  inherited Destroy;
end;

procedure TcnsSignalDisplay.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  MouseState := gmsNormal;
end;

procedure TcnsSignalDisplay.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  DrawMarker(-1, -1);
end;

procedure TcnsSignalDisplay.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:
  Integer);
var
  WorldRect: TRect;
begin
  WorldRect.TopLeft := ClientToScreen(DataRect.TopLeft);
  WorldRect.BottomRight := ClientToScreen(DataRect.BottomRight);
  if PtInRect(DataRect, Point(X, Y)) then
  begin
    if (Button = mbLeft) then
    begin
      MouseState := gmsZoom;
      if ssShift in Shift then
        ZoomKind := zkYAxis
      else if ssCtrl in Shift then
        ZoomKind := zkXAxis
      else
        ZoomKind := zkFree;
      StartX := X;
      StartY := Y;
      ClipCursor(@WorldRect);
    end
    else if (Button = mbRight) then
    begin
      MouseState := gmsMove;
      StartX := X;
      StartY := Y;
      ClipCursor(@WorldRect);
    end;
  end; // if
  inherited;
end;

procedure TcnsSignalDisplay.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  case MouseState of
    gmsNormal:
      if PtInRect(DataRect, Point(X, Y)) then
      begin
        Cursor := crNone;
        DrawMarker(X, Y)
      end
      else
      begin
        DrawMarker(-1, -1);
        Cursor := crDefault;
      end; // if
    gmsZoom:
      begin
        DrawMarker(X, Y);
        DrawRubberBand(StartX, StartY, X, Y, ZoomKind);
      end;
    gmsMove:
      begin
        DrawMoveLine(X, Y);
        DrawMarker(X, Y);
      end;
  end; // case
  inherited;
end;

procedure TcnsSignalDisplay.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:
  Integer);
var
  dXMin, dXMax, dYMin, dYMax: double;
begin
  DrawMarker(-1, -1);
  case MouseState of
    gmsNormal:
      if Button = mbMiddle then
      begin
        CalculateAllRange;
      end; // if
    gmsZoom:
      begin
        with RubberBandRect.TopLeft do
          MouseToWorld(X, Y, dXMin, dYMax);
        with RubberBandRect.BottomRight do
          MouseToWorld(X, Y, dXMax, dYMin);
        DrawRubberBand(0, 0, 0, 0, ZoomKind);
        MouseState := gmsNormal;
        Lock;
        if ZoomKind in [zkFree, zkXAxis] then
          FXAxis.SetRange(dXMin, dXMax);
        if ZoomKind in [zkFree, zkYAxis] then
          FYAxis.SetRange(dYMin, dYMax);
        Unlock;
        ClipCursor(nil);
      end;
    gmsMove:
      begin
        Lock;
        if dXRatio <> 0 then
          with FXAxis do
            SetRange(Min - (X - StartX) / dXRatio, Max - (X - StartX) / dXRatio);
        if dYRatio <> 0 then
          with FYAxis do
            SetRange(Min + (Y - StartY) / dYRatio, Max + (Y - StartY) / dYRatio);
        MouseState := gmsNormal;
        DrawMoveLine(-1, -1);
        Unlock;
        ClipCursor(nil);
      end;
  end; // case
  DrawMarker(X, Y);
  inherited;
end;

procedure TcnsSignalDisplay.DrawMarker(X, Y: integer);
begin
  Canvas.Pen.Mode := pmXor;
  Canvas.Pen.Color := MARKER_COLOR;
  Canvas.Pen.Width := 1;
  if (MarkerX <> -1) and (MarkerY <> -1) then
  begin
    Canvas.MoveTo(MarkerX, MarkerY - MARKER_Y_SIZE);
    Canvas.LineTo(MarkerX, MarkerY + MARKER_Y_SIZE);
    Canvas.MoveTo(MarkerX - MARKER_X_SIZE, MarkerY);
    Canvas.LineTo(MarkerX + MARKER_X_SIZE, MarkerY);
    MarkerX := -1;
    MarkerY := -1;
  end; // if
  if (X <> -1) and (Y <> -1) then
  begin
    MarkerX := X;
    MarkerY := Y;
    Canvas.MoveTo(MarkerX, MarkerY - MARKER_Y_SIZE);
    Canvas.LineTo(MarkerX, MarkerY + MARKER_Y_SIZE);
    Canvas.MoveTo(MarkerX - MARKER_X_SIZE, MarkerY);
    Canvas.LineTo(MarkerX + MARKER_X_SIZE, MarkerY);
  end; // if
end;

procedure TcnsSignalDisplay.DrawRubberBand(StartX, StartY, EndX, EndY: integer; Kind:
  TcnsSignalDisplayZoomKind);
begin
  Canvas.Pen.Mode := pmXor;
  Canvas.Pen.Color := BAND_COLOR;
  Canvas.Pen.Width := 1;
  Canvas.Pen.Style := psDot;
  if not IsRectEmpty(RubberBandRect) then
    with RubberBandRect do
      Canvas.Polyline([Point(Left, Top), Point(Right, Top), Point(Right, Bottom),
        Point(Left, Bottom), Point(Left, Top)]);
  case Kind of
    zkYAxis:
      begin
        StartX := DataRect.Left;
        EndX := DataRect.Right - 1;
      end;
    zkXAxis:
      begin
        StartY := DataRect.Top;
        EndY := DataRect.Bottom - 1;
      end;
  end;
  RubberBandRect.Left := Min(StartX, EndX);
  RubberBandRect.Top := Min(StartY, EndY);
  RubberBandRect.Right := Max(StartX, EndX);
  RubberBandRect.Bottom := Max(StartY, EndY);
  if not IsRectEmpty(RubberBandRect) then
    with RubberBandRect do
      Canvas.Polyline([Point(Left, Top), Point(Right, Top), Point(Right, Bottom),
        Point(Left, Bottom), Point(Left, Top)]);
end;

procedure TcnsSignalDisplay.DrawMoveLine(X, Y: integer);
begin
  Canvas.Pen.Mode := pmXor;
  Canvas.Pen.Color := MOVE_LINE_COLOR;
  Canvas.Pen.Width := 1;
  Canvas.Pen.Style := psDash;
  if (MoveX <> -1) and (MoveY <> -1) then
  begin
    Canvas.MoveTo(StartX, StartY);
    Canvas.LineTo(MoveX, MoveY);
    MoveX := -1;
    MoveY := -1;
  end; // if
  if (X <> -1) and (Y <> -1) then
  begin
    Canvas.MoveTo(StartX, StartY);
    Canvas.LineTo(X, Y);
    MoveX := X;
    MoveY := Y;
  end; // if
end;

procedure TcnsSignalDisplay.CalculateAllRange;
var
  XMin, XMax, YMin, YMax, TmpYMin, TmpYMax: double;
  iLoop: integer;
  Serie: TcnsSerie;
begin
  XMax := 0;
  XMin := 0;
  for iLoop := 0 to Series.Count - 1 do
  begin
    Serie := GetSerie(iLoop);
    if iLoop = 0 then
    begin
      XMax := Serie.BufferSamples;
      Serie.GetMinMax(YMin, YMax);
    end
    else
    begin
      XMax := Max(XMax, Serie.BufferSamples);
      Serie.GetMinMax(TmpYMin, TmpYMax);
      YMin := Min(YMin, TmpYMin);
      YMax := Max(YMax, TmpYMax);
    end; // if/else
  end;
  Lock;
  FXAxis.SetRange(XMin, XMax);
  FYAxis.SetRange(YMin, YMax);
  Unlock;
end;

procedure TcnsSignalDisplay.CalculateRects;
var
  iLeft, iTop, iRight, iBottom, iTextWidth, iTextHeight: integer;
begin
  XAxisRect := Rect(0, 0, 0, 0);
  YAxisRect := Rect(0, 0, 0, 0);
  iLeft := ClientRect.Left + X_MARGIN;
  iTop := ClientRect.Top + Y_MARGIN;
  iRight := ClientRect.Right - X_MARGIN - TICK_MARGIN;
  iBottom := ClientRect.Bottom - Y_MARGIN - TICK_MARGIN;
  iTextWidth := Math.Max(Canvas.TextWidth(format('%fW', [FYAxis.Min])),
    Canvas.TextWidth(format('%fW', [FYAxis.Max])));
  iTextHeight := BackBuffer.Canvas.TextHeight('0123456789');
  DataRect := Rect(iLeft, iTop, iRight, iBottom);
  if FXAxis.Visible then
    DataRect.Bottom := iBottom - iTextHeight;
  if FYAxis.Visible then
    DataRect.Right := iRight - iTextWidth;
  with DataRect do
  begin
    if FXAxis.Visible then
      XAxisRect := Rect(iLeft, Bottom + 1, Right, iBottom + TICK_MARGIN);
    if FYAxis.Visible then
      YAxisRect := Rect(Right + 1, Top, iRight + TICK_MARGIN, Bottom);
  end; // with
  dXRatio := 0;
  dYRatio := 0;
  with FXAxis do
    dXRatio := (DataRect.Right - DataRect.Left + 1) / (Max - Min + 1);
  with FYAxis do
    dYRatio := (DataRect.Bottom - DataRect.Top + 1) / (Max - Min + 1);
end;

procedure TcnsSignalDisplay.DrawAxises;
begin
  FXAxis.DrawOn(BackBuffer.Canvas, XAxisRect, false);
  FYAxis.DrawOn(BackBuffer.Canvas, YAxisRect, true);
end;

procedure TcnsSignalDisplay.DrawSeries;
var
  iSerie: integer;
  Serie: TcnsSerie;
begin
  BackBuffer.Canvas.Brush.Color := FColor;
  BackBuffer.Canvas.FillRect(DataRect);
  for iSerie := 0 to Series.Count - 1 do
  begin
    Serie := GetSerie(iSerie);
    with Serie do
      if Visible and assigned(BufferPtr) then
        DrawOn(BackBuffer.Canvas, DataRect);
  end; // for
end;

procedure TcnsSignalDisplay.Paint;
begin
  if not assigned(BackBuffer) then
  begin
    BackBuffer := TBitmap.Create;
    BackBuffer.Width := Width;
    BackBuffer.Height := Height;
    BackBuffer.PixelFormat := pf24Bit;
    DrawState := DrawState + [dsEraseBackground, dsAxises, dsSeries];
  end; // if
  if dsEraseBackground in DrawState then
  begin
    BackBuffer.Canvas.Brush.Color := FColor;
    BackBuffer.Canvas.FillRect(ClientRect);
  end; // if
  CalculateRects;
  if dsAxises in DrawState then
    DrawAxises;
  if dsSeries in DrawState then
    DrawSeries;
  Canvas.Draw(0, 0, BackBuffer);
  DrawState := [];
end;

procedure TcnsSignalDisplay.Loaded;
begin
  inherited Loaded;
  FreeAndNil(BackBuffer);
  Redraw([dsEraseBackground, dsAxises, dsSeries]);
end;

function TcnsSignalDisplay.GetSerie(Index: integer): TcnsSerie;
begin
  Result := nil;
  if (Index >= 0) and (Index < Series.Count) then
    Result := TcnsSerie(Series[Index]);
end;

procedure TcnsSignalDisplay.SetColor(AColor: TColor);
begin
  if AColor <> FColor then
  begin
    FColor := AColor;
    Redraw([dsEraseBackground, dsSeries, dsAxises]);
  end; // if
end;

procedure TcnsSignalDisplay.Lock;
begin
  LockCount := LockCount + 1;
end;

procedure TcnsSignalDisplay.Unlock;
begin
  LockCount := LockCount - 1;
  Redraw;
end;

procedure TcnsSignalDisplay.SetBounds(ALeft, ATop, AWidth, AHeight: integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  FreeAndNil(BackBuffer);
end;

function TcnsSignalDisplay.AddSerie: TcnsSerie;
begin
  Result := TcnsSerie.Create(Self);
  Series.Add(Result);
end;

function TcnsSignalDisplay.RemoveSerie(Serie: TcnsSerie): boolean;
var
  iIndex: integer;
begin
  Result := true;
  iIndex := Series.IndexOf(Serie);
  if iIndex > -1 then
  begin
    Series.Delete(iIndex);
    Redraw([dsSeries]);
  end
  else
    Result := false;
end;

procedure TcnsSignalDisplay.ClearSeries;
begin
  Series.Clear;
end;

procedure TcnsSignalDisplay.MouseToWorld(Mx, My: integer; var Wx, Wy: double);
begin
  Wx := 0;
  if dXRatio <> 0 then
    Wx := FXAxis.FMin + (Mx - DataRect.Left) / dXRatio;
  Wy := 0;
  if dYRatio <> 0 then
    Wy := FYAxis.FMax - (My - DataRect.Top) / dYRatio;
end;

procedure TcnsSignalDisplay.WorldToMouse(Wx, Wy: double; var Mx, My: integer);
begin
  Mx := 0;
  My := 0;
  if dXRatio <> 0 then
    Mx := DataRect.Left + trunc((Wx - FXAxis.FMin) * dXRatio);
  if dYRatio <> 0 then
    My := DataRect.Top + trunc((FYAxis.FMax - Wy) * dYRatio);
end;

procedure TcnsSignalDisplay.Redraw(NewDrawState: TcnsSignalDisplayDrawState);
begin
  DrawState := DrawState + NewDrawState;
  if LockCount = 0 then
    Repaint;
end;

procedure TcnsSignalDisplay.DrawLine(X1, Y1, X2, Y2: double; Color: TColor);
var
  iX1, iY1, iX2, iY2: integer;
begin
  WorldToMouse(X1, Y1, iX1, iY1);
  WorldToMouse(X2, Y2, iX2, iY2);
  Canvas.Pen.Color := Color;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Mode := pmCopy;
  Canvas.MoveTo(iX1, iY1);
  Canvas.LineTo(iX2, iY2);
end;

end.