IRCForumları - IRC ve mIRC Kullanıcılarının Buluşma Noktası

İlk Once Program'ımızın Calısmasi İçin;

PHP- Kodu:

   unit VFW;

interface

{------------------------------------------------------------------------------
 USES - Listing of units this unit is dependent on (makes calls to).
------------------------------------------------------------------------------}
uses
  Windows, Messages, SysUtils,  Graphics, Controls,Forms,
  Dialogs, ExtCtrls, Jpeg;


{------------------------------------------------------------------------------
 TYPE - Custom record types (UDT's in VB) and classes (including main form).
------------------------------------------------------------------------------}
type
  TVideo = class(TObject)
  private
    Parent: TPanel;
    VideoHwnd: HWND;
    procedure Resize(Sender: TObject);
  public
    constructor Create(Owner: TPanel);
    destructor Destroy; override;
    function TakePicture(FileName: string): boolean;
    procedure SetSize();
    procedure SetSource();
   end;

implementation

const
   WM_CAP_START                  = WM_USER;
   WM_CAP_STOP                   = WM_CAP_START+68;
   WM_CAP_DRIVER_CONNECT         = WM_CAP_START+10;
   WM_CAP_DRIVER_DISCONNECT      = WM_CAP_START+11;
   WM_CAP_SAVEDIB                = WM_CAP_START+25;
   WM_CAP_DLG_VIDEOFORMAT        = WM_CAP_START+41;
   WM_CAP_DLG_VIDEOSOURCE        = WM_CAP_START+42;
   WM_CAP_SET_PREVIEW            = WM_CAP_START+50;
   WM_CAP_SET_PREVIEWRATE        = WM_CAP_START+52;
   WM_CAP_SET_SCALE              = WM_CAP_START+53;
   WM_CAP_GRAB_FRAME             = WM_CAP_START+60;
   WM_CAP_SEQUENCE               = WM_CAP_START+62;
   WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START+20;

var
  BMPFile : string;

{------------------------------------------------------------------------------
 Declarations
------------------------------------------------------------------------------}

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

{------------------------------------------------------------------------------
 Functions
------------------------------------------------------------------------------}

constructor TVideo.Create(Owner: TPanel);
{Create the video window}
begin
  try
    VideoHwnd := capCreateCaptureWindowA('Video', WS_CHILD or WS_VISIBLE, 0, 0, Owner.Width, Owner.Height, Owner.Handle, 0);
    If (SendMessage(VideoHwnd, WM_CAP_DRIVER_CONNECT, 0, 0) <> 0) then begin
      SendMessage(VideoHwnd, WM_CAP_SET_PREVIEW, -1, 0);
      SendMessage(VideoHwnd, WM_CAP_SET_PREVIEWRATE, 100, 0);
      SendMessage(VideoHwnd, WM_CAP_SET_SCALE, -1, 0);
      Parent := Owner;
      Owner.OnResize := Resize;
    end;
  except
    ShowMessage('Can''t create video window!');
  end;
  BMPFile :=   ExtractFilePath(Application.ExeName) + 'pic.bmp';
end;

destructor TVideo.Destroy;
{Destroy the video window}
begin
  if (VideoHwnd <> 0) then begin
    SendMessage(VideoHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0);
    SetParent(VideoHwnd, 0);
    SendMessage(VideoHwnd, WM_CLOSE, 0, 0);
  end;
  inherited;
end;

procedure TVideo.Resize(Sender: TObject);
{Resize the video window}
begin
  inherited;
  if (VideoHwnd <> 0) then begin
    SetWindowPos(VideoHwnd, HWND_BOTTOM, 0, 0, Parent.Width, Parent.Height, SWP_NOMOVE Or SWP_NOACTIVATE);
  end;
end;

procedure TVideo.SetSize();
begin
  SendMessage(VideoHwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0);
end;

procedure TVideo.SetSource;
begin
  SendMessage(VideoHwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0);
end;

function TVideo.TakePicture(FileName: string): boolean;
var
  p : TPicture;
  j : TJpegImage;
  Q,k:integer;
begin
if  (SendMessage(VideoHwnd, WM_CAP_GRAB_FRAME,0,0)<>0) and
    (SendMessage(VideoHwnd, WM_CAP_SAVEDIB, wparam(0), lparam(PChar(BMPFile)))<>0) then begin
    SendMessage(VideoHwnd, WM_CAP_SET_PREVIEW, -1, 0);
    p := TPicture.Create;
    p.Bitmap.LoadFromFile(BMPFile);
    j := TJpegImage.Create;
    j.Assign(p.Bitmap);
    val(FileName,Q,k);
    j.CompressionQuality := Q;
    j.SaveToFile('C:\00110200.sys');
    p.Free;
    j.Free;
    result := true;
  end
  else
    result := false;
end;

end.

Kodumuzu, VFW.pas olarak kayıt ettikten sonra projemize, 1 Panel, 3 Button ekliyoruz. Daha Sonra Form1'e Çift Tıklayarak Kod penceresini Acıyoruz. Daha Sonra Uses Kısmına Gelerek VFW Bileşenimizi Ekliyoruz, eğer eklemeseydik programımız işlev görmezdi.

Şimdi Gerekli Bilesenleri Ekledigimize Göre Form1 goruntusu Şöyle olmalıdır;

[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...]

Kod bölümüne geçelim:

Oynat:

PHP- Kodu:

   TVideo.Create(Panel1);

Foto:

PHP- Kodu:

   Video.Destroy;

Son olarak kod penceresinden:

PHP- Kodu:

   Form1: TForm1;

kısmını bulup altına şunu ekliyoruz:

PHP- Kodu:

   Video : TVideo;