Delphi 3d engine





Os presento a continuación CAST II, un game engine open source gratuito para Delphi y Free Pascal.

Características:
Editor wysiwyg.

Compatibilidad - Bajos requerimientos de sistema, utilizando todo tipo de hardware.

Cross platform, multi API - en la versión actual utiliza DirectX 8.1 para hacer el render, pero el motor gráfico está preparado para utilizar también OpenGL o DX 9. 

Performance - El motor gráfico está diseñado para conseguir el máximo rendimiento.

Para hacer un juego con CAST II se tiene que escribir alguna clase que implemente la lógica del juego, crear artwork y construir niveles en el editor.

Incluye varios subsistemas:
-Editor de escenas
-Mensajería
-Rendering
-Audio
-Física (detector de colisiones y motor físico de terceras partes)
-Gestión de inputs
-Timer
-Gestión de red
-Gui

Tiene dos tipos de licencia:
Mozilla Public License  http://www.mozilla.org/MPL/MPL-1.1.html
o GNU Lesser General Public License 2.1  http://www.opensource.org/licenses/lgpl-license.php

Página del fabricante

Página de descarga del programa



EJEMPLOS

Vegetación






Paisajes



Editor de partículas


Escena de un lago

 Editor CAST II
 










Editor de paisajes
 












LINKS DEL BLOG RELACIONADOS:


Modelado 3d Delphi El Juego de las líneas en 3D


Simulación del movimiento de 
los electrones en campo eléctrico  
Rotación de poliedros

Chipmunk 2D physics engine

LIBROS:





















Delphi Chromium Embedded Framework

Para los que quieran tener embebido en su aplicación un navegador que encapsula a Chrome y que además es compatible con Firemonkey (con alguna particularidad) aquí se lo pueden descargar:

Clic aqui para descargar


Una vez que se ha descargado hay que instalar el componente cefcomponent.dpk de la carpeta src (No olvidar poner la ruta de la carpeta "src" en Opciones-Library) 
Espero que este componente no tenga el memory leak que observé en el TWebBrowser.



Las nuevas funciones que ofrece son:
-Embebe un web browser con html5/css3
-parsing javascript
-html5 drag&drop
-Soporte para geolocalizacion
-Aceleracion por GPU
-Manejo de la configuracion para proxy
-Clases para utilizarlo en linea de comandos, url, xml y zip para lectura / parsing
-Acceso a las cookies
-Menu contextual 
-Acceso directo a DOM
-Notificacion e interceptacion de pulsaciones de teclas y foco de la aplicacion
-Manejo de zoom
-Manejo de descargas
-Soporte para webrequest -
-Soporte para multi_threaded_message_loop
-Puede trabajar sin el VCL o como un componente

Ejemplos:
Cargar una URL: (siendo crm: TChromium)
      crm.Browser.MainFrame.LoadUrl(edAddress.Text); 

Recargar una URL:
  if crm.Browser <> nil then
    if FLoading then
      crm.Browser.StopLoad else
      crm.Browser.Reload;


Hacer Zoom:
crm.Browser.ZoomLevel := crm.Browser.ZoomLevel + 0.5;

Obtener el codigo de la pagina:
var
  frame: ICefFrame;
  source: ustring;
begin
  if crm.Browser = nil then Exit;
  frame := crm.Browser.MainFrame;
  source := frame.Source;
  source := StringReplace(source, '<', '<', [rfReplaceAll]);
  source := StringReplace(source, '>', '>', [rfReplaceAll]);
  source := 'Source:
' + source + '
';
  frame.LoadString(source, 'http://tests/getsource');
end;


Ejecutar javascript:
    crm.Browser.MainFrame.ExecuteJavaScript(
      'alert(''JavaScript execute works!'');', 'about:blank', 0);


Mostrar herramientas del programador:
crm.Browser.ShowDevTools;

