• Viernes 8 de Noviembre de 2024, 20:39

Mostrar Mensajes

Esta sección te permite ver todos los posts escritos por este usuario. Ten en cuenta que sólo puedes ver los posts escritos en zonas a las que tienes acceso en este momento.


Temas - keko

Páginas: [1]
1
Pascal / Un Programa Pascal
« en: Sábado 24 de Septiembre de 2005, 18:33 »
program rojoonegro;
uses crt;
var
nu,jugada,jugo,oxo,din:longint;
apu,ape,apue,apo:longint;
begin
randomize;
clrscr;
apu:=3000; {dinero en euros recomendado}
writeln('introduce dinero a perder en la ruleta apuesta minima 1e apuesta maxima ?? ');
readln(apu);
if apu=0 then apu:=3000;
apo:=apu;
ape:=apu;
apue:=1;
jugo:=1;
din:=1;
repeat
nu:=nu+1;
writeln('jugada nø',nu,' tu capital es:',apu,' tu apuesta es de:',din);
if apu>ape then
begin
ape:=apu;
end;
{en la ruleta sale}
jugada:=random(37);
if ((jugada mod 2)=0) and (jugada>0) then OXO:=2;
if ((jugada mod 2)<>0) and (jugada>0) then OXO:=1;
if jugada=0 then OXO:=0;
{writeln('tu dinero total es: ',apu);}
apue:=apue+din;
{writeln('tu apuesta es: ',apue);
writeln('el la ruleta sale ',oxo);}
{writeln('tu juegas ',jugo); }
if oxo=jugo then
begin
{ganaste}
apu:=apu+apue;
din:=1;
apue:=1;
jugo:=jugo+1;
if jugo>2 then jugo:=1;
{ writeln('ganaste!!');}
end
else
begin
{perdiste}
apu:=apu-apue;
din:=din+din;
{ writeln('perdiste!!'); }
end;
{writeln('din=',din); }
{delay(20);}
{writeln('----------------');}
until (keypressed) or (apu<0);
writeln;
writeln('estas a 0 despues de ',nu,' jugadas');
writeln('recuerde q empezo con ',apo,' euros');
writeln('la maxima cantidad ganada fue de ',ape,' euros');
writeln('mi consejo salir corriendo de las rachas malas si pierde 64e');
writeln('equivalen a las tendencias bajistas d bolsa ;-D ');
writeln('retirate con la ganancias');
writeln('quien sabe pero parece q esto funciona a veces si a veces no con 200e');
writeln('con cantidades inferiores a 200e no hay para promediar las tendencias');
writeln('bajistas de este juego... ');
readln;
readln;
end.

este programa usa:  uses crt;  fue realizado en pascal en windows95 para un antiguo pemtiun mi pagina es http://es.geocities.com/mariaudache/probando.htm

SALUDOS.

2
Pascal / Re: programa del bingo
« en: Domingo 16 de Noviembre de 2003, 12:53 »
programa del bingo lo hice usando uses crt; el codigo fuente a continuacion para descargar

3
Pascal / Re: 3 programitas
« en: Domingo 27 de Abril de 2003, 12:00 »
INVASO
un matamarcianos cutre con su fuente y compilado si disparas rapido se ataska
tendras q poner DELAY o utilizar algun ralentizador xq lo hice hace a¤os para
un ordenador +antiguo usa las librerias GRAPH,DOS,CRT

LOTO02
un intento de ganar a la loto existe
una idea q consiste en que en todos los boletos aparecen 3 numeros fijos y los
otros 3 numeros se van combinando esta idea funciona solo al 50%

BYNARIS
un programa sin terminar sobre la 1x2 la idea bastante osada es intentar
cribar 12triples el programa solo los muestra ordenados desde 111111111111
hasta XXXXXXXXXXXX para avanzar boleto pulsa (e) para salir (ESC)

:suerte::no::oops:

4
Perl / programa q no pare
« en: Domingo 16 de Marzo de 2003, 20:29 »
yo tengo un ordenador antiguo sin conexion a internet y me gustaria saber
como puedo hacer que un programa de perl no se pare nunca que este funcionando todo el dia en un ordenador con conexion a internet, GRACIAS!!

5
Perl / programa para enviar SMS
« en: Domingo 9 de Febrero de 2003, 12:56 »
encontre este programa en perl para mandar SMS alguien m dice como funciona?
quiero hacer una pagina web para q me mande los resultados x movil en vez de x
email como se hace?

#!/usr/bin/perl
#     esms, envío de mensajes a móviles de España
#       http://esms.sourceforge.net
#     Copyright (C) 2001 José Juan Zapater Vera batsman.geo@yahoo.com
#         This program is free software; you can redistribute it and/or
#     modify it under the terms of the GNU General Public License as
#     published by the Free Software Foundation; either version 2 of the
#     License, or (at your option) any later version.
#
#         This program is distributed in the hope that it will be
#     useful, but WITHOUT ANY WARRANTY; without even the implied
#     warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#     See the GNU General Public License for more details.
#
#         You should have received a copy of the GNU General Public
#     License along with this program; if not, write to the Free
#     Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#   ChangeLog (casi a estrenar:)
#      2000/2001   Mauricio Julio Fernández Pradier
#            esms hasta versión 0.9.0
#      01/07/2001   0.9.0a
#            José Juan Zapater Vera
#            limpieza del código, corrección para
#            adaptarse a los cambios del servidor de
#            Navegalia
#      06/07/2001   0.9.0
#            Mauricio Julio Fernández Pradier
#            cambios para que funcione con los
#            módulos de Potato, pequeñas
#            modificaciones
#      30/07/2001   0.9.1
#            Incorporación del servidor de mensajes de
#            Movistar.
#            Creada estructura para multiples servidores
#            de forma cómoda.
#            Eliminado el parámetro de columnas porque
#            está derivado del servidor.

use CGI;
use Text::Wrap qw(wrap $columns);
use LWP::UserAgent;
use HTTP::Cookies;
use HTTP::Request::Common qw(POST GET);
use HTML::TreeBuilder;
use IO::Socket;

use strict;

# Definición de los plugins (servidores de mensajes SMS)
# NombreCorto, Descripción, Nº de columnas, Función
my @plugs = (    [ "navegalia", "Servidor de Airtel", 130, &enviar_mensaje_navegalia, ],
      [ "movistar", "Servidor de Movistar", 160-17,  &enviar_mensaje_movistar, ]
      );
# Servidor por defecto
my $plug = 0;

my $debug = 1;
my $nreintentos = 5; # debería haber un parámetro en la línea de comandos
my $errorconexion = 0; # puesto a uno si el servidor está hundido

sub espera
{
    my $tiempo= pop @_;
    print "Esperando $tiempo segundo(s)...n" if ($debug);
    select(undef,undef,undef,$tiempo);
    # granularidad menor que un segundo
}

sub pretty_print()
{
 my $mensaje = pop @_;
 print
 "-------------------------------------------------------------------------n" .
 "$mensajen" .
 "-------------------------------------------------------------------------n";
}


sub obtener_telefono
{
  my $alias = pop @_;
  my $fichero;
  $fichero = $ENV{"HOME"} . "/.esmsalias";
  print "Abriendo fichero de alias $fichero.n";
  print "Buscando teléfono de $alias.n";
  open(INPUT, $fichero);
  while (<INPUT>) {
   chop($_);
        ##   print "Leída línea $_.n";
     if ( /$alias/ ) {
      s/^$alias //g;
      s/ //g;
      s/t//g;
      close(INPUT);
      return $_;
   }
  }
  close(INPUT);
  return 0;
}


sub enviar_mensaje_navegalia
{
 my ($linea, $telefono, $repeat) = @_;
 my $ua = new LWP::UserAgent;
 $ua->agent("Mozilla/4.75 [en] (X11; U; Linux 2.4.5 itanium; Nav)");
 
 my $req = GET 'http://212.73.32.207/html/texto.htm', [ tNumber=>$telefono, nAddress=>"ttt@ttt.es" ];
 $req->header ( Referer =>
  "http://212.73.32.207/html/c_01.htm");
 my $res=$ua->request($req);
 
 unless($res->is_success || $errorconexion) {
   print "Error en la petición HTTP.n";
   print "El servidor no funciona correctamente en este momento.n";
   print "Inténtelo más tarde o comuníqueselo a los autores de esms.n";
   $errorconexion = 1;
    return 1;
 }
 if($res->is_success) {
    $errorconexion = 0;
 } else {
   return 1;
 }
 
 my $tree = HTML::TreeBuilder->new();
 $tree->ignore_text(1);
 $tree->parse($res->content);
 
 my $form = $tree->find_by_attribute('name','envio_sms');
 my $action=$form->attr_get_i('action');
 my $value1=$form->find_by_attribute('name','estado1')->attr_get_i('value');
 my $value2=$form->find_by_attribute('name','estado2')->attr_get_i('value');

 #print "Usando action=$action, estado1=$value1, estado2=$value2.n" if($debug);

 $req= POST $action, [ estado1 => $value1, estado2 => $value2,
    telefonoDestino1 => $telefono, codigoLookFeel => 1, tNumber => "", nAddress => "", texto => $linea];
 $req->header ( Referer => "http://212.73.32.207/html/texto.htm?$telefono");

 &espera(($repeat-1)*2+0.1); #Tengo que hacer pausa que si no no cuela

 $res=$ua->request($req);
 
 # elimina árbol HTML, el reference counting falla
 #$tree->destroy;
 # aunque está en la documentación, no está en el paquete para potato
 # ¿¿??

 # depuración a lo bestia
 # print $res->content if ($debug);
 
 if ($res->content =~ /no se está procesando correctamente/) {
     print ( "Error al enviar el mensaje:n" );
     &pretty_print($linea);
     return 1;
 }
 else {
     print "Mensaje enviado correctamenten" if ($debug);
     return 0;
 }
}

sub enviar_mensaje_movistar
{
 my ($linea, $telefono, $repeat) = @_;
 my $ua = new LWP::UserAgent;
 $ua->agent("Mozilla/4.75 [en] (X11; U; Linux 2.4.5 itanium; Nav)");

 # Obtenemos cookies

 my $cookie_jar = HTTP::Cookies->new;

 my $req = POST 'http://www.correo.movistar.net/enviar_mensajes.asp';
 my $res = $ua->request($req);
 $cookie_jar->extract_cookies($res);
 
 $req= POST 'http://www.correo.movistar.net/confirmacion_envio.asp', [ confirmacion => 0,
    nocache => "7%2F24%2F01+5%3A53%3A55+PM",
    telefono => $telefono, email => "nobody@nobody.com", mensaje_texto => $linea];
 $req->header ( Referer => "http://www.correo.movistar.net/enviar_mensajes.asp");
 $cookie_jar->add_cookie_header($req);
 
 my $res=$ua->request($req);
 
 # depuración a lo bestia
 # print $res->content if ($debug);
 
 if (!($res->content =~ /enviado con éxito/)) {
     print ( "Error al enviar el mensaje:n" );
     &pretty_print($linea);
     return 1;
 }
 else {
     print "Mensaje enviado correctamenten" if ($debug);
     return 0;
 }
}

sub enviar_mensaje{
 my ($linea, $telefono, $repeat) = @_;
 print "- Servidor $plugs[$plug][0] -n";
 my $func = $plugs[$plug][3];
 &$func($linea,$telefono,$repeat);
}

sub help{
   print "esms 0.9.1, Copyright © 2001 José Juan Zapater Vera batsman.geo@yahoo.comnn";
   print "esms comes with ABSOLUTELY NO WARRANTY. This is free software,n";
   print "and you are welcome to redistribute it under certain conditions.n";
   print "n";
   print "Más información en http://esms.sourceforge.net nn";
   print "Uso: esms <telefono> [/px]n";
   for(my $n=1;$n<=scalar(@plugs);$n++){
      print "/p",$plugs[$n-1][0]," ",$plugs[$n-1][1],"n";
   }
   print "nEjemplo:n";
   print " fortune -s | esms 123456789 /pmovistarn";
   print " uname -a | esms Linus n";
   print "nEste último buscará 'Linus' en el fichero de aliasn";
   print   "tt" . $ENV{"HOME"} . "/.esmsaliasn";
   print "Ejemplo de .esmsalias:n";
   print "yo      123456789n";
   print "Linus   1111111111n";
   exit(0);
}

if ($ARGV[0] eq ""){
   help();
}
my $telefono = $ARGV[0];
my $name = $telefono;
if ( $telefono !~ /^[0-9]+/ ) {
   $telefono = &obtener_telefono($telefono);
}
print "Teléfono obtenido: $telefono.n";
if ($telefono == 0)
{
   print "No se pudo encontrar el teléfono asociado a $name.n";
   exit(1);
}

if ($ARGV[1] =~ /^/p/ ){
   $plug=-1;
   for(my $n=1;$n<=scalar(@plugs);$n++){
      if ($plugs[$n-1][0] eq substr($ARGV[1],2)){
         $plug=$n-1;
      }
   }
   if ($plug==-1) {
      &help;
   }
}

$columns=$plugs[$plug][2];
my @in = <STDIN>;
my $mensaje = join ('', @in);

$mensaje =~ s/n/©/g;
$mensaje =~ s/t/ /g;
my $linea = wrap ("","",$mensaje);
my @lineas = split(/n/,$linea);
my $numlineas = @lineas;
$mensaje =~ s/©/n/g;
$| = 1; ## turn auto-flush on

print "Envío de mensaje a móviln";
print "Teléfono: $telefonon";
print "Mensaje:n";
&pretty_print($mensaje);

print "El mensaje ha sido fragmentado en $numlineas paquetes.n"
    if ($numlineas > 1);
print "El mensaje no ha sido fragmentado.n"
    if ($numlineas == 1);
my $j=1;
for (my $i=1; ($i<=$numlineas) && ($j<=$nreintentos); $i++){
    $lineas[$i-1] =~ s/©/n/g;
    $j=1;
    while ($j<=$nreintentos && &enviar_mensaje("$lineas[$i-1]n$i/$numlineas MFP", $telefono, $j )!=0){
   $j++;
    }
}
if ($j<=$nreintentos){
   exit(0); # Sin errores
}
else{
   exit(1); # Con errores
}

6
Pascal / calcula una operacion de bolsa
« en: Lunes 13 de Enero de 2003, 13:03 »
ya se que es una ful pero bueno x si te da por comprar o vender acciones x cajamadrid

program calc;
uses wincrt;
var
te:char;
a,b,c:real;
kan,can,pre,d,dd,ca,ga,toc,tac:real;
begin
repeat
kan:=0;can:=0;pre:=0;d:=0;dd:=0;ca:=0;ga:=0;toc:=0;taC:=0;
te:=' ';
clrscr;
write('cantidad en euros ');read(can);
write('precio ');read(pre);
kan:=can/pre;
writeln('con ',can:0:2,' a ',pre:0:2,' puedes comprar ',kan:0:2);

write('cuantas? ');
read(a);
write('precio? ');
read(b);
clrscr;

{canon}
c:=a*b;
if c<=30 then ca:=0.04;
if (c>30.01) and (c<=300) then ca:=1.20;
if (c>=300.01) and (c<=1500) then ca:=2.53;
if (c>=1500.01) and (c<=3000) then ca:=3.97;
if (c>=3000.01) and (c<=6000) then ca:=5.40;
if (c>=6000.01) and (c<=15000) then ca:=7.02;
if (c>=15000.01) and (c<=30000) then ca:=8.42;
if (c>=30000.01) and (c<=45000) then ca:=9.91;
if (c>=45000.01) and (c<=150000) then ca:=11.35;
if (c>=150000.01) and (c<=300000) then ca:=12.85;
if c>=300000.01 then ca:=14.20;
{lo q se lleva el banco minimo 3.00}
d:=c*0.35/100;
if d<3 then d:=3;
{y el corretaje minimo 4.50}
dd:=c*0.25/100;
if dd<4.50 then dd:=4.50;

