Pascal/Turbo Pascal - Ayuda ejercicio Pascal

   
Vista:

Ayuda ejercicio Pascal

Publicado por nicolas (2 intervenciones) el 30/10/2011 23:23:59
Que tal, el motivo de mi consulta es para ver si me pueden ayudar con este ejercicio..es para mi novia..y me comprometí a hacerlo..pero bueno..mucho no me acuerdo..a ver si me pueden dar una mano..muchas gracias....


buscar producto por codigo, por droga, y nombre
agregar producto
eliminar producto
modificar producto
listar productos faltantes por numero de laboratorio

producto: nombre codigo droga numerodelaboratorio precio stock

laboratorio: numerolaboratorio especialidad direccion

bueno eso es todo..les agradecería si me dan una mano...

saludos

Niko...
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

Ayuda ejercicio Pascal

Publicado por Carlos Cuye cachosistemas@hotmail.com (7 intervenciones) el 31/10/2011 19:43:48
Además de hacernos perder el tiempo, le estás haciendo un enorme daño a tu novia, ya que si ella misma no aprende a resolver ejercicios básicos de inicio de una carrera de informática, nunca llegará a ser una buena profesional, suponiendo que pueda recibirse, ya que en algún momento ella misma deberá resolver ejercicios similares en un examen, y allí no estarás vos para resolverle los ejercicios, y en la facultad. si te pillan copiando puede significar una suspensión......
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Ayuda ejercicio Pascal

Publicado por nikot (2 intervenciones) el 31/10/2011 20:36:30
Lo estoy haciendo yo al ej..ni te gastes..solo quería un poco de orientación..y mi novia no va a estudiar esto ni nada relacionado , solo es una materia para terminar el año
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Ayuda ejercicio Pascal

Publicado por Ramon (2072 intervenciones) el 06/11/2011 19:13:37
{Algo asín}
program drogeri;
uses
crt;
type
puntdatos = ^regdatos;
regdatos = record
nombre : string;
codigo : string;
droga : string;
numero : word;
precio : real;
stock : integer;
labora : string;
especi : string;
direcc : string;
sig, ant : puntdatos;
end;

var
prim, segun, ultim, actu : puntdatos;
f : file of regdatos;
tecla : char;
px, py, opcion : integer;
salir : boolean;