Ejecutar DOM:
begin
{$IFDEF DELPHI12_UP}
  crm.Browser.MainFrame.VisitDomProc(
    procedure (const doc: ICefDomDocument) begin
      doc.Body.AddEventListenerProc('mouseover', True,
        procedure (const event: ICefDomEvent) begin
          caption := getpath(event.Target);
        end)
  end);
{$ELSE}
  crm.Browser.MainFrame.VisitDomProc(domvisitorcallback);
{$ENDIF}
end;


Imprimir una pagina:
crm.Browser.MainFrame.Print;





Red neuronal Backpropagation


Codificación de una red neuronal Backpropagation con dos neuronas de entrada, dos de salida y una capa oculta.
El ejemplo proporciona dos conjuntos de datos con los que se puede entrenar la red y ver lo preciso que ha sido el aprendizaje minimizando el error que se muestra en un gráfico.
Modificando el programa podemos variar el número de veces que entrenamos a la red con los datos de prueba (epochs), de tal forma que llega un momento en el que a partir de un cierto número de epochs el error se mantiene siempre constante e incluso aumenta.


Pantalla del programa


Descargar codigo fuente


La propagación hacia atrás de errores o retropropagación (del inglés backpropagation) es un algoritmo deaprendizaje supervisado que se usa para entrenar redes neuronales artificiales.

El algoritmo emplea un ciclo propagación – adaptación de dos fases. Una vez que se ha aplicado un patrón a la entrada de la red como estímulo, este se propaga desde la primera capa a través de las capas superiores de la red, hasta generar una salida.

La señal de salida se compara con la salida deseada y se calcula una señal de error para cada una de las salidas.

Las salidas de error se propagan hacia atrás, partiendo de la capa de salida, hacia todas las neuronas de la capa oculta que contribuyen directamente a la salida. Sin embargo las neuronas de la capa oculta solo reciben una fracción de la señal total del error, basándose aproximadamente en la contribución relativa que haya aportado cada neurona a la salida original.

Este proceso se repite, capa por capa, hasta que todas las neuronas de la red hayan recibido una señal de error que describa su contribución relativa al error total. La importancia de este proceso consiste en que, a medida que se entrena la red, las neuronas de las capas intermedias se organizan a sí mismas de tal modo que las distintas neuronas aprenden a reconocer distintas características del espacio total de entrada.

Después del entrenamiento, cuando se les presente un patrón arbitrario de entrada que contenga ruido o que esté incompleto, las neuronas de la capa oculta de la red responderán con una salida activa si la nueva entrada contiene un patrón que se asemeje a aquella característica que las neuronas individuales hayan aprendido a reconocer durante su entrenamiento.

(fuente: wikipedia) 


Relacionados:

-----------------------
 Clase TBackProp
------------------------

Archivo:    BackPropCls.pas

Lenguaje:  Delphi 2005

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 clase tBackProp

Reconocimiento de caracteres con Delphi (usa el componente tBackProp anterior)

(Tesis doctoral) técnicas de reconocimiento facial mediante redes neuronales

Redes neuronales con Delphi

Redes neuronales y bolsa (prediccion de cotizaciones)

Si quieres un buen libro sobre redes neuronales pulsa aquí


Obtener parametros modulos fotovoltaicos




Programa que calcula partiendo de los siguientes datos: (se obtienen de la hoja de características del fabricante de los módulos fotovoltaicos)

Intensidad de cortocircuito (Isc).
Tensión de circuito abierto (Voc).
Tensión PMP (Vm).
Intensidad PMP (Im).
Porcentaje de eficiencia.
Temperatura operación nominal (TONC) en grados Kelvin.

El software calcularía los siguientes:


Factor de forma (FF).
Temperatura de célula (Tc) en grados kelvin.
Área (Ac) en metros cuadrados.
Máxima potencia (Pm).
Resistencia para PMP (Rm).

Pulsando el botón "Calcular datos irradiancia G" la aplicación obtendrá los siguientes datos en condiciones de irradiancia G:

Temperatura célula (Tc2).
Tensión (Voc2).
Intensidad cortocircuito (Isc2).
Máxima potencia (Pm2).
Eficiencia con G.


Codigo fuente

