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;

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

Dibuja el fractal Mandelbrot con Delphi

El código fuente lo puedes descargar desde aquí

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

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

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