Arsip: Thxvidfwin sebuah component video sederhana


by herux in Multimedia more 12 years ago 2823
Anda pengen mengetahui bagaimana script untuk capturing video.

silakan pelajari source code component Thxvidfwin ini !!.
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.



Local Business Directory, Search Engine Submission & SEO Tools FreeWebSubmission.com SonicRun.com