Autor: ajpdsoft
Fuente:  http://www.ajpdsoft.com/modules.php?name=News&file=article&sid=439

Ejemplo:
Cálculo para un sistema básico fotovoltaico




Corrección: E4=E1xE2xE3, E3 es la cantidad de horas de uso.

Cálculo de la corriente requerida

A1 Carga total diaria (sumar la columna E4)                                      273 watts-hora/día
A2 Tensión CD del sistema (generalmente 12 ó 24 V)                       12 voltios
A3 Carga diaria corriente (A1/A2)                                                      22.8 amperios-hora
A4 Multiplicar con el factor de seguridad 20% (para compensar
las pérdidas en las baterías y otros componentes)                           1.2
A5 Carga diaria corriente corregida (A4*A3)                                     27.3 amperios-hora
A6 Promedio de horas de sol por día.                                                4 horas
A7 Amperaje que el sistema tendrá que producir (A5/A6)                 6.8 amperios

Cálculo del número de paneles

B1 Amperaje máximo del modulo solar seleccionado
(según especificaciones del fabricante)                                             3.9 amperios
B2 Divida la línea A7 entre la B1 para obtener el número
de módulos que se necesita                                                              1.75
B3 Redondee al número completo inmediato superior                       2

Cálculo del número de baterías

C1 Carga total diaria (A5)                                                                   27.3 amperios-hora
C2 Días de reserva (este es el tiempo que el
sistema tiene que estar funcionando sin sol)                                     3
C3 Capacidad nominal del banco de baterías (C1*C2)                       81.9 amperios-hora
C4 Factor de profundidad de descarga (generalmente 80%,
significa que siempre se deja un 20% de reserva en las baterías)    0.8
C5 Capacidad corregida del banco de baterías (C3/C4)                    102.4 amperios-hora
C6 Capacidad nominal de batería
(según especificaciones del fabricante)                                              120 amperios-hora
C7 Número de baterías        (C5/C6)                                                   0.9
C8 Número de baterías (redondear C7)                                              1



Relacionados:
Detectar inactividad en el sistema
Apagar monitor pulsando una tecla
Apagar servidor de red cuando se apaguen los terminales



Modos blend

A continuación tienen una descripción de diferentes modos blend.

Los parámetros a y b son bytes (desde 0 a 255) debido a que las imágenes son almacenadas de esta forma. El valor devuelto es 1 byte. Recordar que para imágenes RGB se necesita procesar el color de cada canal.

por ejemplo si ponemos:
result := (a * b) SHR 8;
si la imagen es RGB habría que hacer
result.red := (a.red * b.red) SHR 8;
result.green := (a.green * b.green) SHR 8;
result.blue := (a.blue * b.blue) SHR 8;

Relación de modos:
Media

result := (a+b) SHR 1;


Multiplicador:
result := (a*b) SHR 8;

Screen:
result := 255 - ((255-a) * (255-b) SHR 8);

Oscuridad:
if a < b then
  result := a
else
  result := b;

Luminosidad:
if a > b then
  result := a
else
  result := b;

Diferencial:
result := abs(a-b);

Overlay:
if a < 128 then
  result := (a*b) SHR 7
else
  result := 255 - ((255-a) * (255-b) SHR 7);

Hard Light:
if b < 128 then
  result := (a*b) SHR 7
else
  result := 255 - ((255-b) * (255-a) SHR 7);

Soft light:
if b < 128 then
  result := a - (128-b) * (16384-sqr(128-a)) SHR 15
else
  result := ???;

Dodge:
if b = 255 then
  result := 255
else begin
  c := (a SHL 8) DIV (255-b);
  if c > 255 then result := 255 else result := c;
end;

Color Burn:
if b = 0 then
  result := 0
else begin
  c := 255 - (((255-a) SHL 8) DIV b);
  if c < 0 then result := 0 else result := c;
end;

Inverse color burn:
if a = 0 then
  result := 0
else begin
  c := 255 - (((255-b) SHL 8) DIV a);
  if c < 0 then result := 0 else result := c;
end;

