Web Cam den BMP elde etme

[z]

Delphide öyle bir fonksiyon yazacağım ki, Fonksiyonu çağırdığımda, Web-Camin o anda gördüğü nesne BMP olarak RAMa aktarılacak.

Bunun için PC ye hangi marka Web-Cam bağlanmış önemli olmamalı.

Örnek bir program arıyorum.

[ise]

tvideo edit denilen bir component vardı onla bütün formatlarda kayit imkanı ve resim imkanıda vardı  tüm video ve audio codecleride destekliyordu.

[kavbar]

bulent 's screen recorder var baya etkin bir program resim video kaydı için.belirli bir alanı secip kayıt yapabiliyorsun delphie le alakalımıdır bilmiyorum ama ben en etkin bunu bulmusutm kolay anlasılır cam markası onemsemeyen ve kucuk bir programdı.

[z]

Yok yok oyle harici bir sey olmaz, kendi programimin bir parcasi olmali, cok kisa surede veri transferini bitirip TBitmap degiskenimde o anki goruntu olusmali. Vakit kaybina neden olacak bir sey isimi gormez. Cunku gercek zamanda uygulama yapacagim.

[fsan]

merhaba ustat,
bu konu benimde ilgimi cekti,  delphi pek anlamadigim icin tam bilmiyorum ama belki isine yarar.  

Uploader: Murat AKA
Company:  Reference: N/A
Component Download: http://www34.websamba.com/dersbilisim/kamera.zip
 
Question/Problem/Abstract:

Here is a way to connect to the webcam and share the movie .
The capture is firstly saved as a bitmap,then converted to jpeg and last sended to the client.

unit Unit1; 

interface 

uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, IdBaseComponent, IdComponent, IdTCPServer, IdTCPConnection, 
  IdTCPClient, IdMappedPortTCP, IdUDPBase,jpeg, IdUDPServer, IdUDPClient,IdSocketHandle, 
  IdAntiFreezeBase, IdAntiFreeze,vfw, ExtCtrls, Buttons; 

type 
  TForm1 = class(TForm) 
    srv: TIdTCPServer; 
    IdAntiFreeze1: TIdAntiFreeze; 
    Timer1: TTimer; 
    SpeedButton1: TSpeedButton; 
    SpeedButton2: TSpeedButton; 

    procedure FormShow(Sender: TObject); 
    procedure FormClose(Sender: TObject; var Action: TCloseAction); 
    procedure srvExecute(AThread: TIdPeerThread); 
    procedure Timer1Timer(Sender: TObject); 
    procedure SpeedButton1Click(Sender: TObject); 
    procedure SpeedButton2Click(Sender: TObject); 

  private 
    { Private declarations } 
  public 
  h:hwnd; 
  resim_verisi:array[0..50000] of char; 
  dosya:file of char; 
  boyut:longint; 
  kamera_kapat:boolean; 
  kamera_kapali:boolean; 
  kapat:boolean; 
  bilgi:BITMAPINFO; 
  procedure boskalinca(Sender: TObject; var Done: Boolean); 
    { Public declarations } 
  end; 

var 
  Form1: TForm1; 

implementation 


{$R *.dfm} 

procedure TForm1.FormShow(Sender: TObject); 
begin 
kapat:=false; 
kamera_kapat:=falsE; 
if (FileExists('temp.avi'))   then 
DeleteFile('temp.avi'); 

{Görüntü yakalma penceresini oluştur} 
h := capCreateCaptureWindow ('Kamera Önizleme', WS_CHILD or WS_VISIBLE or WS_THICKFRAME , 
100,100, 
   160, 120, 
   Handle, 11011); 
{h penceresini (oluşturduğumuz pencere) kameraya bağlayan fonksiyon} 
     capDriverConnect (h, 0); // 0 ->means default driver. 
     {görüntünün tutulacağı yakalama animasyonu} 
        capFileSetCaptureFile(h, 'temp.avi')  ; 
{görüntünün ayarlarını öğrenen fonksiyon . Bit işlem resmi formatında } 
capGetVideoFormat(h, @bilgi,sizeof(bilgi)); 
{bilgi ye göre h penceresinin konumunu ve boyutunu ayarlayan fonksiyon} 
SetWindowPos(h,HWND_TOP,0,0,bilgi.bmiHeader.biWidth,bilgi.bmiHeader.biHeight, SWP_SHOWWINDOW ); 
    //capSetCallbackOnFrame(h,resimgonder); 

    {Tekli görüntü yakalamayı başlatan fonksiyon} 
       capCaptureSingleFrameOpen(h); 
      // capSetCallbackOnYield(h,hazir); 
