全部积分求DELPHI视频控制源码或详细原理 ( 积分: 300 )

小弟刚刚学编关于硬件的程序，一时不知道怎样开始，网上又缺乏资料，望各位能给予小弟帮助，或加小弟QQ：185318507教导下小弟，小弟感激不尽[]

小弟刚刚学编关于硬件的程序，一时不知道怎样开始，网上又缺乏资料，望各位能给予小弟帮助，或加小弟QQ：185318507教导下小弟，小弟感激不尽[]

控制 不知道
我知道可以用videocap取得视频，用videodisp显示，都是vfw标准不需要了解硬件

我这里有DELPHI视频控制源码，可以发给你

我也想要请发了份给我谢谢
hyxq_15@126.com

我也想要DELPHI视频控制源码，给我一份吧
phil_4000@hotmail.com

我也想要DELPHI视频控制源码，可以给我一份吗?
asia_w@sina.com.cn

我也要，也给我一份啊wenzhi1983@163.com
谢谢！

我也想要
wanghy61@163.com

为好友做毕业设计视频扑获与传输，用到了一个控件包DSPACK。用它和Indy就可以实现
很方便。帖一断代码（这段代码是一个网友写的）DSPACK自代的demo很容易看懂
unit Client;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, DSPack, DirectShow9, StdCtrls, DSUtil,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, jpeg, Menus;

type
TClientForm = class(TForm)
FilterGraph: TFilterGraph;
Grabber: TSampleGrabber;
Filter: TFilter;
VideoWindow: TVideoWindow;
Image: TImage;
Panel: TPanel;
MainMenu: TMainMenu;
VideoPanel: TPanel;
Devices: TMenuItem;
Connect: TMenuItem;
ConnectServer: TMenuItem;
help: TMenuItem;
About: TMenuItem;
DeconnectServer: TMenuItem;
Label1: TLabel;
Panel1: TPanel;
procedure GrabberBuffer(sender: TObject; SampleTime: Double; pBuffer: Pointer; BufferLen: Integer);
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure AboutClick(Sender: TObject);
procedure ConnectServerClick(Sender: TObject);
procedure DeconnectServerClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure OnSelectDevice(sender: TObject);
end;

var
ClientForm: TClientForm;
SysDev: TSysDevEnum;

implementation

uses
About, Connect;

{$R *.dfm}

procedure TClientForm.GrabberBuffer(sender: TObject; SampleTime: Double; pBuffer: Pointer; BufferLen: Integer);
var
hr: HRESULT;
BIHeaderPtr: PBitmapInfoHeader;
MediaType: TAMMediaType;
BitMapHandle: HBitmap;
DIBPtr: Pointer;
jpg: TJpegImage;
memStream: TMemoryStream;
begin
Image.Canvas.Lock;
try
hr := Grabber.SampleGrabber.GetConnectedMediaType(MediaType);
if hr <> S_OK then
Exit;
try
if IsEqualGUID(MediaType.majortype, MEDIATYPE_Video) then
begin
BIHeaderPtr := nil;
if IsEqualGUID(MediaType.formattype, FORMAT_VideoInfo) then
if MediaType.cbFormat = SizeOf(TVideoInfoHeader) then
BIHeaderPtr := @(PVideoInfoHeader(MediaType.pbFormat)^.bmiHeader);
if not Assigned(BIHeaderPtr) then
Exit;
BitmapHandle := CreateDIBSection(0, PBitmapInfo(BIHeaderPtr)^, DIB_RGB_COLORS, DIBPtr, 0, 0);
if BitmapHandle <> 0 then
begin
if DIBPtr = nil then
Exit;
if BufferLen > Integer(BIHeaderPtr^.biSizeImage) then
BufferLen := BIHeaderPtr^.biSizeImage;
Move(pBuffer^, DIBPtr^, BufferLen);
Image.Picture.Bitmap.Handle := BitmapHandle;
end;
end;
finally
FreeMediaType(@MediaType);
end;

memStream := TMemoryStream.Create;
jpg := TJpegImage.Create;
jpg.Assign(Image.Picture.Bitmap);
jpg.CompressionQuality := 10;
jpg.JPEGNeeded;
jpg.Compress;
jpg.SaveToStream(memStream);
jpg.Free;