Soft burn:
if a+b < 256 then begin
  if a = 255 then
    Result := 255
  else begin
    c := (b SHL 7) DIV (255-a);
    if c > 255 then Result := 255 else Result := c;
  end;
end
else begin
  // b cannot be zero here
  c := 255-(((255-a) SHL 7) DIV b);
  if c < 0 then Result := 0 else Result := c;
end;

Quadratic:
if b = 255 then
  result := 255
else begin
  c := a*a DIV (255-b);
  if c > 255 then result := 255 else result := c;
end;

Additive:
c := a+b;
if c > 255 then result := 255 else result := c;

Subtractive:
c := a+b-256;
if c < 0 then result := 0 else result := c;

Stamp:
c := a + 2*b - 256;
if c < 0 then
  result := 0
else if c > 255 then
  result := 255
else
  result := c;

Interpolación:
// for i := 0 to 255 do CosineTab[i] := Round(64-Cos(i*Pi/255)*64);
c := CosineTab[b] + CosineTab[a];
if c > 255 then result := 255 else result := c;

Opacidad o transparencia:
Se introduce el factor de opacidad variable llamado "o"

Definición de opacidad y transparencia:
fopacidad(a,b,o) = o * f(a,b) + (1 - o) * a
Transparencia t = (1 - o), so
ftransparencia(a,b,t) = (1 - t) * f(a,b) + t * a

La función será:
result := a + (f(a,b)-a) * o;








OCR con Tesseract


Tesseract es un motor OCR gratuito creado por HP Labs entre el 1985 y 1995 y desarrollado actualmente por Google.
Es probablemente el más preciso OCR open source disponible actualmente. Combinado con "Leptonica Image Processing Library" puede leer una gran variedad de formatos de imagen y convertirlos a texto en 60 lenguajes. Se distribuye bajo licencia Apache 2.0.
Tesseract trabaja en Linux, Windows (con VC++ Express o CygWin) y Mac OS y puede ser compilado para otras plataformas como Android y IPhone.





Si el código en Delphi no os funciona comprobar en la unit UMainForm.pas que la ruta de los ficheros dll es la correcta en el evento Form.OnCreate
procedure TMainForm.FormCreate(Sender: TObject);
begin
  FCancelled := false;
  SetCurrentDir( ExtractFileDir( ParamStr( 0 ) ) );

  FTesseract := TTesseract.Create
  (
//COMPROBAR LA RUTA DE ABAJO
   ExtractFilePath(Application.ExeName)+'tesseract.dll',
   '..\'


  );

  {
//OTRA FORMA DE PONER LA RUTA
     (
    'tesseract.dll',
    '..\Tesseract\'
  );

}


  FTesseract.OnTaskCancel := TesseractCancel;
  FTesseract.OnTaskProgress := TesseractProgress;
  FTesseract.OnTaskEnd := TesseractTerminate;
  FTesseract.OnTaskError := TesseractError;




Compresion de imagenes con wavelets

Este programa muestra cómo utilizar la compresion-wavelet utilizando la unit "wave.pas" consiguiendo una pérdida mínima en la calidad de la imagen.
La compresión-wavelet es una tecnología que se incluye en el standard jpeg2000.

Autor: HaarWavelet0.6b (C)2K2 Carsten Wächter
toxie@ainc.de
www.ainc.de

La transformada de ondícula (frecuentemente también transformada wavelet) es un tipo especial de transformada de Fourier que representa una señal en términos de versiones trasladadas y dilatadas de una onda finita (denominada óndula madre).
En términos históricos, el desarrollo de las óndulas entronca con varias líneas de pensamiento, a partir del trabajo de Alfred Haar a principios del siglo XX.
En cuanto a sus aplicaciones, la transformada de óndula discreta se utiliza para la codificación de señales, mientras la continua se utiliza en el análisis de señales. Como consecuencia, la versión discreta de este tipo de transformada se utiliza fundamentalmente en ingeniería e informática, mientras que la continua se utiliza sobre todo en la física. Este tipo de transformadas están siendo cada vez más empleadas en un amplio campo de especialidades, a menudo sustituyendo a la transformada de Fourier, por su ventaja para el análisis de señales en el dominio del tiempo y la frecuencia.


