Всё что касается Turbo Pascal 7.0.

#0 by System at 2006-10-20 20:46:32 (940 săptămâni în urmă) - [Link]

Кто может скинуть учебники, стастьи, исходники....и т.д.?

Mesaj util ? Da 0 puncte

1 2 3 4 5
<< Precedenta Următoarea >>

#26 by mdcool (Power User) (0 mesaje) at 2006-10-21 20:52:54 (940 săptămâni în urmă) - [Link]

#25 Capilleary, thx

Mesaj util ? Da 0 puncte

#27 by mdcool (Power User) (0 mesaje) at 2006-10-21 20:56:31 (940 săptămâni în urmă) - [Link]

#16 jekader, pascal-приложения рулезззззз

Mesaj util ? Da 0 puncte

#28 by Capilleary

(Патлатый) (0 mesaje) at 2006-10-21 21:00:51 (940 săptămâni în urmă) - [Link]

Iaka un program care lucreaza oleak ineficient din punct de vedere a folosirii memoriei, dar face treaba. Programul calculeaza exact numarul N!, unde N poate avea valori de pina la 500 sau asha ceva. Nu tzin minte pragul de sus. In C++ shtiu ca pragul am facut sa fie de 10 ori mai mare.

{$N+}
program zerourifactorial;
uses crt;
const max=maxint;
type nrmare=array[1..maxint] of 0..9;
procedure inm(n1:longint;var n2:nrmare; var len:longint);
var a,b,c,minte:longint;
begin
a:=max+1;
b:=len-1;
minte:=0;
repeat
a:=a-1;
c:=n1*n2[a]+minte;
n2[a]:=c mod 10;
minte:=c div 10;
until (minte=0) and (a<=max-b);
len:=len+max-b-a;
end;
var a,b,n,len,c:longint;
nr:nrmare;

begin
clrscr;
write('Introduceti N:' );
readln(n);
len:=1;
nr[max]:=1;
for a:=1 to n do
inm(a,nr,len);
for a:=max-len+1 to max do begin
write(nr[a]);
if nr[a]=0 then inc(c);
end;
writeln;
writeln;
Writeln('Numarul ',n,'! contzine:' );
writeln(len:5,' cifre;' );
writeln(c:5,' zerouri.' );
readkey;
end.

Mesaj util ? Da 0 puncte

#29 by mdcool (Power User) (0 mesaje) at 2006-10-21 21:04:50 (940 săptămâni în urmă) - [Link]

#28 Capilleary, а ты выкладывай еще, вот я своего препода порадую

Mesaj util ? Da 0 puncte

#30 by Capilleary

(Патлатый) (0 mesaje) at 2006-10-21 21:05:40 (940 săptămâni în urmă) - [Link]

ACHTUNGOVII cod. Asta la OMI (Olimpiada Municipala de Informatica) a fost problema. Tipa se da un shir de parantzeze de lungime 2N, sa se determine cite combinatzii corecte distincte sunt. Exemplu: N=3
((()))
()()()
(())()
()(())
Rezultat:4.
Pontu ca trebuia sa calculeze rapid pentru orice N<=64. Da la mine lucra incet printr-o metoda optimizata care are la baza algoritm de tip BackTracking.

