Mostrando entradas con la etiqueta Webcam. Mostrar todas las entradas
Mostrando entradas con la etiqueta Webcam. Mostrar todas las entradas

Efectos con Scanline




 How to use ScanLine property for 24-bit bitmaps? - Stack Overflow



Tbitmap.scanline es una propiedad indexada de solo lectura que devuelve un puntero a una fila de pixeles de un bitmap.
Es la forma más rápida de acceder a los píxeles de una imagen aunque depende del formato de mapa de bits que se establezca desde la propiedad Pixelformat de la unit Graphics.

TPixelFormat = (pfDevice, pf1bit, pf4bit, pf8bit, pf15bit, pf16bit, pf24bit, pf32bit, pfCustom);

Ejemplo de carga un bitmap:

VAR
  bmp: tbitmap;
BEGIN
  bmp := tbitmap.Create;
  TRY
    IF OpenDialog1.Execute THEN
    BEGIN
      bmp.LoadFromFile(OpenDialog1.FileName);
      bmp.PixelFormat := pf24bit;
      Invalidate; { Mostrar la imagen }
    END;
  FINALLY
    bmp.Free;
  END;
END;
 



Cuando
creamos un mapa de bits cada pixel se inicializa al máximo valor, es
decir a 255 por eso el mapa de bits es blanco, ese el formato de pixel
predeterminado.


Un pixel en un mapa de bits de 24 bits se describe con 3 valores rojo, verde y azul, que se almacenan en la memoria en orden inverso: azul, verde y rojo.
El puntero a la matriz de bytes que hace scanline se vería de la siguiente forma:
 





Para obtener el resultado anterior hay que asignar el resultado de Scanline a un puntero de bytes: pByteArray

  VAR
    p: PByteArray;
  BEGIN
    p := FImage.ScanLine[0];
  END;

Por ejemplo para poner el primer pixel de la primera fila de la imagen de color negro y el segundo de color blanco habría que hacer:


VAR
  p: PByteArray;
BEGIN
  p := FImage.ScanLine[0]; { lee la primera fila }
  p[0] := 0; { primer pixel de color negro }
  p[1] := 0;
  p[2] := 0;
  p[3] := 255; { segundo pixel de color blanco }
  p[4] := 255;
  p[5] := 255;
  Invalidate;
END;


También podemos usar la siguiente estructura:



 type
  TRGBTriple = packed record
    rgbtBlue: Byte;
    rgbtGreen: Byte;
    rgbtRed: Byte;
  end;

Para conseguir que la segunda fila del bitmap sea de color negro:

type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..4095] of TRGBTriple;

procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
  Bitmap: TBitmap;
  Pixels: PRGBTripleArray;
begin
  Bitmap := TBitmap.Create;
  try
    Bitmap.Width := 3;
    Bitmap.Height := 2;
    Bitmap.PixelFormat := pf24bit;
    // get pointer to the second row's raw data
    Pixels := Bitmap.ScanLine[1];
    // iterate our row pixel data array in a whole width
    for I := 0 to Bitmap.Width - 1 do
    begin
      Pixels[I].rgbtBlue := 0;
      Pixels[I].rgbtGreen := 0;
      Pixels[I].rgbtRed := 0;
    end;
    Bitmap.SaveToFile('c:\Image.bmp');
  finally
    Bitmap.Free;
  end;
end;
 



De lo anterior podemos observar que el primer pixel del bitmap se encuentra en el offset 0 de la primera fila, el segundo en el offset 3, el tercero en el offset 6 esto quiere decir que el byte en la ubicación x*3 es el componente azul, el byte de la ubicación x*3+1 es el componente verde y el x*3+2 es el rojo.

Entonces si quisiéramos poner una imagen en color negro habría que hacer lo siguiente:

VAR
  p: PByteArray;
  x: Integer;
  y: Integer;
BEGIN { Iterar entre todas las líneas}
  FOR y := 0 TO Pred(FImage.Height) DO
  BEGIN
    p := FImage.ScanLine[y];
    FOR x := 0 TO Pred(FImage.Width) DO
    BEGIN
      p[x * 3] := 0;
      p[x * 3 + 1] := 0;
      p[x * 3 + 2] := 0;
    END;
 END;
