Mega Code Archive
SignalDisplay component
<![CDATA[
Title: SignalDisplay component
Question: 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) 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 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 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.
]]>