wepcam goruntusu
Forum kuralları
Forum kurallarını okuyup, uyunuz!
Forum kurallarını okuyup, uyunuz!
wepcam goruntusu
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
- muratmutlu
- Üye
- Mesajlar: 57
- Kayıt: 02 Tem 2005 02:44
- Konum: Antalya
Birde bunu dene istersen, bende olmuştu
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.
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.
hatalar
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.
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
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.
[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
Merhaba,
Jedi bileşen setinde görüntü yakalama bileşenleri örnekleri ile mevcut incelemenizi öneririm.
Jedi bileşen setinde görüntü yakalama bileşenleri örnekleri ile mevcut incelemenizi öneririm.
Volkan KAMADAN
www.polisoft.com.tr
www.polisoft.com.tr
merhaba arkadaşlar vidgrabber bileşeni kullanarak amatörce birşey yapmayı başardım.belki birilerine lazım olur.
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
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.
Yardıma İhtiyacım var galiba TAM burda ![Smile :)](./images/smilies/icon_smile.gif)
![Smile :)](./images/smilies/icon_smile.gif)