Anonymní profil mALIRKA – Programujte.com
 x   TIP: Přetáhni ikonu na hlavní panel pro připnutí webu

Anonymní profil mALIRKA – Programujte.comAnonymní profil mALIRKA – Programujte.com

 

Příspěvky odeslané z IP adresy 213.168.179.–

Markéta
Delphi › Pexeso
12. 10. 2009   #117111

Ahoj.
Udělala jsem program pexeso..Ale nevím si s něčím rady.Udělala jsem tři tlačítka - start,znovu,konec.Do startu a konce jsem věděla jak zapsat kod,ale nevím jak to napsat do toho znovu.Chci aby to dělalo to: když hraju a něco spletu třeba tak abych si to dala znovu, to by měl být účel tohoto tlačítka..Poraďte mi co tak zapsat do toho kodu tlačítka znovu.Děkuju

Marketa
Delphi › Animace
10. 10. 2009   #116917

To z_moravec : ¨Nějakou aniamci auta jsem už dělala.....Ale tohle si myslím že bude trochu něco jiného..Např chci animaci padání sněhu(vloček), tak místo toho chci pak dát balonky...

Marketa
Delphi › Animace
10. 10. 2009   #116915

Ahoj,
potřebovala bych poradit jak napsat kod na animaci např pohybu balónků či něčeho podobného. Vůbec nevím jak na to.
Děkuji

Anonymní uživatel
Pascal › pomocte
6. 5. 2009   #100601

To o-lox : Tady mám jeden kod,ale nejde spustit a potřebovala bych ho nějak zjednodušit.

Uses crt;

const klic: array[0..26] of char = (' ','E','A','O','I','N','T','S','L','R','K','V','D','M','U',
'C','P','Z','Y','H','J','B','G','F','X','Q','W');
Label
znova1,znova2,nav1,nav2;

Type titer=record
a:integer;
i1:integer;
ok:boolean;
preskoc:boolean;
pru:integer;
presah:boolean;
end;
tt1=array[0..255]of char;
const
znaky:array[1..3]of char=(' ','.',',');

Var i,j,a,b:integer;
slova:array[1..450]of string[20];
slov:integer;
slovnik:array[1..1500]of string[20];
pslov:integer;
f:File;
prevod:tt1;
cele : array[1..3000]of char;
cteno:integer;
iter : array[1..1501]of titer;
z:char;
ret:string;
poslslovo:integer;
test1,test2:boolean;
ft:text;
nalezeno:integer;
pocetpism : array[0..55]of integer;
rezim:byte;
z1,z2:char;
pevne:tt1;
pouzite:array[0..255]of Byte;
pouzitepole:array[0..255] of byte;
poslpouz:Byte;
zbylo:integer;

procedure intro;
begin
while not(eof(ft)) do
begin readln(ft,ret);
i:=1;
repeat
a:=i;
test1:=true;
While (i<=length(ret))and(ret[i]<>' ') do begin
ret[i]:=upcase(ret[i]);
If (ret[i]>'Z')or(ret[i]<'A') then test1:=false;
inc(i);
end;
If (i<>a) and test1 then begin
slovnik[j]:=copy(ret,a,i-a);
inc(j);
end;
inc(i);
until i>length(ret);
end;
End;

Function najdiznak(a:char):byte;
Var i:integer;
Begin
i:=0;
while prevod[i]<>a do inc(i);
najdiznak:=i;
End;

BEGIN
clrscr;
writeln('Lusteni sifrovaneho souboru sifra.txt');
prevod[ord('I')]:=' ';
slovnik[1]:='NEBO';
slovnik[2]:='ZE';
slovnik[3]:='KDYZ';
slovnik[4]:='ALE';
slovnik[5]:='SE';
slovnik[6]:='TO';
slovnik[7]:='BYL';
slovnik[8]:='BUDE';
slovnik[9]:='RYCHLE';
slovnik[10]:='UDELA';
pslov:=10;
assign(ft,'C:Pascal\slovnik2.txt');
reset(ft);
j:=pslov;
intro;
pslov:=j-1;
close(ft);

Assign(f,'C:Pascal\sifra.txt');
Reset(f,1);
blockread(f,cele,3000,cteno);
pevne[ord('.')]:='.';
pevne[ord(',')]:=',';
pevne[ord('I')]:=' ';
pevne[ord('X')]:='A';
for i:=1 to cteno do
begin
test1:=true;
for j:=1 to poslpouz do
If pouzite[j]=ord(cele[i]) then test1:=false;
If pevne[ord(cele[i])]<>#0 then test1:=false;
If test1 then
begin
inc(poslpouz);
pouzite[poslpouz]:=ord(cele[i]);
end;
end;

i:=1; j:=1;
prevod[ord('.')]:='.';
prevod[ord(',')]:=',';
while i<cteno do begin
a:=i;
while not (prevod[ord(cele[i])] in [' ','.',',']) do
begin
slova[j]:=slova[j]+cele[i];
inc(i);
end;
inc(i);
If (cele[i]=',')or(cele[i]='.') then inc(i);
if slova[j]<>'' then inc(j);
end;
slov:=j;
For i:=1 to slov do
inc(pocetpism[length(slova[i])]);

a:=1;
{ iter[a].i1:=1;}
for i:=1 to 300 do iter[i].ok:=false;
test1:=false;
zbylo:=poslpouz;

Repeat
znova1:
for i:=0 to 255 do
If pevne[i]<>#0 then prevod[i]:=pevne[i];

a:=1;
while iter[a].ok or iter[a].preskoc do inc(a);

If slovnik[a]='' then
begin
If (nalezeno>10)and(zbylo<11{9}) then begin
Repeat
clrscr; if keypressed then readkey;
for i:=1 to 80*23 do
If prevod[ord(cele[i])]>#0 then
write(prevod[ord(cele[i])])
else write('_');
Writeln; write('zadej potvrzeni / 0 = konec');
z1:=readkey;
z2:=readkey;
z1:=upcase(z1);
z2:=upcase(z2); write(z1,z2); delay(600);
If z1=#13 then
begin
for z1:='A' to 'Z' do
begin
test1:=false;
for a:=0 to 255 do
If prevod[a]=z1 then test1:=true;
If not test1 then begin
a:=1;
while pouzitepole[a]>0 do inc(a);
pouzitepole[a]:=1;
prevod[pouzite[a]]:=z1;
end;
end;
end else begin
If (z1='0')or(z2='0') then break;
If z2<>'*' then
pevne[Najdiznak(z1)]:=z2 else
pevne[Najdiznak(z1)]:=#0;
for i:=0 to 255 do
If pevne[i]<>#0 then prevod[i]:=pevne[i];
end;
Until false;
writeln('bezim...');
delay(800);
{ If nalezeno>16 then begin textcolor(RED); write(' ENTER'); textcolor(7); readkey; end;}
end;
nalezeno:=1;
for i:=1 to pslov do
begin iter[i].ok:=false;
iter[i].preskoc:=false;
iter[i].i1:=0;
end;
i:=1;
{ If iter[i].presah then begin
iter[i].presah:=false;
iter[i].pru:=0;
inc(i);
end;}
repeat
inc(iter[i].pru);
If pocetpism[length(slovnik[i])]<=iter[i].pru
then begin
iter[i].pru:=0;
inc(i);
end else break;
until false;

for i:=0 to 255 do prevod[i]:=#0;
for i:=0 to 255 do pouzitepole[i]:=0;
zbylo:=poslpouz;
goto znova1;
end;

For j:=0 to iter[a].pru do
begin
Repeat
inc(iter[a].i1);
while (iter[a].i1<slov)and(length(slova[iter[a].i1])<>length(slovnik[a])) do inc(iter[a].i1);
i:=1;
While prevod[ord(slova[iter[a].i1,i])]<>#0 do inc(i);
Until i<=length(slovnik[a]);
If iter[a].i1=slov then break;
end;

If iter[a].i1=slov then begin
iter[a].presah:=true;
iter[a].i1:=1;
poslslovo:=a;
If rezim=1 then begin
slovnik[a]:=slovnik[pslov];
dec(pslov);
end else
begin
test1:=true;
{ for j:=1 to length(slovnik[a]) do
chyba[ord(slovnik[a,j])]:=1;}
{ a:=poslslovo;}
{ slovnik[a]:=slovnik[pslov];
dec(pslov); }
iter[a].preskoc:=true;
test1:=false;
end;
{ dec(a);
goto znova1;}
end else begin
iter[a].ok:=true;
for j:=1 to length(slova[iter[a].i1]) do
begin
z1:=slova[iter[a].i1,j];
For b:=32 to 96 do
If (ord(z1)<>b)and(prevod=slovnik[a,j]) then begin
iter[a].ok:=false;
goto znova1;
end;
If (prevod[ord(slova[iter[a].i1,j])]<>#0)and
(prevod[ord(slova[iter[a].i1,j])]<>slovnik[a,j])
then begin
iter[a].ok:=false;
goto znova1;
end;
for b:=j+1 to length(slova[iter[a].i1]) do
If (((slova[iter[a].i1,j]=slova[iter[a].i1,b])
and(slovnik[a,j]<>slovnik[a,b]))
or
((slovnik[a,j]=slovnik[a,b])
and(slova[iter[a].i1,j]<>slova[iter[a].i1,b])))
then begin
iter[a].ok:=false;
goto znova1;
end;
end;
for j:=1 to length(slova[iter[a].i1]) do
begin
prevod[ord(slova[iter[a].i1,j])]:=slovnik[a,j];
for b:=1 to poslpouz do
If pouzite=ord(slova[iter[a].i1,j]) then
begin
{ pouzite:=pouzite[poslpouz];
dec(poslpouz);}
If pouzitepole=0 then dec(zbylo);
pouzitepole:=1;
break;
end;
end;
end;
If iter[a].ok then inc(nalezeno);
Until false;
close(f);
END.

Anonymní uživatel
Pascal › pomocte
4. 5. 2009   #100479

To pc_manik : pojď na icq....nefunguje

Malirka
Pascal › LOSOVANI
21. 4. 2009   #99582

To Mircosoft : Ahojky.Už jsem něco zplodila s pomocí kamaráda,ale nevím jestli je to ono.
Uses crt;

type pole =array[0..30] of string;

function Losuj(zaci: Pole; pocet: Integer):String;
begin
Losuj:= zaci[random(pocet)];
end;

var i: Byte;
S: Text;
zaci: pole;
pocetnaz: Integer;
vysledek: String;

begin
Assign(S,'C:\Pascal\zaci.txt');
Reset(S);
Randomize;
TextColor(Green);
Writeln('---- Program na zkouseni zaku ----');
TextColor(White);
Writeln;
Write('Zadej pocet zaku ke zkouseni (maximalne 30): ');
Readln(pocetnaz);
Writeln;
i:=0;
while not(eof(S)) do
begin
Readln(S,zaci[i]);
Inc(i);
end;
Close(S);
while not(pocetnaz = 0) do
begin
Writeln;
Vysledek:= Losuj(zaci,i);
Writeln(vysledek);
Pocetnaz:= pocetnaz - 1;
end;
Readkey;
end.

Malirka
Pascal › LOSOVANI
18. 4. 2009   #99378

Aahojky.Mám udělat tady tento program,ale nevím jak ho udlat,tak bych potřebovala nějak poradit.Vím jen, že se to musí určitě udělat přes Random a Randomize.
Zadání:
Sestavte program, který ze vstupního souboru načte seznam žáků a poté náhodně vybere zadaný počet žáků ke zkoušení.
VSTUP: seznam žáků – soubor ZACI.TXT
počet žáků ke zkoušení
VÝSTUP: přehled vylosovaných žáků

Vstupní soubor mám...Je tam je seznam jmen.
Díky

mALIRKA
Pascal › hadani
18. 4. 2009   #99371

To Krychlik : Tady jsem to upravila:
Uses crt;

var N,HADANE,CISLO,POKUSU: Integer;
C: Char;

begin
clrscr;
repeat
POKUSU:= 0;
N:= 0;
HADANE:= 0;
CISLO:= 0;
clrscr;
TextColor(LightBlue);
Writeln('---- Program na hadani cisla ----');
TextColor(White);
Writeln;
Writeln('Zadejte jaka bude horni hranice:');
Readln(N);
Randomize;
CISLO:= random(N);
While CISLO = 0 do CISLO:= Random(N);
Writeln;
Writeln('Hadejte cislo od 1 do ',N);
Readln(HADANE);
if (HADANE <> 0) and (HADANE <> CISLO) then begin
Repeat
POKUSU:= POKUSU + 1;
Writeln;
if HADANE > CISLO then writeln('Cislo je mensi!')
else writeln('Cislo je vetsi!');
Writeln;
readln(HADANE);
until (HADANE = CISLO) or (HADANE = 0);
Writeln;
if HADANE = 0 then writeln('Vzdal jste se')
else Writeln('Gratuluji uhadl/la jste cislo na ', POKUSU+1 ,'. pokus!!!!!!');
end
else begin
if HADANE = 0 then writeln('Vzdal jste se')
else if HADANE = CISLO then writeln('Gratuluji uhadl/la jste cislo na prvni pokus!');
end;
Writeln;
Writeln('Chcete pokracovat? A/N');
Read(C);
Until C<>'A';
Readln;
end.

Malirka
Pascal › hadani
18. 4. 2009   #99348

Ahojky.Tady mám program na hadání čísel.Můžete se na to někdo mrknout jestli to mám podle tohoto zadání dobře.Díky.
Sestavte program, který vygeneruje náhodné celé číslo ze zvoleného rozsahu (1 .. N) a umožní uživateli hádat toto číslo. Po každém tipu uživatele, program napoví, zda hledané číslo je menší nebo větší než zvolená hodnota. Po uhodnutí čísla se kromě gratulace k úspěchu zobrazí i počet pokusů. Pokud uživatel zadá hodnotu nula, znamená to, že se vzdává. Po skončení hádání program nabídne další hru nebo ukončení.
VSTUP: N - horní hranice rozsahu čísel
tipy uživatele
VÝSTUP: nápovědy k hádání (je menší/větší)
gratulace a počet pokusů


Uses crt;

var cislo, hadane, n:Integer;

label znovu;

begin
TextColor(LightBlue);
Writeln('---- Program na hadani cisla ----');
TextColor(White);
znovu:
Writeln;
Writeln('Myslim si cislo od 1 do 100, uhodni ho:');
Writeln;
Randomize;
Cislo:=Random(100);
n:=1;
Write(n,'. pokus: ');
Read(hadane);
While hadane <> cislo do
begin
if hadane > cislo then writeln('Je mensi!')
else writeln('Je vetsi!');
n:=n+1;
Writeln;
Write(n,'. pokus: ');
Read(hadane);
if hadane = 0 then Halt(0);
end;
Writeln;
Write('Gratuluji, myslel jsem si cislo ',cislo,' a uhodnul si ho na ',n,'. pokus');
Writeln;
Writeln;
Write('Chcete hrat znovu? (A/N)');
if UpCase(ReadKey) = 'A' then goto znovu;
end.

Malirka
Pascal › Úkol
18. 4. 2009   #99347

To raddino : Hodila jsem hned pod Uses to celé var a pod ním jsou ty function a jde to v poho..

Malirka
Pascal › trojuhelnik
18. 4. 2009   #99344

To Krychlik : Aha.A jak bys to napsal ty?Nevím jak jinak to napsat.

Malirka
Pascal › Úkol
18. 4. 2009   #99342

To raddino : Aahojky.Já jsem to udělala trochu jinak.Mrkni na to jestli to takhle může být:
Uses crt;


function miliony(pocet: Longint): String;
var retezec: String;
begin
retezec:= '';
case pocet of
1:begin
retezec:= retezec + 'milion';
end;
2:begin
retezec:= retezec + 'dvamiliony';
end;
3:begin
retezec:= retezec + 'trimiliony';
end;
4:begin
retezec:= retezec + 'ctyrimiliony';
end;
5:begin
retezec:= retezec + 'petmilionu';
end;
6:begin
retezec:= retezec + 'sestmilionu';
end;
7:begin
retezec:= retezec + 'sedmmilionu';
end;
8:begin
retezec:= retezec + 'osmmilionu';
end;
9:begin
retezec:= retezec + 'devetmilionu';
end;
end;
miliony:= retezec;
end;


function stovky(pocet: Longint): String;
var retezec: String;
begin
retezec:= '';
case pocet of
1:begin
retezec:= 'sto';
end;
2:begin
retezec:= 'dveste';
end;
3:begin
retezec:= 'trista';
end;
4:begin
retezec:= 'ctyrista';
end;
5:begin
retezec:= 'petset';
end;
6:begin
retezec:= 'sestset';
end;
7:begin
retezec:= 'sedmset';
end;
8:begin
retezec:= 'osmset';
end;
9:begin
retezec:= 'devetset';
end;
end;
stovky:= retezec
end;


function desitky(pocet: Longint): String;
var retezec: String;
begin
retezec:= '';
case pocet of
2:begin
retezec:= 'dvacet';
end;
3:begin
retezec:= 'tricet';
end;
4:begin
retezec:= 'ctyrcet';
end;
5:begin
retezec:= 'padesat';
end;
6:begin
retezec:= 'sedesat';
end;
7:begin
retezec:= 'sedmdesat';
end;
8:begin
retezec:= 'osmdesat';
end;
9:begin
retezec:= 'devadesat';
end;
end;
desitky:= retezec;
end;


function des_problem(pocet: Longint): String;
var retezec: String;
begin
retezec:= '';
case pocet of
1:begin
retezec:= 'jedenact';
end;
2:begin
retezec:= 'dvanact';
end;
3:begin
retezec:= 'trinact';
end;
4:begin
retezec:= 'ctrnact';
end;
5:begin
retezec:= 'patnact';
end;
6:begin
retezec:= 'sestnact';
end;
7:begin
retezec:= 'sedmnact';
end;
8:begin
retezec:= 'osmnact';
end;
9:begin
retezec:= 'devatenact';
end;
end;
des_problem:= retezec;
end;


function tisice(pocet: Longint): String;
var retezec: String;
begin
retezec:= '';
case pocet of
1:begin
retezec:= 'jedentisic';
end;
2:begin
retezec:= 'dvatisice';
end;
3:begin
retezec:= 'tritisice';
end;
4:begin
retezec:= 'ctyritisice';
end;
5:begin
retezec:= 'pettisic';
end;
6:begin
retezec:= 'sesttisic';
end;
7:begin
retezec:= 'sedmtisic';
end;
8:begin
retezec:= 'osmtisic';
end;
9:begin
retezec:= 'devettisic';
end;
end;
tisice:= retezec;
end;


function jednotky(pocet: Longint): String;
var retezec: String;
begin
retezec:= '';
case pocet of
1:begin
retezec:= 'jedna';
end;
2:begin
retezec:= 'dva';
end;
3:begin
retezec:= 'tri';
end;
4:begin
retezec:= 'ctyri';
end;
5:begin
retezec:= 'pet';
end;
6:begin
retezec:= 'sest';
end;
7:begin
retezec:= 'sedm';
end;
8:begin
retezec:= 'osm';
end;
9:begin
retezec:= 'devet';
end;
end;
jednotky:= retezec;
end;


var cislo, delitel: Longint;
retezec: String;
desitky_prob: Boolean;
pocet: Longint;

begin
cislo:= 1;

while (cislo <> 0) do
begin
TextColor(Yellow);
Writeln('---- Program,ktery prevede celociselnou hodnotu na slovni vyjadreni----');
TextColor(White);
Writeln;
Writeln('Zadejte cislo (max. 9 999 999) 0 = konec: ');
readln(cislo);
Writeln;
retezec:= '';
if (cislo <> 0) then
begin
delitel:= 1000000;
pocet:= cislo div delitel;
retezec:= miliony(pocet);

cislo:= cislo - (delitel * pocet);
delitel:= delitel div 10;
pocet:= cislo div delitel;
retezec:= retezec + stovky(pocet);

cislo:= cislo - (delitel * pocet);
delitel:= delitel div 10;
pocet:= cislo div delitel;
retezec:= retezec + desitky(pocet);

if (pocet = 1) then
desitky_prob:= true
else
desitky_prob:= false;

cislo:= cislo - (delitel * pocet);
delitel:= delitel div 10;
pocet:= cislo div delitel;

if(desitky_prob = true) then begin
retezec:= retezec + des_problem(pocet) + 'tisic';
end
else
begin
retezec := retezec + tisice(pocet);
end;

cislo:= cislo - (delitel * pocet);
delitel:= delitel div 10;
pocet:= cislo div delitel;
retezec:= retezec + stovky(pocet);

cislo:= cislo - (delitel * pocet);
delitel:= delitel div 10;
pocet:= cislo div delitel;
retezec:= retezec + desitky(pocet);

if (pocet = 1) then
desitky_prob:= true
else
desitky_prob:= false;


cislo:= cislo - (delitel * pocet);
delitel:= delitel div 10;
pocet:= cislo div delitel;

if(desitky_prob = true) then begin
retezec:= retezec + des_problem(pocet);
end
else
begin
retezec:= retezec + jednotky(pocet);
end;
Writeln(retezec);
end;
end;
Writeln('-----------------------------------------------------------------');
Writeln(' Program ukoncite stiskem libovolne klavesy');
Writeln('-----------------------------------------------------------------');
Readln;
end.

Anonymní uživatel
Pascal › Úkol
18. 4. 2009   #99325

To R R : Díky moc

Anonymní uživatel
Pascal › trojuhelnik
18. 4. 2009   #99324

To Krychlik : Ahojky.Já to mám už upravený.......Myslíte někdo že by to mohlo podle zadání takhle vypadat?

Uses crt;

type TBod = record
x: Real;
y: Real;
end;

type TTroj = record
A: TBod;
B: TBod;
C: TBod;
end;


procedure nacti(var t:TTroj);
begin
Writeln('Zadejte souradnice bodu A (x mezera y): ');
Readln(t.A.x, t.A.y);
Writeln;
Writeln('Zadejte souradnice bodu B (x mezera y): ');
Readln(t.B.x, t.B.y);
Writeln;
Writeln('Zadejte souradnice bodu C (x mezera y): ');
Readln(t.C.x, t.C.y);
end;

procedure vypis(t:TTroj);
begin
Writeln('');
Write('Bod A - [', t.A.x,',', t.A.y,']');
Write(' ');
Write('Bod B - [', t.B.x,',', t.B.y,']');
Write(' ');
Write('Bod C - [', t.C.x,',', t.C.y,']');
Writeln('');
end;

function isValid(t:TTroj):boolean;
begin
isValid:= true;

if ((t.A.x = t.B.x) and (t.A.x = t.C.x)) then
begin
isValid:= false;
end;
if ((t.A.y = t.B.y) and (t.A.y = t.C.y)) then
begin
isValid:= false;
end;
end;

procedure prepocitej(var t:TTroj);
var A,B,C:TBod;
begin
A.x:= (t.A.x + t.B.x) / 2;
A.y:= (t.A.y + t.B.y) / 2;

B.x:= (t.B.x + t.C.x) / 2;
B.y:= (t.B.y + t.C.y) / 2;

C.x:= (t.A.x + t.C.x) / 2;
C.y:= (t.A.y + t.C.y) / 2;

t.A:= A;
t.B:= B;
t.C:= C;
end;

var trojuhelnik: TTroj;
diff: Real;
result: Boolean;
i: Integer;

begin
nacti(trojuhelnik);
Writeln('Zadejte diferenci: ');
Readln(diff);
Writeln('Zadany trojuhelnik: ');
Writeln('--------------------');
vypis(trojuhelnik);

result:= isValid(trojuhelnik);

if (result = false) then
begin
Writeln('Toto neni trojuhelnik !!!');
end
else
begin
for i:= 0 to 5 do begin
prepocitej(trojuhelnik);
WriteLn('Prepocitany trojuhelnik');
WriteLn('-----------------------');
vypis(trojuhelnik);
end;
end;
Readln(diff);
end.

Malirka
Pascal › trojuhelnik
17. 4. 2009   #99288

Ahojky.Tady mám zadání úkolu:
Trojúhelník v rovině je zadán pomocí souřadnic vrcholů. Sestavte program, dle těchto pokynů:

-program určí souřadnice středů stran výchozího trojúhelníka - tyto body budeme považovat za vrcholy nového výchozího trojúhelníka
-celý proces (určení středů stran) se bude opakovat tak dlouho, dokud se souřadnice vrcholů trojúhelníka budou lišit o více než předem zadanou hodnotu – vrcholy trojúhelníka se budou k sobě přibližovat, až v rámci zadané přesnosti splynou v jeden bod.
VSTUP: Souřadnice tří bodů (vrcholy),
Diference – hraniční hodnota pro ukončení výpočtů
VÝSTUP: Souřadnice výsledného bodu
V programu lze použít rekurzi.

Mám část, ale nevím jak dále.

Uses crt;

type TBod = record
x: Integer;
y: Integer;
end;

type TTroj = record
A: TBod;
B: TBod;
C: TBod;
end;

procedure nacti(var t:TTroj);
begin
WriteLn('Zadejte souradnice bodu A (x mezera y): ');
ReadLn(t.A.x, t.A.y);
Writeln;
WriteLn('Zadejte souradnice bodu B (x mezera y): ');
ReadLn(t.B.x, t.B.y);
Writeln;
WriteLn('Zadejte souradnice bodu C (x mezera y): ');
ReadLn(t.C.x, t.C.y);
end;


procedure vypis(t:TTroj);
begin
WriteLn('');
Write('Bod A - [', t.A.x,',', t.A.y,']');
Write(' ');
Write('Bod B - [', t.B.x,',', t.B.y,']');
Write(' ');
Write('Bod C - [', t.C.x,',', t.C.y,']');
WriteLn('');
end;

function isValid(t:TTroj): Boolean;

if ((t.A.x = t.B.x) and (t.A.x = t.C.x)) then
begin
result := false;
end
if ((t.A.y = t.B.y) and (t.A.y = t.C.y)) then
begin
result := false;
end
result := true;

var trojuhelnik: TTroj;
diff: Integer;

begin
nacti(trojuhelnik);
WriteLn('Zadejte diferenci: ');
ReadLn(diff);
Writeln;
WriteLn('Zadany trojuhelnik: ');
WriteLn('------------------------');
vypis(trojuhelnik);
ReadLn(diff);

end.

Delphi › Práce do školy
15. 3. 2009   #97365

Ahojky.Potřebovala bych nějak opravit a zhodnotit tento program, možná by bylo lepší dát to vše do polí,ale to nevím jak.Je to program křižovatka.Doufám že mi někdo pomůžete najít nějaký chybky a pomoci.
Díky.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Borland.Vcl.StdCtrls, System.ComponentModel, Borland.Vcl.ExtCtrls,
Borland.Vcl.Db, Borland.Vcl.ExtDlgs;


type
TForm1 = class(TForm)
Button1: TButton;
Timer1: TTimer;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;


var Form1: TForm1;
Pom: TCanvas;
Buf2: TGraphic;
Bkbmp: Hbitmap;
Backgrounddc:Hwnd;
Rect: TRect;


var x,y: integer;
Stav, Stav1, Stav2: Integer;


var auto_a, auto_b, auto_c, auto_d, auto_e, auto_f, auto_g, auto_h, auto_ch,
auto_i, auto_j, auto_k, auto_l, auto_m, auto_n, auto_o: Integer;
chodec_a, chodec_b, chodec_c, chodec_d, chodec_e, chodec_f: Integer;
cary_a, cary_b, cary_c, cary_d, cary_e, cary_f, cary_g, cary_h, cary_ch,
cary_i, cary_j, cary_k, cary_l, cary_m, cary_n, cary_o, cary_p, cary_q,
cary_r, cary_s, cary_t, cary_u, cary_v, cary_w, cary_aa, cary_bb, cary_cc,
cary_dd, cary_ee, cary_ff, cary_gg, cary_hh: Integer;
silnice_a, silnice_b, silnice_c, silnice_d, silnice_e, silnice_f, silnice_g, silnice_h: Integer;
prechod_a, prechod_b, prechod_c, prechod_d, prechod_e, prechod_f, prechod_g, prechod_h,
prechod_ch, prechod_i, prechod_j, prechod_k, prechod_l, prechod_m, prechod_n,
prechod_o, prechod_p, prechod_q, prechod_r, prechod_s, prechod_t, prechod_u,
prechod_v, prechod_w, prechod_x, prechod_y, prechod_aa, prechod_bb, prechod_cc,
prechod_dd, prechod_ee, prechod_ff, prechod_gg, prechod_hh, prechod_chch,
prechod_ii, prechod_jj, prechod_kk, prechod_ll, prechod_mm: Integer;
siln_a, siln_b, siln_c, siln_d: Integer;
trava_a, trava_b, trava_c, trava_d, trava_e, trava_f, trava_g, trava_h: Integer;
sem_a, sem_b, sem_c, sem_d, sem_e, sem_f, sem_g, sem_h, sem_ch, sem_i, sem_j,
sem_k, sem_l, sem_m, sem_n, sem_o, sem_p, sem_q, sem_r, sem_s, sem_t, sem_u,
sem_v, sem_w: Integer;


implementation

{$R *.nfm}


procedure AutoKresli(a,b,w,h:Integer; barva:TColor);
begin
with Pom do
begin
Brush.Color:= barva;
Pen.Color:= barva;
Rectangle(a-w, b-h, a+w, b+h);
end;
end;

procedure Chodeckresli(c,d,m,n:Integer; barva:TColor);
begin
with Pom do
begin
Brush.Color:= barva;
Pen.Color:= barva;
Rectangle(c-m, d-n, c+m, d+n);
end;
end;

procedure Carykresli(e,f,o,p:Integer; barva:TColor);
begin
with Pom do
begin
Brush.Color:= barva;
Pen.Color:= barva;
Rectangle(e-o, f-p, e+o, f+p);
end;
end;

procedure Prechodkresli(y,z,k,l:Integer; barva:TColor);
begin
with Pom do
begin
Brush.Color:= barva;
Pen.Color:= barva;
Rectangle(y-k, z-l, y+k, z+l);
end;
end;

procedure Silnicekresli(c,d,s,r:Integer; barva:TColor);
begin
with Pom do
begin
Brush.Color:= barva;
Pen.Color:= barva;
Rectangle(c-s, d-r, c+s, d+r);
end;
end;

procedure Semaforkresli(s,k,h,l:Integer; barva:TColor);
begin
with Pom do
begin
Brush.Color:= barva;
Pen.Color:= clBlack;
Ellipse(s-h, k-l, s+h, k+l);
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
Stav:=0;
auto_a:=318;
auto_b:=60;
auto_c:=395;
auto_d:=750;
auto_e:=50;
auto_f:=417;
auto_g:=700;
auto_h:=340;
auto_ch:=318;
auto_i:=-300;
auto_j:=395;
auto_k:=1700;
auto_l:=-770;
auto_m:=417;
auto_n:=1500;
auto_o:=340;
chodec_a:=225;
chodec_b:=750;
chodec_c:=788;
chodec_d:=245;
chodec_e:=490;
chodec_f:=5;
siln_a:=360;
siln_b:=100;
siln_c:=100;
siln_d:=380;
cary_a:=170;
cary_b:=416;
cary_c:=550;
cary_d:=344;
cary_e:=321;
cary_f:=191;
cary_g:=394;
cary_h:=570;
cary_ch:=582;
cary_i:=302;
cary_j:=129;
cary_k:=302;
cary_l:=129;
cary_m:=455;
cary_n:=582;
cary_o:=455;
cary_p:=436;
cary_q:=150;
cary_r:=283;
cary_s:=151;
cary_t:=283;
cary_u:=611;
cary_v:=436;
cary_w:=611;
cary_aa:=356;
cary_bb:=99;
cary_cc:=359;
cary_dd:=677;
cary_ee:=83;
cary_ff:=380;
cary_gg:=650;
cary_hh:=380;
silnice_a:=235;
silnice_b:=379;
silnice_c:=490;
silnice_d:=379;
silnice_e:=359;
silnice_f:=250;
silnice_g:=360;
silnice_h:=510;
prechod_a:=488;
prechod_b:=324;
prechod_c:=488;
prechod_d:=351;
prechod_e:=488;
prechod_f:=378;
prechod_g:=488;
prechod_h:=405;
prechod_ch:=488;
prechod_i:=432;
prechod_j:=230;
prechod_k:=324;
prechod_l:=230;
prechod_m:=351;
prechod_n:=230;
prechod_o:=378;
prechod_p:=230;
prechod_q:=405;
prechod_r:=230;
prechod_s:=432;
prechod_t:=306;
prechod_u:=251;
prechod_v:=333;
prechod_w:=251;
prechod_x:=360;
prechod_y:=251;
prechod_aa:=387;
prechod_bb:=251;
prechod_cc:=414;
prechod_dd:=251;
prechod_ee:=414;
prechod_ff:=510;
prechod_gg:=387;
prechod_hh:=510;
prechod_chch:=360;
prechod_ii:=510;
prechod_jj:=333;
prechod_kk:=510;
prechod_ll:=306;
prechod_mm:=510;
trava_a:=120;
trava_b:=145;
trava_c:=120;
trava_d:=619;
trava_e:=600;
trava_f:=138;
trava_g:=599;
trava_h:=620;
sem_a:=458;
sem_b:=558;
sem_c:=458;
sem_d:=583;
sem_e:=458;
sem_f:=608;
sem_g:=180;
sem_h:=478;
sem_ch:=155;
sem_i:=478;
sem_j:=130;
sem_k:=478;
sem_l:=539;
sem_m:=280;
sem_n:=564;
sem_o:=280;
sem_p:=589;
sem_q:=280;
sem_r:=259;
sem_s:=206;
sem_t:=259;
sem_u:=181;
sem_v:=259;
sem_w:=156;
Timer1.Enabled:=True;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Pom:=tcanvas.create;
Backgrounddc := CreateCompatibleDC(Canvas.Handle);
Bkbmp := CreateCompatibleBitmap(Canvas.Handle, ClientWidth, ClientHeight);
SelectObject(backgrounddc, bkbmp);
Pom.Handle := backgrounddc;
form1.width:=1000;
form1.height:=900;
end;
end;


procedure TForm1.Timer1Timer(Sender: TObject);
begin
Stav1:= round (Stav/33);
Silnicekresli(siln_a,siln_b,77,800, clBlack);
Silnicekresli(siln_c,siln_d,800,77, clBlack);
Silnicekresli(trava_a,trava_b,160,160, clLime);
Silnicekresli(trava_c,trava_d,160,160, clLime);
Silnicekresli(trava_e,trava_f,160,160, clLime);
Silnicekresli(trava_g,trava_h,160,160, clLime);
AutoKresli(auto_a,auto_b,20,40, clBlack);
AutoKresli(auto_c,auto_d,20,40, clBlack);
AutoKresli(auto_e,auto_f,40,20, clBlack);
AutoKresli(auto_g,auto_h,40,20, clBlack);
Autokresli(auto_ch,auto_i,20,40, clBlack);
Autokresli(auto_j,auto_k,20,40, clBlack);
Autokresli(auto_l,auto_m,40,20, clBlack);
Autokresli(auto_n,auto_o,40,20, clBlack);

Chodeckresli(chodec_a,chodec_b,13,13, clLime);
Chodeckresli(chodec_c ,chodec_d,13,13, clLime);
Chodeckresli(chodec_e,chodec_f,13,13, clLime);
Carykresli(cary_a,cary_b,8,39, clWhite);
Carykresli(cary_c,cary_d,8,40, clWhite);
Carykresli(cary_e,cary_f,39,8, clWhite);
Carykresli(cary_g,cary_h,39,8, clWhite);
Carykresli(cary_ch,cary_i,150,4, clWhite);
Carykresli(cary_j,cary_k,150,4, clWhite);
Carykresli(cary_l,cary_m,150,4, clWhite);
Carykresli(cary_n,cary_o,150,4, clWhite);
Carykresli(cary_p,cary_q,4,150, clWhite);
Carykresli(cary_r,cary_s,4,155, clWhite);
Carykresli(cary_t,cary_u,4,160, clWhite);
Carykresli(cary_v,cary_w,4,160, clWhite);
Carykresli(cary_aa,cary_bb,4,98, clWhite);
Carykresli(cary_cc,cary_dd,4,110, clWhite);
Carykresli(cary_ee,cary_ff,95,4, clWhite);
Carykresli(cary_gg,cary_hh,95,4, clWhite);
Carykresli(silnice_a,silnice_b,45,72, clBlack);
Carykresli(silnice_c,silnice_d,45,72, clBlack);
Carykresli(silnice_e,silnice_f,72,46, clBlack);
Carykresli(silnice_g,silnice_h,72,46, clBlack);
Prechodkresli(prechod_a,prechod_b,47,9, clWhite);
Prechodkresli(prechod_c,prechod_d,47,9, clWhite);
Prechodkresli(prechod_e,prechod_f,47,9, clWhite);
Prechodkresli(prechod_g,prechod_h,47,9, clWhite);
Prechodkresli(prechod_ch,prechod_i,47,9, clWhite);
Prechodkresli(prechod_j,prechod_k,47,9, clWhite);
Prechodkresli(prechod_l,prechod_m,47,9, clWhite);
Prechodkresli(prechod_n,prechod_o,47,9, clWhite);
Prechodkresli(prechod_p,prechod_q,47,9, clWhite);
Prechodkresli(prechod_r,prechod_s,47,9, clWhite);
Prechodkresli(prechod_t,prechod_u,9,47, clWhite);
Prechodkresli(prechod_v,prechod_w,9,47, clWhite);
Prechodkresli(prechod_x,prechod_y,9,47, clWhite);
Prechodkresli(prechod_aa,prechod_bb,9,47, clWhite);
Prechodkresli(prechod_cc,prechod_dd,9,47, clWhite);
Prechodkresli(prechod_ee,prechod_ff,9,47, clWhite);
Prechodkresli(prechod_gg,prechod_hh,9,47, clWhite);
Prechodkresli(prechod_chch,prechod_ii,9,47, clWhite);
Prechodkresli(prechod_jj,prechod_kk,9,47, clWhite);
Prechodkresli(prechod_ll,prechod_mm,9,47, clWhite);
case Stav1 of
0..10: begin
Semaforkresli(sem_a,sem_b,13,13,clRed);
Semaforkresli(sem_c,sem_d,13,13,clWhite);
Semaforkresli(sem_e,sem_f,13,13,clWhite);
Semaforkresli(sem_l,sem_m,13,13,clWhite);
Semaforkresli(sem_n,sem_o,13,13,clWhite);
Semaforkresli(sem_p,sem_q,13,13,clGreen);
Semaforkresli(sem_r,sem_s,13,13,clRed);
Semaforkresli(sem_t,sem_u,13,13,clWhite);
Semaforkresli(sem_v,sem_w,13,13,clWhite);
Semaforkresli(sem_g,sem_h,13,13,clWhite);
Semaforkresli(sem_ch,sem_i,13,13,clWhite);
Semaforkresli(sem_j,sem_k,13,13,clGreen);
end;
11,12,25,26: begin
Semaforkresli(sem_a,sem_b,13,13,clWhite);
Semaforkresli(sem_c,sem_d,13,13,clYellow);
Semaforkresli(sem_e,sem_f,13,13,clWhite);
Semaforkresli(sem_l,sem_m,13,13,clWhite);
Semaforkresli(sem_n,sem_o,13,13,clYellow);
Semaforkresli(sem_p,sem_q,13,13,clWhite);
Semaforkresli(sem_r,sem_s,13,13,clWhite);
Semaforkresli(sem_t,sem_u,13,13,clYellow);
Semaforkresli(sem_v,sem_w,13,13,clWhite);
Semaforkresli(sem_g,sem_h,13,13,clWhite);
Semaforkresli(sem_ch,sem_i,13,13,clYellow);
Semaforkresli(sem_j,sem_k,13,13,clWhite);
end;
13..24: begin
Semaforkresli(sem_a,sem_b,13,13,clWhite);
Semaforkresli(sem_c,sem_d,13,13,clWhite);
Semaforkresli(sem_e,sem_f,13,13,clGreen);
Semaforkresli(sem_l,sem_m,13,13,clRed);
Semaforkresli(sem_n,sem_o,13,13,clWhite);
Semaforkresli(sem_p,sem_q,13,13,clWhite);
Semaforkresli(sem_r,sem_s,13,13,clWhite);
Semaforkresli(sem_t,sem_u,13,13,clWhite);
Semaforkresli(sem_v,sem_w,13,13,clGreen);
Semaforkresli(sem_g,sem_h,13,13,clRed);
Semaforkresli(sem_ch,sem_i,13,13,clWhite);
Semaforkresli(sem_j,sem_k,13,13,clWhite);
end;
end;
Stav2:= round (Stav/(44/5));
if (((Stav2>=0) and (Stav2<=3)) or ((Stav2>=47) and (Stav2<=100))) then
begin
auto_a:=auto_a-0;
auto_b:=auto_b+2;
end;
if (((Stav2>=0) and (Stav2<=3)) or ((Stav2>=40) and (Stav2<=100))) then
begin
auto_ch:=auto_ch-0;
auto_i:=auto_i+2;
end;
if (((Stav2>=0) and (Stav2<=6)) or ((Stav2>=47) and (Stav2<=100))) then
begin
auto_c:=auto_c+0;
auto_d:=auto_d-2;
end;
if (((Stav2>=0) and (Stav2<=4)) or ((Stav2>=47) and (Stav2<=100))) then
begin
auto_j:=auto_j+0;
auto_k:=auto_k-2;
end;
if (((Stav2>=0) and (Stav2<=50))) then
begin
auto_e:=auto_e+2;
auto_f:=auto_f-0;
end;
if (((Stav2>=0) and (Stav2<=49))) then
begin
auto_l:=auto_l+2;
auto_m:=auto_m-0;
end;
if (((Stav2>=0) and (Stav2<=50))) then
begin
auto_g:=auto_g-2;
auto_h:=auto_h+0;
end;
if (((Stav2>=0) and (Stav2<=50))) then
begin
auto_n:=auto_n-2;
auto_o:=auto_o+0;
end;
if (((Stav2>=0) and (Stav2<=15)) or ((Stav2>=47) and (Stav2<=100))) then
begin
chodec_a:=chodec_a+0;
chodec_b:=chodec_b-2;
end;
if (((Stav2>=0) and (Stav2<=40))) then;
begin
chodec_c:=chodec_c-2;
chodec_d:=chodec_d+0;
end;
if (((Stav2>=0) and (Stav2<=15)) or ((Stav2>=47) and (Stav2<=100))) then
begin
chodec_e:=chodec_e-0;
chodec_f:=chodec_f+2;
end;

if True then
Stav:= Stav + 1;
if (Stav>33*26) then
Stav := 0;
AutoKresli(auto_a,auto_b,20,40, clBlue);
AutoKresli(auto_c,auto_d,20,40, clRed);
AutoKresli(auto_e,auto_f,40,20, clSilver);
AutoKresli(auto_g,auto_h,40,20, clRed);
Autokresli(auto_ch,auto_i,20,40, clYellow);
Autokresli(auto_j,auto_k,20,40, clBlue);
Autokresli(auto_l,auto_m,40,20, clRed);
Autokresli(auto_n,auto_o,40,20, clYellow);
Chodeckresli(chodec_a,chodec_b,13,13, clMaroon);
Chodeckresli(chodec_c,chodec_d,13,13, clYellow);
ChodecKresli(chodec_e,chodec_f,13,13, clSkyBlue);
{Form1.Canvas.Draw(0,0,Pom);}
rect.Right:=form1.Width;
rect.bottom:=form1.Height;
Canvas.CopyRect(Rect, Pom, Rect);
end;
end.

Malirka
Delphi › křižovatka
2. 3. 2009   #96383

Ahojky.Mám za úkol vytvořit křižovatku.Já to mám hotové.Pomohl mi s tím kámoš, ale přijde mi to moc složité.Nemohl by mi to někdo zjednodušit.Díky moc

Malirka
Inzerce › Hledám brigádu-www stránky
24. 2. 2009   #95872

Ahojky.Scháním nějakej přivídělek tvorbou webových stránek.Mám dvě své stránky: www.hudbamarketa.estranky.cz a www.hudbamarketa2.wgz.cz .
Kdyby jste pro mě někdo něco měl, tak piště na icq: 311-490-356.

Malirka
Delphi › animace
21. 2. 2009   #95652

Ahoj.Já bych chtěla poradit jak mám udělat,aby mi v programu když ho spustím pršelo nebo sněžilo..Potřebovala bych kod nebo radu.Moc děkuju

Malirka
Delphi › Pomoc s animací
18. 2. 2009   #95370

Ahojky.Já mám udělat animaci traktoru,který se pohybuju.Musím tam napsat kody,abych ten traktor nakreslila..Ale nějak mi to nejde udělat aby vypadal tak jako traktor a aby byl zmenšený..Moc děkuju předem..

var
Form1: TForm1;
var x,y,z: integer;

implementation

{$R *.nfm}

procedure Traktor;
begin
with form1.Canvas do
begin
Brush.Color:=ClRed;
Rectangle(x+50,y+25,z+150,z+75);
Brush.Color:=ClBlue;
Ellipse(x+65,y+100,x+90,y+75);
Ellipse(x+100,y+100,x+135,y+55);
Brush.Color:=ClYellow;
Rectangle(x+100,y+0,z+150,z+25);
end;
end;

procedure Traktor1;
begin
with form1.Canvas do
begin
Brush.Color:=ClBtnface;
Pen.Color:=ClBtnface;
Rectangle(x,y,x+250,y+250);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Timer1.Enabled:=true;
end;


procedure TForm1.Timer1Timer(Sender: TObject);
begin
Traktor1;
Traktor;
x:=x+1;
y:=y+1;
z:=z+1;

end;

end.

 

 

Hostujeme u Českého hostingu       ISSN 1801-1586       ⇡ Nahoru Webtea.cz logo © 20032024 Programujte.com
Zasadilo a pěstuje Webtea.cz, šéfredaktor Lukáš Churý