SignalDisplay component (Views: 27)
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. |