END;
 



Ahora vamos a profundizar un poco más en este aspecto, hemos visto que cambiando los valores de los bytes de un pixel podemos conseguir los diferentes tipos de colores y si vamos un poco más allá conseguiremos espectaculares efectos visuales como los siguientes:


- Solarize

VAR
  p: PByteArray;
  x: Integer;
  y: Integer;
BEGIN
  FOR y := 0 TO Pred(FImage.Height) DO
  BEGIN
    p := FImage.ScanLine[y];
    FOR x := 0 TO Pred(FImage.Width) DO
    BEGIN
      IF p[x * 3] > 127 THEN
        p[x * 3] := 255 - p[x * 3];
      IF p[x * 3 + 1] > 127 THEN
        p[x * 3 + 1] := 255 - p[x * 3 + 1];
      IF p[x * 3 + 2] > 127 THEN
        p[x * 3 + 2] := 255 - p[x * 3 + 2];
    END;
  END;
END;




- Invertir colores

 
VAR
  p: PByteArray;
  x: Integer;
  y: Integer;
BEGIN
  FOR y := 0 TO Pred(FImage.Height) DO
  BEGIN { get the pointer to the y line }
    p := FImage.ScanLine[y];
    FOR x := 0 TO Pred(FImage.Width) DO
    BEGIN { modificar el color azul }
      p[x * 3] := 255 - p[x * 3]; { modificar el color verde  }
      p[x * 3 + 1] := 255 - p[x * 3 + 1]; { modificar el color rojo  }
      p[x * 3 + 2] := 255 - p[x * 3 + 2];
    END;
  END;
END;




- Convertir a escala de grises



 Se hace con la siguiente fórmula
Gray = (Red * 3 + Blue * 4 + Green * 2) div 9

VAR
  p: PMyPixelArray;
  x: Integer;
  y: Integer;
  gray: Integer;
BEGIN
  FOR y := 0 TO Pred(FImage.Height) DO
  BEGIN
    p := FImage.ScanLine[y];
    FOR x := 0 TO Pred(FImage.Width) DO
      WITH p[x] DO
      BEGIN
        gray := (Red * 3 + Blue * 4 + Green * 2) DIV 9;
        Blue := gray;
        Red := gray;
        Green := gray;
      END;
  END;
END;






- Hacer un espejo vertical



  procedure TForm1.Button1Click(Sender: TObject);

   procedure EspejoVertical(Origen,Destino:TBitmap);
   var
      x,y          : integer;
      Alto         : integer;
      Po,Pd        : PByteArray;
      tmpBMP       : TBitmap;
      LongScan     : integer;
   begin
     {Si es un modo raro... pasamos}
     case Origen.PixelFormat of
       pfDevice,
       pfCustom:
         Raise exception.create( 'Formato no soportado'+#13+
                                 'Bitmap Format not valid');
     end;

     {Calculamos variables intermedias}
     Alto :=Image1.Picture.Bitmap.Height-1;
     try
       {Calculo de cuánto ocupa un scan}
       LongScan:= Abs( Integer(Origen.ScanLine[0])-
                       Integer(Origen.ScanLine[1]) );
     except
       Raise exception.create( 'ScanLine Error...');
     end;

     {Cremos un bitmap intermedio}
     tmpBMP:=TBitmap.Create;
     with tmpBMP do
     begin
       {Lo asignamos, así se copia la paleta si la hay}
       Assign(Origen);
       {Esto es para que sea un bitmap nuevo... es un bug de D3 y D4}
       Canvas.Pixels[0,0]:=Origen.Canvas.Pixels[0,0];
     end;

     {Damos la vuelta al bitmap}
     for y:=0 to Alto do
     begin
       Po := Origen.ScanLine[y];
       Pd := tmpBMP.ScanLine[Alto-y];
       for x := 0 to LongScan-1 do
       begin
           Pd^[X]:=Po^[X];
       end;
     end;
     {Lo asignamos al bitmap destino}
     Destino.Assign(tmpBMP);
     {Esto es para parchear un bug de Delphi 3 y Delphi4...}
     Destino.Canvas.Pixels[0,0]:=tmpBMP.Canvas.Pixels[0,0];
     tmpBMP.Free;
   end;
 begin
   EspejoVertical( Image1.Picture.Bitmap,
                   Image1.Picture.Bitmap);
   Image1.Refresh;
 end;






