Почти звук

Тема в разделе "Delphi - Multimedia, Графика, Игры", создана пользователем M@T$, 3 янв 2008.

Статус темы:
Закрыта.
  1. M@T$

    M@T$ Гость

    Код (Text):
     
    unit Unit1;

    interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls, ExtCtrls, MMSystem, DirectShow9, ActiveX;

    type
    TForm1 = class(TForm)
    Panel1: TPanel;
    ListBox1: TListBox;
    OpenDialog1: TOpenDialog;
    Timer1: TTimer;
    Label1: TLabel;
    Label2: TLabel;
    Panel2: TPanel;
    Label3: TLabel;
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);

    private
    { Private declarations }
    public
    { Public declarations }
    end;

    var
    Form1: TForm1;
    f: longint;
    n: TStrings;
    implementation

    {$R *.dfm}

    var
    pGraphBuilder: IGraphBuilder;
    pMediaControl: IMediaControl;
    pMediaEvent : IMediaEvent ;





    procedure TForm1.FormCreate(Sender: TObject);
    var
    i: integer;
    cap: TWaveInCaps;
    vol: longint;
    begin
    for i := 0 to waveInGetNumDevs do
    begin
    waveInGetDevCaps(i, Addr(cap), SizeOf(cap));
    ListBox1.Items.Add(cap.szPname )
    end;
    waveOutGetVolume(ListBox1.ItemIndex, @Vol);
    f:=vol shr 16;
    end;

    procedure TForm1.Timer1Timer(Sender: TObject);
    var
    vol, r: longint;
    hr: HRESULT;
    evCode: Integer;

    begin
    waveOutGetVolume( ListBox1.ItemIndex, @Vol);
    Label1.Caption:= Inttostr(vol shr 16);
    r:=vol shr 16;


    //Смысл в том чтобы при изменении уровня звука в большую сторону начиналась воспроизводится
    один из видеоклипов из списка в Memo или LISTBOXa

    if r>f then begin n:=Memo1.Lines;
    begin
    CoInitialize(nil);

    if Assigned(pGraphBuilder) then pGraphBuilder := nil;
    if Assigned(pMediaControl) then pMediaControl := nil;
    if Assigned(pMediaEvent)  then pMediaEvent  := nil;

    hr := CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC, IID_IGraphBuilder, pGraphBuilder);
    if FAILED(hr) then begin
    ShowMessage('Не удаётся создать GraphBuilder');
    exit;
    end;

    hr := pGraphBuilder.QueryInterface(IID_IMediaControl, pMediaControl);
    if FAILED(hr) then begin
    ShowMessage('Не удаётся получить интерфейс MediaControl');
    exit;
    end;

    hr := pGraphBuilder.QueryInterface(IID_IMediaEvent, pMediaEvent);
    if FAILED(hr) then begin
    ShowMessage('Не удаётся получить интерфейс MediaEvent');
    exit;
    end;

    //    Ну жно что бы воспроизводились видеофайлы из списка


    // n предположительно имя файла
    //помогите правильно указать имя файла

    hr := pGraphBuilder.RenderFile(StringToOleStr( n), '');
    if FAILED(hr) then begin
    ShowMessage('Не удаётся прорендерить файл');
    exit;
    end;

    hr := pMediaControl.Run;
    if FAILED(hr) then begin
    ShowMessage('не удаётся воспроизвести файл');
    exit;
    end;

    pMediaEvent.WaitForCompletion(INFINITE, evCode);
    CoUninitialize;
    end;


    end;
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    begin
    If opendialog1.Execute then Memo1.Lines.Add(opendialog1.FileName);
    end;



    end.
     
Загрузка...
Похожие Темы - Почти звук
  1. deeeman
    Ответов:
    4
    Просмотров:
    2.204
  2. gorlanovmax
    Ответов:
    29
    Просмотров:
    16.299
  3. paxac
    Ответов:
    4
    Просмотров:
    67
  4. Devil
    Ответов:
    4
    Просмотров:
    353
  5. diod_
    Ответов:
    8
    Просмотров:
    3.687
Статус темы:
Закрыта.

Поделиться этой страницей