{$N+}
program paranteze;
uses crt;
type bit=0..1;
binar=array[1..45] of bit;
procedure incr(var nr:binar; posit:longint; cs:longint);
begin
{functzia adauga o unitate la variabila nr de la pozitzia posit de la urma}
if nr[posit]=1 then begin
nr[posit]:=0;
incr(nr,posit-1,cs); {recursia la procedura cu positzia noua}
end else
nr[posit]:=1; {deci nu e nevoie de schimbare a altor cifre din nr}
end;
procedure generate(var s:binar; n,cs:longint);
var a,b:integer;
{I idee care optimizeaza lucrul e de a incepe nu de la 10000000000,
unde 1='(' shi 0=' )', ci de la 10101010101000 adica ()()()())) sau asha
ceva... caci aceasta e aproape de prima combinatzie corecta}
begin
for a:=cs-n to cs-3 do begin
inc(b);
if b mod 2 =1 then
s[a]:=1
else s[a]:=0;
s[cs-2]:=0;
s[cs-1]:=0;
s[cs]:=0;
end;
end;
var s:binar;
a,b,cs,c,n,p:longint;
label verif;
begin
clrscr;
write('Introduceti N:' );
readln(n);
n:=n*2; {deodata inmultzesc cu 2}
cs:=41; {trebuia de pus la const, e lungimea shirului}
generate(s,n,cs);
b:=cs-n-1; {valoare de lucru des folosita}
repeat {Luam toate variantele posibile}
incr(s,cs-2,cs);
{a II-a idee care optimizeaza lucrul programului este urmatoarea:
prima paranteza este TOT TIMPUL deschisa iar ultima este inchisa, deci
avem de calculat de 2 ori mai mutzina informatzie datorita faptului ca noi
adaugam la numarul binar nu 1, ci 2. Exemplu:
10101000
10101010
10101100
10101110
10110001
10110011
10110101}
a:=b; {a este pozitzia primei cifre a numarului in shirul s}
repeat
a:=a+1;
verif: if s[a]=1 then c:=c+1 else c:=c-1;
{c este un contor al parantzelor deschise}
if c<0 then begin
c:=0;
{a III-a idee care optimizeaza lucrul programului este urmatoarea:
daca s-au inchis mai multe paranteze decit s-au deschis (c<0) atunci
ultima ' )' se schimba in '(' shi se cerceteaza din nou shirul de la
pozitzia trecuta, in care c=0. Aceasta se face cu GOTO Verif}
s[a]:=1;
goto verif;
end;
until a=cs-1;
if c=0 then
{se adauga 1 unitate la contorul combinatziilor corecte}
p:=p+1
else c:=0;
until s[b]=1;
{conditzia de intrerupere a ciclului: numarul se lungeshte}
writeln(p-1);
{nu shtiu de ce, dar rezultatul e tot timpul cu 1 mai mare ca cel corect,
gresheala s-a indreptat foarte repede shi simplu. Principalul e ca lucreaza.}
readkey;
end.

De ce ACHTUNGOVII, cititzi commenturile.
Evident ca dupa asta l-am facut in C++, lucra fara bugs sh stranietatzi, de vreo 4 ori mai rapid. Evident ca cu totul alt algoritm, dar tot pe baza BackTracking-ului.

Mesaj util ? Da 0 puncte

#31 by jekader

(Besatzungsarmee) (0 mesaje) at 2006-10-21 21:08:39 (940 săptămâni în urmă) - [Link]

#24 mdcool, просто жми F9 - он скажет compile successfull

а про initgraph - надо указать директорию с библиотекой.

У меня это - "..\bgi" у кого-то ""

Mesaj util ? Da 0 puncte

#32 by Capilleary

(Патлатый) (0 mesaje) at 2006-10-21 21:10:37 (940 săptămâni în urmă) - [Link]

Din programul shcolar.
Cod care rezolva un sistem de ecuatzii de orice rang mai mic de 49 prin metoda lui Cramer (nu e Cramer de pe Torrents

)

program cramer;
uses crt;
type matrice=array[1..50,1..49] of real;
solutzii=array[1..49] of real;

{citirea matricii sistemului de ecuatzii}
procedure citire(var f:text; var ar:matrice; var n:integer);
var a,b:integer;
begin
readln(f,n);
for b:=1 to n do begin
for a:=1 to n+1 do
read(f,ar[a,b]);
readln(f);
end;
end;

{coeficientul inmultzit cu matricea de ordinul inferior}
function coef(var ar:matrice; var n:integer):real;
var a,b,d,e:integer;
c:real;
begin
d:=0;
repeat
inc(d);
until (ar[1,d]<>0) or (d=n);
for a:=d+1 to n do begin
if ar[1,a]<>0 then begin
c:=ar[1,d]/ar[1,a];
for b:=1 to n do ar[b,a]:=ar[b,d]-ar[b,a]*c;
end;
end;
coef:=ar[1,d];
for b:=1 to n do begin
inc(e);
if b<>d then
for a:=2 to n do
ar[a-1,e]:=ar[a,b];
end;
n:=n-1;
end;

{functzia recursiva de aflare a determinantului shi a dx, dy, dz,...}
function det(ar:matrice; n,x:integer):real;
var a,b:integer;
ax:matrice;
begin
for b:=1 to n do
for a:=1 to n do
if a<>x then
ax[a,b]:=ar[a,b]
else ax[a,b]:=ar[n+1,b];
if n>1 then det:=coef(ax,n)*det(ax,n,n+1);
if n=1 then det:=ax[1,1];
end;

{calculeaza radacinile}
procedure calcul(ar:matrice; n:integer; var s:solutzii);
var a:integer;
begin
for a:=1 to n do
s[a]:=det(ar,n,a)/det(ar,n,n+1);
end;

{programul principal}
var fdn:string;
f:text;
ar:matrice;
s:solutzii;
n,a:integer;
begin
clrscr;
writeln('Introducetzi fishierul ce contzine matricea sistemului' );
readln(fdn);
assign(f,fdn);
reset(f);
citire(f,ar,n);
calcul(ar,n,s);
for a:=1 to n do write('x',a,'=',s[a]:6:2,' ' );
readkey;
end.