- Ajustar el brillo  



 Se hace con la siguiente fórmula:
NewPixel = OldPixel + (1 * Percent) div 200



FUNCTION IntToByte(AInteger: Integer): Byte; INLINE;
BEGIN
  IF AInteger > 255 THEN
    Result := 255
  ELSE IF AInteger < 0 THEN
    Result := 0
  ELSE
    Result := AInteger;
END;

PROCEDURE TMainForm.AdjustBrightness(Percent: Integer);
VAR
  p: PMyPixelArray;
  x: Integer;
  y: Integer;
  amount: Integer;
BEGIN
  amount := (255 * Percent) DIV 200;
  FOR y := 0 TO Pred(FImage.Height) DO
  BEGIN
    p := FImage.ScanLine[y];
    FOR x := 0 TO Pred(FImage.Width) DO
      WITH p[x] DO
      BEGIN
        Blue := IntToByte(Blue + amount);
        Green := IntToByte(Green + amount);
        Red := IntToByte(Red + amount);
      END;
  END;
  Invalidate;
END;

PROCEDURE TMainForm.ScanLineBrightnessClick(Sender: TObject);
VAR
  amount: Integer;
BEGIN
  amount := StrToInt(InputBox('Brightness Level', 'Enter a value from -100 to 100:', '50'));
  AdjustBrightness(amount);
END;

Como instalar el componente tProeffectimage

Continuando con el post de ayer

http://delphimagic.blogspot.com/2011/05/programa-para-generar-efectos-graficos.html

a continuación os muestro cómo instalarlo en Windows XP:



Instalación en Delphi 7:



1) Abrimos el archivo dclusr.dpk que está en

c:\archivos de programa\borland\delphi7\lib

2) En la ventana que nos aparece pulsamos el botón "Add"

3) Desde la pestaña "Add unit" y en la caja "Unit File name" localizamos el archivo Proeffectimage.pas y pulsamos el botón OK

4) Después pulsamos el botón "Compile" y "Install" y si todo está correcto veremos en la pestaña de componentes "Samples" el icono Proeffectimage.



Instalación en Delphi 2009:



Es prácticamente igual lo que cambia es que hay que abrir el archivo dclusr.dproj que está en

c:\archivos de programa\CodeGear\RadStudio\6.0\lib

y después hay que ir al menú View->Project Manager












Programa para generar efectos gráficos


Con el componente freeware tProeffectimage escrito por Babak Sateli podrán generar alucinantes efectos gráficos en sus programas, además de una manera muy sencilla ya que lo único que hay que hacer es añadir un trackbar para obtener el parámetro asociado a cada una de las funciones ( está probado en Delphi 7 y Delphi 2009) :



El siguiente código viene en el ejemplo que acompaña a la instalación:



Case EffectsList.ItemIndex of

0: ProEffectImage.Effect_GaussianBlur (TrackBar.Position);

1: ProEffectImage.Effect_SplitBlur (TrackBar.Position);

2: ProEffectImage.Effect_AddColorNoise (TrackBar.Position * 3);

3: ProEffectImage.Effect_AddMonoNoise (TrackBar.Position * 3);

4: For i:=1 to TrackBar.Position do

ProEffectImage.Effect_AntiAlias;

5: ProEffectImage.Effect_Contrast (TrackBar.Position * 3);

6: ProEffectImage.Effect_FishEye (TrackBar.Position div 10+1);

7: ProEffectImage.Effect_Lightness (TrackBar.Position * 2);

8: ProEffectImage.Effect_Darkness (TrackBar.Position * 2);

9: ProEffectImage.Effect_Saturation (255-((TrackBar.Position * 255) div 100));

10: ProEffectImage.Effect_Mosaic (TrackBar.Position div 2);