Tema relacionados:
JPEG 2000 es un estándar de compresión y codificación digital deimágenes. Fue creado por el Joint Photographic Experts Group(Grupo Conjunto de Expertos en Fotografía o JPEG), en el año 2000con la intención de sustituir el formato original creado en 1992. El nuevo formato se basa en la transformada wavelet, en lugar de latransformada de coseno discreta establecida para el estándar original. La extensión de los archivos en formato JPEG 2000 es .jp2.
JPEG 2000 puede trabajar con niveles de compresión mayores que los de JPEG sin incurrir en los principales defectos del formato anterior con altas tasas de compresión: generación de bloques uniformes y aspecto borroso. También se adapta mejor a la carga progresiva de las imágenes. Sus principales desventajas están en que tiende a emborronar más la imagen que JPEG, incluso para un mismo tamaño de archivo (pero sin formar bloques), y que elimina algunos detalles pequeños y texturas, que el formato JPEG normal sí llega a representar.

 Fuente: Wikipedia


Mostrar una regla en pantalla





Regla configurable en pantalla con las siguientes características:
  • Medida en pixels
  • Media en milímetros
  • Transparencia configurable
  • Tickers horizontales y verticales
etc..

http://delphi.about.com/library/weekly/aa080205a.htm
by Zarko Gajic
Codigo fuente

Relacionados
Mostrar los modos de visualizacion de la tarjeta grafica
Generar efectos graficos
Dar capacidades de scripting a tu aplicacion



Mini visor del registro



Muestra los items del registro de nuestro PC ( regedit.exe ) utilizando dos componentes: tTreeView y tListView.
Es lo que veríamos si vamos al botón de inicio->ejecutar y escribimos "regedit.exe"

Codigo fuente

Relacionados

Antikeylooger
Firewall en delphi
Acceder a los contadores del sistema

Servidor y cliente UDP

User Datagram Protocol (UDP) es un protocolo de red basado en el intercambio de datagramas, sin que se haya establecido previamente una conexión entre dos equipos, ya que dentro de cada datagrama se incorpora toda la información de direccionamiento que se requiera.
La principal desventaja que tiene es que no tiene un control de flujo, es decir se pueden perder paquetes en la transmisión y ni el cliente ni el servidor se enteran (en el caso de TCP se pediría una retransmisión del paquete perdido), se suele usar en la retransmisión de audio o vídeo por la red o en los protocolos DHCP, BOOTP y DNS.

Si te interesa ampliar más información te recomiendo el siguiente libro.

El conjunto de funciones que os presento sirve para crear un servidor y cliente UDP con los componentes indy.
Inicialmente pide la IP del servidor (para pruebas teclearemos 127.0.0.1)

Posteriormente comprobaremos desde el visor de propiedades que el buffer del componente UDPServer o UDPClient no supere los 65000 Kbytes.

Para comprobar la transmisión de un fichero cualquiera, el interface nos permite cargarlo desde nuestro PC y transmitirlo utilizando un tmemorystream.

A continuación os muestro el procedimiento del componente UDPServer para leer los datos transmitidos por UDP.



procedure TMainForm.UDPServerUDPRead(Sender: TObject; AData: TStream;
 ABinding: TIdSocketHandle);
var
 StrStream : TStringStream;
 MemStream : TMemoryStream;
begin
 if AData.Size<=255 then
 begin
 StrStream:=TStringStream.Create('');
 StrStream.CopyFrom(AData, AData.Size);
Memo.Lines.Add(ABinding.PeerIP+': '+copy(StrStream.DataString,5,length(StrStream.DataString)));
 StrStream.Free;
 end else
 begin
 MemStream:= TMemoryStream.Create;
 MemStream.CopyFrom(AData, AData.Size);
  if SaveDialog.Execute then MemStream.SaveToFile(SaveDialog.FileName);
 MemStream.Free;

end; 

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.