unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, IdIPWatch,
IdTCPClient, IdTCPServer, Dialogs, ShellAPI, StdCtrls, ExtCtrls, Clipbrd, Math,
IdComponent, Forms, JPEG, IdTCPConnection, IdCustomTCPServer, IdBaseComponent,
IdContext;
type
TfrmMain =
class(TForm)
TCPClient: TIdTCPClient;
Timer1: TTimer;
Timer2: TTimer;
Panel1: TPanel;
TCPServer: TIdTCPServer;
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
procedure FormCreate(Sender: TObject);
procedure TCPServerExecute(AContext: TIdContext);
private
Handle: THandle;
{ Private declarations }
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
Status, Diff: Boolean;
NEW_BMP, OLD_BMP, BUFFER_BMP: TBitmap;
JPG: TJpegImage;
const
WM_CAP_DRIVER_CONNECT = WM_USER + 10;
WM_CAP_EDIT_COPY = WM_USER + 30;
WM_CAP_SET_PREVIEW = WM_USER + 50;
WM_CAP_SET_OVERLAY = WM_USER + 51;
WM_CAP_SET_PREVIEWRATE = WM_USER + 52;
implementation
{$R *.dfm}
//Berechnen der Farbunterschiede für eine bessere Bildrate
procedure GetDifference(ZielDC,DC1,DC2:HDC;DCwidth:integer;DCheight:integer);
begin
BitBlt(ZielDC, 0, 0, DCWidth, DCHeight, DC2, 0, 0, SRCCOPY);
bitblt(ZielDC, 0, 0, DCWidth, DCHeight, DC1, 0, 0, SRCINVERT);
end;
//Notwendige Funktion zum Zugriff auf die Webcam
function capCreateCaptureWindow(lpszWindowName: LPCSTR; dwStyle: DWORD; X, Y, nWidth, nHeight: Integer; hwndParent: HWND; nID: Integer): HWND;
stdcall;
external '
AVICAP32.DLL'
name '
capCreateCaptureWindowA';
//Sucht solange den Server bis er ihn gefunden hat
//Soll später außerhalb des Netzwerkes laufen.
//Abfangen von Fehlermeldungen, wenn der Server
//nicht on ist; Reconnecten bis zum Erfolg
procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
If Status = False
then
begin
TCPClient.Host:= '
127.0.0.1';
Try
TCPClient.Connect;
Except
end;
Try
If TCPClient.IOHandler.ReadLn = '
Connecting to Client ...'
then Status := True;
Except
Status := False;
end;
end;
//Abschalten -und Anschalten der Webcamanzeige
//und des Streames wenn (keine) Verbindung steht.
If (Status = True )
and (Timer2.Enabled = False)
then Timer2.Enabled := True;
If (Status = False)
and (Timer2.Enabled = True )
then Timer2.Enabled := False;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
//Initialisierung
Status := False;
Diff := False;
NEW_BMP := TBitmap.Create;
OLD_BMP := TBitmap.Create;
BUFFER_BMP := TBitmap.Create;
JPG := TJPEGImage.Create;
JPG.CompressionQuality := 100;
//Webcam anzeigen
Handle := capCreateCaptureWindow('
Video', ws_child + ws_visible, 0, 0, 640, 480, Panel1.Handle, 1);
SendMessage(
Handle, WM_CAP_DRIVER_CONNECT, 0, 0);
SendMessage(
Handle, WM_CAP_SET_PREVIEWRATE, 15, 0);
SendMessage(
Handle, WM_CAP_SET_OVERLAY, 1, 0);
SendMessage(
Handle, WM_CAP_SET_PREVIEW, 1, 0);
end;
procedure TfrmMain.Timer2Timer(Sender: TObject);
var
Datei: textFile;
S: TMemoryStream;
begin
//Kopieren des Webcam-Bildes
SendMessage(
Handle, WM_CAP_EDIT_COPY, 1, 0);
//Wenn es das 1. Bild ist, kann kein Unterschied berechnet werden ...
If Diff = False
then
begin
NEW_BMP.LoadFromClipboardFormat(cf_BitMap,ClipBoard.GetAsHandle(cf_Bitmap), 0);
JPG.Assign(NEW_BMP);
Diff := True;
end
//Wenn es aber schon mind. das 2 ist, kann der Unterschied berechnet werden.
Else
begin
OLD_BMP.Assign(NEW_BMP);
NEW_BMP.LoadFromClipboardFormat(cf_BitMap,ClipBoard.GetAsHandle(cf_Bitmap), 0);
BUFFER_BMP.Width := Min(OLD_BMP.Width, NEW_BMP.Width);
BUFFER_BMP.Height := Min(OLD_BMP.height, NEW_BMP.height);
GetDifference(BUFFER_BMP.Canvas.Handle, OLD_BMP.Canvas.Handle, NEW_BMP.Canvas.Handle, BUFFER_BMP.Width, BUFFER_BMP.Height);
JPG.CompressionQuality := 100;
JPG.Assign(BUFFER_BMP);
end;
//Versuche Stream-Verschicken
Try
S := TMemoryStream.Create;
TCPClient.IOHandler.
Write(S);
FreeAndNil(S);
Except
ShowMessage('
Fehler: Stream konnte nicht verschickt werden.');
end;
end;
procedure TfrmMain.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
//Freigeben
OLD_BMP.Free;
NEW_BMP.Free;
BUFFER_BMP.Free;
JPG.Free;
end;
procedure TfrmMain.TCPServerExecute(AContext: TIdContext);
var
connected: boolean;
S: TMemoryStream;
begin
//"Willkommensmeldung" zur Kontrolle, ob Verbindung zum Clienten steht
AContext.Connection.IOHandler.WriteLn('
Connecting to Client ...');
connected := true;
S := TMemoryStream.Create;
while connected
do begin
try
//Versuche Stream zu empfangen
AContext.Connection.IOHandler.ReadStream(S);
JPG := TJPEGImage.Create;
JPG.LoadFromStream(S);
Windows.Beep(1000,2000);
JPG.SaveToFile('
temp.jpg');
JPG.Free;
except
ShowMessage('
Fehler: Stream konnte nicht verschickt werden.');
end;
end;
FreeAndNil(S);
end;
end.