writeln('compra----------------');
writeln('acciones: ',a:0:2);
writeln('precio: ',b:0:2);
writeln('banco: ',d:0:2);
writeln('bolsa: ',dd:0:2);
writeln('canon: ',ca:0:2);
ga:=d+dd+ca;
writeln('gastos: ',ga:0:2);
toc:=c+ga;
writeln('TOTAL: ',toc:0:2);
writeln('---------------------');
write('precio venta? ');
read(b);
c:=a*b;
if c<=30 then ca:=0.04;
if (c>30.01) and (c<=300) then ca:=1.20;
if (c>=300.01) and (c<=1500) then ca:=2.53;
if (c>=1500.01) and (c<=3000) then ca:=3.97;
if (c>=3000.01) and (c<=6000) then ca:=5.40;
if (c>=6000.01) and (c<=15000) then ca:=7.02;
if (c>=15000.01) and (c<=30000) then ca:=8.42;
if (c>=30000.01) and (c<=45000) then ca:=9.91;
if (c>=45000.01) and (c<=150000) then ca:=11.35;
if (c>=150000.01) and (c<=300000) then ca:=12.85;
if c>=300000.01 then ca:=14.20;

d:=c*0.35/100;
if d<3 then d:=3;
dd:=c*0.25/100;
if dd<4.50 then dd:=4.50;

writeln('venta----------------');
writeln('acciones: ',a:0:2);
writeln('precio: ',b:0:2);
writeln('banco: ',d:0:2);
writeln('bolsa: ',dd:0:2);
writeln('canon: ',ca:0:2);
ga:=d+dd+ca;
writeln('gastos: ',ga:0:2);
tac:=c-ga;
writeln('TOTAL: ',tac:0:2);
writeln('--------------------------');
writeln('resultado venta-compra ',tac-toc:0:2);
ga:=(tac-toc)*166.386;
writeln('lo mismo pero en pesetas ',ga:0:2);
writeln('pulsa (s) salir o (n) para continuar ');
repeat
if keypressed then te:=readkeY;
until (te='s') or (te='n');
until te='s';

end.

7
Pascal / un juego en pascal
« en: Lunes 13 de Enero de 2003, 12:45 »
un juego en pascal criticas constructivas vale?

program musica;
uses crt;
var
te:char;
as,cox,le,er,pu,x,bo,a,b,c,num:integER;
sin:array[1..40] of byte;

procedure GRITAAA;
var
za,ze:integer;
BEGIN
za:=random(1100);
if za<700 then za:=700;
FOR ZE:=0 TO ZA DO
      BEGIN
      SOUND(1000-ZE);
      DELAY(1);
      SOUND(RANDOM(90)+ZE);
      DELAY(1);
      END;
      NOSOUND;
END;
procedure doo(d,k:integer);
begin
sound(65*(k+k));{do}
delay(d);{duracion nota}
nosound;
end;

procedure re(d,k:integer);
begin
sound(73*(k+k));{re}
delay(d);
nosound;
end;

procedure mi(d,k:integer);
begin
sound(82*(k+k));{mi}
delay(d);
nosound;
end;

procedure fa(d,k:integer);
begin
sound(87*(k+k));{fa}
delay(d);
nosound;
end;

procedure sol(d,k:integer);
begin
sound(98*(k+k));{sol}
delay(d);
nosound;
end;

procedure la(d,k:integer);
begin
sound(110*(k+k));{la}
delay(d);
nosound;
end;

procedure si(d,k:integer);
begin
sound(123*(k+k));{si}
delay(d);
nosound;
end;
procedure melodia;
begin
    for b:=1 to num do
     begin
     if sin<b>=0 then delay(300);
     if sin<b>=1 then doo(300,8);
     if sin<b>=2 then re(300,8);
     if sin<b>=3 then mi(300,8);
     if sin<b>=4 then fa(300,8);
     if sin<b>=5 then sol(300,8);
     if sin<b>=6 then la(300,8);
     if sin<b>=7 then si(300,8);
     end;
end;

