Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Потрепаться";
Текущий архив: 2002.05.16;
Скачать: [xml.tar.bz2];

Вниз

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]

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



Страницы: 1 вся ветка

Форум: "Потрепаться";
Текущий архив: 2002.05.16;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.47 MB
Время: 0.005 c
1-50036
Batiskaf
2002-04-29 12:38
2002.05.16
Hash table in Delphi5?


6-50079
sgs
2002-03-01 13:54
2002.05.16
Netscape (iPlanet) Enterprise web server


4-50176
SPeter
2002-03-15 22:29
2002.05.16
Обработка сообщений.


3-49818
Саша
2002-04-18 12:40
2002.05.16
установка bde


3-49819
ao1973
2002-04-18 11:44
2002.05.16
КАК програмно СОЗДАТЬ файл БД ACESS-a ?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский