Вот пример. На форме две кнопки (Open, Exit).
PaintBox и ScrollBar
| Код |
unit Waveshow;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
ScrollBar1: TScrollBar;
OpenDialog1: TOpenDialog;
cmdOpen: TButton;
cmdExit: TButton;
Panel1: TPanel;
PaintBox1: TPaintBox;
procedure cmdOpenClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure cmdExitClick(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure ScrollBar1Change(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FileIsOpen : Boolean;
TheFileName : String[79];
WaveFile : File;
WaveBytes : LongInt;
BytesPerSBPosition : Integer;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{ We're spoofing here. The header is *usually* 44 bytes long. It }
{ would be better to just read the doggone thing and make sure. }
const
WaveHdrSize = 44;
{ if you make the PaintBox wider than 1024, you will really need to }
{ make this larger! It will be GPF city if you don't. }
var
ReadBuffer : Array[0..1023] of Byte;
procedure TForm1.FormCreate(Sender: TObject);
begin
FileIsOpen := False;
OpenDialog1.DefaultExt := 'wav';
OpenDialog1.FileName := '*.wav';
OpenDialog1.Filter := 'Wave files (*.wav)|*.wav';
Form1.Caption := 'Pete C.''s Wave Displayer';
end;
procedure TForm1.cmdOpenClick(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
if FileIsOpen then CloseFile (WaveFile);
try
TheFileName := OpenDialog1.Filename;
AssignFile (WaveFile, TheFileName);
Reset (WaveFile, 1);
FileIsOpen := True;
Form1.Caption := TheFileName;
WaveBytes := FileSize (WaveFile) - WaveHdrSize;
BytesPerSBPosition := 1;
while (WaveBytes div BytesPerSBPosition) > 32767 do
inc(BytesPerSBPosition);
if WaveBytes div BytesPerSBPosition > PaintBox1.Width then
begin
ScrollBar1.Visible := True;
ScrollBar1.Max := WaveBytes div BytesPerSBPosition
- PaintBox1.Width;
end
else
ScrollBar1.Visible := False;
if ScrollBar1.Position <> 0 then
ScrollBar1.Position := 0
else
PaintBox1.Refresh;
except
on E: EInOutError do
MessageDlg ('Unable to open ' + TheFileName + #10 + #13
+ 'Error was ' + E.Message, mtError, [mbOK], 0);
end;
end;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
X, NumRead : Integer;
CurrPos : LongInt;
begin
if FileIsOpen then
begin
CurrPos := (ScrollBar1.Position * BytesPerSBPosition) + WaveHdrSize;
Seek (WaveFile, CurrPos);
with PaintBox1.Canvas do
begin
FillChar (ReadBuffer, SizeOf(ReadBuffer), $80);
BlockRead (WaveFile, ReadBuffer, ClipRect.Right, NumRead);
Pen.Color := clLime;
MoveTo (0, ReadBuffer[0] shr 1); { 128 bit high picture }
for X := 1 to NumRead - 1 do
LineTo (X, ReadBuffer[X] shr 1);
end;
end;
end;
procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
PaintBox1.Refresh;
end;
procedure TForm1.cmdExitClick(Sender: TObject);
begin
Application.Terminate;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if FileIsOpen then CloseFile (WaveFile);
end;
end.
|
|