begin
clrscr;
gotoxy(3,1);write('un juego de EIO&EGO 2003');
fa(600,8);mi(600,8);re(1000,8);mi(600,8);sol(600,8);mi(600,8);
fa(600,8);mi(600,8);re(1000,8);
delay(2000);
doo(300,8);doo(300,8);sol(300,8);sol(300,8);la(300,8);la(300,8);
sol(600,8);fa(300,8);fa(300,8);mi(300,8);mi(300,8);re(300,8);re(300,8);doo(600,8);
delay(2000);
textmode(co40);
randomize;
clrscr;
cox:=10; {centrar los gotoxy }
pu:=1; {posicion de gotoxy para ?}
num:=2;{cuantas ? salen ej 5 ---> 3????}
le:=0; {de nivel}
as:=5; {5 repeticiones sube nivel}
 repeat
  {melodia}
  if bo=0 then
   begin
   pu:=1;
   er:=0;
   {melodia al azar}
   delay(2000);
   gotoxy(1,3);write('estamos en el nivel---> ',le);
   clrscr;
   gotoxy(1,3);write('estamos en el nivel---> ',le);
   for b:=2 to num do
    begin
    gotoxy(b,1+cox);write('?');
    end;
   for b:=1 to num do
   begin
   a:=random(8);
   sin<b>:=a;
   end;
   {suena melodia}
   melodia;
   bo:=1;
   gotoxy(1,1+cox);write(sin[1]);
   end;
 te:=' ';
 if keypressed then
  begin
  te:=readkey;
  pu:=pu+1;
  end;
 if te='0' then
  begin
  x:=0;
  end;
 if te='1' then
  begin
  x:=1;
  doo(300,8);
  end;
 if te='2' then
  begin
  x:=2;
  re(300,8);
  end;
 if te='3' then
  begin
  x:=3;
  mi(300,8);
  end;
 if te='4' then
  begin
  x:=4;
  fa(300,8);
  end;
 if te='5' then
  begin
  x:=5;
  sol(300,8);
  end;
 if te='6' then
  begin
  x:=6;
  la(300,8);
  end;
 if te='7' then
  begin
  x:=7;
  si(300,8);
  end;
 gotoxy(3,1);write('oido musical de EIOM301@HOTMAIL.COM');
 gotoxy(1,3);write('1=do 2=re 3=mi 4=fa 5=sol 6=la 7=si');
 gotoxy(1,4);write('0=silencio ESC=salir');
 gotoxy(1,3+cox);write('nivel:',le);
 gotoxy(1,4+cox);write(pu);
 {comprueba}
 if (sin[pu]=x) and (pu>1) then
  begin
  if pu=num then
    begin
    le:=le+1;
    if le>as then
     begin
     as:=as+5;
     num:=num+1;
     end;
    if num>=40 then num:=40;
    bo:=0;
    end;
  gotoxy(pu,1+cox);write(x);
  end;
 if (sin[pu]<>x) and (pu>1)  then
  begin
  er:=er+1;
  if er<5 then doo(700,1);
  if er>4 then gritaaa;
  gotoxy(pu,1+cox);write(x);
  delay(600);
  gotoxy(1,1+cox);write(sin[1]);
  for b:=2 to num do
   begin
   gotoxy(b,1+cox);write('?');
   end;
  pu:=1;
  melodia;
  end;
gotoxy(1,2+cox);write('Errores:',er);
until te=chr(27);
end.

8
Pascal / Re: un fallido intento de simulacion de bolsa
« en: Lunes 13 de Enero de 2003, 12:43 »
un programilla en pascal intenta ser un simulador pero se queda en juego malillo

program bolsa;
uses crt,dos;
var
te:char;
xxg,cug,dg:word;
gra:array[1..23,1..300] of word;
ddd,dd1,dd2,dd3,mo,mu,cu,ka,di,a,b,c,cc,d:longint;
cox,sub,baj,can:longinT;
ibe:array[1..23] of word;
xs:array[1..5] of byte;
xss:array[1..5] of longint;
ibc:array[1..23] of byte;
con,xx:real;
procedure grafico;
var
rgg:registers;
colo,xgg,ygg:word;
c1gg,c2gg:word;
begin
colo:=random(5);
if colo=0 then colo:=11;
if colo=1 then colo:=12;
if colo=2 then colo:=13;
if colo=3 then colo:=14;
if colo=4 then colo:=15;
{modo vga}
with rgg do
begin
ah:=0;
al:=19;
end;
intr($10,rgg);
for c1gg:=1 to dg do
begin
 ygg:=0;
 for c2gg:=199 downto 0 do
  begin
  if (gra[cug,c1gg]>=ygg) and (gra[cug,c1gg]<=ygg+32) then break;
  ygg:=ygg+33; {de 20c arriba o abajo en 300dias}
  end;
