Traducir mensajes de Outlook con Delphi

.

Para los que no quieren perder tiempo en traducir emails acudiendo a páginas web, aquí tienen un COM add-in para Outlook que usa el servicio SOAP desde http://babelfish.altavista.com/ que los traducirá directamente desde el programa Microsoft Outlook.

Para ello simplemente hay que seleccionar un mensaje de la bandeja de entrada y pulsar el botón "Traducir" que aparecerá en el menú principal del Outlook, tal como muestra la imagen del post.

Para compilarlo se necesita Delphi 6 o 7 (Enterprise) ya que ambas soportan SOAP nativamente.

El "esqueleto" de este código os puede servir para crear vuestro propio add-in.

Descargar código fuente:

http://www.dimastr.com/babelfish/download/BFOutlook_source.zip

¿Qué es un add-in? (wikipedia)
http://es.wikipedia.org/wiki/Add-in

Apagar servidor de red cuando se apaguen los terminales

-

Continuando con los posts sobre ahorro de energía os presento este software. Su función es ir comprobando continuamente el estado (ON, OFF) de cada uno de los equipos y en el momento que detecta que todos ellos están OFF ejecutará la acción de apagado del servidor que se haya definido (por defecto "shutdown -s").



Desde el archivo "parametros.ini" podemos configurar las variables necesarias para su funcionamiento (ip del servidor, acción de apagado, intervalo de comprobación, IPs de los equipos de red). Hay que tener en cuenta que este programa se deberá iniciar desde el servidor de red.

Seguramente en vuestro trabajo como administradores de redes tendréis momentos en los que están todos los terminales de red apagados y sin embargo está encendido el servidor por lo que evidentemente es un gasto energético innecesario, por tanto si aplicamos este software ahorraremos energía, evitaremos emisiones de CO2, y se amplia la vida útil del equipo al estar encendido menos horas. Un servidor de red consume aprox. 250 watios/hora por lo que el ahorro energético acumulado en un año podría llegar a ser muy importante.



Link para su descarga (código fuente en Delphi y ejecutable)

http://JJavierPareja.googlepages.com/Apagarservidor.zip

Software para backup en Delphi

--

Aquí tienen un software de backup multi-hilo con multitud de funciones. La versión 8 está bajo licencia "Mozilla Public License 1.1"

Se puede usar como aplicación o servicio y según su autor usa muy pocos recursos, puede ser iniciado en background o como aplicación independiente, también puede copiar archivos de un destino a otro en modo normal, comprimido o encriptado (utilizando diferentes métodos)

Software Cobian Backup V8.0 (código fuente y ejecutable)

http://sourceforge.net/project/showfiles.php?group_id=188619&package_id=220727&release_id=496809

Página del fabricante

http://www.educ.umu.se/~cobian/cobianbackup.htm#OS

Google Maps - API Codificación Geográfica

Excelente post de Neftalí -Germán Estévez- sobre codificación geográfica para aquellos que quieran utilizar Google Maps en sus aplicaciones Delphi. Es de lo mejor que he visto en Internet en Español sobre este tema.

El link es:
http://neftali.clubdelphi.com/?p=335

Integración con Google Maps:
http://neftali.clubdelphi.com/?p=380

Obtener las modificaciones que un usuario realiza sobre el Mapa y trasladarlas a nuestro programa en delphi:
http://neftali.clubdelphi.com/?p=413

Osciloscopio en tiempo real

Aquí os dejo un link interesante para montaros vuestro osciloscopio programado en Delphi.







Es un componente de dibujo en tiempo real y un osciloscopio virtual.



Tiene ejemplos de código para Cpp, Visual, Mathworks y por supuesto Delphi.



Se puede descargar desde aquí:

http://www.oscilloscope-lib.com/oscilloscope_DLL.zip





Página principal:

http://www.oscilloscope-lib.com/

Crea espectaculares fractales con Delphi

Aquí tienen un fantástico programa "Apophisys" para visualizar espectaculares imágenes fractales.


Con este software podrán editar, crear y renderizar fractales. Viene con muchísimos ejemplos prediseñados, a cada cual más original, pudiéndose modificar diferentes parámetros (color, gradiente, posición de la cámara, perspectiva, escala, etc.) para conseguir nuevos efectos.

