Cálculo de valores de resistencias eléctricas

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
 

Descarga código fuente

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.

http://www.thepenguincult.com/proyectos/arduino-delphi-lm35/

Autor: Roberto Ramirez

Descargar programa para controlar LEDs

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.

Simular un doble clic sobre la pantalla

Hace tiempo que quería obtener una función como la siguiente, sobre todo para conseguir
ahorrarme alguna acción repetitiva que tengo que realizar diariamente como informático.
Según Microsoft recomienda utilizar la función SendInput en vez de Mouse_Event, sin
embargo las pruebas que he realizado con SendInput no me han funcionado cuando se trata
de simular clics de ratón.

procedure TForm1.Button1Click(Sender: TObject);
var
P: TPoint;
begin
GetCursorPos(P); //almcacena la posición actual del cursor
SetCursorPos(Left + 10, Top + 10);
Mouse_Event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
Mouse_Event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
GetDoubleClickTime;
Mouse_Event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
Mouse_Event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
SetCursorPos(P.X, P.Y); //restaura el cursor a la posición original
end;

Vumetro

Un vúmetro 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 





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.
 

Tarjeta controladora y tarjeta de desarrollo

DelphiController y DelphiDevBoard es un controlador de dispositivos y una tarjeta de desarrollo que permiten practicar la programación de sistemas embebidos y microcontroladores. Se proporcionan plantillas, compilador compatible en Pascal y un entorno de depuración y desarrollo basado en un IDE standard. (Delphi, FreePascal)
Más información en www.blaisepascal.eu

Hardware.
M324D40 DelphiCPU
www.blaisepascal.eu
A programmed AtMega324 40 pin dual in line controller chip measuring
50 x 17 x 4 mm. This chip contains all basic computer parts like :
- 32 kBytes Flash memory for program storage
- 2 kByte RAM for variables
- 32 general purpose registers
- 1 kByte of EeRom for non - volatile storage
- a AVR CPU
- a hardware multiplier for fast mathematics
- a clock oscillator able to run up to 20 MHz.
The chip also contains a set of input and output peripherals like :
- JTAG interface for real-time debugging
- 3 timer counters with interrupts for a system clock and delays
- 6 PWM channels which can be used for motor speed and direction
control
- 8 analog to digital converters 10 Bit with 1x, 10x and 200x amplifiers
for interfacing with analog sensors, voltages and potentiometers
- I2C interface for expanding the number of peripherals
- Watchdog timer for automatic reset when a failure is detected
- Analog comparator for accurate level detection
- 32 programmable digital in- and output lines for lamps, switches,
LCD, TCP/IP etc.
4 KByte of the 32 KByte flash is reserverved and
preprogrammed with the:
- OS : an operating system implementing a system clock, starting of
servers and user applications
- BIOS : I/O drivers for EeRom and standard hardware
- Hardware test : standard hardware test application
- M485A server : monitor for RAM and EeRom including a Flash
programmer for user applications
- I/O server : synchronized I/O with RAM records

Author:
Anton J. Vogelaar

Funciones para manipular bits

//lee si un bit determinado es igual a 1



function Get_a_Bit(const aValue: Cardinal; const Bit: Byte): Boolean;

begin

Result := (aValue and (1 shl Bit)) <> 0;

end;



//pone un bit determinado a 1



function Set_a_Bit(const aValue: Cardinal; const Bit: Byte): Cardinal;

begin

Result := aValue or (1 shl Bit);

end;



//pone un determinado bit a 0



function Clear_a_Bit(const aValue: Cardinal; const Bit: Byte): Cardinal;

begin

Result := aValue and not (1 shl Bit);

end;



//Activa o desactiva un bit



function Enable_a_Bit(const aValue: Cardinal; const Bit: Byte; const Flag: Boolean): Cardinal;

begin

Result := (aValue or (1 shl Bit)) xor (Integer(not Flag) shl Bit);

end;

Controlar 8 inputs / 16 outputs del PIC18F4550 desde USB

Aquí se muestra la forma para manejar 8 entradas y 16 de salidas del microprocesador PIC18F4550 desde el puerto USB. Se necesita cargar previamente el fichero PIC.HEX en el micro.