mem[$a000:c2gg*320+c1gg]:=colo;
end;
readln;
with rgg do
begin
ah:=0;
al:=1;
end;
{volver a texto}
intr($10,rgg);
end;

procedure jorna;
begin
{sube2 baja3 mantiene01}
{las 23 del nasti}
for A:=1 to 23 do
 begin
 b:=random(4);
 if (b=0) or (b=1) then
  begin
  ibc[a]:=15;
  if ibe[a]<30 then ibe[a]:=30;
  gra[a,dg]:=ibe[a];
  end;
 if b=2 then
  begin
  c:=random(70); {<---pesetas}
  if c=0 then c:=1;
  ibe[a]:=ibe[a]+c;
  if ibe[a]<30 then ibe[a]:=30;
  gra[a,dg]:=ibe[a];
  ibc[a]:=lightgreen;
  end;
 if b=3 then
  begin
  c:=random(70);
  if c=0 then c:=1;
  d:=ibe[a];
  d:=D-c;
  if d<30 then d:=30; {la accion +baja si baja tanto tanto no se puede quedar en 0 o si,meten papel q dicen no?}
  ibe[a]:=d;
  gra[a,dg]:=ibe[a];
  ibc[a]:=lightred;
  end;
 end;
{-------------}
end;{de proc}

begin
randomize;
clrscr;
textmode(co40);

di:=1;
ka:=0;
can:=1000000-1684;
{---------}
{cada accion a?}
for a:=1 to 35 do
 begin
 b:=random(6001);
 if b<500 then b:=500;{minimo 500pts 3e}
 ibe[a]:=b;
 end;
xs[1]:=0;xss[1]:=0;
xs[2]:=0;xss[2]:=0;
xs[3]:=0;xss[3]:=0;
xs[4]:=0;xss[4]:=0;
xs[5]:=0;xss[5]:=0;

repeat
b:=1;
for a:=1 to 23 do
begin
textcolor(ibc[a]);
xx:=ibe[a]/166.386;
gotoxy(1,b);write('(',a,')',xx:4:2);
b:=b+1
end;
{------tus movimientos----}
textcolor(7);
gotoxy(20,1);write('dia:',di);
gotoxy(14,2);write('op? c:compra v:vende s:sal');
con:=can/166.386;
gotoxy(14,3);write('cantidad:',con:4:2,'$');
gotoxy(14,6);write('cartera');
gotoxy(14,7);write('(',xs[1],')......',xss[1]);
gotoxy(14,8);write('(',xs[2],')......',xss[2]);
gotoxy(14,9);write('(',xs[3],')......',xss[3]);
gotoxy(14,10);write('(',xs[4],')......',xss[4]);
gotoxy(14,11);write('(',xs[5],')......',xss[5]);
gotoxy(14,12);write('f1: para ver grafico');
te:=' ';
te:=readkey;
if te=chr(59) then
 BEGIN
 sound(1000);
 delay(40);
 nosound;
 gotoxy(14,12);write('                    ');
 gotoxy(14,12);write('numero(x)? ');
 readln(cug);
 grafico;
 END; {de grafico}

if te='c' then
 BEGIN
 gotoxy(14,4);write('numero (x)?');
 readln(a);
 gotoxy(14,5);write('cuantos titulos? ');
 readln(cu);
dd1:=0;
dd2:=0;
for ddd:=1 to cu do
 begin
 if ddd>dd1 then
  begin
  dd2:=dd2+332;
  dd1:=dd1+4000;
  end;
 end;
dd1:=0;
dd3:=0;
for ddd:=1 to cu do
 begin
 if ddd>dd3 then
  begin
  dd3:=dd3+1000;
  dd1:=dd1+500;
  end;
 end;
d:=can-(cu*ibe[a])-(cu div 4)-dd2-dd1;
 {-----}
{ clrscr;
 writeln('can ',can);
 writeln('can ',d);
 writeln('ibe ',ibe[a]);
 writeln('dd2 ',dd2);
 writeln('dd1 ',dd1);
 readln;
 clrscr; }
 {-----}

