wepcam goruntusu

[samety81]

sayın arkadaslar ben wepcam goruntusunu delphi ekranına aktarmak istiyorum formlarda arattım ancak oralarda hep bi yerden sonrası için bilgi var ben daha öğrenciyim anlamıyorum orda yazanlardan bu goruntuyu aktarmak için neler yapmam gerekiyorr yardımcı olursanız memnun olurum odev için az zamanım kaldı pls

[vedatkaba]

bu konu daha önce konuşuldu bir kaç kez hatta bir örnek program linki vardı bir soru üzerine verilmiş olan.kolay gelsib

[samety81]

hocam o zaman kusura bakmayın ben aradım form da benım bulduklarım sadece bir yerden sonra yardımcı oluyordu rica etsen o sayfanın linkini verebilirmisinmiz

[vedatkaba]

viewtopic.php?t=10232&highlight=webcam

Buraya bak bakalım

[muratmutlu]

unit Unit1;

interface

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

type
TForm1 = class(TForm)
OpenVideo: TButton;
CloseVideo: TButton;
BMPKaydet: TButton;
AviBaslat: TButton;
AviDurdur: TButton;
GrabDurdur: TButton;
SaveDialog1: TSaveDialog;
Panel1: TPanel;
Timer1: TTimer;
procedure OpenVideoClick(Sender: TObject);
procedure CloseVideoClick(Sender: TObject);
procedure BMPKaydetClick(Sender: TObject);
procedure AviBaslatClick(Sender: TObject);
procedure AviDurdurClick(Sender: TObject);
procedure GrabDurdurClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
hWndC : THandle;
CapturingAVI : bool;

public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

const WM_CAP_START = WM_USER;
const WM_CAP_STOP = WM_CAP_START + 68;
const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
const WM_CAP_SAVEDIB = WM_CAP_START + 25;
const WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
const WM_CAP_SEQUENCE = WM_CAP_START + 62;
const WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;

function capCreateCaptureWindowA(lpszWindowName : PCHAR;
dwStyle : longint;
x : integer;
y : integer;
nWidth : integer;
nHeight : integer;
ParentWin : HWND;
nId : integer): HWND;
STDCALL EXTERNAL 'AVICAP32.DLL';


procedure TForm1.OpenVideoClick(Sender: TObject);
begin
hWndC := capCreateCaptureWindowA('My Own Capture Window',
WS_CHILD or WS_VISIBLE ,
Panel1.Left,
Panel1.Top,
Panel1.Width,
Panel1.Height,
Form1.Handle,
0);
if hWndC <> 0 then
begin
SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
Timer1.Enabled := True;
end;
end;

procedure TForm1.CloseVideoClick(Sender: TObject);
begin
if hWndC <> 0 then begin
SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
hWndC := 0;
Timer1.Enabled := False;
end;
end;

procedure TForm1.BMPKaydetClick(Sender: TObject);
begin
if hWndC <> 0 then begin
SaveDialog1.DefaultExt := 'bmp';
SaveDialog1.Filter := 'Bitmap files (*.bmp)|*.bmp';
if SaveDialog1.Execute then
SendMessage(hWndC,
WM_CAP_SAVEDIB,
0,
longint(pchar(SaveDialog1.FileName)));
end;
end;

procedure TForm1.AviBaslatClick(Sender: TObject);
begin
if hWndC <> 0 then begin
SaveDialog1.DefaultExt := 'avi';
SaveDialog1.Filter := 'AVI files (*.avi)|*.avi';
if SaveDialog1.Execute then begin
CapturingAVI := true;
SendMessage(hWndC,
WM_CAP_FILE_SET_CAPTURE_FILEA,
0,
Longint(pchar(SaveDialog1.FileName)));
SendMessage(hWndC, WM_CAP_SEQUENCE, 0, 0);
end;
end;
end;

procedure TForm1.AviDurdurClick(Sender: TObject);
begin
if hWndC <> 0 then begin
SendMessage(hWndC, WM_CAP_STOP, 0, 0);
CapturingAVI := false;
end;
end;

