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;


Relacionados:
wake on lan 
Detectar inactividad en el sistema

Apagar monitor pulsando una tecla
Apagar servidor de red cuando se apaguen los terminales

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

 

Post relacionados:
OCR con Tesseract

Dibuja el fractal Mandelbrot con Delphi





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

Rotar un punto en 3D

Rx,Ry,Rz =Ángulo X,Y,Z
X,Y,Z=posición inicial del punto
NX,NY,NZ=posición final del punto
const
PIDiv180 = 0.017453292519943295769236907684886;

procedure Rotate(Rx, Ry, Rz: Double; x, y, z: Double; var Nx, Ny, Nz: Double);
var
TempX: Double;
TempY: Double;
TempZ: Double;
SinX: Double;
SinY: Double;
SinZ: Double;
CosX: Double;
CosY: Double;
CosZ: Double;
XRadAng: Double;
YRadAng: Double;
ZRadAng: Double;
begin
XRadAng := Rx * PIDiv180;
YRadAng := Ry * PIDiv180;
ZRadAng := Rz * PIDiv180;

SinX := Sin(XRadAng);
SinY := Sin(YRadAng);
SinZ := Sin(ZRadAng);

CosX := Cos(XRadAng);
CosY := Cos(YRadAng);
CosZ := Cos(ZRadAng);

Tempy := y * CosY - z * SinY;
Tempz := y * SinY + z * CosY;
Tempx := x * CosX - Tempz * SinX;

Nz := x * SinX + Tempz * CosX;
Nx := Tempx * CosZ - TempY * SinZ;
Ny := Tempx * SinZ + TempY * CosZ;
end;
(* End Of *)

LIBROS:



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

Funciones Matemáticas

Determinar si un punto existe dentro de un triángulo
function PointInTriangle(const Px, Py, x1, y1, x2, y2, x3, y3: Double): Boolean;
var
Or1: Integer;
Or2: Integer;
Or3: Integer;
begin
Or1 := Orientation(x1, y1, x2, y2, Px, Py);
Or2 := Orientation(x2, y2, x3, y3, Px, Py);
Or3 := Orientation(x3, y3, x1, y1, Px, Py);

if (Or1 = Or2) and (Or2 = Or3) then
Result := True
else if Or1 = 0 then
Result := (Or2 = 0) or (Or3 = 0)
else if Or2 = 0 then
Result := (Or1 = 0) or (Or3 = 0)
else if Or3 = 0 then
Result := (Or2 = 0) or (Or1 = 0)
else
Result := False;
end;
(* End of PointInTriangle *)

function Orientation(const x1, y1, x2, y2, Px, Py: Double): Integer;
var
Orin: Double;
begin
(* Linear determinant of the 3 points *)
Orin := (x2 - x1) * (py - y1) - (px - x1) * (y2 - y1);

if Orin > 0.0 then
Result := +1 (* Orientaion is to the right-hand side *)
else if Orin < 0.0 then
Result := -1 (* Orientaion is to the left-hand side *)
else
Result := 0; (* Orientaion is neutral aka collinear *)
end;
(* End of Orientation *)


LIBROS:

Matemáticas, el fascinante mundo de los números

Matrix computations (Matematical Science)

Geometría analítica del plano y del espacio

Mecánica de fluidos

Geometría Afín y Euclidea 

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


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 
Vumetro con Delphi