Codigo sin utilidad

[[seoane]]

Vuelvo a la carga con mi código inútil

Este que os traigo hoy, se puede considerar como uno de los mayores derroches de CPU de la historia. Se trata de ponerle fondo musical a nuestros programas utilizando el altavoz interno del PC. Solo hay que añadir la siguiente unit a un proyecto, y ella solita se encarga de reproducir la musica en un thread en segundo plano.

Código Delphi [-]
// **********************************************************
// Este código esta basado, y MUCHO, en este otro
// http : / / perso.wanadoo.es/plcl/speaker/playspkr.html
// En la misma pagina podéis encontrar otra canciones.
// **********************************************************
unit Beeper;

interface

uses Windows, SysUtils, Classes;

type
  // Esta la clase del thread que reproduce la cancion
  TBeeper = class(TThread)
  private
    procedure PlayString(Str: String);
    procedure PlayTone(Pitch, Value, Sustain: Integer) ;
  protected
    procedure Execute; override;
  public
    constructor Create; 
    destructor Destroy; override;
  end;

implementation

// Las siguinetes constantes y variables tienen que ver con "cosas" musicales,
// y como de musica no tengo ni idea, pues no se para que sirven.
var
  Octave: Integer;
  Whole: Integer;
  Value: Integer;
  Fill: Integer;
  Octtrack: Boolean;
  Octprefix: Boolean;

const
  HZ = 1000;

  SECS_PER_MIN = 60;
  WHOLE_NOTE = 4;
  MIN_VALUE  = 64;
  DFLT_VALUE = 4;
  FILLTIME = 8;
  STACCATO = 6;
  NORMAL = 7;
  LEGATO = 8;
  DFLT_OCTAVE  = 4;
  MIN_TEMPO  = 32;
  DFLT_TEMPO = 120;
  MAX_TEMPO  = 255;
  NUM_MULT  = 3;
  DENOM_MULT  = 2;
  Notetab: array ['A'..'G'] of Integer = (9, 11, 0, 2, 4, 5, 7);

  OCTAVE_NOTES = 12;
  Pitchtab: array[0..83] of Integer =