procedure TForm1.GrabDurdurClick(Sender: TObject);
begin
if hWndC <> 0 then
SendMessage(hWndC, WM_CAP_GRAB_FRAME, 0, 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Timer1.Interval := 1;
CapturingAVI := false;
hWndC := 0;
SaveDialog1.Options :=
[ofHideReadOnly, ofNoChangeDir, ofPathMustExist]
end;

end.

[samety81]

merhabalar ben şu şekilde kısa ve kolay birşekilde yapmayı başardım ancak bazı uyarılar veriyor uyarılarla birlikte kodlarıda yazacagım.

Kod: Tümünü seç

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Grids, Buttons, ComCtrls,
  VideoCap, VideoMci, MMSystem;


type
  TVideo = class(TForm)
    Panel1: TPanel;
    VideoArea: TPanel;
    Image1: TImage;
    BitBtn1: TBitBtn;
    VideoLabel: TLabel;
    procedure BitBtn1Click(Sender: TObject);
    procedure CapStatus(Sender: TObject);
    procedure FormCreate(Sender: TObject);


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

var
  Video: TVideo;

implementation

{$R *.dfm}
procedure TVideo.CAPStatus(Sender: TObject);
begin
	Panel1.Color := clBtnFace;
	Panel1.Refresh;
end;
procedure TVideo.BitBtn1Click(Sender: TObject);
var
  MyCapStatusProc : TCapStatusProc;
begin
 		// Stop MCI - Video
	MciClose;

 		// Start CAP -  Video
	CapSetVideoArea( VideoArea );
  CapSetInfoLabel( VideoLabel );
  MyCapStatusProc := CAPStatus;
	CapSetStatusProcedure( MyCapStatusProc );
	if CapOpenDriver then
  begin
		CapSetCapSec( 15 * 3 );
		CapShow;
    end;
end;
end.

hata ise:
[Error] WARNING. Duplicate resource(s):
[Error] Type 10 (RCDATA), ID TVIDEO:
[Error] File Unit1.dfm resource kept; file c:\documents and settings\sekkil_cocuk\desktop\capmci\WVideo.DFM resource discarded.
burda exe yi oluşturuyor ve exe den program çalışıyor ancak programdan run la çalıştığım zaman bu hata ile karşılaşıyorum
not:yukarıdaki komutları bi tane düzgün bir şekilde çalışan bir program içerisinden alarak yeni bir delphi ekranına attım acaba nerde bir şeyi atadım ya da nerede yanlışlık var
iyi günler

[vkamadan]

Merhaba,
Jedi bileşen setinde görüntü yakalama bileşenleri örnekleri ile mevcut incelemenizi öneririm.

[samety81]

merhaba arkadaşlar vidgrabber bileşeni kullanarak amatörce birşey yapmayı başardım.belki birilerine lazım olur.

Kod: Tümünü seç

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,jpeg,ExtCtrls, VidGrab, StdCtrls, Buttons, ComCtrls, ExtDlgs;

type
  TForm1 = class(TForm)
    VideoGrabber1: TVideoGrabber;
    BitBtn1: TBitBtn;
    TrackBar1: TTrackBar;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Edit1: TEdit;
    Button1: TButton;
    BitBtn2: TBitBtn;
    Button2: TButton;
    Image1: TImage;
    Timer1: TTimer;
    Button3: TButton;
    TrackBar2: TTrackBar;
    TrackBar3: TTrackBar;
    TrackBar4: TTrackBar;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button4: TButton;
    Image2: TImage;
    procedure BitBtn1Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  i:integer=0;
  x,y:integer;
  renk:integer;
implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
VideoGrabber1.StartPreview;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
 VideoGrabber1.VideoProcessing_Brightness :=-TrackBar1.Position;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   VideoGrabber1.StopPreview;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
TrackBar1.Position:=trackbar1.Position+strtoint(Edit1.Text);
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
TrackBar1.Position:=trackbar1.Position-strtoint(Edit1.Text);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
TrackBar1.Position:=-VideoGrabber1.VideoProcessing_Brightness;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
form2.Show;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   i:=i+1;
   VideoGrabber1.CaptureFrameTo (fc_BmpFile,'foto'+inttostr(i));
   Timer1.Enabled:=true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   Image1.Picture.LoadFromFile('foto'+inttostr(i)+'.bmp');
   Timer1.Enabled:=false;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  kir,yes,mav:byte;
  gri:byte;
begin
  For x:=0 to Image1.Width-1 Do
  begin
    For y:=0 to Image1.Height-1 Do
    begin
      renk:=ColorToRGB(Image1.Canvas.Pixels[x,y]);
      kir:=renk div 65536;
      kir:=kir+TrackBar2.Position;
      renk:=renk mod 65536;

      yes:=renk div 256;
      yes:=yes+TrackBar3.Position;
      mav:=renk mod 256;
      mav:=mav+TrackBar4.Position;
      Image1.Canvas.Pixels[x,y]:=RGB(kir,yes,mav);
    end;
  end; 

end;  

procedure TForm1.Button4Click(Sender: TObject);
var
  kir,yes,mav:byte;
  gri:byte;
  renk1:string;
begin
  For x:=0 to Image1.Width-1 Do
  begin
    For y:=0 to Image1.Height-1 Do
    begin
    image2.Height:=image1.Height;
    image2.Width:=image1.Width;
   Image2.Canvas.Pixels[x,y]:=RGB((GetRValue(Image1.Canvas.Pixels[x,y]))+TrackBar2.Position,(GetGValue(Image1.Canvas.Pixels[x,y]))+TrackBar3.Position,
   (GetBValue(Image1.Canvas.Pixels[x,y]))+TrackBar4.Position);
    end;
  end; 

end;  


end.

burda ben yakaladıgım resmi image nesnesine rgb sini değiştirerek atama yöntemiyle bişeyler yaptım.amatörce amabendaha öğrenciyim şimdilik bukadar geldi elimden iki yöntemle yaptım biride bu forumda image nesnesindeki resmi gri tonaçeviriyordu ordan parcacıklaralarak yamayı denedim ancak renk bilgisi yetersizliğinden dolayı onu bitiremedim ancak ikinci yaptıgım uygulamada başardım istediğimi

[samety81]

şey unutmadan ben burda yakaladıgım resmi iamge nesnesine atarken kodu artarda yaparken hata veriyor neden acaba bende arada beklemesiiçin timer nesnesi kullandım.neden boyle bir hata veriyor sistem belirtilen yolu bulamıyor diye bir hata veriyor du .