Existen 2 versiones, en una utilizan la API de Windows y en la otra el componente TJvHidController que se puede descargar desde aquí:

http://www.soft-gems.net/index.php?option=com_content&task=view&id=14&Itemid=33



Código fuente en Delphi



Autor: rylryl

Página personal: http://pageperso.aol.fr/CRylou/TC_UNIV_rylryl.html

Osciloscopio con la tarjeta de sonido

Podemos utilizar la tarjeta de sonido como si fuese la sonda de entrada de un osciloscopio, con ello limitaremos el rango y la amplitud de frecuencias que podemos ver pero como material educativo y de experimentación es mas que suficiente.

Tiene un botón llamado "Spectrum" que analiza la amplitud de cada una de las frecuencias contenidas en una muestra. Se utiliza la transformada rápida de Fourier para analizar la señal.

Descargar programa



http://delphiforfun.org/programs/oscilloscope.htm

Autoclic con Delphi

Software para simular pulsaciones de teclado

Este programa permite grabar las secuencias de puntos sobre la pantalla para después simular la pulsación de 1 clic de ratón sobre ellos, también es posible especificar un nombre para las secuencias a teclear y poner un delay entre cada clic y entre cada secuencia.

Con este soft podrán hacer clic a intervalos regulares sobre un banner y además evitar muchas secuencias repetitivas que los programadores tenemos que hacer a diario.



Autor:

http://pogopixels.fr/



Código fuente

Emulador PIC 16F84 con Delphi

Es uno de los microcontroladores más populares del mercado, ideal para principiantes, debido a su arquitectura de 8 bits, 18 pines, y un set de instrucciones RISC muy amigable para memorizar y fácil de entender, internamente consta de:

• Memoria Flash de programa (1K x 14).


• Memoria EEPROM de datos (64 x 8).


• Memoria RAM de 68 registros x 8.


• Un temporizador/contador (timer de 8 bits).


• Un divisor de frecuencia.


• Varios puertos de entrada-salida (13 pines en dos puertos, 5 pines el puerto A y 8 pines el puerto B).

En este caso os presento un emulador freeware realizado en Delphi con código fuente incluido.



Link de descarga

Bloquear disco

Esta es una utilidad que permitirá bloquear el acceso a cualquier unidad de disco de vuestro sistema. No usa componente de terceros, todo se programa con las units de Delphi standard.
Recordar que antes de cerrar la aplicación tienen que pulsar el botón "unlock" para desbloquear el disco.
Está probado en Delphi 7 y funciona incluso con unidades USB.

Código fuente

Optimizando la memoria del sistema

Cuando una aplicación se minimiza se libera parte de la memoria virtual no utilizada y eso es porque Windows realiza una llamada a la función SetProcessWorkingSetSize.

En el caso de Delphi existe un código de inicialización de las units que ocupa mucho espacio, pero que sólo se necesita durante el arranque del programa. Por consiguiente realizando regularmente llamadas a esta función podremos optimizar la utilización de memoria de nuestra aplicación.

El código sería el siguiente:

procedure Optimizar_memoria;
var
MainHandle : THandle;
begin
try
MainHandle := OpenProcess(PROCESS_ALL_ACCESS, false, GetCurrentProcessID);
SetProcessWorkingSetSize(MainHandle,DWORD(-1),DWORD(-1));
finally
CloseHandle(MainHandle);
end;
end;

Extracción segura de un pendrive

Para los interesados en saber cómo extraer un pendrive de forma segura con Delphi, aquí os dejo un documento con varias funciones que os resolverán esta tarea.

function OpenVolume(ADrive: char): THandle;

function LockVolume(AVolumeHandle: THandle): boolean;

function DismountVolume(AVolumeHandle: THandle): boolean;

function PreventRemovalOfVolume(AVolumeHandle: THandle; APreventRemoval: boolean): boolean;

function AutoEjectVolume(AVolumeHandle: THandle): boolean;

function EjectVolume(ADrive: char): boolean;

CODIGO FUENTE EN DELPHI