Mesaj util ? Da 0 puncte

#33 by Capilleary

(Патлатый) (0 mesaje) at 2006-10-21 21:13:28 (940 săptămâni în urmă) - [Link]

Pantovii grafic se primeshte

program graphic;
uses crt,graph;
var a,b,c,d,e:integer;
x1,x,y,y2:real;
begin
detectgraph(a,b);
initgraph(a,b,'c:\bp\bgi' );
x1:=-0.999;
setcolor(white);
line(0,240,640,240);
line(320,0,320,480);
repeat
x1:=x1+1;
x:=x1/10000;
y:=-(

(-6*x*x*x+2)/sqr(x*x*x+2)-(x*cos(x)*ln(x)-sin(x))/(x*ln(x)*ln(x))

);
if y<-5 then y:=-5; if y>5 then y:=5;
y:=y*64+240;
putpixel(round(x*64+320),round

,lightgreen);
until x1>50000;
readkey;
end.

Editat de către Capilleary la 2006-10-21 21:17:59

Mesaj util ? Da 0 puncte

#34 by jekader

(Besatzungsarmee) (0 mesaje) at 2006-10-21 21:14:44 (940 săptămâni în urmă) - [Link]

#32 Capilleary, школьная программа? :-O

у нас самым крутым считалось сделать домик при помощи lineto :lol:

Mesaj util ? Da 0 puncte

#35 by Capilleary

(Патлатый) (0 mesaje) at 2006-10-21 21:16:40 (940 săptămâni în urmă) - [Link]

Eu ma pregateam de BAC, transmiteam la alt patzan care se pregatea de BAC prin mail (eviX), problema care nu o intzelegeam

program sdlkfjss;
var p1,p2:^integer;
begin
new(p1);
p1^:=10;
p2:=p1;
new(p1);
p1^:=p1^ div 2;
writeln(p1^,' ',p2^);
end.
{Iaca acum uita-te atent la acest program copiat din cartea de bac.
Trebuie sa scrii ce va afisha in urma executziei. Mai bine gindeshte-te
la inceput ce poate sa afisheze, dupa aceasta da-i drumul de vreo 20 de ori
fara sa faci nici o schimbare (pur hsi simplu apeshi ca debilul F9 tzinind pe
CTRL). Nu faci nici un fel de clrscr, dupa asta apeshi ALT-F5, uita-te shi
gruzeshte-te. Explica cumva de unde se ia prima cifra. Nu are nici o legatura
cu Maxint, cu 2 la vre-o putere sau asha ceva. Cum vei shti cu ce este egal?
Mai era shi problema 48, care pur shi simplu atribuie o valoare char la
o variabila integer. Ndaaa, spune ce va afisha TIPA... MOR DI SHIUDA}

Mesaj util ? Da 0 puncte

#36 by Capilleary

(Патлатый) (0 mesaje) at 2006-10-21 21:20:01 (940 săptămâni în urmă) - [Link]

#34 jekader, mi-a mers ca am avut un prof tinar, un patzan care 2 ani in urma terminase masteratu. In kopkilarie umbla pe la olimpiade natzionale de infosha, odata a luat locul 1 chiar. Prikalist, nu refuza cite o piva cu patzanii

. Starcraft jucam in timpul liber cu el (idiotu ne rupea cu cite 2 divizii de batoane pe totzi sh nu-i puteam face nik). Numa k la ceilaltzi profi nu le placea de dinsu. Sh a avut probleme mari in liceu. De 2 ori erau sa-l concedieze, odata chiar cu privarea dreptului de a preda.

Mesaj util ? Da 0 puncte

#37 by kuett Fotbalist

(VIP) (0 mesaje) at 2006-10-21 21:32:18 (940 săptămâni în urmă) - [Link]

#16 jekader, :w00t:

Mesaj util ? Da 0 puncte

#38 by kuett Fotbalist

(VIP) (0 mesaje) at 2006-10-21 21:39:28 (940 săptămâni în urmă) - [Link]

eh si zadrotzi in pascal O_O vreu si eu sa sti asa ceva

Mesaj util ? Da 0 puncte

#39 by UTM

(Power User) (0 mesaje) at 2006-10-21 21:55:15 (940 săptămâni în urmă) - [Link]

{ Program facut demult, shi un screen :wink:

}

program trulala; uses crt;
Var Scr : Array[0..199,0..319] Of Byte Absolute $A000:$0000;
procedure setmcga; assembler; asm mov ax,0013h; int 10h end;
procedure settext; assembler; asm mov ax,0003h; int 10h end;