Se puede descargar desde aquí, (con código fuente incluido)

http://sourceforge.net/projects/apophysis/

Links relacionados:

The fractal flame algorithm http://flam3.com/flame.pdf

Ahorrar energía con Delphi

A continuación os presento una serie de funciones para ahorrar energía en vuestros equipos.



//pasar monitor a modo de ahorro de energía

procedure modoAhorroDeEnergia;

begin SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 1);

end;



//apagar monitor

procedure apagarMonitor;

begin SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 2);

end;



//Encender monitor:

procedure encenderMonitor;

begin SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, -1);

end;





//Apagar equipo (requiere permisos administrativos)

PROCEDURE apagarEquipo;

begin

IF NOT (ExitWindowsEx(EWX_SHUTDOWN + EWX_FORCE, 0)) then

showmessage('No puedo apagar el equipo');

end;



//Reiniciar equipo

PROCEDURE ReiniciarEquipo;

begin

IF NOT (ExitWindowsEx(EWX_REBOOT, 0)) then

showmessage('No puedo reiniciar el equipo');

end;



//Devuelve TRUE si el sistema puede Hibernar

FUNCTION TForm1.SystemCanHibernate(): boolean;

RESOURCESTRING

rsDll = 'powrprof.dll';

rsFunc = 'IsPwrHibernateAllowed';

TYPE

TFunc = FUNCTION: boolean; stdcall;

VAR

func: TFunc;

hDll: THandle;

BEGIN

result := false;

hDll := LoadLibrary(PChar(rsDll));

IF (hDll <> 0) THEN

TRY

@func := GetProcAddress(hDll, PChar(rsFunc));

result := Assigned(func) AND func();

FINALLY

FreeLibrary(hDll);

END;

END;





//Devuelve TRUE si el sistema puede ser suspendido

FUNCTION tform1.SystemCanSuspend(): boolean;

RESOURCESTRING

rsDll = 'powrprof.dll';

rsFunc = 'IsPwrSuspendAllowed';

TYPE

TFunc = FUNCTION: boolean; stdcall;

VAR

func: TFunc;

hDll: THandle;

BEGIN

result := false;

hDll := LoadLibrary(PChar(rsDll));

IF (hDll <> 0) THEN

TRY

@func := GetProcAddress(hDll, PChar(rsFunc));

result := Assigned(func) AND func();

FINALLY

FreeLibrary(hDll);

END;

END;

OCR con Delphi

Aquí tenéis un OCR (Optical Character Recognition) en Delphi, que traduce lo que se ha tecleado o escrito en formato de imagen (como un bitmap) dentro de un fichero editable (texto), viene con código fuente (freeware y licencia open source)

Tiene la capacidad de aprender patrones desde un tipo y tamaño de font determinado utilizando una red neural con el algoritmo de backpropagación.

Hay que tener encuenta que el OCR no ha sido entrenado, por lo que lo primero que hay que hacer es entrenarlo para que pueda reconocer el texto.

Para ello hay que abrir la ventana "Process->Training...", seleccionar los patrones desde los fonts disponibles y el tamaño de letra (Manteniendo pulsado shift o Ctrl se seleccionan varios items), o también se puede dibujar con el ratón un patrón, y para finalizar pulsar el botón "Add Training Pairs".

Cuando estén todos items definidos (podemos probar p.ej. con los números "1,2,3,4")

pulsamos el botón "Train".

El botón "Test" prueba la red. (Es conveniente pulsarlo para ver el tanto por ciento de coincidencia del patrón con el dato de prueba)

Ventana de entrenamiento:

Seleccionar el Font, Char y Size y después pulsar "Add Training Pairs"

Ventana para teclear los datos:

Escribir con el ratón en la parte superior alguno de los números seleccionado en la pantalla anterior (con cuidado de imitar el font y su tamaño) y después activar el menú "Process->Recognize"

En la parte inferior de la ventana aparecen los caracteres reconocidos por el programa.

En este caso la coincidencia ha sido del 100 por ciento.







Descargar el programa con su código fuente:





Pruebas realizadas con Delphi 7