if ConnectForm.TCPClient.Connected then
begin
try
ConnectForm.TCPClient.WriteInteger(memStream.Size);
ConnectForm.TCPClient.WriteBuffer(memStream.Memory^, memStream.Size, True);
except
end;
end;
memStream.Free;
finally
Image.Canvas.Unlock;
end;
end;

procedure TClientForm.FormCreate(Sender: TObject);
var
i: Integer;
Device: TMenuItem;
begin
SysDev := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
if SysDev.CountFilters > 0 then
for i := 0 to SysDev.CountFilters - 1 do
begin
Device := TMenuItem.Create(Devices);
Device.Caption := SysDev.Filters.FriendlyName;
Device.Tag := i;
Device.OnClick := OnselectDevice;
Devices.Add(Device);
end;
end;

procedure TClientForm.OnSelectDevice(sender: TObject);
begin
FilterGraph.ClearGraph;
FilterGraph.Active := False;
Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag);
FilterGraph.Active := True;
with FilterGraph as ICaptureGraphBuilder2 do
CheckDSError(RenderStream(@PIN_CATEGORY_PREVIEW, nil, Filter as IBaseFilter, Grabber as IBaseFilter, VideoWindow as IbaseFilter));
FilterGraph.Play;
end;

procedure TClientForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
SysDev.Free;
FilterGraph.ClearGraph;
FilterGraph.Active := False;
if ConnectForm.TCPClient.Connected then
ConnectForm.TCPClient.Disconnect;
end;

procedure TClientForm.AboutClick(Sender: TObject);
begin
AboutForm.Show;
end;

procedure TClientForm.ConnectServerClick(Sender: TObject);
begin
ConnectForm.Show;
end;

procedure TClientForm.DeconnectServerClick(Sender: TObject);
begin
if ConnectForm.TCPClient.Connected then
ConnectForm.TCPClient.Disconnect;
end;

end.

unit Server;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPServer, ExtCtrls, jpeg,
Menus, StdCtrls, IdStack, IdSocketHandle, Buttons;

type
TServerForm = class(TForm)
TCPServer: TIdTCPServer;
Image: TImage;
Panel: TPanel;
MainMenu: TMainMenu;
FileMenu: TMenuItem;
FileExit: TMenuItem;
lblIP: TLabel;
HelpMenu: TMenuItem;
FileAbout: TMenuItem;
spbActiveServer: TSpeedButton;
lblPort: TLabel;
lblShowIP: TLabel;
lblShowPort: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure TCPServerExecute(AThread: TIdPeerThread);
procedure FileExitClick(Sender: TObject);
procedure FileAboutClick(Sender: TObject);
procedure spbActiveServerClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
ServerForm: TServerForm;

implementation

uses
About;

{$R *.dfm}

procedure TServerForm.FormCreate(Sender: TObject);
var
Binding: TIdSocketHandle;
IPList: TStrings;
begin
IPList := GStack.LocalAddresses.Create;
TCPServer.Bindings.Clear;
if IPList.Count > 0 then
begin
Binding := TCPServer.Bindings.Add;
Binding.IP := IPList.Strings[IPList.Count - 1];
Binding.Port := 8085;
lblShowIP.Caption := Binding.IP;
lblShowPort.Caption := IntToStr(Binding.Port);
end;
//IPList := nil;
end;

procedure TServerForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if TCPServer.Active then
TCPServer.Active := False;
end;

procedure TServerForm.TCPServerExecute(AThread: TIdPeerThread);
var
memStream: TMemoryStream;
jpg: TJpegImage;
BufferLen: Integer;
begin
if AThread.Connection.Connected and not AThread.Terminated then
begin
memStream := TMemoryStream.Create;
BufferLen := AThread.Connection.ReadInteger;
memStream.Size := BufferLen;
AThread.Connection.ReadBuffer(memStream.Memory^, BufferLen);
jpg := TJpegImage.Create;
jpg.LoadFromStream(memStream);
Image.Picture.Bitmap.Assign(jpg);
jpg.Free;
memStream.Free;
end;
end;

procedure TServerForm.FileExitClick(Sender: TObject);
begin
Close;
end;

procedure TServerForm.FileAboutClick(Sender: TObject);
begin
AboutForm.Show;
end;

procedure TServerForm.spbActiveServerClick(Sender: TObject);
begin
if TCPServer.Active then
begin
spbActiveServer.Caption := '启动';
TCPServer.Active := False;
end else
begin
spbActiveServer.Caption := '停止';
TCPServer.Active := True;
end;
end;

end.