{hz de unde am gasit asta, da aranjeaza paleta de culori}
procedure dopal; assembler;
asm
mov dx,03c8h; xor al,al; out dx,al; inc dx; mov cx,8;
@set_red:mov al,16; sub al,cl; shl al,03; out dx,al; xor al,al;
out dx,al; out dx,al; loop @set_red; mov cx,16;
@set_yellow: mov al,60; out dx,al; mov al,16; sub al,cl; shl al,02;
out dx,al; xor al,al; out dx,al; loop @set_yellow; mov cx,16;
@set_white: mov al,60; out dx,al; out dx,al; mov al,16; sub al,cl;
shl al,02; out dx,al; loop @set_white; mov cx,208; mov al,63;
@whithey: out dx,al; out dx,al; out dx,al; loop @whithey;
end;

procedure init; var i,j:integer;
begin setmcga; dopal; fillchar(scr,sizeof(scr),0);end;

var i,j:integer; const Xstart=50; Xend=75; Height=199;

function med(i,j:integer):byte; var c1,c2,c3,c4:integer; m:real;
begin c1:=0; c2:=0; c3:=0; c4:=0;
if (j-1>Xstart) then c1:=scr[i-1,j-1] else c1:=scr[i-1,j] div 2;
c2:=scr[i-1,j];
if (j+1<Xend) then c3:=scr[i-1,j+1] else c3:=scr[i-1,j] div 2;
if (i>=2) then c4:=scr[i-2,j] else c4:=scr[i-1,j] div 2;
m:=(c1+c2+c3+c4)/4.05; med:=trunc(m)+random(2);
end;

begin init;
repeat
for j:=Xstart to Xend do begin scr[0,j]:=45-random(2); scr[1,j]:=50-random(2); end;
for i:=1 to height do
for j:=Xstart to Xend do scr[i,j]:=med(i,j);
until keypressed;
readln; settext;
end.

SCREEN:

Editat de către UTM la 2006-10-21 22:00:50

Mesaj util ? Da 0 puncte

#40 by VadikRamm

(Der Metzgermeister) (0 mesaje) at 2006-10-21 22:42:08 (940 săptămâni în urmă) - [Link]

#39 UTM, V nature asha focushor arata pascalu?

Mesaj util ? Da 0 puncte

#41 by VadikRamm

(Der Metzgermeister) (0 mesaje) at 2006-10-21 23:05:27 (940 săptămâni în urmă) - [Link]

Way patzani, ma credetz sau nu da eu stiu sa scriu numa: "Program P1;" Restu iau de la professoare, ii dau din ochi sh vine cu foaia cu raspuns - shutka, copii de la vecin, ucionii blin.

Mesaj util ? Da 0 puncte

#42 by Roosvelt (¡Hala Madrid! Y Nada Más!) (0 mesaje) at 2006-10-21 23:09:43 (940 săptămâni în urmă) - [Link]

#34 jekader, +1.
У вас кто учителем был или была?

Mesaj util ? Da 0 puncte

#43 by jekader

(Besatzungsarmee) (0 mesaje) at 2006-10-21 23:22:53 (940 săptămâni în urmă) - [Link]

#42 Roosvelt, ой, не напоминай... Гордиевская Наталья Анатольевна...

Mesaj util ? Da 0 puncte

#44 by Roosvelt (¡Hala Madrid! Y Nada Más!) (0 mesaje) at 2006-10-21 23:27:14 (940 săptămâni în urmă) - [Link]

#43 jekader, +1
:rofl:

Mesaj util ? Da 0 puncte

#45 by jekader

(Besatzungsarmee) (0 mesaje) at 2006-10-21 23:29:53 (940 săptămâni în urmă) - [Link]

#44 Roosvelt, а ты что, тоже пушкинец?

Mesaj util ? Da 0 puncte

#46 by Roosvelt (¡Hala Madrid! Y Nada Más!) (0 mesaje) at 2006-10-21 23:31:13 (940 săptămâni în urmă) - [Link]

#45 jekader, :yes:

Mesaj util ? Da 0 puncte

#47 by VadikRamm

(Der Metzgermeister) (0 mesaje) at 2006-10-21 23:42:09 (940 săptămâni în urmă) - [Link]

am o problema, vreu sa copii un program scris in word sh nu vre sa copie, fac copy in word apoi ma duc in pascal da paste nu vre sa faca, de ce? sh pot altfel sa copii repejor fisierul?

Mesaj util ? Da 0 puncte

#48 by Stinger

(VIP) (0 mesaje) at 2006-10-21 23:43:46 (940 săptămâni în urmă) - [Link]