El programa utiliza el componente TBackProp



Autor:        Theo Zacharias (theo_yz@yahoo.com)

Descripción : TBackProp es una clase que encapsula un objeto de red neuronal backpropagation

Eventos: OnTraining, OnTrainingFinish


Propiedades: ErrorThreshold (r/w), InputLayer (r/w),
                  InputPatternHeight (r/o), InputPatternWidth (r/o),
                  KnownSymbol (r/o), LearningRate (r/w), MaxEpoch (r/w),
                  Modified (r/o), NHiddenNeuron (r/o), NInputNeuron (r/o),
                  NNeuronError (r/o), NOutputNeuron (r/o), NTrainingEpoch (r/o),
                  NTrainingNeuron (r/o), NTrainingPair (r/o), OutputLayer (r/o),
                  StopTraining (r/w), TargetClassificationError (r/w),
                  TargetPatternHeight (r/o), TargetPatternWidth (r/0),
                  TargetSquaredError (r/o), TrainingError (r/o),
                  WeightsInitFactor (r/w)


Métodos: : AddTrainingPairs, Apply, GetResult, NewKnowledge,
                  OpenKnowledge, Retrain, SaveKnowledge, Train



Descargar el componente tBackProp

Dibuja el fractal Mandelbrot con Delphi

El código fuente lo puedes descargar desde aquí

Calcular el enésimo número de fibonacci

{
Fibonacci integers are defined as:
Fibonacci Zahlen sind wie folgt definiert:

fib[n+2] = fib[n+1] + fib[n];
fib[1] = 1;
fib[0] = 1;

Example/Beispiel: fib[4] = fib[3] + fib[2] = fib[2] + fib[1] + fib[1] + fib[0] =
fib[1] + fib[0] + fib[1] + fib[1] + fib[0] = 5
}

function fibit(n: Integer): Integer;
var
a, b, i, temp: Integer;
begin
temp := 1;
a := 1;
b := 1;
for i := 1 to n - 1 do
begin
temp := a + b;
a := b;
b := temp;
end;
Result := temp;
end;

function fibrec(n: Integer): Integer;
var
temp: Integer;
begin
temp := 0;
if (n = 0) then temp := 1;
if (n = 1) then temp := 1;
if (n > 1) then temp := fibrec(n - 1) + fibrec(n - 2);
Result := temp;
end;


// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToStr(fibit(10)));
ShowMessage(IntToStr(fibrec(10)));
end;



Autor: Dev4u.ch
Homepage: http://www.dev4u.ch

Obtener punto 3 de un triángulo equilátero desde los otros 2

procedure CreateEquilateralTriangle(x1, y1, x2, y2: Double; var x3, y3: Double);
const
Sin60 = 0.86602540378443864676372317075294;
const
Cos60 = 0.50000000000000000000000000000000;
begin
{ Translate for x1,y1 to be origin }
x2 := x2 - x1;
y2 := y2 - y1;
{ Rotate 60 degrees and translate back }
x3 := ((x2 * Cos60) - (y2 * Sin60)) + x1;
y3 := ((y2 * Cos60) + (x2 * Sin60)) + y1;
end;
(* End Of Create Equilateral Triangle *)

Autor: Arash Partow
Homepage: http://www.partow.net

Ángulo creado por 3 segmentos 3D

function VertexAngle(x1, y1, z1, x2, y2, z2, x3, y3, z3: Double): Double;

var

Dist: Double;

begin

(* Quantify coordinates *)

x1 := x1 - x2;

x3 := x3 - x2;

y1 := y1 - y2;

y3 := y3 - y2;

z1 := z1 - z2;

z3 := z3 - z2;



(* Calculate Lay Distance *)

Dist := (x1 * x1 + y1 * y1 + z1 * z1) * (x3 * x3 + y3 * y3 + z3 * z3);



if IsEqual(Dist, 0) then Result := 0.0

else

Result := ArcCos((x1 * x3 + y1 * y3 + z1 * z3) / sqrt(Dist)) * _180DivPI;

end;

(* End Of VertexAngle *)

Ángulo creado por 2 segmentos 2D