11: ProEffectImage.Effect_Twist (200-(TrackBar.Position * 2)+1);

12: ProEffectImage.Effect_Splitlight (TrackBar.Position div 20);

13: ProEffectImage.Effect_Tile (TrackBar.Position div 10);

14: ProEffectImage.Effect_SpotLight (TrackBar.Position ,

Rect (TrackBar.Position ,

TrackBar.Position ,

TrackBar.Position +TrackBar.Position*2,

TrackBar.Position +TrackBar.Position*2));

15: ProEffectImage.Effect_Trace (TrackBar.Position div 10);

16: For i:=1 to TrackBar.Position do

ProEffectImage.Effect_Emboss;

17: ProEffectImage.Effect_Solorize (255-((TrackBar.Position * 255) div 100));

18: ProEffectImage.Effect_Posterize (((TrackBar.Position * 255) div 100)+1);

19: ProEffectImage.Effect_Grayscale;

20: ProEffectImage.Effect_Invert;



end;{Case}



Fuente:

babak_sateli@yahoo.com

http://raveland.netfirms.com




Descargar codigo











Detector de movimiento con Delphi



Este software detecta el movimiento entre imágenes tomadas por una webcam, se pueden ajustar varios parámetros como la sensibilidad, pixels verificados y el retardo antes de avisar. Cuando salta un aviso nos enviará un email ( antes hay que cambiar el nombre del host SMTP ) y se guardará en la carpeta "detection" una imagen jpg de ese instante.

Es interesante observar cómo se inicializa el dispositivo de captura de imagen de la siguiente forma:



hcam:=capCreateCaptureWindowA('',0,0,0,320,240,handle,0);

sendmessage(hcam,1034,0,0);

form1.DoubleBuffered:=true;



Descargar codigo fuente


















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;

 




Webcam con Delphi ( II )

A continuación os muestro nuevas utilidades para usar una webcam con Delphi.



ALMACENAR UNA SECUENCIA DE VIDEO

Nuevos componentes del form:



tSaveDialog,Definición de propiedades:

- Name = Guardar



tButtonDefinición de propiedades:

- Name = BtnAlmacenarVideo

- Caption = AlmacenarVideo



En el Evento Onclic del tButton poner





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;







GUARDAR UNA FOTO DE LA VENTANA DE CAPTURA

Añadir un tButton



tButtonDefinición de propiedades:

- Name = BtnGuardarImagen

- Caption = Guardar Imagen



Código del 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;







Webcam con Delphi (I)


A continuación os presento el software que os permitirá manejar vuestra Webcam con Delphi.



Primeramente tenéis que instalar en vuestro sistema el software "Microsoft Video for Windows SDK " que contiene la librería Avicap32.dll.

Dentro de las funciones que contiene utilizaremos "capCreateCaptureWindowA" para inicializar el driver y capturar la imagen.

Después para manejar la ventana de captura tendremos que usar la función "SendMessage" lo que facilita y simplifica muchísimo el trabajo a los programadores.




Ahora vamos con el programa:



Como variables globales añadimos:



Ventana: hwnd; //Handle de la ventana de captura



En la sección "const" escribimos:





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;





En la sección "implementation":





FUNCTION capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint; x: integer; y: integer; nWidth: integer; nHeight: integer; ParentWin: HWND; nId: integer): HWND; STDCALL EXTERNAL 'AVICAP32.DLL';





Es la llamada a la librería externa Avicap32.dll



Elementos de la interface:



-Botón "iniciar" (Al pulsarlo empezará la captura de la imagen procedente de la Webcam)



-Botón "detener" (Para parar la captura de la imagen)



-Control de Imagen "tImage" (lo llamaremos "Image1")







El código que se incluirá dentro de los botones es el siguiente:



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;



En el evento Onclose deberemos hacer una llamada al procedimiento incluido en el botón "Detener".

Y eso es todo por ahora, en posteriores artículos iremos añadiendo más utilidades.











Simulación del movimiento de los electrones en un campo electrico

Espectacular simulación realizada con OpenGL del movimiento de los electrones cuando atraviesan un campo eléctrico. Como muestra la image...