Arsip: Thxvidfwin sebuah component video sederhana

Sebenarnya pengen upload aja component ini ke delphi-id, tapi kok gak bisa yah... padahal saya termasuk orang yang males berkata-kata.

Anda pengen mengetahui bagaimana script untuk capturing video.
silakan pelajari source code component Thxvidfwin ini !!.
anda boleh merubah dan menambah dan mengganti sekalipun nama dari component ini. karena tujuan saya hanya agar kita belajar bersama!!

untuk pengembangan silakan lihat MS SDK Help file yg ada beserta delphi 7

tapi jika anda merasa berterima kasih pada saya. tetap cantumkan nama saya di script yg anda rubah !

unit HXvidfwin;



(              

  THXvidfwin Component (Freeware Delphi Component)

  HeruX video for window class



  created by:

    (C)2008. Heru Susanto (herux delphi-id)

    email: hersuck77@yahoo.com

    as THXvidfwin on HeruX palette



 u can use, modified or redistribute this class... but don't

 forget my name...

 of course there is a lot of bug, but i don't have much time.

 so may be u ...



                )



interface



uses

  SysUtils, Classes, Messages, Windows, ExtCtrls, TypInfo, Controls;



type

  PVOID = Pointer;

  {$EXTERNALSYM PVOID}

  LONG  = Longint;

  {$EXTERNALSYM LONG}

  PLONG = ^LONG;

  {$EXTERNALSYM PLONG}

  int   = Integer;

  {$EXTERNALSYM int}



const

    WM_CAP_START                    = WM_USER;

    WM_CAP_SEQUENCE                 = WM_CAP_START + 62;

    WM_CAP_DRIVER_CONNECT           = WM_CAP_START + 10;

    WM_CAP_DRIVER_DISCONNECT        = WM_CAP_START + 11;

    WM_CAP_SET_PREVIEW              = WM_CAP_START + 50;

    WM_CAP_SET_PREVIEWRATE          = WM_CAP_START + 52;

    WM_CAP_SET_SCALE                = WM_CAP_START + 53;



type

  THXvidfwin = class(TComponent)

  private

    FStartVideo: Boolean;

    FLayar: TPanel;

    hwndc: HWND;

    Ffps: Integer;

    FOnLayarMouseDown: TMouseEvent;

    function AVICapSendMess(Hnd: HWND; Msg: Cardinal; wParam: int; lParam: int): DWORD;

    function capDriverConnect(Hnd: HWND; i: int): Boolean;

    function capDriverDisconnect(Hnd: HWND): Boolean;

    function capCreateCaptureWindowA(WindowName : LPCSTR; dwStyle: DWORD;

          x, y: int;nWidth, nHeight: int; hwndParent: HWND; nID: int): HWND;

    function capPreviewScale(Hnd: HWND; f: BOOL): Boolean;

    function capPreviewRate(Hnd: HWND; i: int): Boolean;

    function capPreview(Hnd: HWND; f: BOOL): Boolean;

    procedure DoLayarMouseDown(var Message: TWMMouse; Button: TMouseButton;

          Shift: TShiftState);

    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;

  protected

    procedure SetStartVideo(Value: Boolean);

    function GetLayar: TPanel;

    procedure SetLayar(Value: TPanel);

    function Getfps: Integer;

    procedure Setfps(Value: Integer);

    procedure LayarMouseDown(Button: TMouseButton; Shift: TShiftState;

        X, Y: Integer); dynamic;

  public

    constructor Create(aOwner: TComponent);

    destructor Destroy;

    property fps: Integer read Getfps write Setfps default 200;

  published

    property Layar: TPanel read GetLayar write SetLayar;

    property StartVideo: Boolean read fStartVideo write SetStartVideo;

    property OnLayarMouseDown: TMouseEvent read FOnLayarMouseDown write FOnLayarMouseDown;

  end;





procedure Register;



implementation



{$R *.dcr}



procedure Register;

begin

  RegisterComponents('heruX', [THXvidfwin]);

end;



