Codigo sin utilidad

[[seoane]]

Empezado por ArdiIIa

Pues mira, quería aportar mi granito a este hilo, y de momento va a ser que no. Parece que todo lo que hago resulta útil .
Esto no es código pero buscando en la sección de trucos un poco de código, resulta que me he encontrado con algo que me ha resultado inútil...

• si buscas por sector: no devuelve nada
• si buscas por cluster: no devuelve nada
• si buscas por sector cluster: el resultado es inútil...

Eso es porque no sabes como buscar
http://www.clubdelphi.com/trucos/index.php?id=356

O porque nadie mira mis hilos
http://www.clubdelphi.com/foros/showthread.php?t=34186
http://www.clubdelphi.com/foros/show...83&postcount=8

Pero estamos hablando de código inútil, ya veo que tu te has animado. Haber si alguien mas se anima ... Vale cualquier cosa ...

[dec]

Hola,

Hombre, este Hilo parece pensado para cierto ¿programa? que escribí hace tiempo para ilustrar no sé qué Hilo de estos Foros. Nótese que no he tocado una coma del código para publicarlo en este Hilo:

Código Delphi [-]
{*******************************************************}
{                                                       }
{       Pelota Loca, un programa inútil (?)             }
{                                                       }
{       Copyright (c) 2006 David Esperalta              }
{                                                       }
{               GNU Public License                      }
{                                                       }
{*******************************************************}

program PelotaLoca;

{$APPTYPE CONSOLE}

uses
  Forms,
  Windows,
  Classes,
  SysUtils,
  Controls,
  ExtCtrls,
  Graphics;

const
  CANTIDAD_MOVIMIENTO = 15; { Cantidad de movimiento }

var
  FForm  : TForm;
  FShape : TShape;

type
  TAuxiliar = class
  private
    FTimer: TTimer;
    procedure TimerTick(Sender: TObject);
    procedure KeyDownEvent(Sender: TObject;
               var Key: Word; Shift: TShiftState);
  public
    constructor Create;
    destructor Destroy; override;
  end;

{ TAuxiliar }

constructor TAuxiliar.Create;
begin
  FTimer := TTimer.Create(nil);
  FTimer.Interval := 100;
  FTimer.Enabled  := true;
  FTimer.OnTimer  := TimerTick;
end;

destructor TAuxiliar.Destroy;
begin
  FTimer.Free;
  inherited Destroy;
end;