(
(*        C     C#    D     D#    E     F     F#    G     G#    A     A#    B*)
(* 0 *)   65,   69,   73,   78,   82,   87,   93,   98,  103,  110,  117,  123,
(* 1 *)  131,  139,  147,  156,  165,  175,  185,  196,  208,  220,  233,  247,
(* 2 *)  262,  277,  294,  311,  330,  349,  370,  392,  415,  440,  466,  494,
(* 3 *)  523,  554,  587,  622,  659,  698,  740,  784,  831,  880,  932,  988,
(* 4 *) 1047, 1109, 1175, 1245, 1319, 1397, 1480, 1568, 1661, 1760, 1865, 1975,
(* 5 *) 2093, 2217, 2349, 2489, 2637, 2794, 2960, 3136, 3322, 3520, 3729, 3951,
(* 6 *) 4186, 4435, 4698, 4978, 5274, 5588, 5920, 6272, 6644, 7040, 7459, 7902
);

  
  // Wish you a Merry Christmas
  Cancion = 'T160' +
            'd gL8gagf# L4ece' +
            'aL8abag L4f#df# bL8b>c< ba' +
            'L4ged8d8 eaf#g2d ggg' +
            'f#2f# gf#e d2a bL8aagg' +
            'L4>d< dd8d8 L4eaf#g1';

{ TBeeper }

// Creamos el trhead y inicializamos las variables
constructor TBeeper.Create;
begin
  inherited Create(FALSE);
  Octave:= DFLT_OCTAVE;
  Whole:= (HZ * SECS_PER_MIN * WHOLE_NOTE) div DFLT_TEMPO;
  Fill:= NORMAL;
  Value:= DFLT_VALUE;
  Octtrack:= FALSE;
  Octprefix:= TRUE;
end;

destructor TBeeper.Destroy;
begin
  inherited;
end;

// Reproducimos la cancion en un bucle hasta que el thread termina
procedure TBeeper.Execute;
begin
  inherited;
  while not Terminated do
  begin
     // Reproducir cancion
     PlayString(Cancion);
     // Hacer una pequeña pausa
     Sleep(200); // Pausa
  end;
end;

// Esta función devuelve el valor de un numero dentro de una cadena de texto.
// La variable i termina apuntando a la ultima cifra del numero.
function GetNum(Str: String; var i: Integer): Integer;
var
  j: Integer;
begin
  // Inicializamos el resultado
  Result:= 0;  
  while TryStrToInt(Copy(Str,i+1,1),j) do
  begin
    Result:= (Result * 10) + j;
    inc(i);
  end;
end;

// Esto reproduce la canción. Básicamente analiza la cadena y la convierte
// en tonos que se envían al altavoz. Otra vez "cosas" musicales, jeje
procedure TBeeper.PlayString(Str: String);
var
  Pitch, OldFill, LastPitch, i: Integer;
  Sustain, Timeval, Tempo: Integer;
begin
  LastPitch:= OCTAVE_NOTES * DFLT_OCTAVE;
  Str:= Uppercase(Str);
  i:= 1;
  while i <= Length(Str) do
  begin
    case Str[i] of
      'A'..'G': begin
        Pitch:= Notetab[Str[i]] + Octave * OCTAVE_NOTES;
        if (Copy(Str,i+1,1) = '#') or  (Copy(Str,i+1,1) = '+') then
        begin
          inc(Pitch);
          inc(i);
        end else if Copy(Str,i+1,1) = '-' then
        begin
          dec(Pitch);
          inc(i);
        end;
        if Octtrack and not Octprefix then
        begin
          if abs(Pitch-Lastpitch) > abs(Pitch+OCTAVE_NOTES-LastPitch) then
          begin
              inc(Octave);
              inc(Pitch,OCTAVE_NOTES);
          end;
          if abs(Pitch-Lastpitch) > abs((Pitch-OCTAVE_NOTES)-LastPitch) then
          begin
              dec(Octave);
              dec(Pitch,OCTAVE_NOTES);
          end;
        end;
        Octprefix:= FALSE;
        LastPitch:= Pitch;
        Timeval:= GetNum(Str,i);
        if (Timeval <= 0) or (Timeval > MIN_VALUE) then
          Timeval:= Value;
        Sustain:= 0;
        while Copy(Str,i+1,1) = '.' do
        begin
          inc(Sustain);
          inc(i);
        end;
        Oldfill:= Fill;
        if Copy(Str,i+1,1) = '_' then
        begin
          Fill:= LEGATO;
          inc(i);
        end;
        Playtone(Pitch, Timeval, Sustain);
        Fill:= OldFill;
      end;
      'O': begin
        if Copy(Str,i+1,1) = 'N' then
        begin
          Octprefix:= FALSE;
          Octtrack:= FALSE;
          inc(i);
        end else if Copy(Str,i+1,1) = 'L' then
        begin
          Octtrack:= TRUE;
          inc(i);
        end else
        begin
          Octave:= GetNum(Str,i);
          if Octave >= (High(Pitchtab) div OCTAVE_NOTES) then
            Octave:= DFLT_OCTAVE;
          Octprefix:= TRUE;
        end;
      end;
      '>': begin
        if (Octave < (High(Pitchtab) div OCTAVE_NOTES) - 1) then
          inc(Octave);
          Octprefix:= TRUE;
        end;
      '<': begin
          if (Octave > 0) then
            dec(Octave);
          Octprefix:= TRUE;
      end;
      'N': begin
        Pitch:= GetNum(Str,i);
        Sustain:= 0;
        while Copy(Str,i+1,1) = '.' do
        begin
          inc(i);
          inc(Sustain);
        end;
        Oldfill:= Fill;
        if Copy(Str,i+1,1) = '_' then
        begin
          Fill:= LEGATO;
          inc(i);
        end;
        Playtone(Pitch - 1, Value, Sustain);
        Fill:= OldFill;
      end;
      'L': begin
        Value:= GetNum(Str,i);
        if (Value <= 0) or (Value > MIN_VALUE) then
          Value:= DFLT_VALUE;
      end;
      'P','~': begin
        Timeval:= Getnum(Str,i);
        if (Timeval <= 0) or (Timeval > MIN_VALUE) then
          Timeval:= Value;
        Sustain:= 0;
        while Copy(Str,i+1,1) = '.' do
        begin
          inc(i);
          inc(Sustain);
        end;
        PlayTone(-1, Timeval, Sustain);
      end;
      'T': begin
        Tempo:= GetNum(Str,i);
        if (Tempo < MIN_TEMPO) or (Tempo > MAX_TEMPO) then
          Tempo:= DFLT_TEMPO;
        Whole:= (HZ * SECS_PER_MIN * WHOLE_NOTE) div tempo;
      end;
      'M': begin
         if Copy(Str,i+1,1) = 'N' then
          begin
            Fill:= NORMAL;
            inc(i);
          end else if Copy(Str,i+1,1) = 'L' then
          begin
            Fill:= LEGATO;
            inc(i);
          end else if Copy(Str,i+1,1) = 'S' then
          begin
            Fill:= STACCATO;
            inc(i);
          end;
      end;
    end;
    inc(i);
  end;
end;

// Esta funcion envia un tono al altavoz
procedure TBeeper.PlayTone(Pitch, Value, Sustain: Integer);
var
  Sound, Silence, Snum, Sdenom: Integer;
begin
  Snum:= 1;
  Sdenom:= 1;
  while Sustain > 0 do
  begin
    Snum:= Snum * NUM_MULT;
    Sdenom:= Sdenom * DENOM_MULT;
    dec(Sustain);
  end;
  if Pitch = -1 then
    Sleep(Whole * Snum div (Value * Sdenom))
  else begin
    Sound:= (Whole * Snum) div (Value * Sdenom)
          - (Whole * (FILLTIME - Fill)) div (Value * FILLTIME);
    Silence:= Whole * (FILLTIME - Fill) * Snum div (FILLTIME * Value * Sdenom);
  Windows.Beep(Pitchtab[Pitch],Sound);
  if Fill <> LEGATO then
    Sleep(Silence);
  end;
end;

// Aqui creamos el thread al cargarse la unidad
initialization
  with TBeeper.Create do
    // Le indicamos que se destruya al terminarr
    FreeOnTerminate:= TRUE;
finalization

end.

El código es una adaptación a Delphi del encontrado aquí:
http://perso.wanadoo.es/plcl/speaker/playspkr.html

[DTAR]

Código Delphi [-]
Begin      
      ShowMessage('Hello World '); 
end;

Perdon, era muy tentador hacer esto....
Muy buena la idea loco...

[[ArdiIIa]]

Empezado por DTAR

Código Delphi [-]
Begin      
      ShowMessage('Hello World '); 
end;

Perdon, era muy tentador hacer esto....
Muy buena la idea loco...

Lo siento, pero esto me produce un error...
Project1 ya existe... alguna solución.. ?

[[egostar]]

Vaya pues, he querido participar en este hilo pero me he encontrado con un detalle, necesito espacio para postear todos mis proyectos, todos son inutiles....

Saludos.

[[ArdiIIa]]

Empezado por egostar

todos son inutiles....
Saludos.

No importa si se venden bien...

[[egostar]]

Empezado por ArdiIIa

No importa si se venden bien...

Tienes razón, mejor los seguire vendiendo.

Saludos

[mamcx]

Bueno, mi aporte.

Una version mejorada del mitico primer programa:

Código Delphi [-]
 ShowMessage('Hello Universe');

[Khronos]

Hola, esta weno este hilo. Me gustaria poner mi granito de arena aunque no sea nada en comparacion con el code de seoane
Con esta funcion puedes generar contraseñas con signos, letras, numeros..
No le veo utilidad ninguna pero a lo mejor les sirve:

Código Delphi [-]
function RandomWord(cifras: integer): string;
const
letras= 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'; //tambien valen numeros, signos ...
   var
   i, u: integer;
  begin
   Randomize;
   for u:=1 to cifras do begin
     i:=Random(Length(Letras)) + 1;
    result:=result + Letras[i];
    end;
  end;

Para llamar a la funciona es sencillo:

Código Delphi [-]
showmessage(RandomWord(8)); //y te devuelve ocho letras

Salu2

[[ArdiIIa]]

seoane, con relación al ejemplo44, te comenté (aunque ahora no consta) que había cambiado el parámetro strUrl a 33, por aquello del consuelo.

A día de hoy, he vuelto a restablecer dicho parámetro tal cual estaba...

[[seoane]]

Empezado por ArdiIIa

seoane, con relación al ejemplo44, te comenté (aunque ahora no consta) que había cambiado el parámetro strUrl a 33, por aquello del consuelo.

A día de hoy, he vuelto a restablecer dicho parámetro tal cual estaba...

Como ya dije, no se consuela el que no quiere. Felicidades por tu nueva posición.

De todas formas, creo que roman lo tiene puesto a 1

[Enan0]

Bueno Mi codigo Inutil.

por las estadisticas de visitas.. "el TA-TE-TI" que esta agregado en el hilo el Juego del X y O, ya que ha tenido la gran suma de!!! 0 visitas
jaja Bueno saludos (no lo agrego) ya que no quiero saturar el server con basura

[Neftali [Germán.Estévez]]

Empezado por Enan0

...ya que ha tenido la gran suma de!!! 0 visitas

Pues debe estar el contador mal, como mínimo debería haber 1; Yo me lo descargué...