procedure
TForm1
.
pbDrawWavPaint(Sender: TObject);
var
KX, KY:
Extended
;
i, X, Y, DY, X1, X2, NX, MinNX, Chanel, aWidth, aHeight:
Integer
;
Can: TCanvas;
DrawWaveForm:
Boolean
;
begin
if
WavInfo
.
NumSamples >=
5000
then
tbTime
.
Max:=
300
else
if
WavInfo
.
NumSamples >=
10000
then
tbTime
.
Max:=
500
else
if
WavInfo
.
NumSamples >=
100000
then
tbTime
.
Max:=
10000
;
Can := pbDrawWav
.
Canvas;
aWidth := pbDrawWav
.
Width;
aHeight := pbDrawWav
.
Height;
Can
.
Brush
.
Color := pnBackground
.
Color;
Can
.
FillRect(pbDrawWav
.
ClientRect);
Chanel := tcDrawWav
.
TabIndex;
if
(Chanel >=
0
)
and
(WavInfo
.
NumSamples >
1
)
and
(WavInfo
.
MaxAmplitude >
0
)
then
begin
DrawWaveForm := rgPaintType
.
ItemIndex =
0
;
if
DrawWaveForm
then
MinNX :=
2
else
MinNX :=
1
;
X1 := sbTimePos
.
Position - sbTimePos
.
Min;
NX := Max(sbTimePos
.
PageSize, MinNX);
X2 := Min(X1 + NX -
1
, WavInfo
.
NumSamples -
1
);
KX := aWidth / (NX - MinNX +
1
);
KY := aHeight * tbAmplitude
.
Position / (WavInfo
.
MaxAmplitude *
2
);
DY := aHeight
div
2
;
Can
.
Pen
.
Color := clLime;
Can
.
Brush
.
Color := clGreen;
for
i := X1
to
X2
do
begin
X := Trunc(KX * (i - X1));
Y := aHeight - Trunc(KY * WavInfo
.
Samples[Chanel, i] + DY);
if
DrawWaveForm
then
begin
if
i = X1
then
Can
.
MoveTo(X, Y)
else
Can
.
LineTo(X, Y);
end
else
begin
Can
.
Rectangle(X, DY, Trunc(KX * (i - X1 +
1
)), Y);
end
;
end
;
if
cbDrawOX
.
Checked
then
begin
Can
.
Pen
.
Color := clWhite;
Can
.
MoveTo(
0
, DY);
Can
.
LineTo(aWidth, DY);
end
;
end
;
end
;
procedure
TForm1
.
tcDrawWavChange(Sender: TObject);
begin
pbDrawWav
.
Invalidate;
end
;
procedure
TForm1
.
UpdateScrollBar;
var
MaxPos:
Integer
;
begin
sbTimePos
.
PageSize := (sbTimePos
.
Max - sbTimePos
.
Min +
1
)
div
tbTime
.
Position;
MaxPos := sbTimePos
.
Max - sbTimePos
.
PageSize +
1
;
if
sbTimePos
.
Position > MaxPos
then
sbTimePos
.
Position := MaxPos;
pbDrawWav
.
Invalidate;
end
;
procedure
TForm1
.
tbTimeChange(Sender: TObject);
begin
UpdateScrollBar;
end
;
procedure
TForm1
.
tbAmplitudeChange(Sender: TObject);
begin
UpdateScrollBar;
end
;
procedure
TForm1
.
sbTimePosChange(Sender: TObject);
begin
pbDrawWav
.
Invalidate;
end
;
procedure
TForm1
.
cbDrawOXClick(Sender: TObject);
begin
pbDrawWav
.
Invalidate;
end
;
procedure
TForm1
.
rgPaintTypeClick(Sender: TObject);
begin
pbDrawWav
.
Invalidate;
end
;