Morphing con Delphi



Espectacular programa de morphing basado en las transformaciones sucesivas de cuadriláteros, merece la pena que lo probéis ya que seguro que aprenderéis muchas cosas sobre esta técnica de imagen.

Autor:
Nicoo   (bigbezus@free.fr)
Codigo fuente

Descargar programa


Relacionados
Librería Exif
Modos blend
Programa para generar efectos graficos
Componente para manipulacion de imagenes
Chipmunk 2D physics engine

Delphi twain

Implementación de las funciones twain para Delphi.
Captura imágenes  desde una webcam con unas pocas líneas de código.
3 modos de transferencia de imágenes:
-Desde la memoria,
-Utilizando un handle de windows.
-Utilizando un archivo temporal.

Autor: Gustavo Daud
http://delphitwain.sourceforge.net/
Sitio2:



Relacionados

Librería Exif
Modos blend
Programa para generar efectos graficos
Componente para manipulacion de imagenes
Morphing con delphi


Vumetro

Un vumetro es un dispositivo que muestra la intensidad de una señal en unidades de volumen, y es muy habitual encontrarlo en equipos de sonido (mezcladores, amplificadores, etc..)
Este programa visualiza la forma de onda del sonido que pasa por el micrófono del PC y añade además un vúmetro de 2 canales.
Sólo tienen que conectar el micrófono al PC y empezar a hablar para probarlo.




Descargar programa
Descargar codigo fuente

Web:
http:\\www.cppblog.com\kenlistian 

Relacionados:
Osciloscopio con la tarjeta de sonido
Visualizar el espectro de las frecuencias de sonido 
Leer las cabeceras de un archivo mp3 
Conversor MPEG4 a AVI 
Reproducir notas musicales 


UNIT3.PAS

unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls,ShellAPI, StdCtrls,MMSystem, ComCtrls ,math;

type
  TArrayBuf = array[0..10239] of byte;    //1   KByte
  PArrayBuf = ^TArrayBuf;


  TForm3 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    ProgressBar1: TProgressBar;
    ProgressBar2: TProgressBar;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Label3Click(Sender: TObject);
  private
    hWaveIn: HWaveIn;
    WaveFormat: TWaveFormatEx;           //Wave_audioÊý¾Ý¸ñʽ
  public
    procedure Meter_vu();
    procedure WNDPROC(var msg: TMessage); override;
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.Button1Click(Sender: TObject);
begin
  Meter_vu();
  Button1.Enabled := False;
end;

procedure TForm3.Meter_vu;
var
  i: integer;
  WaveHdr: PWaveHdr;
  DaBuffer: PArrayBuf;
  iError : integer;
begin
  WaveFormat.wFormatTag      := WAVE_FORMAT_PCM;
  WaveFormat.nChannels       := 1;    //MONO
  WaveFormat.nSamplesPerSec  := 8000; //²ÉÑùΪ8k,44100
  WaveFormat.nAvgBytesPerSec := 8000;
  WaveFormat.nBlockAlign     := 1;
  WaveFormat.wBitsPerSample  := 8;

  iError := WaveInOpen(@hWaveIn, 0, @WaveFormat, handle, 0, CALLBACK_WINDOW);
  if iError <> 0 then
  begin
    ShowMessage('err WaveInOpen');
    Exit;
  end;

  //´´½¨8¸öbuffer
  for i := 1 to 8 do
  begin
    DaBuffer := new(PArrayBuf);
    WaveHdr := new(PWaveHdr);
    with WaveHdr^ do
    begin
      lpData := pointer(DaBuffer);
      dwBufferLength := sizeof(DaBuffer); //1024 = 1 KByte
      dwBytesRecorded := 0;
      dwUser := 0;
      dwFlags := 0;
      dwLoops := 0;
    end;

    iError := WaveInPrepareHeader(hWaveIn, WaveHdr, sizeOf(TWaveHdr));
    if iError <> 0 then
    begin
      ShowMessage('Error WaveInPrepareHeader! ');
      Exit;
    end;
    iError := WaveInAddBuffer(hWaveIn, WaveHdr, Sizeof(TWaveHdr));
    if iError <> 0 then
    begin
      ShowMessage('Error WaveInAddBuffer! ');
      Exit;
    end;
  end;

  iError := WaveInStart(hWaveIn);
  if (iError <> 0) then
  begin
    ShowMessage('Error , WaveInStart');
  end;
end;


procedure TForm3.FormDestroy(Sender: TObject);
begin
  if not Button1.Enabled then
  begin
    WaveInStop(hWaveIn); //Stop
    WaveInReset(hWaveIn);
    WaveInClose(hWaveIn);
  end;
end;



procedure TForm3.WNDPROC(var msg: TMessage);
var
  Hdr: PWaveHdr;
  i: integer;
  r: real;
  tt: Integer;
  vVal , vVal_temp: Integer;
