Delphi 2009 VfW/VideoCap Webcam nicht möglicht?!

[ma_sch]

Hey Leute,

ich möchte in mein Projekt ein Webcam-Interface einbauen.

Hab mich schon über die verschiedenen Methoden (VfW,DirectShow,VideoCap,JediVCl,DSPack usw) informiert und verfügbare Demos ausprobiert.

Solange ich diese mit Delphi 2006 abwärts erstellten Programme mit dem alten Design, auf der alten Form usw. in Delphi 2009 einfach nur öffne, kompilieren und laufen lasse, funktioniert die Mehrheit auch noch soweit ganz gut..

Sobald ich aber beginne, eigene Programme nach dem Vorbild der Demos mit 100%ig identischen Grundlagen in Delphi 2009 (neues Design,neue Form&Buttons usw..) zu erstellen, laufen die Programme nach wie vor, sie lassen sich ohne Fehler kompilieren, jedoch in keinem Fall ist das Bild der Webcam auf der Form zu sehen! Woran kann das liegen?!

Ich habe es sowohl mit der VideoCap/AviCap-Methode als auch mit der "Video for Windows" versucht, kein Erfolg. Die VideoCap/AviCap../VfW-Units waren in jedem Fall die originale aus den Sourcen der Demo-Proggis. Die externen Packs und Libraries habe ich mal noch außen vor gehalten, da diese denke ich mal eine aufwendigere Einarbeitung erfordern.

Bei den Testläufen ist mir aufgefallen, das in den Testläufen jeweils unterschiedliche Module unten in der "compiler-log-Anzeige" aktiv waren. Läuft das Programm im alten Stil und man startet das Video-Fenster,erscheint das Videobild der Webcam und im Logger unten steht: "Thread-Start: Thread-ID: 3776. Prozess VideoCapture.exe (5976)". Läuft das in Delphi 2009 erstellte Programm, heißt es dort: Modul laden: xvidcore.dll. Ohne Debug-Infos. Basisadresse: $04700000. Prozess SkinnerBox1p.exe (3824).
Hängt das Problem vllt mit den Xvid-/Video-Codecs allgemein zutun?
Oder liegt es doch an der Firewall?!

Ich poste mal noch meinen Code zum drüberschauen:

Delphi-Quellcode:

unit SkinnerBox1u;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Menus, VfW, ExtCtrls;