También se puede extraer el pendrive mediante llamada a la función HotPlugEjectDevice de la librería hotplug.dll de Windows.

Su definición en Delphi es:
function HotPlugEjectDevice(hwndParent: Cardinal; lpDeviceInstanceId: PWideChar): LongBool; stdcall external 'hotplug';

El código con WinExec es el siguiente:
WinExec(PChar('c:\windows\system32\rundll32 hotplug.dll,HotplugEjectDevice '),SW_SHOWNORMAL);

y para hacer aparecer la ventana de desconectar hardware sería:
WinExec(PChar('c:\windows\system32\rundll32 shell32.dll,Control_RunDLL hotplug.dll'),SW_SHOWNORMAL);

Osciloscopio en tiempo real

Aquí os dejo un link interesante para montaros vuestro osciloscopio programado en Delphi.







Es un componente de dibujo en tiempo real y un osciloscopio virtual.



Tiene ejemplos de código para Cpp, Visual, Mathworks y por supuesto Delphi.



Se puede descargar desde aquí:

http://www.oscilloscope-lib.com/oscilloscope_DLL.zip





Página principal:

http://www.oscilloscope-lib.com/

Disable the mouse wheel

Is there any way to disable the mouse wheel for a particular application or form?

Answer:

You can use a handler for the Application.OnMessage event to filter out messages (e.g WM_MOUSEWHEEL) before any control in your application sees them. Note that this will not work with all mouse drivers. There are some that can be configured to not post the standard wheel messages but to send WM_VSCROLL messages instead if the control under the mouse has scrollbars. This "compatibility mode" is there to make the wheel usable with applications that do not have wheel support build in.

procedure TMainForm.FormCreate(Sender: TObject);
begin
Application.OnMessage := AppMessage;
end;
procedure TMainform.Appmessage(var Msg: TMsg; var Handled: Boolean);
begin
Handled := msg.Message = WM_MOUSEWHEEL;
end;

If you only want to do this for a specific form class you would modify this method to

procedure TMainform.Appmessage(var Msg: TMsg; var Handled: Boolean);
begin
Handled := (msg.Message = WM_MOUSEWHEEL) and
(Screen.Activeform is TMySpecialFormclass);
end;

Author: Peter Below

Check whether a mouse button is being pressed

...
uses
Windows;
...
function IsBtnPressed(ABtn: integer): boolean;
//ABtn can be either VK_LBUTTON, VK_MBUTTON, or VK_RBUTTON
begin
result := (GetAsyncKeyState(ABtn) and $8000) = $8000;
end

Capture mouse clicks at statusbar

uses
Windows, Messages, Forms, Classes, SysUtils, Controls, ComCtrls, Commctrl;
type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
procedure FormCreate(Sender: TObject);
private
procedure WMNotify(var AMsg: TWMNotify); message WM_NOTIFY;
end;
...
procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
begin
for i := 0 to 3 do
with StatusBar1.Panels.Add do begin
Width := 100;
Text := Format(’Panel %d’,[i]);
end;
end;
procedure TForm1.WMNotify(var AMsg: TWMNotify);
var
pNMM: PNMMouse;
ctrl: TWinControl;
hWindow: HWND;
iPanel: integer;
begin
inherited;
pNMM := PNMMouse(AMsg.NMHdr);
hWindow := pNMM^.hdr.hwndFrom;
ctrl := FindControl(hWindow);
iPanel := pNMM^.dwItemSpec;
case pNMM^.hdr.code of
NM_CLICK:
Caption := Format(’%s was clicked at panel %d’,[ctrl.Name,iPanel]);
NM_DBLCLK:
Caption := Format(’%s was doubleclicked
at panel %d’,[ctrl.Name,iPanel]);
NM_RCLICK:
Caption := Format(’%s was rightclicked
at panel %d’,[ctrl.Name,iPanel]);
NM_RDBLCLK:
Caption := Format(’%s was rightdoubleclicked
at panel %d’,[ctrl.Name,
iPanel]);
end;
end;

How to format a disk

