Imagem - fazendo grafico de linhas tipo sinal de audio

Top  Previous  Next

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: 

1. Multiple data series. 

2. Individual control over X axis and Y axis. 

3. Paning 

4. 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) 2002All 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 >= 0and (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 <> -1and (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 <> -1and (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 <> -1and (MoveY <> -1) then 

  begin 

    Canvas.MoveTo(StartX,StartY); 

    Canvas.LineTo(MoveX,MoveY); 

    MoveX := -1

    MoveY := -1

  end// if 

  if (X <> -1and (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 >= 0and (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