function VertexAngle(x1, y1, x2, y2, x3, y3: Double): Double;
var
Dist: Double;
begin
(* Quantify coordinates *)
x1 := x1 - x2;
x3 := x3 - x2;
y1 := y1 - y2;
y3 := y3 - y2;

(* Calculate Lay Distance *)
Dist := (x1 * x1 + y1 * y1) * (x3 * x3 + y3 * y3);

if Dist = 0 then Result := 0.0
else
Result := ArcCos((x1 * x3 + y1 * y3) / sqrt(Dist)) * _180DivPI;
end;
(* End Of VertexAngle *)


Autor: Arash Partow
Homepage: http://www.partow.net

Conversor MPEG4 a AVI con Delphi

MP4Cam2AVI es un conversor de archivos con formato MPEG4 a AVI, muy útil para los que tengan cámaras mpeg4.También soporta los formatos MJPEG y H263.



Viene con código fuente y licencia GNU.



Se puede descargar desde aquí:



http://sourceforge.net/projects/mp4cam2avi/



Cosas que se pueden hacer:



- Convertir y unir videos MPEG-4 ASP desde tu cámara a un único video DivX-compatible MPEG-4 para ser visto en un PC o DVD-MPEG4 player, preservando la calidad original;

- Modo Batch para convertir varios ficheros secuencialmente;

- Convierte películas*.MP4 (MPEG4 ASP) desde Nero Recode a un formato AVI compatible para un reproductor DVD-MPEG4;

- Convierte películas MJPEG desde cámaras de fotos a un DivX-AVI compatible MPEG-4 con un clic;

- Convierte videos H.264 (MPEG-4 AVC) *.MP4 al formato H.264 AVI, que podrán ser editables con VirtualDub y reproducibles con Windows Media Player (H.264 VfW se necesitará el codec(p.ej. el último FFDShow);

- Comprueba los clips MPEG-4 ASP/MJPEG antes de la conversión usando vista previa;

- Edita clips antes de la conversión usando timeline;

- Corrige el audio/video lag de algunas cámaras como el modelo Minolta A200

- Incorpora un filtro pasa-bajo (viene perfecto para la Sanyo Xacti C1)









Formatos de cámaras soportados:

MPEG4-AVC camcorders:
Sanyo: CG65
Casio: EX-V7, EX-S880, Z1200
Others: Aiptek GO-HD
MPEG4-ASP camcorders:
Sanyo: VPC-Ñ1, C4, C40, C5, C6, HD-1, HD-2
Olympus: C770 Movie
Sony: Sony DSC-M1, M2
Pentax: OptioMX, MX4, S5n, S5z, S6, A10
Samsung: Digimax V40, V50, V70, V700, V800, U-CA5, L85, VP-MX10A
Casio: EX-P505, EX-Z750, EX-Z850, EX-S500, EX-S600
Kodak V603, Z612, Z760, Z1275
Photo cameras with H.263 video:
Kodak DX4530
Photo cameras with MOV MJPEG video
Canon Tx1, Kodak LS753, Minolta A2, Minolta Dimage Z3, Nikon Coolpix 5200, Nikon 8400, Nikon E8800, Panasonic FX7, Panasonic FZ-1, Panasonic TZ5, Pentax 750Z, Olympus C-5000/C-5050/C-8080, Olympus mini digital, Pentax Optio X, Sanyo Xacti J1, Fuji S7000.


Formatos de entrada:
File type: *.MP4, *.MOV, *.AVI, *.3GP
(3gp support is experimental, no AMR audio)
Video: MPEG4 ASP, MPEG-4 AVC, MJPEG, H.263, Sorenson Video 3
Audio: AAC, PCM, u-Law, ADPCM, MP3

Formatos de salida:
File types: *.AVI
Video: Source video or XviD MPEG-4 ASP
Audio: Source audio, PCM or MP3

Usar archivos pdf con Delphi

Para trabajar con archivos pdf dentro de tu aplicación Delphi tienen que seguir los siguientes pasos:

1) Asegurarte que tienes la última versión del programa "Adobe Acrobar Reader" (Se puede descargar gratuitamente desde la página de Adobe

2) Abrir Delphi e Importar el control ActiveX Adobe Acrobat

Menú Component->Import ActiveX Control...


