A wave plotter component that is able to draw sin, poly and squared lines, I used this in a osciloscope xD
I didn't liked this code, but the draw part (TWaveShape.paint) is looking cool, I used the same "X" coord to draw the 3 kinds of lines :)
I mean:
loop(x){
case waveType of
wtSin: y := lala;
wtPoly: y := lele;
wtSqr: y := lili;
end;
}
1
2 unit WavePlotter;
3
4 interface
5
6 uses
7 forms, dialogs, SysUtils, Classes, Controls, Graphics;
8
9 const
10 PI2 = PI * 2;
11
12 type
13 TWaveType = ( wtSqr, wtPoly, wtSin );
14
15 TWave = class( TPersistent )
16 public
17 waveType: TWaveType;
18 color: TColor;
19 offset: integer;
20 frequency, amplitude, volts, interval, gain: extended;
21
22 procedure AssignTo(Dest: TPersistent); override;
23 end;
24
25 TWaveShape = class( TGraphicControl )
26 protected
27 fWaves: TList;
28 fBoxSize: integer;
29 fLineColor: TColor;
30
31 function getWave(const index: integer): TWave;
32 procedure setBoxSize(const Value: integer);
33
34 function getBackgroundColor: TColor;
35 procedure setBackgroundColor(const Value: TColor);
36 procedure setLineColor(const Value: TColor);
37
38 public
39 constructor create( AOwner: TComponent ); override;
40 destructor destroy; override;
41
42 procedure clear;
43 procedure delete( const index: integer );
44
45 function add: integer;
46
47 property waves[ const index: integer]: TWave read GetWave;
48
49 published
50 procedure paint; override;
51 property boxSize: integer read fBoxSize write setBoxSize;
52 property backgroundColor: TColor read getBackgroundColor write setBackgroundColor;
53 property lineColor: TColor read fLineColor write setLineColor;
54
55 //inherited
56 //property Canvas;
57 property Align;
58 property Anchors;
59 property Constraints;
60 property DragCursor;
61 property DragKind;
62 property DragMode;
63 property Enabled;
64 //property Font;
65 property ParentColor;
66 //property ParentFont;
67 property ParentShowHint;
68 property PopupMenu;
69 property ShowHint;
70 property Visible;
71 property OnClick;
72 property OnContextPopup;
73 property OnDblClick;
74 property OnDragDrop;
75 property OnDragOver;
76 property OnEndDock;
77 property OnEndDrag;
78 property OnMouseDown;
79 property OnMouseMove;
80 property OnMouseUp;
81 property OnStartDock;
82 property OnStartDrag;
83 end;
84
85 implementation
86
87 function max( const a, b: integer ): integer;
88 begin
89 if a > b then
90 result := a
91 else
92 result := b;
93 end;
94
95 { TWaveShape }
96
97 function TWaveShape.add: integer;
98 begin
99 result := fWaves.add( TWave.Create );
100 end;
101
102 procedure TWaveShape.clear;
103 begin
104 while fWaves.count > 0 do begin
105 TWave( fWaves[0] ).free;
106 fWaves.delete( 0 );
107 end;
108 end;
109
110 constructor TWaveShape.create(AOwner: TComponent);
111 begin
112 inherited;
113 fWaves := TList.create;
114 fLineColor := clGray;
115 color := clBtnFace;
116 fBoxSize := 50;
117 end;
118
119 procedure TWaveShape.delete(const index: integer);
120 begin
121 if ( index > -1 ) and ( index < fWaves.count ) then begin
122 TWave( fWaves[index] ).free;
123 fWaves.delete( index );
124 end;
125 end;
126
127 destructor TWaveShape.destroy;
128 begin
129 fWaves.free;
130 inherited;
131 end;
132
133 function TWaveShape.getBackgroundColor: TColor;
134 begin
135 result := color;
136 end;
137
138 function TWaveShape.getWave(const index: integer): TWave;
139 begin
140 result := nil;
141 if ( index > -1 ) and ( index < fWaves.count ) then
142 result := TWave( fWaves[ index ] );
143 end;
144
145 procedure TWaveShape.paint;
146 var
147 k, x: integer;
148 lastX, lastY: array of integer;
149 y: extended;
150 begin
151 if not enabled then
152 exit;
153 canvas.brush.color := color;
154 canvas.fillRect( clientRect );
155
156 setLength( lastY, fWaves.count );
157 setLength( lastX, fWaves.count );
158 for k := 0 to high( lastY ) do begin
159 lastY[k] := clientHeight div 2 + waves[k].offset;
160 lastX[k] := 0;
161 end;
162
163 for x := 0 to max( clientWidth, clientHeight ) do begin
164 with canvas do begin
165 pen.color := fLineColor;
166 pen.width := 1;
167 pen.style := psDot;
168
169 if x mod fBoxSize = 0 then begin
170 moveTo( 0, x + trunc( frac( clientHeight / 2 / fBoxSize ) * fBoxSize ) );
171 lineTo( clientWidth, x + trunc( frac( clientHeight / 2 / fBoxSize ) * fBoxSize ) );
172
173 moveTo( x, 0 );
174 lineTo( x, clientHeight );
175 end;
176
177 for k := 0 to fWaves.count - 1 do begin
178 with waves[k] do begin
179 pen.color := color;
180 pen.width := 1;
181 pen.style := psSolid;
182
183 y := pi*k + PI2 * x * interval / fBoxSize * frequency;
184
185 case waveType of
186 wtSin:
187 y := sin( y );
188 wtPoly: begin
189 y := frac( y / PI2 );
190 if y <= 0.25 then
191 y := y / 0.25
192 else if y <= 0.75 then
193 y := ( -y + 0.5 ) / 0.25
194 else
195 y := ( y - 1 ) / 0.25;
196 end;
197 wtSqr: begin
198 if frac( y / PI2 ) <= 0.5 then
199 y := 1
200 else
201 y := -1;
202 end;
203 end;
204 y := ( y * ( fBoxSize / volts ) * amplitude * gain ) + clientHeight / 2 + offset;
205 moveTo( lastX[k], lastY[k] );
206 lastX[k] := x;
207 lastY[k] := trunc( y );
208 lineTo( x, lastY[k] );
209 end;
210 end;
211 end;
212 end;
213 end;
214
215 procedure TWaveShape.setBackgroundColor(const Value: TColor);
216 begin
217 color := Value;
218 Invalidate;
219 end;
220
221 procedure TWaveShape.setBoxSize(const Value: integer);
222 begin
223 fBoxSize := Value;
224 invalidate;
225 end;
226
227
228 procedure TWaveShape.setLineColor(const Value: TColor);
229 begin
230 fLineColor := Value;
231 Invalidate;
232 end;
233
234 { TWave }
235
236 procedure TWave.AssignTo(Dest: TPersistent);
237 begin
238 if Dest.ClassType <> TWave then
239 inherited;
240 with TWave( Dest ) do begin
241 waveType := self.waveType;
242 color := self.color;
243 offset := self.offset;
244 frequency := self.frequency;
245 amplitude := self.amplitude;
246 volts := self.volts;
247 interval := self.interval;
248 gain := self.gain;
249 end;
250 end;
251
252 end.
