lazarus 编写摄像头程序(附源代码)

panlifeng

Lazarus WebCam (網路攝影機)
        分類：Win32 版本    2010/03/04 17:24        

用 Lazarus 寫了一個網路攝影機的測試程式, 程式很簡單, 重點在 VFW.pas  (Video for windows include file for WIN32) 這個引入檔, 在 C++ Builder 的 Include 檔目錄中, Borland 公司有幫 C++ 開發者寫好一個 VFW.hpp 供影像處理相關程式使用, 但 Delphi  中卻沒有; 所以使用 Delphi 或是 Lazarus 都要去網路找找有沒人幫你轉好成 Pascal 的引入檔; 感謝網路上好心人士整理提供了這個引入檔 (for Lazarus) , 程式只要呼叫使用相關的函式即可 (對裝置依賴很深, 應該是只能用在 WIN32 環境), 有興趣者可以打開 VFW.pas  來看, 裏面有近百種的影像處理函式宣告, 我們今天只是示範最簡單通用的一種 - 抓 WEBCAM 影像

以前金禾有出過一本書叫 "多媒體視訊程式設計 - 使用 Delphi", 雖然當時沒用到, 公司也不是做多媒體專案的, 但因為本身有收集技術書籍的習慣, 所以這本書我有買, 以後有機會再參考這本書, 用 Lazarus + VFW.PAS 來研究影像處理上的應用 (後來發現書中光碟就有附 VFW.PAS FOR Delphi 版的, 不用到網路找, 書中很多應用也都需要用到 VFW.PAS , FOR Lazarus 版的跟 FOR Delphi 版的雖然是 "大同" 但還是有些 "小異" , 若你懶得修改或是不會改, 就直接到網路找 FOR 不同開發工具版本的  VFW.PAS )


unit Unit1;
{$mode objfpc}{$H+}
interface
uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, Windows, vfw ;  //要 uses 這個 vfw.pas
type
  { TForm1 }
  TForm1 = class(TForm)
    Panel1: TPanel;
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  private
    { private declarations }
  public
    { public declarations }
  end;
var
  Form1: TForm1;
  nobreak: boolean;
implementation
{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var hCapWnd: HWND;
    ScanDriver: boolean;
    i: integer;
begin
  //參考 K.top taishyang 作品
  //設定 CaptureWindows 在 Panel1 上
  hCapWnd := capCreateCaptureWindow('My Capture Window',
                                   WS_VISIBLE or WS_CHILD ,
                                   0,
                                   0,
                                   Panel1.Width,
                                   Panel1.Height,
                                   Panel1.Handle,
                                   0);
  ScanDriver := false;
  for i:= 0 to 9 do
  begin
    ScanDriver:=capDriverConnect(hCapWnd,i);
    if (ScanDriver) then break;
  end;
  if not ScanDriver then
  begin
    ShowMessage('攝影機連接失敗..');
    Close;
    exit;
  end;
  capDriverConnect (hCapWnd, 0); //與驅動程式連結
  capPreviewRate(hCapWnd,100); //每秒影像變化張數
  capPreview(hCapWnd,true);

end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
  );
begin
  if (Key=27) then nobreak:=false;
end;
initialization
  {$I Unit1.lrs}
end.

wc12561

不错，期待LINUX下版本

bruce0829

偶的舊文章被人轉貼到這來啦 ....

補充一下源碼下載位置

什麼 ?  不能提交源碼位置, 說什麼我的發表數小於 10 , 不能提交帶有連結位置的訊息 .... 有沒搞錯 ? 限制東限制西, 要怎麼進步 ? 提交源碼位置有風險嗎 ? 真要搞怪的人他一樣可以發表灌水 10 個等級之後再來搞怪呀 ~

bruce0829

■ 程式下載 (含 source code)

http://digitraveler.homelinux.com/down_load/LazWebCam.zip

xusonglie

不错！又学习了一招

zhnantz

学习ing...

小晖

现想用这方面东东.
找到源头了.

http://digitraveler.homelinux.com/down_load/LazWebCam.zip


linux下有可实现的么?

heroical

来晚了，已经无法下载。