Varian Workshop

← →
Sergo (2002-04-08 13:11) [0]

Мож кто подскажет, почему в моей проге VrScope1 не строит график?

unit Unit1;

interface

uses
Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls,MMSystem,VrControls, VrBorder,VrScale,VrScope,VrDesign,VrClasses,VrLeds,VrLcd, VrThreads,VrBlotter;

type
TData8 = array [0..127] of byte;
PData8 = ^TData8;
TPointArr = array [0..127] of TPoint;
PPointArr = ^TPointArr;
TForm1 = class(TForm)
Button2: TButton;
Label1: TLabel;
Memo1: TMemo;
Button3: TButton;
VrScale1: TVrScale;
VrBorder1: TVrBorder;
VrScope1: TVrScope;
Label2: TLabel;

procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure VrScope1NeedData(Sender: TObject; Channel: Integer;
var Value: Integer);

private

public
procedure OnWaveIn(var Msg: TMessage); message MM_WIM_DATA;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

var
WaveIn: hWaveIn;
hBuf: THandle;
BufHead: TWaveHdr;
bufsize: integer;
Bits16: integer;
p: PPointArr;
stop: boolean = false;
b: extended;
c: integer;
Value: integer;

procedure TForm1.Button1Click(Sender: TObject);
var
header: TWaveFormatEx;
BufLen: word;
buf: pointer;
begin
VrScope1.Active:=true;
VrScope1.Interval:=10;
VrScope1.Frequency:=50;
BufSize := 50;
Bits16 := 0;
with header do begin
wFormatTag := WAVE_FORMAT_PCM;
nChannels := 1;
nSamplesPerSec := 22025;
wBitsPerSample := integer(Bits16)*8+8;
nBlockAlign := nChannels * (wBitsPerSample div 8);
nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
cbSize := 0;
end;
WaveInOpen(Addr(WaveIn), WAVE_MAPPER, addr(header),
Form1.Handle, 0, CALLBACK_WINDOW);
BufLen := header.nBlockAlign * BufSize;
hBuf := GlobalAlloc(GMEM_MOVEABLE and GMEM_SHARE, BufLen);
Buf := GlobalLock(hBuf);
with BufHead do begin
lpData := Buf;
dwBufferLength := BufLen;
dwFlags := WHDR_BEGINLOOP;
end;
WaveInPrepareHeader(WaveIn, Addr(BufHead), sizeof(BufHead));
WaveInAddBuffer(WaveIn, addr(BufHead), sizeof(BufHead));
GetMem(p, BufSize * sizeof(TPoint));
stop := true;
WaveInStart(WaveIn);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
VrScope1.Active:=false;
VrScope1.Clear;
if stop = false then Exit;
stop := false;
while not stop do Application.ProcessMessages;
stop := false;
WaveInReset(WaveIn);
WaveInUnPrepareHeader(WaveIn, addr(BufHead), sizeof(BufHead));
WaveInClose(WaveIn);
GlobalUnlock(hBuf);
GlobalFree(hBuf);
FreeMem(p, BufSize * sizeof(TPoint));
end;

procedure TForm1.OnWaveIn;
var
i: integer;
data8: PData8;
begin
begin
Data8 := PData8(PWaveHdr(Msg.lParam)^.lpData);
for i := 0 to BufSize - 1 do begin
b:=int(0.775*exp(ln(10)*(0.05*(data8^[i]-128)))*500);
c:=round(b);
label1.caption:=floattostr(c);
memo1.lines.Add(inttostr(data8^[i]-128));
end; end;
if stop
then WaveInAddBuffer(WaveIn, PWaveHdr(Msg.lParam),
SizeOf(TWaveHdr))
else stop := true;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
Button2.Click
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
memo1.clear;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
memo1.clear;
end;

procedure TForm1.VrScope1NeedData(Sender: TObject; Channel: Integer;var Value: Integer);
begin
Value := Random(100) + 1;
label2.Caption:=floattostr(c);
end;

end.

← →
MBo (2002-04-08 13:22) [1]

обрати внимание на свойство channels

← →
Sergo (2002-04-08 13:28) [2]

>MBo ©
Ты подсказал мне пример работы с VrScope и там ничего с channels
не делалось, мож я просто чего то не понимаю?
Будь добр, подскажи, плиз.

← →
MBo (2002-04-08 13:38) [3]

щелкни в Obj Inspector на channels и заведи канал (один или сколько нужно). В OnNeedData номер канала передается.

← →
Sergo (2002-04-08 13:46) [4]

>Mbo
Огромное тебе спасибо! Выручил в очередной раз!

← →
Sergo (2002-04-08 14:05) [5]

>Mbo
А как сделать, чтобы график строился относительно центральной линии?

← →
MBo (2002-04-08 14:14) [6]

;(((
и зачем нам дан object inspector? ;)
minvalue,maxvalue

← →
Sergo (2002-04-08 14:23) [7]

:)) Спасибо! Гоню я уже :))

Varian Workshop Найти похожие ветки