Dasar pembuatan komponen video

Silakan kembangkan… baca help WinAPI bawaan delphi 7

unit HXvidfwin;

(************************************************************
  THXvidfwin Component (Freeware Delphi Component)
  HeruX video for window class

  created by:
    (C)2008. Heru Susanto (herux delphi-id)
    email: herux.igsw@yahoo.co.id
    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.

8 thoughts on “Dasar pembuatan komponen video

  1. herux says:

    HXvidfwin.dcr cuma buat icon aja. u buang aja gak papa. cuma ntar komponen pake icon default dari delphi.

    Maaf nih blom tersedia downloadnya blom sempat. u gunain aja dulu seadanya ya !.

  2. alisulaiman says:

    Pak Heru, tolong dibuatkan sesi tersendiri unutk materi tentang dasar-dasar Pemrograman Delphi. Sehingga semua biar bertambah bingung pak….???!!!@@@#$%#@^ He…He….

  3. herux says:

    he..he.. okey deh pak ali, ntar kalo sempet !
    ngarang kata kata indah susah banget. mending coding..

    makanya aq ngeblog biar sambil latihan nulis !

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s