function capCreateCaptureWindow(

    lpszWindowName      : LPCSTR;

    dwStyle             : DWORD;

    x, y                : int;

    nWidth, nHeight     : int;

    hwndParent          : HWND;

    nID                 : int

    ): HWND; stdcall; external 'avicap32' name 'capCreateCaptureWindowA';





{ THXvidfwin }



function THXvidfwin.AVICapSendMess(Hnd: HWND; Msg: Cardinal; wParam,

  lParam: int): DWORD;

begin

  if IsWindow(Hnd)

  then Result := SendMessage(Hnd,Msg,wParam,lParam)

  else Result := 0;

end;



function THXvidfwin.capCreateCaptureWindowA(WindowName: LPCSTR;

  dwStyle: DWORD; x, y, nWidth, nHeight: int; hwndParent: HWND;

  nID: int): HWND;

begin

  Result := capCreateCaptureWindow(WindowName, dwStyle, x, y, nWidth, nHeight,

          hwndParent, nID);

end;



function THXvidfwin.capDriverConnect(Hnd: HWND; i: int): Boolean;

begin

  Result := AVICapSendMess(Hnd,WM_CAP_DRIVER_CONNECT,i,0) <> 0;

end;



function THXvidfwin.capDriverDisconnect(Hnd: HWND): Boolean;

begin

  Result := AVICapSendMess(Hnd,WM_CAP_DRIVER_DISCONNECT, 0, 0) <> 0;

end;



function THXvidfwin.capPreview(Hnd: HWND; f: BOOL): Boolean;

begin

  Result := AVICapSendMess(Hnd,WM_CAP_SET_PREVIEW,wPARAM(f),0) <> 0;

end;



function THXvidfwin.capPreviewRate(Hnd: HWND; i: int): Boolean;

begin

  Result := AVICapSendMess(Hnd,WM_CAP_SET_PREVIEWRATE,i,0) <> 0;

end;



function THXvidfwin.capPreviewScale(Hnd: HWND; f: Bool): Boolean;

begin

  Result := AVICapSendMess(Hnd,WM_CAP_SET_SCALE,wParam(f),0) <> 0;

end;



constructor THXvidfwin.Create(aOwner: TComponent);

begin

  inherited Create(aOwner);

  ffps := 200;

end;



destructor THXvidfwin.Destroy;

begin

  if fStartVideo = True then fStartVideo := False;

  Destroy;

end;



procedure THXvidfwin.DoLayarMouseDown(var Message: TWMMouse;

  Button: TMouseButton; Shift: TShiftState);

begin

  with Message do

  LayarMouseDown(Button,Shift, XPos, YPos); //KeysToShiftState(Keys) + 

end;



function THXvidfwin.Getfps: Integer;

begin

  Result := ffps;

end;



function THXvidfwin.GetLayar: TPanel;

begin

  Result := fLayar;

end;



procedure THXvidfwin.LayarMouseDown(Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

  if Assigned(FOnLayarMouseDown) then

  FOnLayarMouseDown(FLayar,Button,Shift,x,y);

end;



procedure THXvidfwin.Setfps(Value: Integer);

begin

  if Value <> ffps then

  begin

  ffps := Value;

  Updated;

  end;

end;



procedure THXvidfwin.SetLayar(Value: TPanel);

begin

  fLayar := Value;

end;



procedure THXvidfwin.SetStartVideo(Value: Boolean);

begin

  if (fLayar <> nil) and (Value = True) then

  try

  hwndc := capCreateCaptureWindowA('Video',WS_CHILD + WS_VISIBLE, 5, 5, Layar.Width-10, Layar.Height-10, Layar.Handle,1);

  capDriverConnect(hwndc,0);

  capPreviewScale(hwndc,true);

  capPreviewRate(hwndc,ffps);

  finally

  capPreview(hwndc,True);

  end;



  if Value = False then

  capDriverDisconnect(hwndc);

end;



procedure THXvidfwin.WMLButtonDown(var Message: TWMLButtonDown);

begin

  inherited;

  DoLayarMouseDown(Message, mbLeft, []);

end;



end.