Pulsa el botón "Install..." y aparecerá en la carpeta "Samples" un componente llamado TPdf.

3) Ahora ya podemos crear una nueva aplicación con un TButton, TOpenDialog y TPDF

Dentro del método Onclic del Tbutton pondremos el siguiente código:

OpenDialog1.Filter := 'PDF Files (*.pdf)*.pdf';
if OpenDialog1.Execute then Pdf1.src := OpenDialog1.FileName;

No olvidar que hay que redimensionar el componente tpdf para poder visualizar correctamente el documento pdf.

Se pueden añadir botones con las funciones: gotoFirstPage, gotoLastPage, setZoom(percent: Single) para ir a la primera, última página o para establecer un zoom.

Videos sobre Delphi 2009

Aquí tienen un video sobre el funcionamiento de diferentes componentes de la VCL de Delphi 2009.

La primera parte es una presentación en inglés durante unos minutos para luego empezar la narración en Español.

Link: http://info.danysoft.com/free/WhatsNewInTheVCL_Spanish.zip (55Mb)

Otros videos:

- 100 Delphi IDE Tips and Hints en Inglés

- Tomando ventaja con el desarrollo multicapa en Delphi.Net

- Desarrollo de aplicaciones multi-hilo con Delphi
- Centralizando acciones com ActionManager
- Compitiendo a nivel internacional con Delphi 2009

Componente para manipulacion de imagenes en Delphi

Aquí tienen un impresionante componente llamado " TEffects " para manipulación de imágenes en Delphi.

Con él se pueden realizar efectos que se ven en programas de retoque fotográfico o edición de imágenes como Corel Paintshop o Adobe Photoshop.

Notas de instalación

El uso de los ejemplos necesita previamente la instalación de las siguientes unit.

que deben ser instaladas en el siguiente orden

1. MemUtils


2. ExactTimer


3. Waiter


4. GrayBitmap


5. Shape


6. Effects


7. GraphUtils


8. FunThings

 Download FULL set

Entre otras cosas se pueden implementar los siguientes temas:

(Copiado de la página del autor)

Adjusts color information

Inverts colors

Filters colors

Rotate image to any degree

Adjusts channel colors

Fills channels

Implements transparency effect

Implements blur effect

Implements rough blur effect

Implements pixelization effect

Uploads and extracts a data of any type into a single image at binary level (cryptography)

A few fun things are in TGraphUtils and TFunThings units. These units include:

TBitmapConvertor is intended for conversions between TBitmap class and TSmallBitmap structure (TSmallBitmap is type of dynamic array that represents 32 bit image of any size)

TCustomTextConvertor is abstract class that contains base code for conversion from bitmap into colored text

TCustomTextDrawer is one more abstract class with a code for drawing of colored text on a display device context

TTextConvertor converts image into html document

TTextDrawer is descendant of TCustomTextDrawer class

TDesktopDrawer is descendant of TCustomTextDrawer class which draws text directly on the desktop.

Link de descarga del Componente:

http://www.myart.bz/pisarev.net/english/effects/0/index.htm

Trucos sobre tWebBrowser ( II )

A continuación tenéis más procedimientos relacionados con el componente tWebBrowser:

CREAR UN tWebBrowser EN RUNTIME
procedure TForm1.Button1Click(Sender: TObject);
var
wb: TWebBrowser;
begin
wb := TWebBrowser.Create(Form1);
TWinControl(wb).Name := 'MyWebBrowser';
TWinControl(wb).Parent := Form1;
wb.Align := alClient;
// TWinControl(wb).Parent := TabSheet1; ( To put it on a TabSheet )
wb.Navigate('http://delphimagic.blogspot.com');
end;

DESHACER, REHACER, SELECCIONAR TODO
Añadir
uses ActiveX;

y al final de la unit

initialization
OleInitialize(nil);
finalization
OleUninitialize;