type
  TForm1 = class(TForm)
    VideoPanel1: TPanel;
    Image1: TImage;
    MainMenu1: TMainMenu;
    Datei1: TMenuItem;
    Optionen1: TMenuItem;
    Info1: TMenuItem;
    KameraTreiber1: TMenuItem;
    N1: TMenuItem;
    KameraBilder1: TMenuItem;
    StatusBar1: TStatusBar;
    KameraBedienung: TPanel;
    KameraStart: TButton;
    KameraStop: TButton;
    Foto: TButton;
    procedure FormCreate(Sender: TObject);
    procedure KameraStartClick(Sender: TObject);
    procedure KameraStopClick(Sender: TObject);
    procedure VideoPanel1Resize(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure ChangeDriver(Sender: tObject);
  public
    { Public-Deklarationen }
    capHandle: THandle;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  FileCounter : Word = 0;
  Path : String = '';
  capDriverNum: Integer;

procedure TForm1.FormCreate(Sender: TObject);
var
  szDeviceName: array [0..80] of AnsiChar;
  szDeviceVersion: array [0..80] of AnsiChar;
  wIndex: Integer;
  m: tMenuItem;
begin
  capDriverNum:= -1;
  for wIndex := 0 to 9 do
  begin
    if (capGetDriverDescription (wIndex, szDeviceName,
        sizeof (szDeviceName), szDeviceVersion,
        sizeof (szDeviceVersion))) then
    begin
      inc(capDriverNum);
      m := tMenuItem.Create(Form1.KameraTreiber1);
      m.Caption := szDeviceName+' - ('+szDeviceVersion+')';
      m.Tag := wIndex;
      m.OnClick := Form1.ChangeDriver;
      if capDriverNum = 0 then m.Checked := True;  // Check first Item
      m.RadioItem := True;
      Form1.KameraTreiber1.Add(m);
    end;
  end;

  if capDriverNum <= -1 then
  begin
    m := tMenuItem.Create(Form1.KameraTreiber1);
    m.Caption := 'Kein Treiber gefunden';
    // m.OnClick := Call Messagebox...
    m.RadioItem := True;
    m.Checked := True;
    Form1.KameraTreiber1.Add(m);
  end else
    capDriverNum := 0;  // Select first Driver

  Form1.DoubleBuffered := True;
end;

procedure TForm1.ChangeDriver(Sender: TObject);
var
  DriverName: String;
  Idx: Integer;
begin
  if Sender is TMenuItem then
  begin
    DriverName := (Sender as TMenuItem).Caption;
    idx := (Sender as TMenuItem).Tag;
    (Sender as TMenuItem).Checked := True;
    // messagebox(handle,PAnsiChar(DriverName +#9+IntToStr(idx)),'#',0);
    if idx <> capDriverNum then
    begin
      KameraStop.Click;  // Close old
    end;
  end;
end;

procedure TForm1.KameraStartClick(Sender: TObject);
begin
  if capDriverNum <= -1 then
  begin
    Application.MessageBox('Kein Capture-Treiber gefunden',
      'Sorry', MB_ICONSTOP + MB_OK);
    Exit;
  end;

  // Init & Open Video Device
  StatusBar1.SimpleText := 'Open Video Device... (' +
    Format('%d x %d', [VideoPanel1.Width, VideoPanel1.Height]) + ')';

  capHandle := capCreateCaptureWindow(PAnsiChar('CapVideo'), WS_CHILD or WS_VISIBLE,
    Form1.VideoPanel1.Left, Form1.VideoPanel1.Top, Form1.VideoPanel1.Width,
    Form1.VideoPanel1.Height, Form1.VideoPanel1.Handle, 0);


  // If capHandle = nil then ... Fehler beim Init?

  // Init the first Capture Driver 0
  capDriverConnect(capHandle, capDriverNum); // SendMessage(capHandle, WM_CAP_DRIVER_CONNECT, 0,
  // Set Preview Rate 50 msec.
  capPreviewRate(capHandle,50);  // SendMessage(capHandle, WM_CAP_SET_PREVIEWRATE, 20, 0);
  capOverlay(capHandle, True);  // SendMessage(capHandle, WM_CAP_SET_OVERLAY, 1, 0);
  capPreview(capHandle, True);  // SendMessage(capHandle, WM_CAP_SET_PREVIEW, 1, 0);
end;

procedure TForm1.KameraStopClick(Sender: TObject);
begin
  if capDriverNum <= -1 then Exit;

  // Close Video Device
  StatusBar1.SimpleText := 'Close Video Device...';

  capCaptureStop(capHandle);
  capDriverDisconnect(CapHandle);
end;

procedure TForm1.VideoPanel1Resize(Sender: TObject);
begin
  VideoPanel1.Caption := Format('Video Capture Panel ( %d x %d )',
    [VideoPanel1.Width, VideoPanel1.Height]);
end;

end.

Wäre super nett wenn Ihr mir bei meinem Problem helfen könntet! Ich hock hier seit drei Tagen vor dem Proggi und komme nicht weiter. :(

Grüße

Marco

[ma_sch]

Hallo nochmal,

ich habe herausgefunden dass das Problem auftritt, sobald ich die TXPManifest au die Form ziehe.

Bewirkt diese Unit im Hintergrund vielleicht noch andere Dinge als die Oberfläche in den XP-Stil zu verwandeln?

[ma_sch]

Mit DSPack funktioniert es.

Thread kann geschlossen werden.