Author: Liran Shahar
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.ziphttp://www.com-n-sense.com/ftpro
ot/SignalDisplay.zip
(the zip file contains number of components such as: WaveFileParser and
SignalDisplay and more...)
1
2 {*==============================================================================
3 Copyright (C) 2002, All rights reserved, Com-N-Sense Ltd
4 ================================================================================
5 File: SignalDisplay.pas
6 Author: Liran Shahar, Com-N-Sense Ltd
7 Updated: 24/03/2022
8 Purpose: 2D signal graph display
9 ================================================================================
10 History:
11 24/03/2002, Liran Shahar
12 - Axis visible property at design time bug fixed.
13 - Axis color property at design time bug fixed.
14 - Memory leak fixed (caused by unfreed series objects).
15 - Added ClearSeries procedure to clear the graph from all series (i.e data).
16
17 08/03/2002, Liran Shahar
18 - Initial release.
19 ==============================================================================*}
20 unit SignalDisplay;
21
22 interface
23
24 uses
25 Windows, Messages, Sysutils, Classes, Graphics, Controls, Contnrs, Forms, Math,
26 SignalTypes;
27
28 const
29 X_MARGIN = 10;
30 Y_MARGIN = 10;
31 TICK_MARGIN = 4;
32 DEFAULT_WIDTH = 100;
33 DEFAULT_HEIGHT = 100;
34
35 type
36 TcnsBufferType = (btShortint, btByte, btSmallint, btWord, btLongint, btLongword,
37 btSingle, btDouble);
38
39 TcnsSignalDisplay = class;
40
41 TcnsSignalDisplayObject = class(TPersistent)
42 private
43 FVisible: boolean;
44 FColor: TColor;
45 Parent: TcnsSignalDisplay;
46 protected
47 procedure SetVisible(AVisible: boolean); virtual;
48 procedure SetColor(AColor: TColor); virtual;
49 procedure InitInternalVariables; virtual;
50 procedure NotifyParent; virtual; abstract;
51 public
52 constructor Create(AParent: TcnsSignalDisplay); virtual;
53 destructor Destroy; override;
54 published
55 property Visible: boolean read FVisible write SetVisible default true;
56 property Color: TColor read FColor write SetColor default clWhite;
57 end;
58
59 TcnsAxis = class(TcnsSignalDisplayObject)
60 private
61 FMin: double;
62 FMax: double;
63 FTicks: integer;
64 protected
65 procedure SetTicks(ATicks: integer); virtual;
66 procedure InitInternalVariables; override;
67 procedure NotifyParent; override;
68 public
69 procedure SetRange(AMin, AMax: double); virtual;
70 procedure DrawOn(Canvas: TCanvas; WorkRect: TRect; bVertical: boolean); virtual;
71 property Min: double read FMin;
72 property Max: double read FMax;
73 published
74 property Ticks: integer read FTicks write SetTicks default 0;
75 end;
76
77 TcnsSerie = class(TcnsSignalDisplayObject)
78 private
79 FBufferPtr: pointer;
80 FBufferType: TcnsBufferType;
81 FBufferSamples: integer;
82 FBufferStep: integer;
83 protected
84 procedure SetBufferPtr(ABufferPtr: pointer); virtual;
85 procedure SetBufferType(ABufferType: TcnsBufferType); virtual;
86 procedure SetBufferSamples(ABufferSamples: integer); virtual;
87 procedure SetBufferStep(ABufferStep: integer); virtual;
88 procedure InitInternalVariables; override;
89 procedure NotifyParent; override;
90 function GetSampleValue(iSample: integer): double; virtual;
91 public
92 procedure DrawOn(Canvas: TCanvas; WorkRect: TRect); virtual;
93 procedure GetMinMax(var dMin, dMax: double); virtual;
94 property BufferPtr: pointer read FBufferPtr write SetBufferPtr;
95 published
96 property BufferType: TcnsBufferType read FBufferType write SetBufferType default
97 btByte;
98 property BufferSamples: integer read FBufferSamples write SetBufferSamples
99 default
100 0;
101 property BufferStep: integer read FBufferStep write SetBufferStep default 1;
102 end;
103
104 TcnsSignalDisplayMouseState = (gmsNormal, gmsZoom, gmsMove);
105
106 TcnsSignalDisplayDrawState = set of (dsEraseBackground, dsAxises, dsSeries);
107
108 TcnsSignalDisplayZoomKind = (zkFree, zkXAxis, zkYAxis);
109
110 TcnsSignalDisplay = class(TGraphicControl)
111 private
112 FXAxis: TcnsAxis;
113 FYAxis: TcnsAxis;
114 FColor: TColor;
115 LockCount: integer;
116 Series: TObjectList;
117 dXRatio: double;
118 dYRatio: double;
119 BackBuffer: TBitmap;
120 MarkerX, MarkerY, StartX, StartY, MoveX, MoveY: integer;
121 MouseState: TcnsSignalDisplayMouseState;
122 XAxisRect, YAxisRect, DataRect, RubberBandRect: TRect;
123 DrawState: TcnsSignalDisplayDrawState;
124 ZoomKind: TcnsSignalDisplayZoomKind;
125 protected
126 procedure CMMouseEnter(var message: TMessage); message CM_MOUSEENTER;
127 procedure CMMouseLeave(var message: TMessage); message CM_MOUSELEAVE;
128 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
129 override;
130 procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
131 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
132 override;
133 procedure DrawMarker(X, Y: integer); virtual;
134 procedure DrawRubberBand(StartX, StartY, EndX, EndY: integer; Kind:
135 TcnsSignalDisplayZoomKind); virtual;
136 procedure DrawMoveLine(X, Y: integer); virtual;
137 procedure CalculateAllRange; virtual;
138 procedure CalculateRects; virtual;
139 procedure DrawAxises; virtual;
140 procedure DrawSeries; virtual;
141 procedure Paint; override;
142 procedure Loaded; override;
143 function GetSerie(Index: integer): TcnsSerie; virtual;
144 procedure SetColor(AColor: TColor); virtual;
145 public
146 constructor Create(AOwner: TComponent); override;
147 destructor Destroy; override;
148 procedure Lock; virtual;
149 procedure Unlock; virtual;
150 procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
151 function AddSerie: TcnsSerie; virtual;
152 function RemoveSerie(Serie: TcnsSerie): boolean; virtual;
153 procedure ClearSeries; virtual;
154 procedure MouseToWorld(Mx, My: integer; var Wx, Wy: double); virtual;
155 procedure WorldToMouse(Wx, Wy: double; var Mx, My: integer); virtual;
156 procedure Redraw(NewDrawState: TcnsSignalDisplayDrawState = []); virtual;
157 procedure DrawLine(X1, Y1, X2, Y2: double; Color: TColor); virtual;
158 property Serie[Index: integer]: TcnsSerie read GetSerie;
159 published
160 property XAxis: TcnsAxis read FXAxis write FXAxis;
161 property YAxis: TcnsAxis read FYAxis write FYAxis;
162 property Color: TColor read FColor write SetColor;
163 property OnCanResize;
164 property OnClick;
165 property OnConstrainedResize;
166 property OnContextPopup;
167 property OnDblClick;
168 property OnMouseDown;
169 property OnMouseMove;
170 property OnMouseUp;
171 property OnResize;
172 end;
173
174 procedure register;
175
176 implementation
177
178 procedure register;
179 begin
180 RegisterComponents('Com-N-Sense', [TcnsSignalDisplay]);
181 end;
182
183 //=============================================================================
184 // TcnsSignalDisplayObject
185 //=============================================================================
186
187 constructor TcnsSignalDisplayObject.Create(AParent: TcnsSignalDisplay);
188 begin
189 inherited Create;
190 Parent := AParent;
191 InitInternalVariables;
192 end;
193
194 destructor TcnsSignalDisplayObject.Destroy;
195 begin
196 inherited Destroy;
197 end;
198
199 procedure TcnsSignalDisplayObject.SetVisible(AVisible: boolean);
200 begin
201 if AVisible <> FVisible then
202 begin
203 FVisible := AVisible;
204 NotifyParent;
205 end; // if
206 end;
207
208 procedure TcnsSignalDisplayObject.SetColor(AColor: TColor);
209 begin
210 if AColor <> FColor then
211 begin
212 FColor := AColor;
213 NotifyParent;
214 end; // if
215 end;
216
217 procedure TcnsSignalDisplayObject.InitInternalVariables;
218 begin
219 FVisible := true;
220 FColor := clWhite;
221 end;
222
223 //=============================================================================
224 // TcnsAxis
225 //=============================================================================
226
227 procedure TcnsAxis.SetTicks(ATicks: integer);
228 begin
229 if ATicks <> FTicks then
230 begin
231 FTicks := ATicks;
232 NotifyParent;
233 end; // if
234 end;
235
236 procedure TcnsAxis.InitInternalVariables;
237 begin
238 inherited InitInternalVariables;
239 FMin := 0.0;
240 FMax := 0.0;
241 FTicks := 0;
242 end;
243
244 procedure TcnsAxis.NotifyParent;
245 begin
246 Parent.Redraw([dsEraseBackground, dsAxises]);
247 end;
248
249 procedure TcnsAxis.SetRange(AMin, AMax: double);
250 begin
251 if (AMin <> FMin) or (AMax <> FMax) then
252 begin
253 FMin := AMin;
254 FMax := AMax;
255 Parent.Redraw([dsEraseBackground, dsAxises, dsSeries]);
256 end; // if
257 end;
258
259 procedure TcnsAxis.DrawOn(Canvas: TCanvas; WorkRect: TRect; bVertical: boolean);
260 var
261 iTextWidth, iTextHeight, iLoop, iPos, iTicks: integer;
262 sText: AnsiString;
263 dTickDelta, dRangeDelta: double;
264 begin
265 iTextHeight := Canvas.TextHeight('0123456789');
266 Canvas.Font.Color := FColor;
267 Canvas.Pen.Color := FColor;
268 Canvas.Pen.Style := psSolid;
269 Canvas.Pen.Width := 1;
270 Canvas.Pen.Mode := pmCopy;
271 if not IsRectEmpty(WorkRect) then
272 with WorkRect do
273 begin
274 Canvas.Brush.Style := bsSolid;
275 Canvas.Brush.Color := Parent.Color;
276 Canvas.FillRect(WorkRect);
277 Canvas.Brush.Style := bsClear;
278 if bVertical then
279 begin
280 sText := format('%f', [FMax]);
281 Canvas.TextRect(WorkRect, Left + TICK_MARGIN, Top, sText);
282 sText := format('%f', [FMin]);
283 Canvas.TextRect(WorkRect, Left + TICK_MARGIN, Bottom - iTextHeight, sText);
284 iTicks := FTicks;
285 if iTicks > 0 then
286 begin
287 dTickDelta := (Bottom - Top + 1) / (iTicks + 1);
288 dRangeDelta := (FMax - FMin) / (iTicks + 1);
289 for iLoop := 1 to Ticks do
290 begin
291 iPos := Bottom - trunc(dTickDelta * iLoop);
292 Canvas.Polyline([Point(Left, iPos), Point(Left + TICK_MARGIN, iPos)]);
293 sText := format('%f', [FMin + iLoop * dRangeDelta]);
294 Canvas.TextRect(WorkRect, Left + TICK_MARGIN, iPos - iTextHeight shr 1,
295 sText);
296 end; // for
297 end; // if
298 Canvas.Polyline([Point(Right, Top), Point(Left, Top), Point(Left, Bottom),
299 Point(Right, Bottom)]);
300 end
301 else
302 begin
303 sText := format('%f', [FMin]);
304 Canvas.TextRect(WorkRect, Left + 1, Top + TICK_MARGIN, sText);
305 sText := format('%f', [FMax]);
306 iTextWidth := Canvas.TextWidth(sText);
307 Canvas.TextRect(WorkRect, Right - iTextWidth - 1, Top + TICK_MARGIN, sText);
308 iTicks := FTicks;
309 if iTicks > 0 then
310 begin
311 dTickDelta := (Right - Left + 1) / (iTicks + 1);
312 dRangeDelta := (FMax - FMin) / (iTicks + 1);
313 for iLoop := 1 to Ticks do
314 begin
315 iPos := Left + trunc(dTickDelta * iLoop);
316 Canvas.Polyline([Point(iPos, Top), Point(iPos, Top + TICK_MARGIN)]);
317 sText := format('%f', [FMin + iLoop * dRangeDelta]);
318 iTextWidth := Canvas.TextWidth(sText);
319 Canvas.TextRect(WorkRect, iPos - iTextWidth shr 1, Top + TICK_MARGIN,
320 sText);
321 end; // for
322 end; // if
323 Canvas.Polyline([Point(Left, Bottom), Point(Left, Top), Point(Right, Top),
324 Point(Right, Bottom)]);
325 end; // if/else
326 end; // with
327 end;
328
329 //=============================================================================
330 // TcnsSerie
331 //=============================================================================
332
333 procedure TcnsSerie.SetBufferPtr(ABufferPtr: pointer);
334 begin
335 if ABufferPtr <> FBufferPtr then
336 begin
337 FBufferPtr := ABufferPtr;
338 NotifyParent;
339 end; // if
340 end;
341
342 procedure TcnsSerie.SetBufferType(ABufferType: TcnsBufferType);
343 begin
344 if ABufferType <> FBufferType then
345 begin
346 FBufferType := ABufferType;
347 NotifyParent;
348 end; // if
349 end;
350
351 procedure TcnsSerie.SetBufferSamples(ABufferSamples: integer);
352 begin
353 if ABufferSamples <> FBufferSamples then
354 begin
355 FBufferSamples := ABufferSamples;
356 NotifyParent;
357 end; // if
358 end;
359
360 procedure TcnsSerie.SetBufferStep(ABufferStep: integer);
361 begin
362 if ABufferStep <> FBufferStep then
363 begin
364 FBufferStep := ABufferStep;
365 NotifyParent;
366 end; // if
367 end;
368
369 procedure TcnsSerie.InitInternalVariables;
370 begin
371 inherited InitInternalVariables;
372 FBufferPtr := nil;
373 FBufferType := btByte;
374 FBufferSamples := 0;
375 FBufferStep := 1;
376 end;
377
378 procedure TcnsSerie.NotifyParent;
379 begin
380 Parent.Redraw([dsSeries]);
381 end;
382
383 function TcnsSerie.GetSampleValue(iSample: integer): double;
384 begin
385 Result := 0;
386 case FBufferType of
387 btShortint: Result := PArrayShortint(FBufferPtr)^[iSample];
388 btByte: Result := PArrayByte(FBufferPtr)^[iSample];
389 btSmallint: Result := PArraySmallint(FBufferPtr)^[iSample];
390 btWord: Result := PArrayWord(FBufferPtr)^[iSample];
391 btLongint: Result := PArrayLongint(FBufferPtr)^[iSample];
392 btLongword: Result := PArrayLongword(FBufferPtr)^[iSample];
393 btSingle: Result := PArraySingle(FBufferPtr)^[iSample];
394 btDouble: Result := PArrayDouble(FBufferPtr)^[iSample];
395 end; // case
396 end;
397
398 procedure TcnsSerie.DrawOn(Canvas: TCanvas; WorkRect: TRect);
399 var
400 ClippingRgn: HRGN;
401 bFirst: boolean;
402 iLoop, iX, iY, iHeight, iSample, iNumberOfSamples, PrevX, PrevY: integer;
403 dValue: double;
404 begin
405 PrevX := -1;
406 PrevY := -1;
407 ClippingRgn := CreateRectRgnIndirect(WorkRect);
408 SelectClipRgn(Canvas.Handle, ClippingRgn);
409 iHeight := WorkRect.Bottom - WorkRect.Top + 1;
410 Canvas.Pen.Color := FColor;
411 Canvas.Pen.Style := psSolid;
412 Canvas.Pen.Width := 1;
413 bFirst := true;
414 with Parent.XAxis do
415 iNumberOfSamples := trunc(Max - Min);
416 for iLoop := 0 to iNumberOfSamples - 1 do
417 begin
418 iX := trunc(Parent.dXRatio * iLoop);
419 iSample := (iLoop + trunc(Parent.XAxis.Min)) * FBufferStep;
420 if (iSample >= 0) and (iSample < FBufferSamples) then
421 begin
422 dValue := GetSampleValue(iSample);
423 iY := iHeight - trunc((dValue - Parent.YAxis.Min) * Parent.dYRatio);
424 if bFirst or (iX <> PrevX) or (iY <> PrevY) then
425 begin
426 if bFirst then
427 Canvas.MoveTo(WorkRect.Left + iX, WorkRect.Top + iY)
428 else
429 Canvas.LineTo(WorkRect.Left + iX, WorkRect.Top + iY);
430 bFirst := false;
431 end; // if
432 PrevX := iX;
433 PrevY := iY;
434 end; // if
435 end; // for
436 SelectClipRgn(Canvas.Handle, 0);
437 DeleteObject(ClippingRgn);
438 end;
439
440 procedure TcnsSerie.GetMinMax(var dMin, dMax: double);
441 var
442 iSample: integer;
443 dSample: double;
444 begin
445 for iSample := 0 to FBufferSamples - 1 do
446 begin
447 dSample := GetSampleValue(iSample);
448 if iSample = 0 then
449 begin
450 dMin := dSample;
451 dMax := dSample;
452 end
453 else
454 begin
455 dMin := Min(dMin, dSample);
456 dMax := Max(dMax, dSample);
457 end; // if/else
458 end; // for
459 end;
460
461 //=============================================================================
462 // TcnsSignalDisplay
463 //=============================================================================
464 const
465 Y_TICK = 4;
466 X_TICK = 4;
467
468 MARKER_X_SIZE = 8;
469 MARKER_Y_SIZE = 8;
470
471 MARKER_COLOR = clWhite;
472 BAND_COLOR = clWhite;
473 MOVE_LINE_COLOR = clWhite;
474
475 constructor TcnsSignalDisplay.Create(AOwner: TComponent);
476 begin
477 inherited Create(AOwner);
478 FXAxis := TcnsAxis.Create(Self);
479 FYAxis := TcnsAxis.Create(Self);
480 Width := DEFAULT_WIDTH;
481 Height := DEFAULT_HEIGHT;
482 LockCount := 0;
483 Series := TObjectList.Create;
484 Series.OwnsObjects := true;
485 MarkerX := -1;
486 MarkerY := -1;
487 MoveX := -1;
488 MoveY := -1;
489 MouseState := gmsNormal;
490 end;
491
492 destructor TcnsSignalDisplay.Destroy;
493 begin
494 FreeAndNil(FXAxis);
495 FreeAndNil(FYAxis);
496 FreeAndNil(Series);
497 inherited Destroy;
498 end;
499
500 procedure TcnsSignalDisplay.CMMouseEnter(var message: TMessage);
501 begin
502 inherited;
503 MouseState := gmsNormal;
504 end;
505
506 procedure TcnsSignalDisplay.CMMouseLeave(var message: TMessage);
507 begin
508 inherited;
509 DrawMarker(-1, -1);
510 end;
511
512 procedure TcnsSignalDisplay.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
513 Y:
514 Integer);
515 var
516 WorldRect: TRect;
517 begin
518 WorldRect.TopLeft := ClientToScreen(DataRect.TopLeft);
519 WorldRect.BottomRight := ClientToScreen(DataRect.BottomRight);
520 if PtInRect(DataRect, Point(X, Y)) then
521 begin
522 if (Button = mbLeft) then
523 begin
524 MouseState := gmsZoom;
525 if ssShift in Shift then
526 ZoomKind := zkYAxis
527 else if ssCtrl in Shift then
528 ZoomKind := zkXAxis
529 else
530 ZoomKind := zkFree;
531 StartX := X;
532 StartY := Y;
533 ClipCursor(@WorldRect);
534 end
535 else if (Button = mbRight) then
536 begin
537 MouseState := gmsMove;
538 StartX := X;
539 StartY := Y;
540 ClipCursor(@WorldRect);
541 end;
542 end; // if
543 inherited;
544 end;
545
546 procedure TcnsSignalDisplay.MouseMove(Shift: TShiftState; X, Y: Integer);
547 begin
548 case MouseState of
549 gmsNormal:
550 if PtInRect(DataRect, Point(X, Y)) then
551 begin
552 Cursor := crNone;
553 DrawMarker(X, Y)
554 end
555 else
556 begin
557 DrawMarker(-1, -1);
558 Cursor := crDefault;
559 end; // if
560 gmsZoom:
561 begin
562 DrawMarker(X, Y);
563 DrawRubberBand(StartX, StartY, X, Y, ZoomKind);
564 end;
565 gmsMove:
566 begin
567 DrawMoveLine(X, Y);
568 DrawMarker(X, Y);
569 end;
570 end; // case
571 inherited;
572 end;
573
574 procedure TcnsSignalDisplay.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:
575 Integer);
576 var
577 dXMin, dXMax, dYMin, dYMax: double;
578 begin
579 DrawMarker(-1, -1);
580 case MouseState of
581 gmsNormal:
582 if Button = mbMiddle then
583 begin
584 CalculateAllRange;
585 end; // if
586 gmsZoom:
587 begin
588 with RubberBandRect.TopLeft do
589 MouseToWorld(X, Y, dXMin, dYMax);
590 with RubberBandRect.BottomRight do
591 MouseToWorld(X, Y, dXMax, dYMin);
592 DrawRubberBand(0, 0, 0, 0, ZoomKind);
593 MouseState := gmsNormal;
594 Lock;
595 if ZoomKind in [zkFree, zkXAxis] then
596 FXAxis.SetRange(dXMin, dXMax);
597 if ZoomKind in [zkFree, zkYAxis] then
598 FYAxis.SetRange(dYMin, dYMax);
599 Unlock;
600 ClipCursor(nil);
601 end;
602 gmsMove:
603 begin
604 Lock;
605 if dXRatio <> 0 then
606 with FXAxis do
607 SetRange(Min - (X - StartX) / dXRatio, Max - (X - StartX) / dXRatio);
608 if dYRatio <> 0 then
609 with FYAxis do
610 SetRange(Min + (Y - StartY) / dYRatio, Max + (Y - StartY) / dYRatio);
611 MouseState := gmsNormal;
612 DrawMoveLine(-1, -1);
613 Unlock;
614 ClipCursor(nil);
615 end;
616 end; // case
617 DrawMarker(X, Y);
618 inherited;
619 end;
620
621 procedure TcnsSignalDisplay.DrawMarker(X, Y: integer);
622 begin
623 Canvas.Pen.Mode := pmXor;
624 Canvas.Pen.Color := MARKER_COLOR;
625 Canvas.Pen.Width := 1;
626 if (MarkerX <> -1) and (MarkerY <> -1) then
627 begin
628 Canvas.MoveTo(MarkerX, MarkerY - MARKER_Y_SIZE);
629 Canvas.LineTo(MarkerX, MarkerY + MARKER_Y_SIZE);
630 Canvas.MoveTo(MarkerX - MARKER_X_SIZE, MarkerY);
631 Canvas.LineTo(MarkerX + MARKER_X_SIZE, MarkerY);
632 MarkerX := -1;
633 MarkerY := -1;
634 end; // if
635 if (X <> -1) and (Y <> -1) then
636 begin
637 MarkerX := X;
638 MarkerY := Y;
639 Canvas.MoveTo(MarkerX, MarkerY - MARKER_Y_SIZE);
640 Canvas.LineTo(MarkerX, MarkerY + MARKER_Y_SIZE);
641 Canvas.MoveTo(MarkerX - MARKER_X_SIZE, MarkerY);
642 Canvas.LineTo(MarkerX + MARKER_X_SIZE, MarkerY);
643 end; // if
644 end;
645
646 procedure TcnsSignalDisplay.DrawRubberBand(StartX, StartY, EndX, EndY: integer;
647 Kind:
648 TcnsSignalDisplayZoomKind);
649 begin
650 Canvas.Pen.Mode := pmXor;
651 Canvas.Pen.Color := BAND_COLOR;
652 Canvas.Pen.Width := 1;
653 Canvas.Pen.Style := psDot;
654 if not IsRectEmpty(RubberBandRect) then
655 with RubberBandRect do
656 Canvas.Polyline([Point(Left, Top), Point(Right, Top), Point(Right, Bottom),
657 Point(Left, Bottom), Point(Left, Top)]);
658 case Kind of
659 zkYAxis:
660 begin
661 StartX := DataRect.Left;
662 EndX := DataRect.Right - 1;
663 end;
664 zkXAxis:
665 begin
666 StartY := DataRect.Top;
667 EndY := DataRect.Bottom - 1;
668 end;
669 end;
670 RubberBandRect.Left := Min(StartX, EndX);
671 RubberBandRect.Top := Min(StartY, EndY);
672 RubberBandRect.Right := Max(StartX, EndX);
673 RubberBandRect.Bottom := Max(StartY, EndY);
674 if not IsRectEmpty(RubberBandRect) then
675 with RubberBandRect do
676 Canvas.Polyline([Point(Left, Top), Point(Right, Top), Point(Right, Bottom),
677 Point(Left, Bottom), Point(Left, Top)]);
678 end;
679
680 procedure TcnsSignalDisplay.DrawMoveLine(X, Y: integer);
681 begin
682 Canvas.Pen.Mode := pmXor;
683 Canvas.Pen.Color := MOVE_LINE_COLOR;
684 Canvas.Pen.Width := 1;
685 Canvas.Pen.Style := psDash;
686 if (MoveX <> -1) and (MoveY <> -1) then
687 begin
688 Canvas.MoveTo(StartX, StartY);
689 Canvas.LineTo(MoveX, MoveY);
690 MoveX := -1;
691 MoveY := -1;
692 end; // if
693 if (X <> -1) and (Y <> -1) then
694 begin
695 Canvas.MoveTo(StartX, StartY);
696 Canvas.LineTo(X, Y);
697 MoveX := X;
698 MoveY := Y;
699 end; // if
700 end;
701
702 procedure TcnsSignalDisplay.CalculateAllRange;
703 var
704 XMin, XMax, YMin, YMax, TmpYMin, TmpYMax: double;
705 iLoop: integer;
706 Serie: TcnsSerie;
707 begin
708 XMax := 0;
709 XMin := 0;
710 for iLoop := 0 to Series.Count - 1 do
711 begin
712 Serie := GetSerie(iLoop);
713 if iLoop = 0 then
714 begin
715 XMax := Serie.BufferSamples;
716 Serie.GetMinMax(YMin, YMax);
717 end
718 else
719 begin
720 XMax := Max(XMax, Serie.BufferSamples);
721 Serie.GetMinMax(TmpYMin, TmpYMax);
722 YMin := Min(YMin, TmpYMin);
723 YMax := Max(YMax, TmpYMax);
724 end; // if/else
725 end;
726 Lock;
727 FXAxis.SetRange(XMin, XMax);
728 FYAxis.SetRange(YMin, YMax);
729 Unlock;
730 end;
731
732 procedure TcnsSignalDisplay.CalculateRects;
733 var
734 iLeft, iTop, iRight, iBottom, iTextWidth, iTextHeight: integer;
735 begin
736 XAxisRect := Rect(0, 0, 0, 0);
737 YAxisRect := Rect(0, 0, 0, 0);
738 iLeft := ClientRect.Left + X_MARGIN;
739 iTop := ClientRect.Top + Y_MARGIN;
740 iRight := ClientRect.Right - X_MARGIN - TICK_MARGIN;
741 iBottom := ClientRect.Bottom - Y_MARGIN - TICK_MARGIN;
742 iTextWidth := Math.Max(Canvas.TextWidth(format('%fW', [FYAxis.Min])),
743 Canvas.TextWidth(format('%fW', [FYAxis.Max])));
744 iTextHeight := BackBuffer.Canvas.TextHeight('0123456789');
745 DataRect := Rect(iLeft, iTop, iRight, iBottom);
746 if FXAxis.Visible then
747 DataRect.Bottom := iBottom - iTextHeight;
748 if FYAxis.Visible then
749 DataRect.Right := iRight - iTextWidth;
750 with DataRect do
751 begin
752 if FXAxis.Visible then
753 XAxisRect := Rect(iLeft, Bottom + 1, Right, iBottom + TICK_MARGIN);
754 if FYAxis.Visible then
755 YAxisRect := Rect(Right + 1, Top, iRight + TICK_MARGIN, Bottom);
756 end; // with
757 dXRatio := 0;
758 dYRatio := 0;
759 with FXAxis do
760 dXRatio := (DataRect.Right - DataRect.Left + 1) / (Max - Min + 1);
761 with FYAxis do
762 dYRatio := (DataRect.Bottom - DataRect.Top + 1) / (Max - Min + 1);
763 end;
764
765 procedure TcnsSignalDisplay.DrawAxises;
766 begin
767 FXAxis.DrawOn(BackBuffer.Canvas, XAxisRect, false);
768 FYAxis.DrawOn(BackBuffer.Canvas, YAxisRect, true);
769 end;
770
771 procedure TcnsSignalDisplay.DrawSeries;
772 var
773 iSerie: integer;
774 Serie: TcnsSerie;
775 begin
776 BackBuffer.Canvas.Brush.Color := FColor;
777 BackBuffer.Canvas.FillRect(DataRect);
778 for iSerie := 0 to Series.Count - 1 do
779 begin
780 Serie := GetSerie(iSerie);
781 with Serie do
782 if Visible and assigned(BufferPtr) then
783 DrawOn(BackBuffer.Canvas, DataRect);
784 end; // for
785 end;
786
787 procedure TcnsSignalDisplay.Paint;
788 begin
789 if not assigned(BackBuffer) then
790 begin
791 BackBuffer := TBitmap.Create;
792 BackBuffer.Width := Width;
793 BackBuffer.Height := Height;
794 BackBuffer.PixelFormat := pf24Bit;
795 DrawState := DrawState + [dsEraseBackground, dsAxises, dsSeries];
796 end; // if
797 if dsEraseBackground in DrawState then
798 begin
799 BackBuffer.Canvas.Brush.Color := FColor;
800 BackBuffer.Canvas.FillRect(ClientRect);
801 end; // if
802 CalculateRects;
803 if dsAxises in DrawState then
804 DrawAxises;
805 if dsSeries in DrawState then
806 DrawSeries;
807 Canvas.Draw(0, 0, BackBuffer);
808 DrawState := [];
809 end;
810
811 procedure TcnsSignalDisplay.Loaded;
812 begin
813 inherited Loaded;
814 FreeAndNil(BackBuffer);
815 Redraw([dsEraseBackground, dsAxises, dsSeries]);
816 end;
817
818 function TcnsSignalDisplay.GetSerie(Index: integer): TcnsSerie;
819 begin
820 Result := nil;
821 if (Index >= 0) and (Index < Series.Count) then
822 Result := TcnsSerie(Series[Index]);
823 end;
824
825 procedure TcnsSignalDisplay.SetColor(AColor: TColor);
826 begin
827 if AColor <> FColor then
828 begin
829 FColor := AColor;
830 Redraw([dsEraseBackground, dsSeries, dsAxises]);
831 end; // if
832 end;
833
834 procedure TcnsSignalDisplay.Lock;
835 begin
836 LockCount := LockCount + 1;
837 end;
838
839 procedure TcnsSignalDisplay.Unlock;
840 begin
841 LockCount := LockCount - 1;
842 Redraw;
843 end;
844
845 procedure TcnsSignalDisplay.SetBounds(ALeft, ATop, AWidth, AHeight: integer);
846 begin
847 inherited SetBounds(ALeft, ATop, AWidth, AHeight);
848 FreeAndNil(BackBuffer);
849 end;
850
851 function TcnsSignalDisplay.AddSerie: TcnsSerie;
852 begin
853 Result := TcnsSerie.Create(Self);
854 Series.Add(Result);
855 end;
856
857 function TcnsSignalDisplay.RemoveSerie(Serie: TcnsSerie): boolean;
858 var
859 iIndex: integer;
860 begin
861 Result := true;
862 iIndex := Series.IndexOf(Serie);
863 if iIndex > -1 then
864 begin
865 Series.Delete(iIndex);
866 Redraw([dsSeries]);
867 end
868 else
869 Result := false;
870 end;
871
872 procedure TcnsSignalDisplay.ClearSeries;
873 begin
874 Series.Clear;
875 end;
876
877 procedure TcnsSignalDisplay.MouseToWorld(Mx, My: integer; var Wx, Wy: double);
878 begin
879 Wx := 0;
880 if dXRatio <> 0 then
881 Wx := FXAxis.FMin + (Mx - DataRect.Left) / dXRatio;
882 Wy := 0;
883 if dYRatio <> 0 then
884 Wy := FYAxis.FMax - (My - DataRect.Top) / dYRatio;
885 end;
886
887 procedure TcnsSignalDisplay.WorldToMouse(Wx, Wy: double; var Mx, My: integer);
888 begin
889 Mx := 0;
890 My := 0;
891 if dXRatio <> 0 then
892 Mx := DataRect.Left + trunc((Wx - FXAxis.FMin) * dXRatio);
893 if dYRatio <> 0 then
894 My := DataRect.Top + trunc((FYAxis.FMax - Wy) * dYRatio);
895 end;
896
897 procedure TcnsSignalDisplay.Redraw(NewDrawState: TcnsSignalDisplayDrawState);
898 begin
899 DrawState := DrawState + NewDrawState;
900 if LockCount = 0 then
901 Repaint;
902 end;
903
904 procedure TcnsSignalDisplay.DrawLine(X1, Y1, X2, Y2: double; Color: TColor);
905 var
906 iX1, iY1, iX2, iY2: integer;
907 begin
908 WorldToMouse(X1, Y1, iX1, iY1);
909 WorldToMouse(X2, Y2, iX2, iY2);
910 Canvas.Pen.Color := Color;
911 Canvas.Pen.Style := psSolid;
912 Canvas.Pen.Mode := pmCopy;
913 Canvas.MoveTo(iX1, iY1);
914 Canvas.LineTo(iX2, iY2);
915 end;
916
917 end.
|