// Deshacer
procedure TForm1.Button2Click(Sender: TObject);
begin
try
WebBrowser1.ExecWB(OLECMDID_UNDO, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;

//Rehacer
procedure TForm1.Button3Click(Sender: TObject);
begin
try
WebBrowser1.ExecWB(OLECMDID_REDO, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;


// Seleccionar todo
procedure TForm1.Button4Click(Sender: TObject);
begin
try
WebBrowser1.ExecWB(OLECMDID_SELECTALL, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;


GUARDAR TODAS LAS IMÁGENES
uses
UrlMon;

function DownloadFile(SourceFile, DestFile: string): Boolean;
begin
try
Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0,
nil) = 0;
except
Result := False;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
k, p: Integer;
Source, dest, ext: string;
begin
for k := 0 to WebBrowser1.OleObject.Document.Images.Length - 1 do
begin
Source := WebBrowser1.OleObject.Document.Images.Item(k).Src;
p := LastDelimiter('.', Source);
ext := UpperCase(Copy(Source, p + 1, Length(Source)));
if (ext = 'GIF') or (ext = 'JPG') then
begin
p := LastDelimiter('/', Source);
dest := ExtractFilePath(ParamStr(0)) + Copy(Source, p + 1,
Length(Source));
DownloadFile(Source, dest);
end;
end;
end;


HACER UN ZOOM DE UNA PÁGINA
procedure TForm1.Button1Click(Sender: TObject);
begin
//75% del tamaño original
WebBrowser1.OleObject.Document.Body.Style.Zoom := 0.75;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//Tamaño original
WebBrowser1.OleObject.Document.Body.Style.Zoom := 1;
end;


COMPROBAR QUE LA PÁGINA ES SEGURA (SSL)
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
if Webbrowser1.Oleobject.Document.Location.Protocol = 'https:' then
label1.Caption := 'Página segura'
else
label1.Caption := 'Página no segura';
end;


COMPROBAR QUE LA PÁGINA SE ENCUENTRA EN EL DISCO LOCAL
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
if Webbrowser1.Oleobject.Document.Location.Protocol = 'file:' then
begin
label1.Caption := 'El archivo está en el disco local'
end;
end;

Trucos sobre tWebBrowser

tWebBrowser es un componente de Delphi que nos permite incorporar un visualizador de páginas web dentro de nuestras aplicaciones. Depende de la habilidad de nosotros el que podamos realizar un "Internet Explorer", "Firefox", "Opera"...
En este y posteriores artículos os mostraré algunos trucos interesantes:

PROCEDIMIENTOS SOBRE IMPRESIÓN DE PÁGINAS

IMPRIME UNA PÁGINA SIN VENTANA DE DIÁLOGO
procedure TForm1.Button1Click(Sender: TObject);
var
vaIn, vaOut: OleVariant;
begin
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER,
vaIn, vaOut);
end;

IMPRIME UNA PÁGINA CON VENTANA DE DIÁLOGO
procedure TForm1.Button1Click(Sender: TObject);
var
vaIn, vaOut: OleVariant;
begin
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER,
vaIn, vaOut);
end;

IMPRIME UNA VISTA PREVIA DE LA PÁGINA
procedure TForm1.Button1Click(Sender: TObject);
var
vaIn, vaOut: OleVariant;
begin
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINTPREVIEW,
OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
end;

MUESTRA LA VENTANA "CONFIGURAR IMPRESORA"
procedure TForm1.Button1Click(Sender: TObject);
var
vaIn, vaOut: OleVariant;
begin
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_PROMPTUSER,
vaIn, vaOut);
end;


PROCEDIMIENTOS PARA EL MANEJO DEL CLIPBOARD
añadir

uses ActiveX

initialization
OleInitialize(nil);

finalization
OleUninitialize;

