Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
SignalDisplay component Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
02-Sep-03
Category
VCL-General
Language
Delphi 3.x
Views
123
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
DSP, Administrator
Reference URL:
DKB
			 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.


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC