Faccine,Smilies,Emoticon
Gruppo su Faccialibro

Pagina su Faccialibro
Nuova Discussione
Rispondi
 
Pagina precedente | 1 2 3 4 5 6 7 8 9 10 » | Pagina successiva
Stampa | Notifica email    
Autore

Postate il vostro CTRL+V

Ultimo Aggiornamento: 19/02/2018 14:58
OFFLINE
Post: 10.092
Post: 308
Registrato il: 09/01/2004
Città: MILANO
Età: 36
Sesso: Femminile
VocenelWeb
Cool Member
Program archivio;
uses crt;
type
dati=record
codice:integer;
nome,lavoro:string[20];
end;
var
clienti:file of dati;
finito:boolean;
c:dati;
posizione, posizione2:integer;
scelta:byte;
risposta, r:integer;
risposta2[SM=x39898]har;
risposta3,risposta4:string[20];

Procedure input;
begin
with c do
begin
write('Inserisci il codice cliente ');
readln(codice);
if codice<>0 then
begin
write('Inserisci il nome ');
readln(nome);
write('Inserisci il lavoro ');
readln(lavoro);
end
else
finito:=true;
end;
end;

Procedure registra;
begin
write(clienti,c);
end;

Procedure leggi;
begin
reset(clienti);
while not eof(clienti) do
begin
read(clienti,c);
if c.codice<>00 then
begin
with c do
writeln(' ',codice,' ',nome,' ',lavoro);
end;
end;
end;

Procedure aggiungi;
begin
posizione:=filesize(clienti);
seek(clienti,posizione);
input;
registra;
end;

{esistono due tipi di cancellazione:quella logica e quella fisica.
In quella logica si lavora sul codice, smarcando i record con un simbolo
convenzionale. I record nel file rimangono lo stesso numero e contengono al
loro interno i file "cancellati".
In quella fisica si procede allo spostamento di tutti i record,
sovrascrivendo il record da cancellare.}

Procedure cancella;
var
i:integer;
begin
risposta:=0;
reset(clienti);
repeat
write('Inserisci il codice della persona da cancellare');
readln(risposta);
until (risposta>=1)and(risposta<=posizione);
seek(clienti,(risposta-1));
c.codice:=00;
registra;
end;

Procedure modifica;
begin
reset(clienti);
write('Inserisci il codice');
readln(r);
posizione2:=filesize(clienti);
if (r>=1)and(r<=posizione2) then
begin
seek(clienti, (r-1));
write('Vuoi modificare il nome? (s/n) ');
readln(risposta2);
if risposta2='s' then
begin
write('Inserire il nuovo nome ');
readln(risposta3);
c.nome:=risposta3;
registra;
end
else
begin
write('Inserire il nuovo lavoro ');
readln(risposta4);
c.lavoro:=risposta4;
registra;
end;
end
else
writeln('Il codice inserito non Š corretto');
end;

Procedure menu;
begin
repeat;
write(' menu ');
writeln('1 crea ','2 leggi ','3 aggiungi ','4 cancella ','5 modifica ','6 esci');
writeln('Scegli una voce');
readln(scelta);
until (scelta>=1)and(scelta<=6);
case scelta of
1:begin
rewrite(clienti);
repeat
if not finito then
begin
input;
if c.codice<>0 then
registra
end;
until finito
end;
2:leggi;
3:aggiungi;
4[SM=x39898]ancella;
5:modifica;
end;
readln;
end;

begin
clrscr;
assign(clienti,'clienti.dat');
repeat
clrscr;
menu;
until scelta=6;
close(clienti);
end.


program sommatt;
uses crt;
const n=2;
type nr=1..n;
nc=1..n;
matrice=array[nr,nc] of integer;
vettore=array[1..n]of integer;
var m:matrice;
sr,sc,tot:vettore;

procedure caricamatrice(var m:matrice);
var i,j:integer;
begin
for i:=1 to n do
for j:=1 to n do
begin
writeln('inserisci il valore di posto ',i,';',j);
readln(m[i,j]);
end
end;

procedure sommarighe(mat:matrice;var r:vettore);
var i,j,somr:integer;
begin
somr:=0;
for i:=1 to n do
begin
for j:=1 to n do
somr:=somr+mat[i,j];
r:=somr;
somr:=0;
end
end;

procedure sommacolonne(mat:matrice;var c:vettore);
var i,j,somc:integer;
begin
somc:=0;
for j:=1 to n do
begin
for i:=1 to n do
somc:=somc+mat[i,j];
c[j]:=somc;
somc:=0;
end
end;

procedure totale(r,c:vettore;var t:vettore);
var i,som:integer;
begin
for i:=1 to n do
t:=r+c;
end;

procedure stampa(s:vettore;tipo:integer);
var i:integer;
begin
case tipo of
1:writeln('la somma delle righe Š');
2:writeln('la somma delle colonne Š');
3:writeln('la somma delle riche e delle colonne Š');
end;
for i:=1 to n do
writeln(s);
readln;
end;

begin
clrscr;
caricamatrice(m);
sommarighe(m,sr);
sommacolonne(m,sc);
totale(sr,sc,tot);
stampa(sr,1);
stampa(sc,2);
stampa(tot,3);
readln
end.



program verifica1805;
uses crt;
const dim=2;
type matrice=array[1..dim,1..dim] of integer;
var mat:matrice;

procedure caricamatrice(var m:matrice;d:integer);
var i,j:integer;
begin
for i:=1 to d do
for j:=1 to d do
begin
writeln('inserisci il valore di posto ',i,';',j);
readln(m[i,j]);
end
end;

pro
begin
clrscr;
caricamatrice(mat,dim);
readln
end

28/10/2004 19:30
 
Email
 
Scheda Utente
 
Modifica
 
Cancella
 
Quota
Amministra Discussione: | Chiudi | Sposta | Cancella | Modifica | Notifica email Pagina precedente | 1 2 3 4 5 6 7 8 9 10 » | Pagina successiva
Nuova Discussione
Rispondi
Feed | Forum | Bacheca | Album | Utenti | Cerca | Login | Registrati | Amministra
Tutti gli orari sono GMT+01:00. Adesso sono le 05:54. Versione: Stampabile | Mobile | Regolamento | Privacy
FreeForumZone [v.6.1] - Copyright © 2000-2024 FFZ srl - www.freeforumzone.com