COPIA EL TEXTO SELECCIONADO AL CLIPBOARD
procedure TForm1.Button1Click(Sender: TObject);
begin
try
WebBrowser1.ExecWB(OLECMDID_COPY, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;

CORTA EL TEXTO SELECCIONADO AL CLIPBOARD
procedure TForm1.Button1Click(Sender: TObject);
begin
try
WebBrowser1.ExecWB(OLECMDID_CUT, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;

BORRA EL TEXTO SELECCIONADO
procedure TForm1.Button1Click(Sender: TObject);
begin
try
WebBrowser1.ExecWB(OLECMDID_DELETE, OLECMDEXECOPT_PROMPTUSER);
except
end;
end;


COMPROBAR QUE EL COMANDO "COPY" ESTÁ ACTIVO
procedure TForm1.Button1Click(Sender: TObject);
begin
if Webbrowser1.OleObject.Document.queryCommandEnabled('Copy') then
ShowMessage('Copy está activo');
end;

PROCEDIMIENTOS PARA IMPLEMENTAR LOS BOTONES "Siguiente, Anterior, Stop"
procedure TForm1.ButtonBackClick(Sender: TObject);
begin
WebBrowser1.GoBack
end;

procedure TForm1.ButtonForwardClick(Sender: TObject);
begin
WebBrowser1.GoForward
end;

procedure TForm1.ButtonCancelClick(Sender: TObject);
begin
WebBrowser1.Stop;
end;


VARIOS

IR A UNA PÁGINA WEB
WebBrowser.Navigate( URL.Text );

REEMPLAZAR LAS IMÁGENES DE UNA PÁGINA WEB
procedure TForm1.Button1Click(Sender: TObject);
var
li: Word;
begin
// Busca todas las imágenes de una página
for li := 0 to WebBrowser1.OleObject.Document.Images.Length - 1 do
// y las cambia por "MiImagen.gif"
WebBrowser1.OleObject.Document.Images.Item(0).Src := 'c:\MiImagen.gif';
end;


OCULTA LAS BARRAS DE SCROLL
procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.OleObject.Document.Body.Style.OverflowX := 'hidden';
WebBrowser1.OleObject.Document.Body.Style.OverflowY := 'hidden';
end;


GRABA UNA PÁGINA HTML EN UN ARCHIVO
uses
ActiveX, MSHTML_TLB, SHDocVw_TLB,
ComCtrls, OleCtrls;

procedure TForm1.Button1Click(Sender: TObject);
var
HTMLDocument: IHTMLDocument2;
PersistFile: IPersistFile;
begin
HTMLDocument := WebBrowser1.Document as IHTMLDocument2;
PersistFile := HTMLDocument as IPersistFile;
PersistFile.Save(StringToOleStr('c:\MiPaginaWeb.html'), System.True);
end;

DESACTIVA LOS MENUS POPUP
Poner un componente tApplicationEvents en el form y en el evento onMessage poner lo siguiente

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
if (Msg.Message = WM_RBUTTONDOWN) or (Msg.Message = WM_RBUTTONDBLCLK) then
begin
if IsChild(Webbrowser1.Handle, Msg.hwnd) then
begin
// Muestra tu propio popup o lo que tú quieras
Handled := True;
end;
end;
end;

OTRO MÉTODO PARA DESACTIVAR LAS VENTANAS EMERGENTES
En el evento OnNewWindow2 poner lo siguiente:
procedure TForm1.WebBrowserNewWindow2(Sender: TObject;var ppDisp: IDispatch; var Cancel: WordBool);
begin
Cancel := True;
end;

Webcam con Delphi ( III )

Continuando con el proyecto de manejo de una webcam con Delphi os presento el procedimiento para detener la grabación de una secuencia de video:



Tenéis que crear un tButton llamado "PararVideo" y en el evento Onclick teclear lo siguiente:



PROCEDURE TForm1.PararVideoClick(Sender: TObject);

BEGIN

IF ventana <> 0 THEN

BEGIN

SendMessage(ventana, WM_CAP_STOP, 0, 0);

END;

END;







UNIT WEBCAM

============

unit Webcam;
interface
uses
  Windows, Messages;
type
  TWebcam = class
    constructor Create(
      const WindowName: String = '';
      ParentWnd: Hwnd = 0;
      Left: Integer = 0;
      Top: Integer = 0;
      Width: Integer = 0;
      height: Integer = 0;
      Style: Cardinal = WS_CHILD or WS_VISIBLE;
      WebcamID: Integer = 0);
    public
      const
        WM_Connect     = WM_USER + 10;
        WM_Disconnect  = WM_USER + 11;
        WM_GrabFrame   = WM_USER + 60;
        WM_SaveDIB     = WM_USER + 25;
        WM_Preview     = WM_USER + 50;
        WM_PreviewRate = WM_USER + 52;
        WM_Configure   = WM_USER + 41;
    public
      procedure Connect;
      procedure Disconnect;
      procedure GrabFrame;
      procedure SaveDIB(const FileName: String = 'webcam.bmp');
      procedure Preview(&on: Boolean = True);
      procedure PreviewRate(Rate: Integer = 42);
      procedure Configure;
    private
      CaptureWnd: HWnd;
  end;
implementation
function capCreateCaptureWindowA(
  WindowName: PChar;
  dwStyle: Cardinal;
  x,y,width,height: Integer;
  ParentWin: HWnd;
  WebcamID: Integer): Hwnd; stdcall external 'AVICAP32.dll';
{ TWebcam }
procedure TWebcam.Configure;
begin
  if CaptureWnd <> 0 then
    SendMessage(CaptureWnd, WM_Configure, 0, 0);
end;
procedure TWebcam.Connect;
begin
  if CaptureWnd <> 0 then
    SendMessage(CaptureWnd, WM_Connect, 0, 0);
end;
constructor TWebcam.Create(const WindowName: String; ParentWnd: Hwnd; Left, Top,
  Width, height: Integer; Style: Cardinal; WebcamID: Integer);
begin
  CaptureWnd := capCreateCaptureWindowA(PChar(WindowName), Style, Left, Top, Width, Height,
    ParentWnd, WebcamID);
end;
procedure TWebcam.Disconnect;
begin
  if CaptureWnd <> 0 then
    SendMessage(CaptureWnd, WM_Disconnect, 0, 0);
end;
procedure TWebcam.GrabFrame;
begin
  if CaptureWnd <> 0 then
    SendMessage(CaptureWnd, WM_GrabFrame, 0, 0);
end;
procedure TWebcam.Preview(&on: Boolean);
begin
  if CaptureWnd <> 0 then
    if &on then
      SendMessage(CaptureWnd, WM_Preview, 1, 0)
    else
      SendMessage(CaptureWnd, WM_Preview, 0, 0);
end;
procedure TWebcam.PreviewRate(Rate: Integer);
begin
  if CaptureWnd <> 0 then
    SendMessage(CaptureWnd, WM_PreviewRate, Rate, 0);
end;
procedure TWebcam.SaveDIB(const FileName: String);
begin
  if CaptureWnd <> 0 then
    SendMessage(CaptureWnd, WM_SaveDIB, 0, Cardinal(PChar(FileName)));
end;
end.

=================

EJEMPLO DE USO

===============

en el evento OnCreate:

... 

  private
    { Private declarations }
  public
    { Public declarations }
    camera: TWebcam;
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  camera := TWebcam.Create('WebCaptured', Panel1.Handle, 0, 0,
    1000, 1000);
end;

ENCENDIDO Y APAGADO DE LA CAMARA:

================================= 

procedure TForm1.Button1Click(Sender: TObject);
const
  str_Connect = 'Encender la camara';
  str_Disconn = 'Apagar la camara';
begin
  if (Sender as TButton).Caption = str_Connect then  begin
    camera.Connect;
    camera.Preview(true);
    Camera.PreviewRate(4);
    (Sender as TButton).Caption:=str_Disconn;
  end
  else begin
    camera.Disconnect;
    (Sender as TButton).Caption:=str_Connect;
  end;
end; 

CAPTURA DE LA FOTO

==================

procedure TForm1.Button2Click(Sender: TObject);
var
  PanelDC: HDC;
begin
if not Assigned(Image1.Picture.Bitmap) then
    Image1.Picture.Bitmap := TBitmap.Create
  else
  begin
    Image1.Picture.Bitmap.Free;
    Image1.picture.Bitmap := TBitmap.Create;
  end;
  Image1.Picture.Bitmap.Height := Panel1.Height;
  Image1.Picture.Bitmap.Width  := Panel1.Width;
  Image1.Stretch := True;
  PanelDC := GetDC(Panel1.Handle);
  try
    BitBlt(Image1.Picture.Bitmap.Canvas.Handle,
      0,0,Panel1.Width, Panel1.Height, PanelDC, 0,0, SRCCOPY);
  finally
    ReleaseDC(Handle, PanelDC);
  end;
end;