procedure TAuxiliar.KeyDownEvent(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  with FShape do case Key of
    VK_UP:    Top  := Top  - CANTIDAD_MOVIMIENTO;
    VK_RIGHT: Left := Left + CANTIDAD_MOVIMIENTO;
    VK_DOWN:  Top  := Top  + CANTIDAD_MOVIMIENTO;
    VK_LEFT:  Left := Left - CANTIDAD_MOVIMIENTO;
  end;
end;

procedure TAuxiliar.TimerTick(Sender: TObject);
resourcestring
  rsCaption = 'Top: %d - Left: %d';
begin
  with FShape do
  begin
    FForm.Caption := Format(rsCaption, [Top, Left]);

    if (Left > FForm.Width)  then Left := 2;
    if (Top  > FForm.Height) then Top  := 2;

    if (Left < 0) then Left := (FForm.Width  - Width);
    if (Top  < 0) then Top  := (FForm.Height - Height);

    if (GetKeyState(VK_UP) and $4000) > 0
      then Top  := Top  - CANTIDAD_MOVIMIENTO;

    if (GetKeyState(VK_DOWN) and $4000) > 0
      then Top  := Top  + CANTIDAD_MOVIMIENTO;

    if (GetKeyState(VK_LEFT) and $4000) > 0
      then Left := Left - CANTIDAD_MOVIMIENTO;

    if (GetKeyState(VK_RIGHT) and $4000) > 0
      then Left := Left + CANTIDAD_MOVIMIENTO;
  end;
end;

procedure Inicializar();
var
  FAuxilar: TAuxiliar;
begin
  FAuxilar := TAuxiliar.Create;
  FForm    := TForm.Create(nil);
  FShape   := TShape.Create(FForm);

  with FForm do
  begin
    Width       := 400;
    Height      := 300;
    Color       := clWhite;
    KeyPreview  := true;
    BorderStyle := bsDialog;
    Position    := poDesktopCenter;
    OnKeyDown   := FAuxilar.KeyDownEvent;
  end;

  with FShape do
  begin
    Width       := 20;
    Height      := 20;
    Parent      := FForm;
    Brush.Color := clRed;
    Pen.Color   := clWhite;
    Shape       := stCircle;
    Top         := CANTIDAD_MOVIMIENTO;
    Left        := CANTIDAD_MOVIMIENTO;
  end;

  try
    FForm.ShowModal;
  finally
    FForm.Free;
    FAuxilar.Free;
  end;
end;

begin { application }

  Inicializar();

end.

Reconozco que no es tan bueno como el código de Seoane, pero, es que Seoane es mucho Seoane.

Ah. Lo que hace el programa es mostrar un formulario y dentro de este una "pelota". El usuario puede mover la pelota por el formulario utilizando las teclas/flechas.

[dec]

Hola de nuevo,

Ya en el colmo de la inutilidad tengo este código por aquí... que en su momento también fue publicado en estos Foros. Se trata de una unidad que contiene un procedimiento capaz de mostrar un formulario al estilo "MSN Messenger"... con un mensaje dentro y todo.

Código Delphi [-]
{··············································}
{······························· dec - 20005 ··}
{··············································}
{·} unit UMsgPopup; interface {················}
{·} uses Forms,{···}StdCtrls, {················}
{·} Windows,Classes,Graphics; {················}
{·} procedure MsgPopup(const msg: {············}
{·} string; const wait: integer); {············}
{·} implementation {···························}
{·} procedure MsgPopup(const msg: {············}
{·} string; const wait: integer); {············}
{·} var {······································}
{·····} i,max: integer; {······················}
{·····} lbMsg:{}TLabel; {······················}
{·····} fmMsg:{·}TForm; {······················}
{·····} panel:{·}TRect; {······················}
{·} begin {····································}
{···} fmMsg := TForm.Create(nil); {············}
{···} try {····································}
{·····} with fmMsg do {························}
{·····} begin {································}
{·······} Width  := 350; {·····················}
{·······} Height := 110; {·····················}
{·······} Color := clWhite; {··················}
{·······} Caption:=' '+msg; {··················}
{·······} SystemParametersInfo {···············}
{·······} (48, 0, @panel,  0); {···············}
{·······} Top := panel.Bottom; {···············}
{·······} BorderStyle := bsToolWindow; {·······}
{·······} FormStyle{·}:=  fsStayOnTop; {·······}
{·······} lbMsg:=TLabel.Create(fmMsg); {·······}
{·······} Left := panel.Right-fmMsg.Width-2; {·}
{·······} max :=panel.Bottom-fmMsg.Height-2; {·}
{·······} with lbMsg do {······················}
{·······} begin {······························}
{·········} Top{}:= 30; {······················}
{·········} Left := 10; {······················}
{·········} Height:=30; {······················}
{·········} Parent {}:=fmMsg; {················}
{·········} AutoSize :=false; {················}
{·········} Caption{}:=  msg; {················}
{·········} Font.Size :={}14; {················}
{·········} Font.Name := 'Arial'; {············}
{·········} Font.Color{}:= clRed; {············}
{·········} Alignment:= taCenter; {············}
{·········} Font.Style:=[fsBold]; {············}
{·········} Width := fmMsg.Width; {············}
{·······} end ; {······························}
{·······} Show; {······························}
{·······} i := Top; {··························}
{·······} while(i>=max)do {····················}
{·······} begin {······························}
{·········} Top := i; {························}
{·········} Dec(i,2); {························}
{·········} Refresh ; {························}
{·······} end; {·······························}
{·····} end; {·································}
{···} finally {································}
{·····} Sleep(wait); {·························}
{·····} fmMsg.Free;; {·························}
{···} end; {···································}
{·} end; {·····································}
{.} end. {·····································}
{························ www.ClubDelphi.com ·····}
{··············································}

[[ArdiIIa]]

Empezado por dec

Hola de nuevo,
Ya en el colmo de la inutilidad tengo este código por aquí... que en su momento también fue publicado en estos Foros. Se trata de una unidad que contiene un procedimiento capaz de mostrar un formulario al estilo "MSN Messenger"... con un mensaje dentro y todo.

Parece que de ese código falta la otra midad...
Si al código le aplicas mi función invertir, y juntas ambas mitades, tendrías un árbol de navidad o algo similar..

[[ArdiIIa]]

Empezado por seoane

Eso es porque no sabes como buscar

Ya.. Esto es que me llevo mal con el php de los trucos y siempre me espeta algo..

Empezado por seoane

O porque nadie mira mis hilos

También Ya..
Eso es porque tú tienes tu enciclopedia privada en este lugar y sabes como buscar en ella.

[[seoane]]

Empezado por ArdiIIa

Eso es porque tú tienes tu enciclopedia privada en este lugar y sabes como buscar en ella.

Eso también es verdad, utilizo el foro como mi repositorio particular. A veces creo que tengo mas código aquí que en mi disco duro

Truco: Cuando no encuentres algo, busca por Seoane

[dec]

Hola,

Empezado por ArdiIIa

Si al código le aplicas mi función invertir, y juntas ambas mitades, tendrías un árbol de navidad o algo similar..

Je, je, je...

[[ArdiIIa]]

Empezado por seoane

Truco: Cuando no encuentres algo, busca por Seoane

Fuera de bromas... aquí la palabra seoane es mágica, a aunque ahora mismo se obtuvieran 1.867 respuestas por buscarla, seguramente que lo buscado aparecería...
Por cierto ¿Que farmacias hay de guardia hoy.?

[[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.. ?

[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