assignfile(dosya,'temp.jpg'); 

{uygulamanın boşta kalınca çalıştıracağı fonksiyon} 
Application.OnIdle:=boskalinca; 


end; 
procedure TForm1.boskalinca(Sender: TObject; var Done: Boolean); 


begin 
end; 


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); 
begin 
if(not kamera_kapat)  then 
capdriverdisconnect(h); 

end; 

procedure TForm1.srvExecute(AThread: TIdPeerThread); 
var i:integer; 



begin 

i:=(AThread.Connection.ReadInteger(false)); 

///////////////////// 
if i=0 then 

begin 


AThread.Connection.WriteBuffer(boyut,sizeof(longint),false); 
AThread.Connection.WriteBuffer(resim_verisi,boyut,false); 






end; 
/////////////////// 

///////////////////// 
if i=1 then 
begin 

kapat:=true; 

end; 
/////////////////// 





///////////////////// 
if i=2 then 
begin 
kamera_kapali:=true; 
capdriverdisconnect(h); 
caption:='Kamera kapalı'; 
end; 
/////////////////// 

///////////////////// 
if i=3 then 
begin 
capdriverconnect(h,0); 
kamera_kapali:=false; 

caption:='Kamera açık'; 

end; 
/////////////////// 



end; 

procedure TForm1.Timer1Timer(Sender: TObject); 
var dib:tpicture; 
jpg:tjpegimage; 
begin 


if not kamera_kapali then 
begin 
capcapturesingleframe(h); 
capcapturesingleframeclose(h); 



capfilesavedib(h,'temp.bmp'); 




capcapturesingleframeopen(h); 
dib:=tpicture.Create; 
jpg:=tjpegimage.Create; 

dib.LoadFromFile('temp.bmp'); 
jpg.Assign(dib.Bitmap); 
jpg.SaveToFile('temp.jpg'); 


reset(dosya); 

Boyut:=FileSize(Dosya); 

blockread(dosya,resim_verisi,sizeof(resim_verisi),boyut); 
closefile(dosya); 

jpg.Free; 
dib.Free; 

end; 
if kapat then close; 

end; 

procedure TForm1.SpeedButton1Click(Sender: TObject); 
begin 
   capcapturesingleframeclose(h); 
capdlgvideoformat(h); 


capGetVideoFormat(h, @bilgi,sizeof(bilgi)); 
{bilgi ye göre h penceresinin konumunu ve boyutunu ayarlayan fonksiyon} 
SetWindowPos(h,HWND_TOP,0,0,bilgi.bmiHeader.biWidth,bilgi.bmiHeader.biHeight, SWP_SHOWWINDOW ); 
  capcapturesingleframeopen(h); 
end; 

procedure TForm1.SpeedButton2Click(Sender: TObject); 
begin 
   capcapturesingleframeclose(h); 
capdlgvideosource(h); 
capcapturesingleframeopen(h); 
end; 

end.

http://www.delphi3000.com/articles/article_4477.asp?SK=

saygilar..

[z]

Ben bu ornegi calistiramadim. Damardan en temel api turunde cok  program parcacigi bulamazmiyiz?

Bu program veri transferinde disk uzerinden veri aktariyor gibi geldi. Dogrudan Rama transfer olamaz mi?

[Salih UĞUR]

Merhaba, aşağıdaki adreste bu konuda yazılmış türkçe mükemmel bir tez var.

Endüstriyel Ürünlerde Bilg. Dest. Kalite Kont. ve Hata Tespiti
http://www.teknohaber.net/makale.php?id=50801

Kolay gelsin.