if (a>23) or (a<1) then d:=-20;
if (xs[1]<>0) and (xs[2]<>0) and (xs[3]<>0) and (xs[4]<>0) and (xs[5]<>0) and
   (xs[1]<>a) and (xs[2]<>a) and (xs[3]<>a) and (xs[4]<>a) and (xs[5]<>a)
   then d:=-20;

if d<0 then
 begin
 gotoxy(14,5);write('no puede realizar compra---');
 readln;
 enD;
if d>0 then
begin
dd1:=0;
dd2:=0;
for ddd:=1 to cu do
 begin
 if ddd>dd1 then
  begin
  dd2:=dd2+2;
  dd1:=dd1+4000;
  end;
 end;
dd1:=0;
dd3:=0;
for ddd:=1 to cu do
 begin
 if ddd>dd3 then
  begin
  dd3:=dd3+1000;
  dd1:=dd1+500;
  end;
 end;
d:=can-(cu*ibe[a])-(cu div 4)-dd2-dd1;
can:=d;
mu:=0;
for d:=1 to 5 do
 begin
 if xs[d]=a then
  begin
  xss[d]:=xss[d]+cu;
  mu:=1;
  cu:=0;
  break;
  end;
 end;
if mu=0 then
 begin
   for cc:=1 to 5 do
    begin
     if xs[cc]=0 then
      begin
      xs[cc]:=a;
      xss[cc]:=cu;
      break;
      end;
    end;
cu:=0;
 end;
end;
 END; {de compra}
if te='v' then
 BEGIN
 mo:=0;
 gotoxy(14,4);write('numero (x)?');
 read(a);
 gotoxy(14,5);write('cuantos titulos? ');
 readln(cu);
{buscar en cartera}
for cc:=1 to 5 do
 begin
 if (a=xs[cc]) and (cu<=xss[cc]) then
  begin
{  d:=can+(ibe[xs[cc]]*xss[cc]);
  can:=d;
  xss[cc]:=xss[cc]-cu;}
  if xss[cc]=0 then xs[cc]:=0;
  mo:=1;
  ka:=ka-1;
  break;
  end;
 end;
if mo=1 then
 begin
dd1:=0;
dd2:=0;
for ddd:=1 to xss[cc] do
 begin
 if ddd>dd1 then
  begin
  dd2:=dd2+2;
  dd1:=dd1+4000;
  end;
 end;
dd1:=0;
dd3:=0;
for ddd:=1 to xss[cc] do
 begin
 if ddd>dd3 then
  begin
  dd3:=dd3+1000;
  dd1:=dd1+500;
  end;
 end;
{d:=can+(ibe[xs[cc]]*xss[cc])-(xss[cc] div 4)-dd2-dd1;}
d:=(ibe[xs[cc]]*xss[cc])-(xss[cc] div 4)-dd2-dd1;
if d<0 then mo:=0;
 end;

if mo=0 then
 begin
 gotoxy(14,5);write('no puede realizar venta---');
 readln;
 end;
if mo=1 then
 begin
dd1:=0;
dd2:=0;
for ddd:=1 to xss[cc] do
 begin
 if ddd>dd1 then
  begin
  dd2:=dd2+2;
  dd1:=dd1+4000;
  end;
 end;
dd1:=0;
dd3:=0;
for ddd:=1 to xss[cc] do
 begin
 if ddd>dd3 then
  begin
  dd3:=dd3+1000;
  dd1:=dd1+500;
  end;
 end;
d:=(ibe[xs[cc]]*xss[cc])-(xss[cc] div 4)-dd2-dd1;
can:=can+d;
xss[cc]:=xss[cc]-cu;
if xss[cc]=0 then xs[cc]:=0;
 end;

mo:=0;
END; {de venta}

clrscr;
di:=di+1;
dg:=dg+1;
if dg>300 then dg:=1;
jorna;
until te='s';
clrscr;
textmode(co80);
WRITELN('Gracias x jugar a este sucedaneo de bolsa ojala fuese tan facil criticas,comentarios al responsable de esta parida');
writeln('intro');
readlN;
end.

Páginas: [1]