Follow with the project management of a webcam with Delphi I present the procedure to stop recording a video sequence:
You have to create a TButton called "PararVideo" and in the onclick event type the following:
PROCEDURE TForm1.PararVideoClick(Sender: TObject);
BEGIN
IF ventana <> 0 THEN
BEGIN
SendMessage(ventana, WM_CAP_STOP, 0, 0);
END;
END;
Related links
Webcam con Delphi ( I )
Webcam con Delphi ( II )
Webcam with Delphi ( II )
Below you will see new uses for using a webcam with Delphi.
STORING A SEQUENCE OF VIDEO
New components of the form:
tSaveDialog,Properties:
- Name = Guardar
tButtonProperties:
- Name = BtnAlmacenarVideo
- Caption = AlmacenarVideo
In the Onclic event of the TButton write:
Save a picture from the capture window
Add a tButton
tButtonProperties:
- Name = BtnGuardarImagen
- Caption = Guardar Imagen
Code of the Botón
Related articles
Webcam con Delphi ( I )
Webcam con Delphi ( III )
STORING A SEQUENCE OF VIDEO
New components of the form:
tSaveDialog,Properties:
- Name = Guardar
tButtonProperties:
- Name = BtnAlmacenarVideo
- Caption = AlmacenarVideo
In the Onclic event of the TButton write:
PROCEDURE TForm1.BtnAlmacenarVideoClick(Sender: TObject);
BEGIN
IF Ventana <> 0 THEN
BEGIN
Guardar.Filter := 'Fichero AVI (*.avi)*.avi';
Guardar.DefaultExt := 'avi';
Guardar.FileName := 'FicheroAvi';
IF Guardar.Execute THEN
BEGIN
SendMessage(Ventana, WM_CAP_FILE_SET_CAPTURE_FILEA, 0,
Longint(pchar(Guardar.Filename)));
SendMessage(Ventana, WM_CAP_SEQUENCE, 0, 0);
END;
END;
END;
Save a picture from the capture window
Add a tButton
tButtonProperties:
- Name = BtnGuardarImagen
- Caption = Guardar Imagen
Code of the Botón
PROCEDURE TForm1.BtnGuardarImagenClick(Sender: TObject); BEGIN IF Ventana <> 0 THEN BEGIN Guardar.FileName := 'Captura de la imagen'; Guardar.DefaultExt := 'bmp'; Guardar.Filter := 'Fichero Bitmap (*.bmp)*.bmp'; IF Guardar.Execute THEN SendMessage(Ventana, WM_CAP_SAVEDIB, 0, longint(pchar(Guardar.FileName))); END; END;
Related articles
Webcam con Delphi ( I )
Webcam con Delphi ( III )
Webcam with Delphi (I)
I present you the software that allows manage your Webcam with Delphi.
First you have to install the software on your system "Microsoft Video for Windows SDK" that contains the library avicap32.dll.
Among the functions contained use "capCreateCaptureWindowA" to initialize the driver and image capture.
After handling the capture window will have to use the "SendMessage" making it easier and greatly simplifies the developers work.
First you have to install the software on your system "Microsoft Video for Windows SDK" that contains the library avicap32.dll.
Among the functions contained use "capCreateCaptureWindowA" to initialize the driver and image capture.
After handling the capture window will have to use the "SendMessage" making it easier and greatly simplifies the developers work.
Now we are goint to the program:
We add global variables:
Ventana: hwnd; //Handle de la ventana de captura
In the section "const" we write
WM_CAP_START = WM_USER;
WM_CAP_STOP = WM_CAP_START + 68;
WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
WM_CAP_SAVEDIB = WM_CAP_START + 25;
WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
WM_CAP_SEQUENCE = WM_CAP_START + 62;
WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
WM_CAP_EDIT_COPY = WM_CAP_START + 30;
WM_CAP_SET_PREVIEW = WM_CAP_START + 50;
WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52;
Section "implementation":
FUNCTION capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint; x: integer; y: integer; nWidth: integer; nHeight: integer; ParentWin: HWND; nId: integer): HWND; STDCALL EXTERNAL 'AVICAP32.DLL';
is the call of the external library Avicap32.dll
Elements of the interface:
-Botón "iniciar" (Pressing start capturing the image from the Webcam)
-Botón "detener" (Press to stop capturing)
-Control de Imagen "tImage" (We called "Image1")
We add global variables:
Ventana: hwnd; //Handle de la ventana de captura
In the section "const" we write
WM_CAP_START = WM_USER;
WM_CAP_STOP = WM_CAP_START + 68;
WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
WM_CAP_SAVEDIB = WM_CAP_START + 25;
WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
WM_CAP_SEQUENCE = WM_CAP_START + 62;
WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
WM_CAP_EDIT_COPY = WM_CAP_START + 30;
WM_CAP_SET_PREVIEW = WM_CAP_START + 50;
WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52;
Section "implementation":
FUNCTION capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint; x: integer; y: integer; nWidth: integer; nHeight: integer; ParentWin: HWND; nId: integer): HWND; STDCALL EXTERNAL 'AVICAP32.DLL';
is the call of the external library Avicap32.dll
Elements of the interface:
-Botón "iniciar" (Pressing start capturing the image from the Webcam)
-Botón "detener" (Press to stop capturing)
-Control de Imagen "tImage" (We called "Image1")
The code to be included within the buttons is as follows:
Botón "Iniciar"
PROCEDURE TForm1.Button1Click(Sender: TObject);
BEGIN
Ventana := capCreateCaptureWindowA('Ventana de captura',
WS_CHILD OR WS_VISIBLE, image1.Left, image1.Top, image1.Width,
image1.Height, form1.Handle, 0);
IF Ventana <> 0 THEN
BEGIN
TRY
SendMessage(Ventana, WM_CAP_DRIVER_CONNECT, 0, 0);
SendMessage(Ventana, WM_CAP_SET_PREVIEWRATE, 40, 0);
SendMessage(Ventana, WM_CAP_SET_PREVIEW, 1, 0);
EXCEPT
RAISE;
END;
END
ELSE
BEGIN
MessageDlg('Error al conectar Webcam', mtError, [mbok], 0);
END;
END;
Botón "Detener"
PROCEDURE TForm1.Button2Click(Sender: TObject);
BEGIN
IF Ventana <> 0 THEN
BEGIN
SendMessage(Ventana, WM_CAP_DRIVER_DISCONNECT, 0, 0);
Ventana := 0;
END;
END;
In the event: Onclose we make a call to the procedure included in the button "Detener".
And that's all for now, we will be adding more items and tips.
Related links:
Webcam con Delphi ( II )
WebCam con Delphi ( III )
Chess with Delphi
Fans of the fascinating game of chess, here is a component that allows you to program it. The course software meets the basic rules of the game and also includes castling, eating the way, etc ...
You can also view the board from the point of view of the opponent, show / hide coordinates and change the design of the pieces.
Another good features it has, is that you can modify the depth of finding the best move to make it more "intelligent".
Download click on the following link (source code included)
http://JJavierPareja.googlepages.com/chessbrd.zip
You can also view the board from the point of view of the opponent, show / hide coordinates and change the design of the pieces.
Another good features it has, is that you can modify the depth of finding the best move to make it more "intelligent".
http://JJavierPareja.googlepages.com/chessbrd.zip
How to use IBDataset with a DataModule
Steps:
1 .- a Cree First Data Module, which will contain all components DB (querys, tables etc.). Ok
2 .- in the data block put the IBDataBase which will be used solely to be used throughout your application (the only other non habra ok)
3. Module in the same data (DataModule) put the IBQuerys the IBUpdates and IBTransaction .. OK
in IBQuery.SQL there you can put your select * from table (eye code but not under the inspector objects) ok.
4 .- then put the IBUpdateSQL connected to that query ok ..
5 .- then add your form unity Module data you created, so that they can gain access to components put in DataModule ok. (Uses name of the unit)
6 .- as you put the following components:
DataSource which connects to the IBQuery ok, then put a DBEdit this connect to the DataSource and then select the field you want to display in DBEdit (DataSource properties and DataField respectively)
7. There are other components as DBGrid and DBNavigator lso which connect like the DBEdit ok.
Well this is Oriented Programming to objects and thus do not have to do this to me mention:
With IBDataset1 do
Try
DisableControls;
SelectSQL.Add ( 'Select *');
SelectSQL.Add ( 'FROM products');
SelectSQL.Add ( 'where Name =' + Combobox1.Text);
Edit1.Text: = FloatToStr (IBDataset1.Fields.Fields [3]. AsFloat);
Finally
EnableControls;
End;
1 .- a Cree First Data Module, which will contain all components DB (querys, tables etc.). Ok
2 .- in the data block put the IBDataBase which will be used solely to be used throughout your application (the only other non habra ok)
3. Module in the same data (DataModule) put the IBQuerys the IBUpdates and IBTransaction .. OK
in IBQuery.SQL there you can put your select * from table (eye code but not under the inspector objects) ok.
4 .- then put the IBUpdateSQL connected to that query ok ..
5 .- then add your form unity Module data you created, so that they can gain access to components put in DataModule ok. (Uses name of the unit)
6 .- as you put the following components:
DataSource which connects to the IBQuery ok, then put a DBEdit this connect to the DataSource and then select the field you want to display in DBEdit (DataSource properties and DataField respectively)
7. There are other components as DBGrid and DBNavigator lso which connect like the DBEdit ok.
Well this is Oriented Programming to objects and thus do not have to do this to me mention:
With IBDataset1 do
Try
DisableControls;
SelectSQL.Add ( 'Select *');
SelectSQL.Add ( 'FROM products');
SelectSQL.Add ( 'where Name =' + Combobox1.Text);
Edit1.Text: = FloatToStr (IBDataset1.Fields.Fields [3]. AsFloat);
Finally
EnableControls;
End;
Retrieve all image links from an HTML document
uses mshtml, ActiveX, COMObj, IdHTTP, idURI;
{ .... }
procedure GetImageLinks(AURL: string; AList: TStrings);
var
IDoc: IHTMLDocument2;
strHTML: string;
v: Variant;
x: Integer;
ovLinks: OleVariant;
DocURL: string;
URI: TidURI;
ImgURL: string;
idHTTP: TidHTTP;
begin
AList.Clear;
URI := TidURI.Create(AURL);
try
DocURL := 'http://' + URI.Host;
if URI.Path <> '/' then
DocURL := DocURL + URI.Path;
finally
URI.Free;
end;
Idoc := CreateComObject(Class_HTMLDocument) as IHTMLDocument2;
try
IDoc.designMode := 'on';
while IDoc.readyState <> 'complete' do
Application.ProcessMessages;
v := VarArrayCreate([0, 0], VarVariant);
idHTTP := TidHTTP.Create(nil);
try
strHTML := idHTTP.Get(AURL);
finally
idHTTP.Free;
end;
v[0] := strHTML;
IDoc.Write(PSafeArray(System.TVarData(v).VArray));
IDoc.designMode := 'off';
while IDoc.readyState <> 'complete' do
Application.ProcessMessages;
ovLinks := IDoc.all.tags('IMG');
if ovLinks.Length > 0 then
begin
for x := 0 to ovLinks.Length - 1 do
begin
ImgURL := ovLinks.Item(x).src;
// The stuff below will probably need a little tweaking
// Deteriming and turning realtive URLs into absolute URLs
// is not that difficult but this is all I could come up with
// in such a short notice.
if (ImgURL[1] = '/') then
begin
// more than likely a relative URL so
// append the DocURL
ImgURL := DocURL + ImgUrl;
end
else
begin
if (Copy(ImgURL, 1, 11) = 'about:blank') then
begin
ImgURL := DocURL + Copy(ImgUrl, 12, Length(ImgURL));
end;
end;
AList.Add(ImgURL);
end;
end;
finally
IDoc := nil;
end;
end;
// Beispiel:
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
GetImageLinks('http://delphimagic.blogspot.com', Memo1.Lines);
end;
{ .... }
procedure GetImageLinks(AURL: string; AList: TStrings);
var
IDoc: IHTMLDocument2;
strHTML: string;
v: Variant;
x: Integer;
ovLinks: OleVariant;
DocURL: string;
URI: TidURI;
ImgURL: string;
idHTTP: TidHTTP;
begin
AList.Clear;
URI := TidURI.Create(AURL);
try
DocURL := 'http://' + URI.Host;
if URI.Path <> '/' then
DocURL := DocURL + URI.Path;
finally
URI.Free;
end;
Idoc := CreateComObject(Class_HTMLDocument) as IHTMLDocument2;
try
IDoc.designMode := 'on';
while IDoc.readyState <> 'complete' do
Application.ProcessMessages;
v := VarArrayCreate([0, 0], VarVariant);
idHTTP := TidHTTP.Create(nil);
try
strHTML := idHTTP.Get(AURL);
finally
idHTTP.Free;
end;
v[0] := strHTML;
IDoc.Write(PSafeArray(System.TVarData(v).VArray));
IDoc.designMode := 'off';
while IDoc.readyState <> 'complete' do
Application.ProcessMessages;
ovLinks := IDoc.all.tags('IMG');
if ovLinks.Length > 0 then
begin
for x := 0 to ovLinks.Length - 1 do
begin
ImgURL := ovLinks.Item(x).src;
// The stuff below will probably need a little tweaking
// Deteriming and turning realtive URLs into absolute URLs
// is not that difficult but this is all I could come up with
// in such a short notice.
if (ImgURL[1] = '/') then
begin
// more than likely a relative URL so
// append the DocURL
ImgURL := DocURL + ImgUrl;
end
else
begin
if (Copy(ImgURL, 1, 11) = 'about:blank') then
begin
ImgURL := DocURL + Copy(ImgUrl, 12, Length(ImgURL));
end;
end;
AList.Add(ImgURL);
end;
end;
finally
IDoc := nil;
end;
end;
// Beispiel:
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
GetImageLinks('http://delphimagic.blogspot.com', Memo1.Lines);
end;
Delphi magic packet : wake on lan
//Function HexToInt used in this procedure is defined in
//the category "Conversions" of this web
PROCEDURE WakeUPComputer(aMacAddress: STRING);
VAR
i, j: Byte;
//lBuffer: array[1..116] of Byte;
lBuffer: SysUtils.TBytes;
lUDPClient: TIDUDPClient;
BEGIN
TRY
FOR i := 1 TO 6 DO BEGIN
lBuffer[i] := HexToInt(aMacAddress[(i * 2) - 1] + aMacAddress[i * 2]); END;
lBuffer[7] := $00;
lBuffer[8] := $74;
lBuffer[9] := $FF;
lBuffer[10] := $FF;
lBuffer[11] := $FF;
lBuffer[12] := $FF;
lBuffer[13] := $FF;
lBuffer[14] := $FF;
FOR j := 1 TO 16 DO BEGIN
FOR i := 1 TO 6 DO BEGIN
lBuffer[15 + (j - 1) * 6 + (i - 1)] := lBuffer[i];
END;
END;
lBuffer[116] := $00;
lBuffer[115] := $40;
lBuffer[114] := $90;
lBuffer[113] := $90;
lBuffer[112] := $00;
lBuffer[111] := $40;
TRY
lUDPClient := TIdUDPClient.Create(NIL);
lUDPClient.BroadcastEnabled := true;
lUDPClient.Host := '255.255.255.255';
lUDPClient.Port := 2050;
// d6 lUDPClient.SendBuffer(lBuffer, 116);
lUDPClient.SendBuffer(lUDPClient.Host, lUDPClient.Port, tidbytes(lBuffer));
FINALLY
lUDPClient.Free;
END;
EXCEPT
RAISE;
END;
END;
//the category "Conversions" of this web
PROCEDURE WakeUPComputer(aMacAddress: STRING);
VAR
i, j: Byte;
//lBuffer: array[1..116] of Byte;
lBuffer: SysUtils.TBytes;
lUDPClient: TIDUDPClient;
BEGIN
TRY
FOR i := 1 TO 6 DO BEGIN
lBuffer[i] := HexToInt(aMacAddress[(i * 2) - 1] + aMacAddress[i * 2]); END;
lBuffer[7] := $00;
lBuffer[8] := $74;
lBuffer[9] := $FF;
lBuffer[10] := $FF;
lBuffer[11] := $FF;
lBuffer[12] := $FF;
lBuffer[13] := $FF;
lBuffer[14] := $FF;
FOR j := 1 TO 16 DO BEGIN
FOR i := 1 TO 6 DO BEGIN
lBuffer[15 + (j - 1) * 6 + (i - 1)] := lBuffer[i];
END;
END;
lBuffer[116] := $00;
lBuffer[115] := $40;
lBuffer[114] := $90;
lBuffer[113] := $90;
lBuffer[112] := $00;
lBuffer[111] := $40;
TRY
lUDPClient := TIdUDPClient.Create(NIL);
lUDPClient.BroadcastEnabled := true;
lUDPClient.Host := '255.255.255.255';
lUDPClient.Port := 2050;
// d6 lUDPClient.SendBuffer(lBuffer, 116);
lUDPClient.SendBuffer(lUDPClient.Host, lUDPClient.Port, tidbytes(lBuffer));
FINALLY
lUDPClient.Free;
END;
EXCEPT
RAISE;
END;
END;
Free textures
Check out this site for free textures:http://www.3dlinks.com/links.cfm?categoryid=10&subcategoryid=94
Turbosquid is a commercial site that sells textures but they also host free ones. You need to open a free account here.http://www.turbosquid.com/
Turbosquid is a commercial site that sells textures but they also host free ones. You need to open a free account here.http://www.turbosquid.com/
Where to get free 3D models
For hundreds of free static models (eg an apple) http://www.3dcafe.com/
NTU 3D Model Database has a massive database of wavefront free models:http://3d.csie.ntu.edu.tw/~dynamic/database/index.html
Turbosquid is a commercial site that sells 3D models but they also host free ones. You need to open a free account here.http://www.turbosquid.com/
Also from the NTU 3D Model Database but with pictures and also only has the first 1000 models from the database:http://www.skinhat.com/freemodels
For actors (eg Quake, Half life models) - Currently down :http://www.planetquake.com/polycount/
NTU 3D Model Database has a massive database of wavefront free models:http://3d.csie.ntu.edu.tw/~dynamic/database/index.html
Turbosquid is a commercial site that sells 3D models but they also host free ones. You need to open a free account here.http://www.turbosquid.com/
Also from the NTU 3D Model Database but with pictures and also only has the first 1000 models from the database:http://www.skinhat.com/freemodels
For actors (eg Quake, Half life models) - Currently down :http://www.planetquake.com/polycount/
Get the keyboard input language
When my application starts, I need to switch the keyboard language to Greek. Currently I use the statement ActivateKeyboardlayout(0, 0). When I need to switch to English (when the application terminates) I execute the same statement one more time. This works fine, but only if the language before the application's execution is English. So, before the call of the statement, I need to know if the language is Greek or English. How can do this?
I usually use the following cycle:
{ ... }
GetKeyboardLayoutName(@t);
y := string(t);
repeat
ActivateKeyboardLayout(HKL_NEXT, 0);
GetKeyboardLayoutName(@t);
x := string(t);
until
((x = y) or (x = '00000405'));
{ ... }
Using this, the English keyboard will give the KeyboardLayoutName '00000409' and the Greek one the '000000408'. These are standard language identifiers. They're the same on any Windows machine.
To display the information, you could use this little trick:
{ ... }
var
kbd: array[0..2] of Char;
begin
GetLocaleInfo(loWord(GetKeyboardLayout(0)), LOCALE_SENGLANGUAGE, kbd, 2);
Form1.Caption := kbd;
{ ... }
Author: Lou Adler
Product: Delphi 7.x (or higher)
I usually use the following cycle:
{ ... }
GetKeyboardLayoutName(@t);
y := string(t);
repeat
ActivateKeyboardLayout(HKL_NEXT, 0);
GetKeyboardLayoutName(@t);
x := string(t);
until
((x = y) or (x = '00000405'));
{ ... }
Using this, the English keyboard will give the KeyboardLayoutName '00000409' and the Greek one the '000000408'. These are standard language identifiers. They're the same on any Windows machine.
To display the information, you could use this little trick:
{ ... }
var
kbd: array[0..2] of Char;
begin
GetLocaleInfo(loWord(GetKeyboardLayout(0)), LOCALE_SENGLANGUAGE, kbd, 2);
Form1.Caption := kbd;
{ ... }
Author: Lou Adler
Product: Delphi 7.x (or higher)
Suscribirse a:
Entradas (Atom)