begin
  inherited;
    case msg.Msg of
    MM_WIM_DATA:
      begin
        vVal := 0;
        Hdr := PWaveHdr(msg.LParam);
        if hdr^.dwBytesRecorded > 0 then
        begin
          r := Image1.ClientWidth / hdr^.dwBytesRecorded;
        end
        else
          r := 0;

        PatBlt(Image1.Canvas.Handle, 0, 0, Image1.ClientWidth, Image1.ClientHeight, BLACKNESS);
        with Image1 do
        begin
          Canvas.Pen.Color := clRed;
          Canvas.MoveTo(0, 127);
          Canvas.LineTo(ClientWidth, 127);
          Canvas.Pen.Color := clMaroon;
          Canvas.MoveTo(round(r * 100), 0);
          Canvas.LineTo(round(r * 100), 255);
          Canvas.MoveTo(round(r * 200), 0);
          Canvas.LineTo(round(r * 200), 255);
          Canvas.MoveTo(round(r * 300), 0);
          Canvas.LineTo(round(r * 300), 255);
          Canvas.MoveTo(round(r * 400), 0);
          Canvas.LineTo(round(r * 400), 255);
          Canvas.MoveTo(round(r * 500), 0);
          Canvas.LineTo(round(r * 500), 255);
          Canvas.MoveTo(round(r * 600), 0);
          Canvas.LineTo(round(r * 600), 255);
          Canvas.MoveTo(round(r * 700), 0);
          Canvas.LineTo(round(r * 700), 255);
          Canvas.MoveTo(round(r * 800), 0);
          Canvas.LineTo(round(r * 800), 255);
          Canvas.MoveTo(round(r * 900), 0);
          Canvas.LineTo(round(r * 900), 255);
          Canvas.MoveTo(round(r * 1000), 0);
          Canvas.LineTo(round(r * 1000), 255);
          Canvas.MoveTo(round(r * 1100), 0);
          Canvas.LineTo(round(r * 1100), 255);
          Canvas.MoveTo(round(r * 1200), 0);
          Canvas.LineTo(round(r * 1200), 255);

          Canvas.Pen.Color := clLime;
          Canvas.MoveTo(0, PArrayBuf(hdr.lpData)^[0]);

          for i := 0 to hdr^.dwBytesRecorded - 1 do
          begin
            Canvas.lineTo(round(r * i), PArrayBuf(hdr.lpData)^[i]);

            //È¡Ñù±¾ÖеķåÖµ·åÖµ,ʵ¼ÊÉÏÈ¡Ñù±¾Ò»¸öµãÒ²¿É
            vVal_temp :=  PArrayBuf(hdr.lpData)^[i];
            if vVal_temp > vVal then
              vVal := vVal_temp;
          end;
        end;

        //²ÉÓðËλ²É¼¯Ñù±¾×î´ó·Ö±´ÊÇ48dB
        try

           //È¡Ñù±¾Êý¾ÝÒ»¸öµãÒ²¿É,ÔÚ8λÉùµÀ[0]Öбíʾ×óÉùµÀ          
           vVal := PArrayBuf(hdr.lpData)^[0];
           vVal := vVal - 127;           //È¡Õñ·ùÕýÖµ
           if vVal < 0 then
             vVal := abs(vVal);
           if vVal = 0 then
             vVal := 1;

            //ÕâÊÇ°´dbÀ´´¦ÀíµÄ
            tt := round(100/48 *  (20 * log10(vVal / 256) + 48 ));
            ProgressBar1.Position := tt;

            //ÓÒÉùµÀ
            vVal := PArrayBuf(hdr.lpData)^[1];
            Dec(vVal, 127);
            vVal := abs(vVal);
            if vVal = 0 then vVal := 1;
            tt := round(100 /48 *  (20 * log10(vVal / 256) + 48 ));
            ProgressBar2.Position := tt;
          except
          end;

        WaveInUnprepareHeader(hWaveIn, hdr, Sizeof(TWaveHdr));

        Dispose(Hdr.lpData);
        DisPose(Hdr);

        Hdr := new(PWaveHdr);
        Hdr^.lpData := pointer(new(PArrayBuf));
        Hdr^.dwBufferLength := 1024;
        Hdr^.dwBytesRecorded := 0;
        Hdr^.dwUser := 0;
        Hdr^.dwFlags := 0;
        Hdr^.dwLoops := 0;

        WaveInPrepareHeader(hWaveIn, Hdr, Sizeof(TWaveHdr));
        WaveInAddBuffer(hWaveIn, Hdr, Sizeof(TWaveHdr));
      end;
  end;


end;


procedure TForm3.Label3Click(Sender: TObject);
begin
  ShellExecute(Handle, 'Open', 'IEXPLORE.EXE',PChar(label3.Caption), '', SW_SHOWNORMAL);
end;

end.