Kod: Tümünü seç
if wecam=true then
caption:='webcam var' else
caption:='webcam yok';
Kod: Tümünü seç
// Component to detect when usb devices are connected or disconnected
// using RegisterDeviceNotification
unit U_Usb;
interface
uses
Windows, Messages, SysUtils, Classes, Forms;
type
PDevBroadcastHdr = ^DEV_BROADCAST_HDR;
DEV_BROADCAST_HDR = packed record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
end;
PDevBroadcastDeviceInterface = ^DEV_BROADCAST_DEVICEINTERFACE;
DEV_BROADCAST_DEVICEINTERFACE = record
dbcc_size: DWORD;
dbcc_devicetype: DWORD;
dbcc_reserved: DWORD;
dbcc_classguid: TGUID;
dbcc_name: short;
end;
const
GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
DBT_DEVICEARRIVAL = $8000; // system detected a new device
DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone
DBT_DEVTYP_DEVICEINTERFACE = $00000005; // device interface class
type
TComponentUSB = class(TComponent)
private
FWindowHandle: HWND;
FOnUSBArrival: TNotifyEvent;
FOnUSBRemove: TNotifyEvent;
procedure WndProc(var Msg: TMessage);
function USBRegister: Boolean;
protected
procedure WMDeviceChange(var Msg: TMessage); dynamic;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property OnUSBArrival: TNotifyEvent read FOnUSBArrival write FOnUSBArrival;
property OnUSBRemove: TNotifyEvent read FOnUSBRemove write FOnUSBRemove;
end;
implementation
constructor TComponentUSB.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FWindowHandle := AllocateHWnd(WndProc);
USBRegister;
end;
destructor TComponentUSB.Destroy;
begin
DeallocateHWnd(FWindowHandle);
inherited Destroy;
end;
procedure TComponentUSB.WndProc(var Msg: TMessage);
begin
if (Msg.Msg = WM_DEVICECHANGE) then
begin
try
WMDeviceChange(Msg);
except
Application.HandleException(Self);
end;
end
else
Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;
procedure TComponentUSB.WMDeviceChange(var Msg: TMessage);
var
devType: Integer;
Datos: PDevBroadcastHdr;
begin
if (Msg.wParam = DBT_DEVICEARRIVAL) or (Msg.wParam = DBT_DEVICEREMOVECOMPLETE) then
begin
Datos := PDevBroadcastHdr(Msg.lParam);
devType := Datos^.dbch_devicetype;
if devType = DBT_DEVTYP_DEVICEINTERFACE then
begin // USB Device
if Msg.wParam = DBT_DEVICEARRIVAL then
begin
if Assigned(FOnUSBArrival) then
FOnUSBArrival(Self);
end
else
begin
if Assigned(FOnUSBRemove) then
FOnUSBRemove(Self);
end;
end;
end;
end;
function TComponentUSB.USBRegister: Boolean;
var
dbi: DEV_BROADCAST_DEVICEINTERFACE;
Size: Integer;
r: Pointer;
begin
Result := False;
Size := SizeOf(DEV_BROADCAST_DEVICEINTERFACE);
ZeroMemory(@dbi, Size);
dbi.dbcc_size := Size;
dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;
dbi.dbcc_reserved := 0;
dbi.dbcc_classguid := GUID_DEVINTERFACE_USB_DEVICE;
dbi.dbcc_name := 0;
r := RegisterDeviceNotification(FWindowHandle, @dbi,
DEVICE_NOTIFY_WINDOW_HANDLE
);
if Assigned(r) then Result := True;
end;
end.
Kod: Tümünü seç
var
webcam:string;
procedure tform1.webcamdetect;
var Idx : integer;
szName,
szVersion: array[0..MAX_PATH] of char;
begin
webcam:='';
for Idx:= 0 to 9 do begin
if capGetDriverDescription(Idx,
@szName,
sizeof(szName),
@szVersion,
sizeof(szVersion)) then begin
webcam:=(szName+' ('+szVersion+')'); end; end;
if webcam='' then begin
Caption:='Webcam Mevcut değil'; end else begin
Caption :='Webcam Mevcut';
end;
end;kodu eklediğin yerin form tanımlarında webcam detect rutininide formun procudure ve function kısmına eklemelisin. ayrıca formun neresinde bu kodu kullanacaksan üstünde bir yede bu kod yer almalı. yada forward diye kodun sonra yer alacağını belirlemelemelisin..c_kral yazdı:Üstatlar bu kodda hata verio "capGetDriverDescription" uses satırına filan bişey eklemek gerekiyormu.
Kod: Tümünü seç
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
CaptureWindow: HWND;
function capCreateCaptureWindowA(lpszWindowName: pchar; dwStyle: dword; x, y, nWidth, nHeight: word; ParentWin: dword; nId: word): dword; stdcall external 'avicap32.dll';
const
WM_CAP_START = $400;
WM_CAP_DRIVER_CONNECT = WM_CAP_START + $a;
WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + $b;
WM_CAP_EDIT_COPY = WM_CAP_START + $1e;
WM_CAP_GRAB_FRAME = WM_CAP_START + $3c;
WM_CAP_STOP = WM_CAP_START + $44;
implementation
{$R *.dfm}
function WebcamExists:boolean;
begin;
Result:=true;
if CaptureWindow = 0 then
begin
CaptureWindow := capCreateCaptureWindowA('CaptureWindow', WS_CHILD and WS_VISIBLE, 0, 0, 0, 0, GetDesktopWindow, 0);
if SendMessage(CaptureWindow, WM_CAP_DRIVER_CONNECT, 0, 0) <> 1 then
begin
Result:=false;
end;
SendMessage(CaptureWindow, WM_CAP_DRIVER_DISCONNECT, 0, 0);
SendMessage(CaptureWindow, WM_CLOSE, 0, 0);
CaptureWindow :=0;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if WebcamExists=False Then
Showmessage('Webcam Bulunamadı..')
else
Showmessage('Webcam var..');
end;
end.