|
|
| (5 intermediate revisions by 2 users not shown) |
| Line 1: |
Line 1: |
| − | {***************************************************************
| + | ==Freepascal VideoTest== |
| − | * Name: VideoTest
| + | Freepascal VideoTest is a simple application that demonstrates how to use a web cam from Free Pascal. |
| − | * Author: Denis Gottardello (info@denisgottardello.it)
| + | It is available from https://sourceforge.net/projects/freepascalvideo/ for Windows and Linux. |
| − | * Created: 2010-08-12
| |
| − | * Copyright: Denis Gottardello (www.denisgottardello.it)
| |
| − | * License:
| |
| − | **************************************************************}
| |
| | | | |
| − | unit TFMainForm;
| + | ==SysRec== |
| | + | [[SysRec]] is a versatile Lazarus application that supports Windows computers. It is available as source code. |
| | | | |
| − | {$mode objfpc}{$H+}
| + | [[Category: Hardware]] |
| − | | + | [[Category:Devices]] |
| − | interface
| + | [[Category:Multimedia]] |
| − | | + | [[Category:Video]] |
| − | uses
| |
| − | Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, TFCamera,
| |
| − | ComCtrls, Buttons, StdCtrls, ExtCtrls, VFW;
| |
| − | | |
| − | type RVideoCapDevice= record
| |
| − | szDeviceName: array[0..79] of Char;
| |
| − | szDeviceVersion: array[0..79] of Char;
| |
| − | end;
| |
| − | | |
| − | type AImageIn= array of Byte;
| |
| − | type PAImageIn= ^AImageIn;
| |
| − | type Av_capability= array of RVideoCapDevice;
| |
| − | | |
| − | type
| |
| − | | |
| − | { TMainForm }
| |
| − | | |
| − | TMainForm = class(TForm)
| |
| − | BitBtn1: TBitBtn;
| |
| − | TBBCamera: TBitBtn;
| |
| − | GroupBox2: TGroupBox;
| |
| − | TMLog: TMemo;
| |
| − | TEDriver: TEdit;
| |
| − | TECard: TEdit;
| |
| − | TEBusInfo: TEdit;
| |
| − | TEVersion: TEdit;
| |
| − | TECapabilities: TEdit;
| |
| − | TEReserved: TEdit;
| |
| − | GroupBox1: TGroupBox;
| |
| − | Label1: TLabel;
| |
| − | Label2: TLabel;
| |
| − | Label3: TLabel;
| |
| − | Label4: TLabel;
| |
| − | Label5: TLabel;
| |
| − | Label6: TLabel;
| |
| − | TLBVideoCards: TListBox;
| |
| − | StatusBar1: TStatusBar;
| |
| − | procedure FormCreate(Sender: TObject);
| |
| − | procedure FormDestroy(Sender: TObject);
| |
| − | procedure TBBCameraClick(Sender: TObject);
| |
| − | procedure FormShow(Sender: TObject);
| |
| − | procedure TLBVideoCardsClick(Sender: TObject);
| |
| − | private
| |
| − | AAv_capability: Av_capability;
| |
| − | TSLInterfacesList: TStringList;
| |
| − | Camera: TCamera;
| |
| − | IsCameraConnected: Boolean;
| |
| − | FHandle: Integer;
| |
| − | public
| |
| − | { public declarations }
| |
| − | end;
| |
| − | | |
| − | var
| |
| − | MainForm: TMainForm;
| |
| − | | |
| − | implementation
| |
| − | | |
| − | uses
| |
| − | Windows;
| |
| − | | |
| − | { TMainForm }
| |
| − | | |
| − | procedure TMainForm.FormShow(Sender: TObject);
| |
| − | var
| |
| − | VideoCapDevice: RVideoCapDevice;
| |
| − | I: Integer;
| |
| − | begin
| |
| − | SetLength(AAv_capability, 0);
| |
| − | for I:= 0 to 99 do begin
| |
| − | if capGetDriverDescription(I, @VideoCapDevice.szDeviceName, sizeof(VideoCapDevice.szDeviceName), @VideoCapDevice.szDeviceVersion, sizeof(VideoCapDevice.szDeviceVersion)) then begin
| |
| − | SetLength(AAv_capability, Length(AAv_capability)+ 1);
| |
| − | AAv_capability[Length(AAv_capability)- 1]:= VideoCapDevice;
| |
| − | TLBVideoCards.Items.Append(VideoCapDevice.szDeviceName +', '+ VideoCapDevice.szDeviceVersion);
| |
| − | end;
| |
| − | end;
| |
| − | end;
| |
| − | | |
| − | procedure TMainForm.TBBCameraClick(Sender: TObject);
| |
| − | var
| |
| − | FDriverCaps: TCapDriverCaps;
| |
| − | begin
| |
| − | if not IsCameraConnected then begin
| |
| − | Camera:= TCamera.Create(Self);
| |
| − | Camera.FHandle:= @FHandle;
| |
| − | FHandle:= capCreateCaptureWindow(nil, WS_CHILDWINDOW or WS_VISIBLE or WS_CLIPCHILDREN or WS_CLIPSIBLINGS , Camera.TPCamera.Left+ 5, Camera.TPCamera.Top+ 5, Camera.TPCamera.Width- 10, Camera.TPCamera.Height-10, Camera.TPCamera.Handle, 0);
| |
| − | if (FHandle<> 0) and capDriverConnect(FHandle, TLBVideoCards.ItemIndex) then begin
| |
| − | if capDriverGetCaps(FHandle, @FDriverCaps, SizeOf(TCapDriverCaps)) then begin
| |
| − | if FDriverCaps.fHasOverlay then begin
| |
| − | TMLog.Lines.Append('Driver connected, accepts overlay');
| |
| − | if not capPreviewRate(FHandle, 0) then TMLog.Lines.Append('Error capPreviewRate(FHandle, 0)!');
| |
| − | if capOverlay(FHandle, True) then TMLog.Lines.Append('Video Capture - Overlay (Hardware)');
| |
| − | end else begin
| |
| − | TMLog.Lines.Append('Driver connected, software rendering');
| |
| − | if not capPreviewRate(FHandle, 33) then TMLog.Lines.Append('Error capPreviewRate(FHandle, 33)!');
| |
| − | if capPreview(FHandle, True) then TMLog.Lines.Append('Video Capture - Preview (Software)');
| |
| − | end;
| |
| − | IsCameraConnected:= true;
| |
| − | TBBCamera.Caption:= 'Stop';
| |
| − | end;
| |
| − | end;
| |
| − | Camera.Show();
| |
| − | end else begin
| |
| − | if capCaptureStop(FHandle) and capDriverDisconnect(FHandle) then begin
| |
| − | Camera.Free;
| |
| − | IsCameraConnected:= false;
| |
| − | TBBCamera.Caption:= 'Start';
| |
| − | end;
| |
| − | end;
| |
| − | end;
| |
| − | | |
| − | procedure TMainForm.FormCreate(Sender: TObject);
| |
| − | begin
| |
| − | TSLInterfacesList:= TStringList.Create();
| |
| − | IsCameraConnected:= false;
| |
| − | end;
| |
| − | | |
| − | procedure TMainForm.FormDestroy(Sender: TObject);
| |
| − | begin
| |
| − | TSLInterfacesList.Free;
| |
| − | end;
| |
| − | | |
| − | procedure TMainForm.TLBVideoCardsClick(Sender: TObject);
| |
| − | begin
| |
| − | if (TLBVideoCards.ItemIndex> -1) and (TLBVideoCards.ItemIndex< TLBVideoCards.Items.Count) then begin
| |
| − | TEDriver.Text:= AAv_capability[TLBVideoCards.ItemIndex].szDeviceName;
| |
| − | TEVersion.Text:= AAv_capability[TLBVideoCards.ItemIndex].szDeviceVersion;
| |
| − | TBBCamera.Enabled:= true;
| |
| − | end;
| |
| − | end;
| |
| − | | |
| − | initialization
| |
| − | {$I TFMainForm.lrs}
| |
| − | | |
| − | end.
| |
