Delphi Magic: 1/10/12

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

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.

Morphing con Delphi

Delphi twain

Vumetro