Club Delphi  
    Paypal   FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Coloboración Paypal con ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 10-03-2007
Avatar de Héctor Randolph
[Héctor Randolph] Héctor Randolph is offline
Miembro Premium
 
Registrado: dic 2004
Posts: 882
Poder: 22
Héctor Randolph Va por buen camino
No creo que haya problema conmigo, la mayoría del código que escribo no tiene utilidad .

Hablando en serio, las rutinas que escribiste están muy buenas y siempre aprendo mucho de ellas.

Saludos
Responder Con Cita
  #2  
Antiguo 10-03-2007
Avatar de seoane
[seoane] seoane is offline
Miembro Premium
 
Registrado: feb 2004
Ubicación: A Coruña, España
Posts: 3.717
Poder: 26
seoane Va por buen camino
El siguiente código baja las tiras de Raulito el friki, en el rango especificado. Si se utiliza un rango muy grande tarda un poco así que paciencia.

Código Delphi [-]
uses UrlMon, ShellApi;

procedure Raulito(Min, Max: Integer);
var
  i: Integer;
  Path: Array[0..MAX_PATH] of Char;
begin
  FillChar(Path,Sizeof(Path),#0);
  // Obtenemos el directorio temporal
  if GetTempPath(Sizeof(Path)-1, @Path) <> 0 then
  begin
    // Creamos el directorio "Raulito", dentro del temporal, si no existe ya 
    if DirectoryExists((String(Path) + 'Raulito')) or
      CreateDir(String(Path) + 'Raulito') then
    begin
      // Comenzamos el bucle
      for i:= Min to Max do
        // Bajamos la imagen al directorio "Raulito"
        UrlDownloadToFile(nil,
          PChar(Format('http://www.telefonica.net/web2/recurrente/tira/tira%d.png',[i])),
          PChar(String(Path) + Format('Raulito\tira%d.png',[i])),0,nil);
      // Mostramos la carpeta "Raulito"
      Shellexecute(0,nil,PChar(String(Path) + 'Raulito'),nil,nil,SW_SHOW);
    end;
  end;
end;


// Por ejemplo
Raulito(80,89);
// O si queremos todas (hasta hoy)
Raulito(0,89);
Responder Con Cita
  #3  
Antiguo 11-03-2007
Avatar de seoane
[seoane] seoane is offline
Miembro Premium
 
Registrado: feb 2004
Ubicación: A Coruña, España
Posts: 3.717
Poder: 26
seoane Va por buen camino
Ahora es el turno de un interprete de Brainfucker

La wikipedia define este lenguaje de la siguiente manera:
Cita:
Empezado por Wikipedia
Brainfuck (jodecerebros) es un lenguaje de programación esotérico, diseñado por Urban Müller en 1993, con el objetivo de hacer un lenguaje que fuera a la vez muy simple, Turing completo y que requiriese un compilador pequeño. Müller basó Brainfuck en la máquina de Turing.
Para saber mas sobre este lenguaje:
http://es.wikipedia.org/wiki/Brainfuck (Español)
http://en.wikipedia.org/wiki/Brainfuck (Ingles)

Ahora que ya sabemos algo sobre el Brainfucker, vamos con su interprete:
Código Delphi [-]
program bf;

{$APPTYPE CONSOLE}

uses Windows, SysUtils, Classes;

// Esta funcion interpreta el codigo
procedure Brainfuck(Codigo: String);
const
  // El tamaño del array, el estandar es 30000
  Size = 30000;
  // Mensajes de error del interprete
  strPointerError = 'El puntero no es valido';
  strBracketError = 'Se encontro un bracket sin pareja';
var
  i,j: Integer;
  Min, Max, P: PByte;
begin
  // Obtenemos memoria para alojar el array de bytes
  GetMem(Min,Size);
  try
    // Inicializamos el array a cero
    FillChar(Min^,Size,#0);
    // Establecemos el limite superior e inferior
    Max:= Min;
    inc(Max,Size - 1);
    // Inicializamos el puntero en la primera posicion del array
    P:= Min;
    i:= 1;
    // Comenzamos a recorrer el codigo
    while (i <= Length(Codigo)) do
    begin
      case Codigo[i] of
        '>': begin  // Incrementamos el puntero
               if P = Max then
                 raise Exception.Create(strPointerError);
               inc(P);
             end;
        '<': begin  // Decrementamos el puntero
               if P = Min then
                 raise Exception.Create(strPointerError);
               dec(P);
             end;
        '+': inc(P^); // Incrementamos el valor actual
        '-': dec(P^); // Leemos el valor actual
        '.': Write(Char(P^)); // Imprimime el valor actual
        ',': Read(Char(P^)); // Lee un valor de la entrada
        '[': if P^ = 0 then // Comienza un bucle
             begin
               j:= 1;
               // Como la condicion es cero saltamos al final del bucle
               repeat
                 inc(i);
                 if i > Length(Codigo) then
                    raise Exception.Create(strBracketError);
                  case Codigo[i] of
                    '[': inc(j);
                    ']': dec(j);
                  end;
               until (j=0);
             end;
        ']': if P^ <> 0 then // Finaliza un bucle
             begin
               j:= 1;
               repeat
                 dec(i);
                 // Como la condicion no es cero saltamos al principio del bucle
                 if i < 1 then
                    raise Exception.Create(strBracketError);
                  case Codigo[i] of
                    '[': dec(j);
                    ']': inc(j);
                  end;
               until (j=0);
             end;
      end;
      inc(i);
    end;
  finally
    // Liberamos la memoria del array
    FreeMem(Min);
  end;
end;

begin
  // Comprobamos que nos han pasado el fichero con el codigo
  if ParamCount = 1 then
  try
    with TStringList.Create do
    try
      // Abrimos el fichero con el codigo
      LoadFromFile(ParamStr(1));
      // Lo interpretamos
      Brainfuck(Text);
    finally
      Free;
    end;
  except
    // Si ocurre una excepcion la imprimimos
    On E: Exception do
    begin
      Writeln(E.Message);
    end;
  end;
end.
Ya tenemos nuestro flamante interprete de Brainfucker, pero haciendo honor a su nombre, es jodidamente complicado programar en este lenguaje . Así que sera mejor que pongamos algunos ejemplo para probarlo.

El hola mundo:
Código:
++++++++++
[>+++++++>++++++++++>+++>+<<<<-] The initial loop to set up useful values in the array
>++.                             Print 'H'
>+.                              Print 'e'
+++++++.                         Print 'l'
.                                Print 'l'
+++.                             Print 'o'
>++.                             Print ' '
<<+++++++++++++++.               Print 'W'
>.                               Print 'o'
+++.                             Print 'r'
------.                          Print 'l'
--------.                        Print 'd'
>+.                              Print '!'
>.                               Print newline
La serie de Fibbonaci:
Código:
>++++++++++>+>+[
    [+++++[>++++++++<-]>.<++++++[>--------<-]+<<<]>.>>[
        [-]<[>+<-]>>[<<+>+>-]<[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-
            [>+<-[>+<-[>+<-[>[-]>+>+<<<-[>+<-]]]]]]]]]]]+>>>
    ]<<<
]
This program doesn't terminate; you will have to kill it.
Daniel B Cristofani (cristofdathevanetdotcom)
http://www.hevanet.com/cristofd/brainfuck/
Este es la leche, introduces un numero y el lo dibuja girado 45 grados:
Código:
>>>>+>+++>+++>>>>>+++>>+[
    -,[----------[---[+<++++[>-----<-]+>[<+>--------[<+>-
    [--->>+++++++++++++[<<[-<+>>]>[<]>-]<<
    [+>+++++[<-------->-]<[<+>-]]]]]]]]
    <
    [<<++[>>>>>>>>>>>+<<<<<<<<<<<-]<<+>+>+>>>+>+>>+>+<<<<<-
    [<<+>>>+>+>>>+<<<<<-
    [<<<<+>>->>>>->>+<<<<-
    [<<<<->+>>>>->>>->-<<<<<-
    [<<<->>>>+<-
    [<<<+>>>>->+>>+<<<<-
    [<<<<+>->+>>>+>>>>+<<<<<-
    [<<->>>->->>>-<<<<<-
    [<<<<->+>>>>+>+>>>+<<<<<-
    [<<<<+>>>>>>-<<-
    [<<+>>>->>>>-<<<<<-
    [>+>>>->+<<<<<-
    [>>+<<-
    [<<<->->>>->->>+<<<<-
    [<<<+>+>>>+>+<<-
    [>->-<<-
    [<<->>>+>+<<-
    [<<+>>>>>>->-<<<<<-
    [<<<<->>->>-
    [<<<<+>>>>>>>>+<<<<-
    [<<<<->>+>>>>>>>+<<<<<-
    [>->>>-<<<<-]]]]]]]]]]]]]]]]]]]]]
    >[[<<<<<<<<<<<+>>>>>>>>>>>-]>]+>>>>>>>+>>+<]>
]<<[-]<[-[>>>>+<<<<-]]<<<<<<++<+++<+++[>]<[
    >>>>>++++++++[<++++++<++++>>-]>>>[-[<+<<<<.>>>>>-]]<<+<<-<<<<[
        -[-[>+<-]>]>>>[.[>]]<<[<+>-]>>>[<<-[<++>-]>>-]
        <<[++[<+>--]>+<]>>>[<+>-]<<<<<<<<
    ]>>>>>++++++++++.>+[[-]<]<<<
]
[Enter a number using ()-./0123456789abcdef and space, and hit return.
Daniel B Cristofani (cristofdathevanetdotcom)
http://www.hevanet.com/cristofd/brainfuck/]
Como podéis ver, este interprete si que es algo de lo mas inútil en el mundo real, pero puede resultar fascinante para algún friki como yo

PD: La función de entrada ',' no termina de convencerme como esta implementada, si alguien se anima a mejorarla ...
Archivos Adjuntos
Tipo de Archivo: zip Brainfucker.zip (4,4 KB, 65 visitas)
Tipo de Archivo: zip Ejemplos.zip (930 Bytes, 49 visitas)

Última edición por seoane fecha: 15-03-2007 a las 17:40:53.
Responder Con Cita
  #4  
Antiguo 11-03-2007
Avatar de dec
dec dec is offline
Moderador
 
Registrado: dic 2004
Ubicación: Alcobendas, Madrid, España
Posts: 13.141
Poder: 36
dec Tiene un aura espectaculardec Tiene un aura espectacular
Hola,

Joroba con el BrainFucker...
__________________
David Esperalta
www.decsoftutils.com
Responder Con Cita
  #5  
Antiguo 11-03-2007
Avatar de ArdiIIa
[ArdiIIa] ArdiIIa is offline
Miembro Premium
 
Registrado: nov 2003
Ubicación: Valencia city
Posts: 1.481
Poder: 24
ArdiIIa Va por buen camino
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...
__________________
Un poco de tu generosidad puede salvar la vida a un niño. ASÍ DE SENCILLO
Responder Con Cita
  #6  
Antiguo 11-03-2007
Avatar de ArdiIIa
[ArdiIIa] ArdiIIa is offline
Miembro Premium
 
Registrado: nov 2003
Ubicación: Valencia city
Posts: 1.481
Poder: 24
ArdiIIa Va por buen camino
Palíndromos....

A ver si esto puede resultar inútil....

Código Delphi [-]
//Esta función invierte el contenido del texto pasado (Upper)
Function Invertir(Texto: String) : String;
Var I : Integer;
Begin
    For I := Length(Texto) downto 1 DO
        Result := Result + Texto[i];
    Result := UpperCase(Result);
End;



// Algunos ejemplos inútiles 
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage( Invertir('SOMETEMOS'));
ShowMessage( Invertir('RECONOCER'));
ShowMessage( Invertir('SOLDADLOS'));
ShowMessage( Invertir('Amigo no gima.'));
ShowMessage( Invertir('Sé verlas al revés.') );
ShowMessage( Invertir('Se lo creí, mareada. Era miércoles') );
ShowMessage( Invertir('No solo no lo son') );
ShowMessage( Invertir('Nada, yo soy Adán') );
ShowMessage( Invertir('La ruta nos aportó otro paso natural') );
ShowMessage( Invertir('Dábale arroz a la zorra el abad') );
ShowMessage( Invertir('Anita lava la tina'));
ShowMessage( Invertir('Anita la gorda lagartona no traga la droga latina'));
end;
__________________
Un poco de tu generosidad puede salvar la vida a un niño. ASÍ DE SENCILLO
Responder Con Cita
  #7  
Antiguo 11-03-2007
Avatar de seoane
[seoane] seoane is offline
Miembro Premium
 
Registrado: feb 2004
Ubicación: A Coruña, España
Posts: 3.717
Poder: 26
seoane Va por buen camino
Cita:
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 ...

Última edición por seoane fecha: 11-03-2007 a las 13:29:07.
Responder Con Cita
  #8  
Antiguo 11-03-2007
Avatar de dec
dec dec is offline
Moderador
 
Registrado: dic 2004
Ubicación: Alcobendas, Madrid, España
Posts: 13.141
Poder: 36
dec Tiene un aura espectaculardec Tiene un aura espectacular
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.
__________________
David Esperalta
www.decsoftutils.com
Responder Con Cita
  #9  
Antiguo 11-03-2007
Avatar de dec
dec dec is offline
Moderador
 
Registrado: dic 2004
Ubicación: Alcobendas, Madrid, España
Posts: 13.141
Poder: 36
dec Tiene un aura espectaculardec Tiene un aura espectacular
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 ·····}
{··············································}
__________________
David Esperalta
www.decsoftutils.com
Responder Con Cita
  #10  
Antiguo 11-03-2007
Avatar de ArdiIIa
[ArdiIIa] ArdiIIa is offline
Miembro Premium
 
Registrado: nov 2003
Ubicación: Valencia city
Posts: 1.481
Poder: 24
ArdiIIa Va por buen camino
Cita:
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..
Cita:
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.
__________________
Un poco de tu generosidad puede salvar la vida a un niño. ASÍ DE SENCILLO
Responder Con Cita
  #11  
Antiguo 11-03-2007
Avatar de seoane
[seoane] seoane is offline
Miembro Premium
 
Registrado: feb 2004
Ubicación: A Coruña, España
Posts: 3.717
Poder: 26
seoane Va por buen camino
Cita:
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
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Utilidad para comparar dos bases de datos. avmm2004 Varios 1 16-11-2006 20:47:22
Utilidad para contar lineas de código Alexander Varios 10 18-10-2006 00:14:55
Utilidad para manejo de lista TODO ANG4L Varios 3 02-08-2006 09:36:39
Cual es la utilidad de la paleta Server Gelmin Servers 1 05-03-2004 22:20:36
utilidad del application.tag Giniromero OOP 8 17-10-2003 12:21:53


La franja horaria es GMT +2. Ahora son las 02:55:33.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi