Este programa sirve para calcular los valores de un resistor en función del color de las bandas de colores que lleva serigrafiadas en su superficie.
Author : Nicolas Paglieri
e-mail : webmaster@ni69.info
Cálculo de valores de resistencias eléctricas
Programas Delphi que utilizan OPENGL
1) Generador de curvas de Bezier
Esta aplicación genera un array de vértices utilizados para construir curvas de Bezier. Requiere que la tarjeta gráfica sea compatible con OpenGL.Codigo fuente y programa
2) Utilización de una Webcam
Utilizando las primitivas OpenGL, permite ver la imagen de una webcam en una rejilla tridimensional, con la posibilidad de cambiar el ángulo de la cámara, la distancia del observador y la rotación de la imagen.
Simulador de circuitos lógicos
Simulador de circuitos con código fuente que permite diseñar circuitos basándose en puertas lógicas: Y, AND, OR, etc.
Una vez que se termina el diseño se puede activar virtualmente para ver su resultado.
Utilizando o no una tabla es posible realizar funciones básicas: sumador, comparador, etc y simular cualquier expresión booleana de una forma fácil.
El autor incluye varios ejemplos:
-Un display de 7 segmentos
-Un multiplicador binario.
Descargar codigo
Autor: Montero-Ribas
Web: ADMR.CAD.Free.fr
OCR simplificado
Realiza una limpieza del fondo de una imagen y a continuación pasa a texto su contenido haciendo la función de un OCR.Author: Dennis Malkoff
E-mail: info@sminstall.com
Codigo fuente
Redondear numeros reales
Aquí tienen varias formas de redondear correctamente números reales:
======
function RoundStr(Zn: Real; kol_zn: Integer): Real;
var
snl, s, s0, s1, s2: string;
n, n1: Real;
nn, i: Integer;
begin
s := FloatToStr(Zn);
if (Pos(',', s) > 0) and (Zn > 0) and
(Length(Copy(s, Pos(',', s) + 1, length(s))) > kol_zn) then
begin
s0 := Copy(s, 1, Pos(',', s) + kol_zn - 1);
s1 := Copy(s, 1, Pos(',', s) + kol_zn + 2);
s2 := Copy(s1, Pos(',', s1) + kol_zn, Length(s1));
n := StrToInt(s2) / 100;
nn := Round(n);
if nn >= 10 then
begin
snl := '0,';
for i := 1 to kol_zn - 1 do
snl := snl + '0';
snl := snl + '1';
n1 := StrToFloat(Copy(s, 1, Pos(',', s) + kol_zn)) + StrToFloat(snl);
s := FloatToStr(n1);
if Pos(',', s) > 0 then
s1 := Copy(s, 1, Pos(',', s) + kol_zn);
end
else
s1 := s0 + IntToStr(nn);
if s1[Length(s1)] = ',' then
s1 := s1 + '0';
Result := StrToFloat(s1);
end
else
Result := Zn;
end;
Opcion 2:
function RoundEx(X: Double; Precision: Integer ): Double;
// Precision : 1, 10,100 ...
var
ScaledFractPart, Temp: Double;
begin
ScaledFractPart := Frac(X) * Precision;
Temp := Frac(ScaledFractPart);
ScaledFractPart := Int(ScaledFractPart);
if Temp >= 0.5 then
ScaledFractPart := ScaledFractPart + 1;
if Temp <= -0.5 then
ScaledFractPart := ScaledFractPart - 1;
Result := Int(X) + ScaledFractPart / Precision;
end;
Opcion 3:
function FormatData(s: String; i: Integer): String;
begin
Result:=FloatToStr(Round(StrToFloat(s)*exp(i*ln(10)))/(exp(i*ln(10))));
end;
Opcion 4:
function RoundFloat(R: Extended; Decimals: Integer): Extended;
var
Factor: Extended;
begin
Factor := Int(Exp(Decimals * Ln(10)));
Result := Round(Factor * R) / Factor;
end;
La llamada sería de la siguiente forma:
showmessage(FloatToStr(RoundStr(2.3456789,3)));
showmessage(FloatToStr(RoundEx(2.3456789,1000)));
showmessage(formatdata('2,3456789',3));
showmessage(FloatToStr(RoundFloat(2.3456789,3)));
procedure TForm1.AumentaPrioridad;
var
ProcessID : DWORD;
ProcessHandle : THandle;
ThreadHandle : THandle;
begin
ProcessID := GetCurrentProcessID;
ProcessHandle := OpenProcess(PROCESS_SET_INFORMATION,
false, ProcessID);
SetPriorityClass(ProcessHandle, REALTIME_PRIORITY_CLASS);
ThreadHandle := GetCurrentThread;
SetThreadPriority(ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL);
end;
Opcion1:
======
function RoundStr(Zn: Real; kol_zn: Integer): Real;
var
snl, s, s0, s1, s2: string;
n, n1: Real;
nn, i: Integer;
begin
s := FloatToStr(Zn);
if (Pos(',', s) > 0) and (Zn > 0) and
(Length(Copy(s, Pos(',', s) + 1, length(s))) > kol_zn) then
begin
s0 := Copy(s, 1, Pos(',', s) + kol_zn - 1);
s1 := Copy(s, 1, Pos(',', s) + kol_zn + 2);
s2 := Copy(s1, Pos(',', s1) + kol_zn, Length(s1));
n := StrToInt(s2) / 100;
nn := Round(n);
if nn >= 10 then
begin
snl := '0,';
for i := 1 to kol_zn - 1 do
snl := snl + '0';
snl := snl + '1';
n1 := StrToFloat(Copy(s, 1, Pos(',', s) + kol_zn)) + StrToFloat(snl);
s := FloatToStr(n1);
if Pos(',', s) > 0 then
s1 := Copy(s, 1, Pos(',', s) + kol_zn);
end
else
s1 := s0 + IntToStr(nn);
if s1[Length(s1)] = ',' then
s1 := s1 + '0';
Result := StrToFloat(s1);
end
else
Result := Zn;
end;
Opcion 2:
function RoundEx(X: Double; Precision: Integer ): Double;
// Precision : 1, 10,100 ...
var
ScaledFractPart, Temp: Double;
begin
ScaledFractPart := Frac(X) * Precision;
Temp := Frac(ScaledFractPart);
ScaledFractPart := Int(ScaledFractPart);
if Temp >= 0.5 then
ScaledFractPart := ScaledFractPart + 1;
if Temp <= -0.5 then
ScaledFractPart := ScaledFractPart - 1;
Result := Int(X) + ScaledFractPart / Precision;
end;
Opcion 3:
function FormatData(s: String; i: Integer): String;
begin
Result:=FloatToStr(Round(StrToFloat(s)*exp(i*ln(10)))/(exp(i*ln(10))));
end;
Opcion 4:
function RoundFloat(R: Extended; Decimals: Integer): Extended;
var
Factor: Extended;
begin
Factor := Int(Exp(Decimals * Ln(10)));
Result := Round(Factor * R) / Factor;
end;
La llamada sería de la siguiente forma:
showmessage(FloatToStr(RoundStr(2.3456789,3)));
showmessage(FloatToStr(RoundEx(2.3456789,1000)));
showmessage(formatdata('2,3456789',3));
showmessage(FloatToStr(RoundFloat(2.3456789,3)));
Al trabajar con imágenes en 3D he tenido que utilizar alguna de estas funciones y lo que he hecho para acelerar su cálculo es aumentar la prioridad de mi aplicación con la siguiente función:
procedure TForm1.AumentaPrioridad;
var
ProcessID : DWORD;
ProcessHandle : THandle;
ThreadHandle : THandle;
begin
ProcessID := GetCurrentProcessID;
ProcessHandle := OpenProcess(PROCESS_SET_INFORMATION,
false, ProcessID);
SetPriorityClass(ProcessHandle, REALTIME_PRIORITY_CLASS);
ThreadHandle := GetCurrentThread;
SetThreadPriority(ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL);
end;
Reproducir archivo MIDI en piano virtual
Con esta aplicación puedes abrir un archivo MIDI y reproducirlo en un piano virtual. Para que funcione hay que instalar previamente el package zzPianoEx.dpk con lo que tendremos los componentes: TPianoKeyBoard, TMidiOutput, TMidiFile, TMidiInput, TMidiPlayer, TPianoChannels, TPianoTracks.
XI'AN Science and Technology University, Shanghai, China
http://www.PianoEx.com
Author: ZHONG WAN
Email: webmaster@PianoEx.com
MSN: ziziiwan@hotmail.com
Descargar programa
Codigo fuente
Ejemplos archivos MIDI
Archivo1.mid
Archivo2.mid
Archivo3.mid
Firewall en Delphi
iSafer es un firewall winsock que permite entre otras cosas añadir / quitar reglas de acceso en función de IPs, modificar el nivel de seguridad, crear un registro de acceso, comprobar el estado de los puertos. Es bastante completo y para su instalación antes hay que descargar madCodeHook desde http://madshi.net y el componente TrayIcon.pas que viene incluido en el código fuente.
Ha sido diseñado y creado por Do Duc Truong (Truong2D@yahoo.com) y LTH(LuuTruongHuy@yahoo.com)
================================================================
MOSTRAR PROPIEDADES DEL FW
La siguiente aplicación permite controlar diferentes aspectos del Firewall que viene incluido en Windows (Probado en WindowsXP)
- Muestra sus propiedades
- Permite activarlo o desactivarlo
- Hace un listado de los programas autorizados
- Activa la configuración por defecto
- Lista servicios relacionados
- Muestra la configuración ICMP
Codigo fuente
Antikeylogger
Los componentes TAntiKeyLoggerEdit TAntiKeyLoggerMem sirven para dificultar las acciones de los keyloggers insertando en el buffer de teclado del PC caracteres basura. Podéis ver un ejemplo en la imagen del texto capturado por un keylogger cuando se usa el notepad y cuando se usa este programa.
Mediante la propiedad GarbageCount se puede especificar el número de caracteres falsos que se añaden en el buffer.
Autor: Wuul Wuuldev@googlemail.com
Web:
=========================================================
PSMAntiKeyLogger
Real-time protection, protects you against KeyLoggers (For Windows 9x/ME/NT/2K/XP)
(C) 2003-2004 PSMKorea - Do Duc Truong, Truong2D@Yahoo.com
Project description:
PreSetup\PreSetup.dpr: Create PreSetup.exe, killing processes before copying new files (For setup only)
PSMAntiK.Dll\PSMAntiK.dpr: Injected DLL
PSMAntiSpy_Kr\PSMAntiSpy.dpr: Main application
PSMAntiSpySvc\PSMAntiS.dpr: Service
PSMStartupCfg_Kr\PSMStartupCfg.dpr: Additional tool
Setup\setup.wse: Script to create the full setup (Wise Installation System - Professional Edition)
NOTE for developers:
- Special component used: madCodeHook/madX : www.madshi.net
- Need to Install the TrayIcon compnent in TrayIcon.pas
- Change the const Lang in every project to switch between two language English/Korean. for ex: const Lang='KO';
Antivirus
AiD Scanner free Antivirus v3.4.3 es un antivirus totalmente operativo que viene con código fuente e incorpora una base de firmas de 60.000 virus que se pueden ampliar incluyendo otras nuevas, utilizando la aplicación "Aid database creator" que viene incluida en el soft.
Autor: DoGeR
BlackCash2006@Yandex.ru
DoGeR@bit-lab.info
Codigo fuente
Autor: DoGeR
BlackCash2006@Yandex.ru
DoGeR@bit-lab.info
Codigo fuente
Comprimir jpgs
Con este programa se comprimen imágenes bmp y jpg en archivos jpg.
Características:
-Regulación del nivel de compresión.
-6 formatos standards de redimiensionamiento.
-Varios formatos de exportación, incluyen zip.
-Gestión completa de exif, xmp, miniaturas, thumbnails, copyright.
-Posibilidad de añadir copyrights o cualquier texto sobre la imagen.
-Posibilidad de cambiar la fecha de creación o modificación.
Autor:
Nicolas Plagieri
http://www.ni69.info/
Aplicacion
Codigo fuente
Ping Alert
Este programa envia un ping a intervalos regulares a un PC para comprobar su estado, si no obtiene respuesta permite lanzar un programa o un mensaje de aviso.
Muy útil para monitorizar servidores o equipos de misión crítica.
Toda la configuración se encuentra en el archivo nopingalert.conf
Codigo fuente
Movimiento de un octoedro
Efecto lupa
Programa que amplia el texto sobre el que se posiciona el cursor para facilitar su lectura.
Programa efecto lupa
Codigo fuente
Mostrar los modos de visualización de la tarjeta gráfica
Pasos a seguir para mostrar con Delphi los diferentes modos de visualización de la tarjeta gráfica del PC.
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
Button2: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// En el form creamos un tLlistbox y un tButton y en el evento Onclic de este último ponemos lo siguiente
procedure TForm1.Button1Click(Sender: TObject);
var
d: _devicemodeA;
i: integer;
begin
i:=0;
while EnumDisplaySettings(nil,i,d)<>false do
begin
ListBox1.Items.Add('Mode: '+IntToStr(i+1)+' - '+FloatToStr(D.dmPelsWidth)+'x'+FloatToStr(D.dmPelsHeight)+'x'+FloatToStr(D.dmBitsPerPel)+' - '+FloatToStr(D.dmDisplayFrequency)+' Hz');
inc(i,1);
end;
end;
// Al hacer clic sobre uno de los modos de pantalla pulsamos el Button2 y lo activamos.
procedure TForm1.Button2Click(Sender: TObject);
var
d: _devicemodeA;
begin
EnumDisplaySettings(nil, ListBox1.ItemIndex, D);
ChangeDisplaySettings(D, CDS_UPDATEREGISTRY);
end;
end.
El resultado es un ListBox con todos los modos de visualización de nuestra tarjeta de vídeo.
Mode: 2 - 640x480x8 - 60 Hz
Mode: 3 - 640x480x8 - 72 Hz
Mode: 4 - 640x480x8 - 75 Hz
Mode: 5 - 640x480x8 - 85 Hz
Mode: 6 - 640x480x8 - 100 Hz
Mode: 7 - 640x480x8 - 120 Hz
Mode: 8 - 640x480x8 - 160 Hz
Mode: 9 - 640x480x8 - 200 Hz
Mode: 10 - 720x480x8 - 60 Hz
Mode: 11 - 800x480x8 - 60 Hz
Mode: 12 - 800x600x8 - 56 Hz
Mode: 13 - 800x600x8 - 60 Hz
Mode: 14 - 800x600x8 - 72 Hz
Mode: 15 - 800x600x8 - 75 Hz
Mode: 16 - 800x600x8 - 85 Hz
Mode: 17 - 800x600x8 - 100 Hz
Mode: 18 - 800x600x8 - 120 Hz
Mode: 19 - 800x600x8 - 160 Hz
Mode: 20 - 960x600x8 - 60 Hz
Mode: 21 - 1024x576x8 - 60 Hz
Mode: 22 - 1024x768x8 - 60 Hz
Mode: 23 - 1024x768x8 - 70 Hz
Mode: 24 - 1024x768x8 - 75 Hz
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
Button2: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// En el form creamos un tLlistbox y un tButton y en el evento Onclic de este último ponemos lo siguiente
procedure TForm1.Button1Click(Sender: TObject);
var
d: _devicemodeA;
i: integer;
begin
i:=0;
while EnumDisplaySettings(nil,i,d)<>false do
begin
ListBox1.Items.Add('Mode: '+IntToStr(i+1)+' - '+FloatToStr(D.dmPelsWidth)+'x'+FloatToStr(D.dmPelsHeight)+'x'+FloatToStr(D.dmBitsPerPel)+' - '+FloatToStr(D.dmDisplayFrequency)+' Hz');
inc(i,1);
end;
end;
// Al hacer clic sobre uno de los modos de pantalla pulsamos el Button2 y lo activamos.
procedure TForm1.Button2Click(Sender: TObject);
var
d: _devicemodeA;
begin
EnumDisplaySettings(nil, ListBox1.ItemIndex, D);
ChangeDisplaySettings(D, CDS_UPDATEREGISTRY);
end;
end.
El resultado es un ListBox con todos los modos de visualización de nuestra tarjeta de vídeo.
Mode: 2 - 640x480x8 - 60 Hz
Mode: 3 - 640x480x8 - 72 Hz
Mode: 4 - 640x480x8 - 75 Hz
Mode: 5 - 640x480x8 - 85 Hz
Mode: 6 - 640x480x8 - 100 Hz
Mode: 7 - 640x480x8 - 120 Hz
Mode: 8 - 640x480x8 - 160 Hz
Mode: 9 - 640x480x8 - 200 Hz
Mode: 10 - 720x480x8 - 60 Hz
Mode: 11 - 800x480x8 - 60 Hz
Mode: 12 - 800x600x8 - 56 Hz
Mode: 13 - 800x600x8 - 60 Hz
Mode: 14 - 800x600x8 - 72 Hz
Mode: 15 - 800x600x8 - 75 Hz
Mode: 16 - 800x600x8 - 85 Hz
Mode: 17 - 800x600x8 - 100 Hz
Mode: 18 - 800x600x8 - 120 Hz
Mode: 19 - 800x600x8 - 160 Hz
Mode: 20 - 960x600x8 - 60 Hz
Mode: 21 - 1024x576x8 - 60 Hz
Mode: 22 - 1024x768x8 - 60 Hz
Mode: 23 - 1024x768x8 - 70 Hz
Mode: 24 - 1024x768x8 - 75 Hz
Ver equipos de la red
Programa para ver los equipos que componen una red y sus recursos compartidos, viene con código fuente (válido para Delphi 7 en adelante)
Autor: Vadim Crits
Gravedad pixelada
Simulación del movimiento de miles de píxeles bajo la influencia de las reglas de la gravedad.
Autor: Gerben Wijnja
Ver los cambios en el sistema de archivos
Muestra en tiempo real los cambios producidos en cualquier fichero del PC
Utiliza un CallBack definida en la unit WFSU:
PInfoCallBack = ^TInfoCallBack;
TInfoCallBack = record
FAction : Integer;
FDrive : string;
FOldFileName : string;
FNewFileName : string; end;
TWatchFileSystemCallBack = procedure (pInfo: TInfoCallBack);
Sniffer de red
Indicando una IP, podemos ver el tráfico de datos de entrada y salida.
Podemos filtrar por puerto o por tipo de trama (SYS, RST, ACK, FIN, URG)
Autor:
Pierre Freby pfreby@hotmail.com
Descargar codigo fuente
Podemos filtrar por puerto o por tipo de trama (SYS, RST, ACK, FIN, URG)
Autor:
Pierre Freby pfreby@hotmail.com
Descargar codigo fuente
Juego de damas avanzado
Aquí tienen el conocido juego de las damas. Tiene como opción la posibilidad de jugar humano-máquina, máquina-máquina, giro de tablero y varios niveles (beginer, intermediate, expert).
Librería Exif
Biblioteca de funciones para crear, editar y modificar los metadatos exif y ipctc en archivos de imágenes con formato jpg.
Autor:
Chris Rolliston (http://delphihaven.wordpress.com/).
Licence:
MPL 1.1 (text at http://www.mozilla.org/MPL/MPL-1.1.html).
Features
· Exif parsing is 100% pure Delphi code — doesn’t use (say) LibExif or LibTiff, GDI+, WIC, or even Windows.pas.
· Reads and writes both small- and big-endian data.
· Surfaces both standard Exif and Windows Explorer tags, and provides access to the tags of some maker note types too.
· Doesn’t corrupt internal maker note offsets when data is rewritten, and takes account of the Microsoft-defined OffsetSchema tag.
· Can optional write XMP data as per the XMP Exif schema.
· Includes an IPTC reader/writer class as well.
Delphi y Arduino
Aquí tienen 2 programas que permiten controlar desde Delphi la placa de hardware arduino, uno es para leer la temperatura desde el sensor LM35 y el otro para apagar y encender unos leds.
Buscando en la red también encontré esta página donde explica cómo se interconecta el sensor LM35.
Autor: Roberto Ramirez
Descargar programa para leer la temperatura
PROGRAMA PARA CONTROLAR LEDs
{*
* Delphi LEDs Control
* -----------------
* Controls the state (ON/OFF) of 5 LEDs connected to an Arduino Board
* on Digital Pins 2,3,4,5,6 thru the serial comm
*
* Created April 02 2009
* copyleft 2009 Roberto Ramirez
* Full Source code at http://www.thepenguincult.com/proyectos/arduino-delphi-control/
*
*}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, CPort, CPortCtl, Menus;
type
TForm1 = class(TForm)
btn_connect: TButton;
ComPort1: TComPort;
StatusBar1: TStatusBar;
btn_Setup: TButton;
chk_led1: TCheckBox;
chk_led2: TCheckBox;
chk_led3: TCheckBox;
chk_led4: TCheckBox;
chk_led5: TCheckBox;
btn_loop: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
procedure btn_connectClick(Sender: TObject);
procedure btn_SetupClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure chk_led1Click(Sender: TObject);
procedure chk_led2Click(Sender: TObject);
procedure chk_led3Click(Sender: TObject);
procedure chk_led4Click(Sender: TObject);
procedure chk_led5Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btn_loopClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btn_connectClick(Sender: TObject);
begin
if ComPort1.Connected then
begin
btn_connect.Caption:='Connect'; // Toggle the caption of Connection Button
btn_Setup.Enabled:=True; // If not connected, lets enable the Setup Button
btn_loop.Enabled:=false; // Knight Rider demo button is disabled at first
// This block resets the state of all Leds to Off
// According to Arduino Code the Chars A,B,C,D,E are used
// to set Digital Pins (2-6) to LOW
comport1.WriteStr('A');
comport1.WriteStr('B');
comport1.WriteStr('C');
comport1.WriteStr('D');
comport1.WriteStr('E');
//-----------------------------------------------
// This block resets the state of all Check Boxes to Unchecked
chk_led1.Checked:=false;
chk_led2.Checked:=false;
chk_led3.Checked:=false;
chk_led4.Checked:=false;
chk_led5.Checked:=false;
//-----------------------------------------------
ComPort1.Close; // COM Port in use is closed
statusbar1.Panels[1].Text:='Disconnected'; // Status bar is set to display connection info
// This block disables the check boxes
// so the user cannot change them if COM Port is disconnected
chk_led1.Enabled:=false;
chk_led2.Enabled:=false;
chk_led3.Enabled:=false;
chk_led4.Enabled:=false;
chk_led5.Enabled:=false;
//------------------------------------------------
end
else
begin
btn_connect.Caption:='Disconnect'; // Toggle the caption of Connection Button
btn_Setup.Enabled:=False; // If not connected, lets disable the Setup Button
btn_loop.Enabled:=true; // Now that conection is posible Knight Rider demo button is enabled
ComPort1.Open; // COM Port in use is finally opened
statusbar1.Panels[1].Text:='Connected'; // Status bar is set to display connection info
// This block enables the check boxes
// so the user can change them to set LED states when COM Port is connected
chk_led1.Enabled:=true;
chk_led2.Enabled:=true;
chk_led3.Enabled:=true;
chk_led4.Enabled:=true;
chk_led5.Enabled:=true;
//------------------------------------------------
end
end;
procedure TForm1.btn_SetupClick(Sender: TObject);
begin
comport1.ShowSetupDialog; // Opens the predefined Setup Dialog (part of ComPort component)
statusbar1.Panels[0].Text:='Port in use ' + comport1.Port; // Status bar is set to display Port in use after setup dialog
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
statusbar1.Panels[0].Text:='Port in use ' + comport1.Port; // Status bar is set to display predefined Port in use at begining of program execution
if comport1.Connected=true then
statusbar1.Panels[1].Text:='Connected' // Status bar is set to display connection info at begining of program execution
else
statusbar1.Panels[1].Text:='Disconnected'
end;
// Next are the procedures to turning ON and OFF each led using the variables
// defined on both Arduino code and delphi code.
// Sending the predifined vars thru serial comm (on byte at the time)
// Ports 2,3,4,5,6 are turned ON by sending it corresponding var 1,2,3,4,5
// and they are turned OFF by sending it corresponding var A,B,C,D,E
procedure TForm1.chk_led1Click(Sender: TObject);
begin
if chk_led1.Checked=true then
comport1.WriteStr('1')
else
comport1.WriteStr('A')
end;
procedure TForm1.chk_led2Click(Sender: TObject);
begin
if chk_led2.Checked=true then
comport1.WriteStr('2')
else
comport1.WriteStr('B')
end;
procedure TForm1.chk_led3Click(Sender: TObject);
begin
if chk_led3.Checked=true then
comport1.WriteStr('3')
else
comport1.WriteStr('C')
end;
procedure TForm1.chk_led4Click(Sender: TObject);
begin
if chk_led4.Checked=true then
comport1.WriteStr('4')
else
comport1.WriteStr('D')
end;
procedure TForm1.chk_led5Click(Sender: TObject);
begin
if chk_led5.Checked=true then
comport1.WriteStr('5')
else
comport1.WriteStr('E')
end;
// Here ends the ON/OFF procedures for each led
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if ComPort1.Connected then
begin
comport1.WriteStr('A'); // If the application is closed, its good to leave
comport1.WriteStr('B'); // everything as we found it at start.
comport1.WriteStr('C'); // So we reset all the leds to OFF
comport1.WriteStr('D');
comport1.WriteStr('E');
ComPort1.Close;
end
end;
procedure TForm1.btn_loopClick(Sender: TObject);
begin
// We turn off all Led Check Boxes to allow a clean state before and after Knight Rider Demo mode
chk_led1.Checked:=false;
chk_led2.Checked:=false;
chk_led3.Checked:=false;
chk_led4.Checked:=false;
chk_led5.Checked:=false;
// Here begins the rough mode of Knight Rider Demo ;)
comport1.WriteStr('1');
Sleep(50);
comport1.WriteStr('A');
Sleep(50);
comport1.WriteStr('2');
Sleep(50);
comport1.WriteStr('B');
Sleep(50);
comport1.WriteStr('3');
Sleep(50);
comport1.WriteStr('C');
Sleep(50);
comport1.WriteStr('4');
Sleep(50);
comport1.WriteStr('D');
Sleep(50);
comport1.WriteStr('5');
Sleep(50);
comport1.WriteStr('E');
Sleep(50);
comport1.WriteStr('4');
Sleep(50);
comport1.WriteStr('D');
Sleep(50);
comport1.WriteStr('3');
Sleep(50);
comport1.WriteStr('C');
Sleep(50);
comport1.WriteStr('2');
Sleep(50);
comport1.WriteStr('B');
Sleep(50);
comport1.WriteStr('1');
Sleep(50);
comport1.WriteStr('A');
Sleep(50);
end;
end.
Manejar archivos DICOM
DICOM (Digital Imaging and Communication in Medicine) es el estándar
reconocido mundialmente para el intercambio de imágenes médicas, pensado
para el manejo, almacenamiento, impresión y transmisión de imágenes médicas.
Mas abajo pueden descargarse un conversor de archivos
en formato DICOM a bmp, jpg o png y un visor de imágenes que
incluye el objeto ActiveX ezDICOMax.ocx.
Para instalarlo:
Desde Delphi seleccionar 'Import ActiveX Control' desde el
menú "component" y después pulsar "Add" y
"Install" seleccionado el archivo DCMaxPro.OCX que está incluido en
la carpeta.
Una vez que se ha instalado correctamente se debería ver el
componente "DCMax" en la pestaña "ActiveX" de la barra de
componentes.
Si da un error del tipo "eOlesyserror" es porque no
se ha registrado el activex llamado ezDICOMax.ocx
Para instalarlo teclear: c:\regsvr32 ezDICOMax.ocx
y para desinstalarlo c:\regsvr32 /u ezDICOMax.ocx
Codigo fuente en Delphi :
Conversor de imagenes DICOM a bmp,jpg,png
Autor: Wolfgang Krug and Chris Rorden
chris.rorden@nottingham.ac.uk
Visor de imagenes
PROCEDIMIENTOS DEL PROGRAMA
procedure TForm1.ToolClick(Sender: TObject);
begin
DCMax1.DCMtool := (sender as TSpeedButton).tag;
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.Open1Click(Sender: TObject);
begin
if not OpenDialog1.execute then exit;
DCMax1.DCMfilename := OpenDialog1.Filename;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DCMax1.DCMtoolbar := false;
Smooth1.Checked := DCMax1.DCMsmoothOn;
end;
procedure TForm1.N2001Click(Sender: TObject);
var lPct: integer;
begin
(Sender as TMenuItem).Checked := true;
lPct := (Sender as TMenuItem).tag;
if lPct = 0 then begin
if not DCMax1.DCMbestFitZoom then
DCMax1.DCMbestFitZoom := true;
end else begin
if DCMax1.DCMbestFitZoom then
DCMax1.DCMbestFitZoom := false;
DCMax1.DCMzoomPct := lPct;
end;
end;
procedure TForm1.Smooth1Click(Sender: TObject);
begin
Smooth1.Checked := not Smooth1.Checked;
DCMax1.DCMsmoothOn := Smooth1.Checked;
end;
procedure TForm1.InvertedHotmetal1Click(Sender: TObject);
begin
(Sender as TMenuItem).Checked := true;
DCMax1.DCMcolorscheme := (Sender as TMenuItem).tag;
end;
procedure TForm1.N3x3Click(Sender: TObject);
var lMosaic: integer;
begin
lMosaic := (Sender as TMenuItem).tag;
(Sender as TMenuItem).checked := true;
//Form1.caption := inttostr(lMosaic);
DCMax1.DCMmosaicFirstSlice := 1;
DCMax1.DCMmosaicLastSlice := maxint;
DCMax1.DCMmosaicRows := lMosaic;
DCMax1.DCMmosaicCols := lMosaic;
//DCMax1.DCMmosaicX[lMosaic,lMosaic,1] := MaxInt;
//DCMax1.DCMmosaicX[2,2,1,16];
//xxxx
end;
procedure TForm1.DelphiDemo1Click(Sender: TObject);
begin
showmessage('DelphiDemo by Chris Rorden. Demonstrates ezDICOM ActiveX component. '+
DCMax1.DCMversionInfo);
end;
procedure TForm1.ShowHeader1Click(Sender: TObject);
begin
ShowHeader1.Checked := not ShowHeader1.Checked;
DCMax1.DCMshowHeader := ShowHeader1.Checked;
end;
procedure TForm1.Copy1Click(Sender: TObject);
begin
if DCMax1.DCMshowHeader then
DCMax1.DCMcopyHeader2Clipboard
else
DCMax1.DCMcopyImage2Clipboard;
end;
procedure TForm1.Saveimage1Click(Sender: TObject);
begin
if not SaveDialog1.Execute then exit;
DCMax1.DCMsaveToFile := SaveDialog1.FileName;
end;
procedure TForm1.Border1Click(Sender: TObject);
begin
// DCMax1.DCMmo
end;
procedure TForm1.Unloadimages1Click(Sender: TObject);
begin
end;
(*procedure TForm1.Loadc0020dcm50times1Click(Sender: TObject);
var lInc: integer;
begin
for lInc := 1 to 50 do
DCMax1.DCMfilename := 'C:\0020.dcm';
end;
procedure TForm1.Unloadimages1Click(Sender: TObject);
begin
DCMax1.DCMunloadImages:= 0;
end;
*)
procedure TForm1.PreviousSliceItemClick(Sender: TObject);
begin
if DCMax1.DCMslice > 1 then
DCMax1.DCMslice := DCMax1.DCMslice -1
else
DCMax1.DCMslice := DCMax1.DCMimageSlices;
end;
procedure TForm1.NextSliceItemClick(Sender: TObject);
begin
if DCMax1.DCMslice < DCMax1.DCMimageSlices then
DCMax1.DCMslice := DCMax1.DCMslice +1
else
DCMax1.DCMslice := 1;
end;
procedure TForm1.DCMax1DCMmouseMoveIntensity(ASender: TObject; X, Y,
Button, Shift, Intensity: Integer; RGB: WordBool);
begin
Caption := inttostr(X)+','+inttostr(Y)+':'+inttostr(intensity);
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
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
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
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;
Suscribirse a:
Entradas (Atom)
Simulación del movimiento de los electrones en un campo electrico
Espectacular simulación realizada con OpenGL del movimiento de los electrones cuando atraviesan un campo eléctrico. Como muestra la image...
-
Este programa sirve para calcular los valores de un resistor en función del color de las bandas de colores que lleva serigrafiadas en su s...