const
SHFMT_DRV_A = 0;
SHFMT_DRV_B = 1;
SHFMT_ID_DEFAULT = $FFFF;
SHFMT_OPT_QUICKFORMAT = 0;
SHFMT_OPT_FULLFORMAT = 1;
SHFMT_OPT_SYSONLY = 2;
SHFMT_ERROR = -1;
SHFMT_CANCEL = -2;
SHFMT_NOFORMAT = -3;

function SHFormatDrive(hWnd: HWND;
Drive: Word;
fmtID: Word;
Options: Word): Longint
stdcall; external 'Shell32.dll' Name 'SHFormatDrive';

procedure TForm1.Button1Click(Sender: TObject);
var
FmtRes: Longint;
begin
try
FmtRes := ShFormatDrive(Handle,
SHFMT_DRV_A,
SHFMT_ID_DEFAULT,
SHFMT_OPT_QUICKFORMAT);
case FmtRes of
SHFMT_ERROR: ShowMessage('Error formatting the drive');
SHFMT_CANCEL: ShowMessage('User canceled formatting the drive');
SHFMT_NOFORMAT: ShowMessage('No Format')
else
ShowMessage('Disk has been formatted!');
end;
except
ShowMessage('Error Occured!');
end;
end;
{
Normally, if a diskette is not in the drive when SHFormatDrive is called,
the system displays a critical error dialog box that asks the user
to Abort, Retry, or Ignore.
You can prevent the system from displaying this dialog box by calling
the SetErrorMode API with SEM_FAILCRITICALERRORS.
}
var
EMode: Word;
begin
EMode := SetErrorMode(SEM_FAILCRITICALERRORS);
SetErrorMode(EMode);
end;

Get the keyboard input language

When my application starts, I need to switch the keyboard language to Greek. Currently I use the statement ActivateKeyboardlayout(0, 0). When I need to switch to English (when the application terminates) I execute the same statement one more time. This works fine, but only if the language before the application's execution is English. So, before the call of the statement, I need to know if the language is Greek or English. How can do this?


I usually use the following cycle:
{ ... }
GetKeyboardLayoutName(@t);
y := string(t);
repeat
ActivateKeyboardLayout(HKL_NEXT, 0);
GetKeyboardLayoutName(@t);
x := string(t);
until
((x = y) or (x = '00000405'));

{ ... }
Using this, the English keyboard will give the KeyboardLayoutName '00000409' and the Greek one the '000000408'. These are standard language identifiers. They're the same on any Windows machine.
To display the information, you could use this little trick:
{ ... }
var
kbd: array[0..2] of Char;
begin
GetLocaleInfo(loWord(GetKeyboardLayout(0)), LOCALE_SENGLANGUAGE, kbd, 2);
Form1.Caption := kbd;
{ ... }


Author: Lou Adler
Product: Delphi 7.x (or higher)

Determine the processor speed in MHz

Here is a handy routine which will return an estimated core processor speed (CPU speed) of your PC. Read the comment to see how to use it.



function GetCpuSpeed: Comp;

{ function to return the CPU clock speed only. }

{ Usage: MessageDlg(Format('%.1f MHz', [GetCpuSpeed]), mtConfirmation, [mbOk], 0); }

var

t: DWORD;

mhi, mlo, nhi, nlo: DWORD;

t0, t1, chi, clo, shr32: Comp;

begin

shr32 := 65536;

shr32 := shr32 * 65536;

t := GetTickCount;

while t = GetTickCount do

begin

end;

asm

DB 0FH

DB 031H

mov mhi,edx

mov mlo,eax

end;

while GetTickCount < (t + 1000) do

begin

end;

asm

DB 0FH

DB 031H

mov nhi,edx

mov nlo,eax

end;

chi := mhi;

if mhi < 0 then

chi := chi + shr32;

clo := mlo;

if mlo < 0 then

clo := clo + shr32;

t0 := chi * shr32 + clo;

chi := nhi;

if nhi < 0 then

chi := chi + shr32;

clo := nlo;

if nlo < 0 then

clo := clo + shr32;

t1 := chi * shr32 + clo;

Result := (t1 - t0) / 1E6;

end;