function readato(xt, yt : integer;cual : char) : string;
var
texto : string;
cont : integer;
caract : char;
begin
cont := 1;
repeat
caract := readkey;
if cual in['n','N'] then
begin
if caract in[#48..#57,#46] then
begin
texto[cont] := caract;
texto[0] := chr(cont);
gotoxy(xt + cont, yt);write(texto[cont]);
cont := cont + 1;
if cont > 80 then
cont := 80;
end;
end;
if cual in['t','T'] then
begin
if caract in[#32..#126,#164,#165] then
begin
texto[cont] := caract;
texto[0] := chr(cont);
gotoxy(xt + cont, yt);write(texto[cont]);
cont := cont + 1;
if cont > 80 then
cont := 80;
end;
end;
if caract = #8 then
begin
cont := cont - 1;
if cont < 1 then
cont := 1;
texto[cont] := ' ';
texto[0] := chr(cont);
gotoxy(xt + cont, yt);write(texto[cont]);
end;
until (caract = #13) or (caract = #27);
if caract = #13 then
begin
readato := copy(texto,1,length(texto));
end
else
begin
readato := ' ';
end;
end;

procedure iniciopunt;
begin
prim := nil;
ultim := nil;
end;

procedure entradatos;
var
erro : integer;
begin
clrscr;
with actu^ do
begin
gotoxy(10,4);write('Entre Nombre = ');
nombre := readato(24,4,'t');
gotoxy(10,5);write('Entre Codigo = ');
codigo := readato(24,5,'t');
gotoxy(11,6);write('Entre Droga = ');
droga := readato(24,6,'t');
gotoxy(10,7);write('Entre Numero = ');
val(readato(24,7,'n'),numero,erro);
gotoxy(10,8);write('Entre Precio = ');
val(readato(24,8,'n'),precio,erro);
gotoxy(11,9);write('Entre Stock = ');
val(readato(24,9,'n'),stock,erro);
gotoxy(5,10);write('Entre Laboratorio = ');
labora := readato(24,10,'t');
gotoxy(2,11);write('Entre Especialidad = ');
gotoxy(22,11);especi := readato(24,11,'t');
gotoxy(7,12);write('Entre Direccion = ');
direcc := readato(25,12,'t');
end;
end;

procedure entrada;
begin
if prim = nil then
begin
new(actu);
entradatos;
actu^.sig := nil;
actu^.ant := nil;
prim := actu;
ultim :=actu;
end
else
begin
segun := ultim;
new(actu);
entradatos;
segun^.sig := actu;
actu^.sig := nil;
actu^.ant := segun;
ultim := actu;
end;
assign(f,'c:\tp\Almacen.dat');
{$I-} reset(f); {$I+}
if ioresult <> 0 then
begin
rewrite(f);
seek(f,0);
write(f,actu^);
close(f);
end
else
begin
seek(f,filesize(f));
write(f,actu^);
close(f);
end;
end;

procedure anuladato(codi : string);
begin

end;

procedure modificadato(codi : string);
begin

end;

procedure buscaproducto;
procedure curbusca(xc, yc : integer; est : boolean);
begin
if est = true then
begin
gotoxy(xc - 1,yc - 1);write('ÚÄÄÄÄÄÄÄÄÄÄÄÄ¿');
gotoxy(xc - 1,yc);write('³');
gotoxy(xc + 12,yc);write('³');
gotoxy(xc - 1,yc + 1);write('ÀÄÄÄÄÄÄÄÄÄÄÄÄÙ');
end
else
begin
gotoxy(xc - 1,yc - 1);write(' ');
gotoxy(xc - 1,yc);write(' ');
gotoxy(xc + 12,yc);write(' ');
gotoxy(xc - 1,yc + 1);write(' ');
end;
end;
var
tec : char;
opci : integer;
fuera : boolean;
xs, ys : integer;
busca : string;
begin
clrscr;
fuera := false;
opci := 1;
xs := 31;
ys := 6;
gotoxy(31,6);write('Por codigo');
gotoxy(31,8);write('Por droga ');
gotoxy(31,10);write('Por nombre');
gotoxy(31,12);write('Salir');
gotoxy(31,16);write('Elija Opcion con [',chr(24),chr(25),'] y [Enter]');
busca := '';
repeat
curbusca(xs,ys,true);
tec := readkey;
curbusca(xs,ys,false);
if tec = #80 then
begin
opci := opci + 1;
if opci > 4 then
opci := 4;
ys := ys + 2;
if ys > 12 then
ys := 12;
end;
if tec = #72 then
begin
opci := opci - 1;
if opci < 1 then
opci := 1;
ys := ys - 2;
if ys < 6 then
ys := 6;
end;
if tec = #13 then
begin
case opci of
1 : begin
clrscr;
gotoxy(10,4);write('Entre Codigo : ');
busca := readato(24,4,'t');
fuera := true;
end;
2 : begin
gotoxy(10,4);write('Entre Droga : ');
busca := readato(24,4,'t');
fuera := true;
end;
3 : begin
gotoxy(10,4);write('Entre Nombre : ');
busca := readato(24,4,'t');
fuera := true;
end;
4 : fuera := true;
end;
end;
until fuera = true;
if length(busca) > 0 then
begin
actu := prim;
while actu <> nil do
begin
with actu^ do
if (busca = codigo) or (busca = droga) or (busca = nombre) then
begin
clrscr;
writeln('Nombre : ',nombre);
writeln('Codigo : ',codigo);
writeln('Droga : ',droga);
writeln('Numero : ',numero);
writeln('Precio : ',precio);
writeln('Stock : ',stock);
writeln('Laboratorio : ',labora);
writeln('Especialidad : ',especi);
writeln('Direccion : ',direcc);
end;
actu := actu^.sig;
end;
end;
writeln;
writeln('Pulse [Enter]');
readln;
end;

procedure textomenu;
begin
gotoxy(10,6);write('Agregar producto');
gotoxy(10,8);write('Modificar producto');
gotoxy(10,10);write('Eliminar producto');
gotoxy(10,12);write('Buscar producto');
gotoxy(10,14);write('Productos faltantes');
gotoxy(10,16);write('Terminar');
gotoxy(10,19);write('Elija Opcion Con [',chr(24),chr(25),'] Y [Enter]');
end;

procedure cursormenu(xm, ym : integer;estado : boolean);
begin
if estado = true then
begin
gotoxy(xm - 1,ym - 1);write('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
gotoxy(xm - 1,ym);write('³');
gotoxy(xm + 20,ym);write('³');
gotoxy(xm - 1,ym + 1);write('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
end
else
begin
gotoxy(xm - 1,ym - 1);write(' ');
gotoxy(xm - 1,ym);write(' ');
gotoxy(xm + 20,ym);write(' ');
gotoxy(xm - 1,ym + 1);write(' ');
end;
end;




begin
clrscr;
iniciopunt;
textomenu;
opcion := 1;
px := 10;
py := 6;
salir := false;
repeat
cursormenu(px,py,true);
tecla := readkey;
cursormenu(px,py,false);
if tecla = #80 then
begin
py := py + 2;
if py > 16 then
py := 16;
opcion := opcion + 1;
if opcion > 6 then
opcion := 6;
end;
if tecla = #72 then
begin
py := py - 2;
if py < 6 then
py := 6;
opcion := opcion - 1;
if opcion < 1 then
opcion := 1;
end;
if tecla = #13 then
begin
case opcion of
1 : begin
entrada;
clrscr;
textomenu;
end;
2 :;
3 :;
4 : begin
buscaproducto;
clrscr;
textomenu;
end;
5 :;
6 : salir := true;
end;
end;
until salir = true;
if actu <> nil then
dispose(actu);
end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar