TIP: Přetáhni ikonu na hlavní panel pro připnutí webu
diky uz mi to jede
Příspěvky odeslané z IP adresy 90.176.43.–
Laker
Laker
pls prosim o pomoc s touto procedurou... mam zadat text a pak mi ho to má vypsat zpet v opacnem poradi napr. zadam Adam a vypise madA... pro vas to bude asi hracka ale ja sem zacatecnik
zacal jsem takhle:
procedure Obrat(var s:string);
var x:array of string;
i,j:byte;
begin
for i:=1 to 100 do begin
for j:=length(retezec) downto 1 do
x[i]:=copy(retezec,j,1);
end;
end;diky predem za odpovedi
Laker
pls prosim o pomoc s touto procedurou... mam zadat text a pak mi ho to má vypsat zpet v opacnem poradi napr. zadam Adam a vypise madA... pro vas to bude asi hracka ale ja sem zacatecnik
zacal jsem takhle:
procedure Obrat(var s:string);
var x:array of string;
i,j:byte;
begin
for i:=1 to 100 do begin
for j:=length(retezec) downto 1 do
x[i]:=copy(retezec,j,1);
end;
Edit2.Text:=x[i];
end;diky predem za odpovedi
Arkan
udelal jsem to trochu jinak ale dik za pomoc :D
Program sinus;
uses Graph,Crt;
var i,gd,gd,PolX,PolY:integer;
K1,K2,x,Sirka,Vyska:real;
begin
clrscr;
Sirka:=4*pi;
Vyska:=4;
InitGraph(gd,gm,'');
PolX:=GetMaxX div 2;
PolY:=GetMaxY div 2;
line(0,PolY,GetMaxX,PolY);
line(PolX,0,PolX,GetMaxY);
OutTextXY(GetMaxX-10,PolY+3,'x');
OutTextXY(PolX+5,1,'y');
K1:=Sirka/GetMaxX;
K2:=GetMaxY/Vyska;
for i:=0 to GetMaxX do
begin
x:=(i-PolX)*K1;
putpixel(i,PolY-trunc(sin(x)*K2),lightblue);
putpixel(i,PolY-trunc(2*sin(x)*K2),lightred);
putpixel(i,PolY-trunc(sin(x/2)*K2),magenta);
putpixel(i,PolY-trunc(sin(2*x)*K2),lightgreen);
end;
SetTextStyle(0,0,2);
SetColor(lightblue);
OutTextXY(20,810,'y=sin(x)');
SetColor(lightred);
OutTextXY(20,830,'y=2*sin(x)');
SetColor(magenta);
OutTextXY(20,850,'y=sin(x/2)');
SetColor(lightgreen);
OutTextXY(20,870,'y=sin(2*x)');
writeln('Pro ukonceni stiskni cokoliv');
readln;
closegraph;
end.
Arkan
mam za ukol vykreslit v pascalu funkci sinx do grafu o dvou osach ale nevim jak nato. Tohle jsem jeste nikdy nedelal takze vubec nevim co s tim
program Trojuhelnik;
uses graph;
var gd,gm:integer;
x:integer;
begin
gd:=detect;
InitGraph(gd,gm,'C:\mojeprogramy\BP\bgi');
line(0,0,0,400);
line(0,200,400,200);
readln;
CloseGraph;
end.
nevite nekdo jak na to? pls
Arkan
Jj mas pravdu uz mi to jede diky ti :smile2:
Arkan
mezi c1 a c2 to urcite nemuze byt protoze tam mam cyklus repeat until takze by se to provedlo vicekrat. Tady je jeste ta unita:
unit trideni;
interface
uses crt,dos;
const m=10000;
type Tpole=array[1..m]of integer;
var p:Tpole;
function Cas:real;
procedure nacti(var p:Tpole;n:integer);
procedure tisk(var p:Tpole;n:integer);
procedure BubbleSort(var p:Tpole;n:integer);
procedure HeapSort(var p:Tpole;n:integer);
procedure QuickSort(var p:Tpole;n:integer);
procedure SelectSort(var p:Tpole;n:integer);
procedure ShakerSort(var p:Tpole;n:integer);
implementation
function Cas:real;
var h,m,s,ss:word;
hr:real;
begin
gettime(h,m,s,ss);
hr:=h;
cas:=hr*3600+m*60+s+ss/100;
end;
procedure nacti(var p:Tpole;n:integer);
var i:integer;
begin
randomize;
for i:=1 to n do
p[i]:=random(1000)+1;
end;
procedure tisk(var p:Tpole;n:integer);
var i:integer;
begin
for i:=1 to n do
write(p[i]:5);
end;
procedure BubbleSort(var p:Tpole;n:integer);
var i,j,x:integer;
begin
for i:=1 to n-1 do
for j:=1 to n-1 do
if p[j] > p[j+1] then begin
x:=p[j];
p[j]:=p[j+1];
p[j+1]:=x;
end;
end;
procedure HeapSort(var p:Tpole;n:integer);
var k,r,pom:integer;
procedure zarazeni;
var i,j:integer;
begin
i:=k;
j:=2*i;
pom:=p[i];
while j<=r do begin
if j<r then
if p[j]<p[j+1] then inc(j);
if pom>p[j] then break;
p[i]:=p[j];
i:=j;
j:=2*i;
end;
p[i]:=pom;
end;
begin
k:=(n div 2)+1;
r:=n;
while k>1 do
begin
dec(k);
zarazeni;
end;
while r>1 do
begin
pom:=p[1];
p[1]:=p[r];
p[r]:=pom;
dec(r);
zarazeni;
end;
end;
procedure QuickSort(var p:Tpole;n:integer);
procedure Trideni(LL,RR:longint);
var x,pom:integer;
L,R:longint;
begin
x:=p[(LL+RR) div 2];
L:=LL;
R:=RR;
repeat
while p[L] < x do inc(L);
while x < p[R] do dec(R);
if L<=R then begin
pom:=p[L];
p[L]:=p[R];
p[R]:=pom;
inc(L);
dec(R);
end;
until L>R;
if LL<r then Trideni(LL,R);
if L<RR then Trideni(L,RR);
end;
begin
Trideni(1,n);
end;
procedure SelectSort(var p:Tpole;n:integer);
var i,j,min,pom:integer;
begin
for i:=1 to n-1 do
begin
min:=p[i];
for j:=i+1 to n do
begin
if min>p[j] then
begin
min:=p[j];
pom:=j;
end;
end;
p[pom]:=p[i];
p[i]:=min;
end;
end;
procedure ShakerSort(var p:Tpole;n:integer);
var j,k,L,R,x:integer;
begin
L:=2;R:=n;k:=n;
repeat
for j:=R downto L do
if p[j-1]>p[j] then begin
x:=p[j-1];
p[j-1]:=p[j];
p[j]:=x;
k:=j;
end;
L:=k+1;
for j:=L to R do
if p[j-1]>p[j] then begin
x:=p[j-1];
p[j-1]:=p[j];
p[j]:=x;
k:=j;
end;
R:=k-1;
until L>R;
end;
begin
end.Arkan
ne to ne toto je muj cely zdrojak
var n:integer;
c1,c2:real;
metoda:word;
begin
clrscr;
n:=0;
writeln('Zadej kterou metodou chces tridit:');
writeln('BubbleSort - stiskni 1');
writeln('HeapSort - stiskni 2');
writeln('QuickSort - stiskni 3');
writeln('SelectSort - stiskni 4');
writeln('ShakerSort - stiskni 5');
case metoda of
1:BubbleSort(p,n);
2:HeapSort(p,n);
3:QuickSort(p,n);
4:SelectSort(p,n);
5:ShakerSort(p,n);
end;
readln(metoda);
repeat
n:=n+500;
nacti(p,n);
sound(100);
c1:=cas;
{metoda}
c2:=cas;
nosound;
tisk(p,n);
writeln;
writeln('Cas trideni metodou ',metoda,' pro ',n,' prvku je:',(c2-c1):5:2,' sekundy');
delay(5000);
until n=5000;do tech zavorek z metodou mezi cas1 a cas2 mam tu metodu vypsat protoze mam zjistit cas trideni ale kdyz to tam dam tak mi to nesetridi tak nevim jak to tam mam zadat aby mi to setridilo. Jinak mi to vypise nesetrizene pole
Arkan
case mam napsany takto
case metoda of
1:BubbleSort(p,n);
2:HeapSort(p,n);
3:QuickSort(p,n);
4:SelectSort(p,n);
5:ShakerSort(p,n);
{nejde mi to nijak vypsat}
sound(100);
c1:=cas;
metoda;
c2:=cas;
nosound;ale nevim jak to mam zadat
Arkan
Pls potreboval bych pomoct. Mám tento zdrojový kód:
program tridici_metody;
uses crt,trideni;
const m=10000;
var n:integer;
c1,c2:real;
begin
clrscr;
n:=0;
repeat
n:=n+500;
nacti(p,n);
sound(100);
c1:=cas;
BubbleSort(p,n);
c2:=cas;
nosound;
tisk(p,n);
writeln;
writeln('Cas trideni pro ',n,' prvku je:',(c2-c1):5:2,' sekundy');
delay(5000);
until n=5000;
writeln('Pro ukonceni stisknete cokoliv');
readkey;
end.ve vlastní unite mam napsané kódy pěti třídících metod ale nevím jak udělat abych si mohl zadat kterou chcu použít. Mělo by to fungovat nějak tak že se me program zeptá kterou metodou chci třídít a já bych si jen vybral třeba číslo této metody. Zkoušel jsem to delat přes CASE ale nejak mi to nefungovalo. Prosím o pomoc je to úkol do školy, moc dík.
mirek
diky moc
mirek
ja neznam presne index toho prvku mam do pole nacist cisla z klavesnice a pak pomoci procedury vypsat indexy kladnych a zapornych cisel. Zkousel jsem ty prvky kopirovat do druheho pole ale nejak mi to porad nejede.
procedure nacti(var p:Tpole;r,s:integer);
var i,j:integer;
begin
for i:=1 to r do
for j:=1 to s do
readln(p[i,j]);
end;
procedure tisk(var p:Tpole;r,s:integer);
var i,j,kladne,zaporne:integer;
begin
kladne:=0;
zaporne:=0;
for i:=1 to r do
begin
for j:=1 to s do
begin
write(p[i,j]:3);
if p[i,j]>0 then
kladne:=kladne+1;
if p[i,j]<0 then
zaporne:=zaporne+1;
end;
writeln;
end;
writeln('Pocet kladnych cisel je: ',kladne);
writeln('Pocet zapornych cisel je: ',zaporne);
end;mirek
ahoj,pls potreboval bych pomoct z ukolem. Mam napsat proceduru ktera vypise kolik kladnych a kolik zapornych cisel je v poli a indexy kladnych a zapornych cisel, zatim mam hotove jen procedury na nacteni a tisk pole ale nevim jak mam vypsat ty indexy. např index kladného čísla v poli A[1,3]
