K neuvěření
Příspěvky odeslané z IP adresy 81.0.253.–
Jak přinutit StringGrid, aby se šířka sloupce automaticky nastavovala podle obsahu buňky?
Toto mi nefunguje:
StringGrid1.ColWidths[1] := StringGrid1.Canvas.TextWidth(StringGrid1.Cells[1,1]);
Zdravím,
potřebuji vyrobit zařízení, které bude vědět co je za datum (X=den,Y=měsíc), dále na něm budu moci mechanicky nastavit hodnota Z=(1-9). Po zapnutí tlačítkem provede matematickou operaci a na dvoumístný display ukáže výsledek a po cca 30 vteřinách se vypne. Vše bude napájene z tužkové baterie.
Nechci si to vyrobit sám, jen scháním někoho kdo by mi to za rozumné peníze dokázal vyrobit. Podle ceny by se odvíjeli i počty kusů. Ale to bych již nechal na domluvě.
Prosím, kdo by si na to troufl napište mi na p.pesula@gmail.com
Díky
Ha, dobrá náhoda.
Tento týden jsem totiž napsal takový textík o řazení podle abecedy.
Podívej se sem:
http://www.int21h.ic.cz/?id=106
Freepascal má údajně potíže se složkami, které používají dlouhé názvy souborů (delší než 8 znaků). Visty ale nutí defaultně instalovat do děsivých a bizarních složek, které tuhle podmínku nesplňují. Takže zkontroluj, kde FPC je a kdyžtak ho přesuň do adresáře typu C:\FPC\
A jedna z možností, jak to udělat pomocí ukládání názvů je tady.
program vyhledavac;
uses dos,crt;
const
pocet:integer = 0;
max_souboru = 100;
type Tpolozka = record
nazev:string;
cislo:integer;
end;
var
VybranySoubor:string;
pozadovany:integer;
polozka:array[1..MAX_SOUBORU] of TPolozka;
Procedure VypisSoubor(f:SearchRec);
begin
inc(pocet); {to same jako pocet:=pocet+1}
writeln(pocet,': ',f.name);
polozka[pocet].nazev:=f.name;
polozka[pocet].cislo:=pocet;
end;
Procedure ZpracujSeznamSouboru(maska:string;skryte:boolean);
var f:SearchRec; i:integer;
begin
if skryte then i:=ReadOnly+Archive+Hidden+SysFile
else i:=ReadOnly+Archive+SysFile; FindFirst(maska,i,f);
while doserror=0 do
begin
if pocet=max_souboru then
begin
writeln('Prilis mnoho souboru - zobrazuji jen prvnich ',max_souboru);
Exit;
end;
VypisSoubor(f);
FindNext(f);
end;
end;
begin
clrscr;
writeln('Seznam souboru:');
ZpracujSeznamSouboru('*.ngc',false);
writeln;
writeln('Napis cislo souboru, ktery chcete kompilovat.');
repeat
readln(pozadovany);
if (pozadovany>pocet) or (pozadovany<1)
then writeln('Nespravne zadani, zkus to znovu')
else Break; {vyskoci ze smycky}
until false;
writeln('Vybral jste soubor c.',pozadovany,', t.j.: ',polozka[pozadovany].nazev);
readln;
end.
Ještě než začneš psát rozsáhlé programy, tak si zvykni na to, označovat globální proměnné alespoň trojpísmenými názvy. Jinak budeš mít problémy s kolizemi názvů a budou vznikat těžko odhalitelné chyby.
Myslím, že už rozumím, co potřebuješ. Možností je několik. Buďto si nějakým způsobem zapamatuješ všechny .NGC soubory nebo si je pamatovat nemusíš, ale vyhledávání provedeš dvakrát. Druhý přístup je tady:
program vyhledavac;
uses dos,crt;
const vypis = 1;
prirazeni = 2;
pocet:integer = 0;
pracovni:integer = 0;
var
VybranySoubor:string;
pozadovany:integer;
Procedure VypisSoubor(f:SearchRec);
begin
inc(pocet); {to same jako pocet:=pocet+1}
writeln(pocet,': ',f.name);
end;
Function PriradSoubor(f:SearchRec):boolean;
begin
inc(pracovni);
if pracovni=pozadovany then
begin
VybranySoubor:=f.name;
PriradSoubor:=true;
end
else PriradSoubor:=false;
end;
Procedure ZpracujSeznamSouboru(maska:string;skryte:boolean;akce:byte);
var f:SearchRec; i:integer;
begin
if skryte then i:=ReadOnly+Archive+Hidden+SysFile
else i:=ReadOnly+Archive+SysFile; FindFirst(maska,i,f);
while doserror=0 do
begin
if akce=VYPIS then VypisSoubor(f) else
if akce=PRIRAZENI then if PriradSoubor(f) then Exit;
FindNext(f);
end;
end;
begin
clrscr;
writeln('Seznam souboru:');
ZpracujSeznamSouboru('*.ngc',false,VYPIS);
writeln;
writeln('Napis cislo souboru, ktery chcete kompilovat.');
repeat
readln(pozadovany);
if (pozadovany>pocet) or (pozadovany<1)
then writeln('Nespravne zadani, zkus to znovu')
else Break; {vyskoci ze smycky}
until false;
ZpracujSeznamSouboru('*.ngc',false,PRIRAZENI);
writeln('Vybral jste soubor c.',pozadovany,', t.j.: ',VybranySoubor);
readln;
end.
[i]writeln(f.name:12,#9,' (',f.size,' B)');[/i]
:12 znamená "roztáhni na délku 12 znaků"
#9 znamená tabulátor
Ty potřebuješ otevřít soubor a číst z něj nějaká data?
To se trošičku liší podle toho, jde-li o textový či binární soubor. V tvém případě bude pravděpodobně textový.
Následující procedura otevře soubor a vypíše na obrazovku jeho obsah.
Procedure VytiskniSoubor(s:string);
var t:text;
u:string;
begin
Assign(t,s);
Reset(t);
while not Eof(t) do begin Readln(t,u);writeln(u);end;
Close(t);
end;
uses Dos;
Procedure VypisSoubor(f:SearchRec);
begin
writeln(f.name:12,#9,' (',f.size,' B)');
end;
Procedure VypisSeznamSouboru(maska:string;skryte:boolean);
{maska je treba *.exe, nebo *.*, proste klasika}
{kdyz je skryte TRUE, tak vypise i skryte soubory}
var f:SearchRec;
i:integer;
begin
if skryte then i:=ReadOnly+Archive+Hidden+SysFile
else i:=ReadOnly+Archive+SysFile;
FindFirst(maska,i,f);
while doserror=
0 do
begin
VypisSoubor(f);
FindNext(f);
end;
end;
begin
VypisSeznamSouboru('*.exe',false);
end.
Aha, až teď jsem si všiml, jak máš uloženou virtuální obrazovku.
Nepíšeš, jestli jde o statické nebo dynamické pole, ale to je vcelku jedno. Jestli výše napsaný kód nebude fungovat, tak zkus odstranit znak ^ a mělo by to běžet.
Jestli děláš v Turbo pascalu nebo Borland pascalu, tak je to:
Move(virtualni_obrazovka^,Ptr(SegA000,0)^,64000);
Jestli ve Freepascalu, tak:
DosMemPut($A000,0,virtualni_obrazovka^,64000);
Zásadní je rozmyslet si, jestli bude tvůj program uvažovat komentáře a textové řetězce.
Správné by totiž bylo v takových případech lámání textu neprovádět.
Jestli ale na to kašleš, tak prostě v řádcích vyhledávej středníky funkcí Pos a podle toho lámej text. Odsazení textu můžeš udělat buďto rovnou nebo až v druhém průchodu.
Chyb tam máš víc, ale největší problém je to, že IOresult dáváš ne za Reset, ale až za CloseFile (který nechápu, proč tam dáváš).
Poopravit se to dá třeba takhle, ale problémů tam zbývá pořád dost"
uses sysutils;
var x,ddd:longint;
f:text;
c:char;
s:string;
begin
x:=0;
repeat
FOR ddd:=65 TO 90 DO
begin
c:=chr(ddd);
Assign(F,c+':\5.txt');
{$I-}
Reset(F);
{$I+}
IF IOresult<>0 THEN x:=0
ELSE begin
Readln(F,s);
IF s = '123456' THEN x:=1; {???}
s:='';
x:=1; {???}
Close(f);
end;
end;
until x=1; {??? - uvedomujes si, ze X muze klidne zustat nula a ty se}
{tudiz dostanes do nekonecneho cyklu?}
end.
Okamžitý restart programu uděláš nejlépe tak, že program ukončíš pomocí procudury Halt a spustíš ho znovu. Buďto prostřednictvím BAT souboru nebo udělej tento program zahnízděný uvnitř jiného, Tzn. že bude spuštěn pomocí procedury Exec z jiného programu.
Jinak, co se týče skoků, tak nezapomeňte, že pomocí Goto se nedá skákat mimo aktuální proceduru. Perfektní věc je ale procedura Exit, která okamžitě vyskočí z procedury či funkce.
Tohle je offtopic, ale docela zajímavé:
Víte, jak v mžiku vytvořit soubor o libovolné velikosti, třeba i v řádu stovek megabajtů?
Procedure VytvorSoubor(s:string;velikost:longint);
var f:file;
a:byte;
begin
Assign(f,s);
Rewrite(f,1);
a:=0;
if velikost>1 then Seek(f,velikost-1);
if velikost>0 then BlockWrite(f,a,1);
Close(f);
end;
Chyba je v tomhle úseku. Přebývá ti tam BEGIN pře podmínkou IF. Další chyba je v řádku pod until, kde mezi "end" a "else" přebývá středník.
if fr=1 then begin
if (kb < 0) or (cedok < 0) or (ba < 0) or (csad < 0) or (microsoft < 0) then
begin
kb :=kb-(tr*sr);
cedok :=cedok-(tr*sr);
ba :=ba-(tr*sr);
csad :=csad-(tr*sr);
microsoft :=microsoft-(tr*sr);
end;
Já taky čtyři :smile18:
Héj, co jste za školu? Odkud?
Včera jsem tenhle úkol (zadání doslova to samé) řešil jedné slečně mailem :smile5:
Myslím, že ambicózní server, kterým Programujte.CZ jistě je, by měl zapracovat na zvýrazňování syntaxe u ukázek kódů v diskuzních vláknech.
V diskuzi o pascalu se by zvýrazňovalo podle pascalovských pravidel, v diskuzi o céčku podle céčkových, atd.
Wimby, nevim, jestli jsi chtěl přesně tohle, ale minimálně inspirovat by tě to mohlo.
Napsal jsem program, který otevře textový soubor a čte z něho slova. Ta vypisuje pod sebe na obrazovku. Pokud ale narazí na slovo INCLUDE tak následující slovo pochopí jako název souboru, který otevře a pokračuje ve čtení z něj. Když dorazí na konec souboru, tak ho zavře a dál se pokračuje z původního, "nadřazeného", souboru.
Chování je tedy dosti složité, ale navenek se to chová úplně jednoduše (koukni se na hlavní program). Zvnějšku se pořád se přistupuje k původnímu objektu, i když ten si podle potřeby deklaruje další.
Pod tímto textem vidíš zdroják. Jestli si ho chceš prakticky odzkoušet na připraveném textu, tak stáhni tento archív: http://www.laaca.borec.cz/ctecka.zip (Vypíše se úryvek z básně Protokol na milici od Vladimíra Vysockého)
{$I-} {chybove stavy pri operacich se soubory si osetrim sam}
type
PCtecka = ^TCtecka;
TCtecka = object
public
konec:boolean;
Procedure OtevriSoubor(s:string);
Procedure ZavriSoubor;
Function CtiSlovo:string;
private
ff:text;
chyba:integer;
potomek:PCtecka;
buffer:string;
Procedure ZalozPotomka(s:string);
Procedure ZrusPotomka;
end;
Function NaVelka(s:string):string;
var i:integer;
begin
for i:=1 to Length(s) do s[i]:=UpCase(s[i]);
NaVelka:=s;
end;
Function VytahniSlovo(var s:string):string;
{Krome toho, ze vrati slovo z retezce, toto slovo z retezce odmaze}
var i,j,k:integer;
begin
k:=0;
for j:=1 to Length(s) do {zjisti, nejsou-li uvodno mezery ci tabulatory}
if s[j] in [' ',#9{tabulator}] then inc(k) else Break;
delete(s,1,k); {casove efektivnejsi je odmazat mezery takto najednou, a ne po jedne}
if s='' then begin VytahniSlovo:='';Exit;end;
k:=0;
for j:=1 to Length(s) do
if not (s[j] in [' ',#9]) then inc(k) else Break;
VytahniSlovo:=Copy(s,1,k);
delete(s,1,k);
end;
Procedure TCtecka.OtevriSoubor(s:string);
begin
Assign(ff,s);
konec:=false;
Reset(ff);
chyba:=IOresult; {Neco spatne? Treba soubor neexistuje?}
buffer:='';
potomek:=nil; {na zadne INCLUDE jsme jeste nenarazili}
end;
Procedure TCtecka.ZavriSoubor;
begin
if potomek<>nil then ZrusPotomka;
Close(ff);
end;
Procedure TCtecka.ZalozPotomka(s:string);
begin
New(potomek);
potomek^.OtevriSoubor(s);
end;
Procedure TCtecka.ZrusPotomka;
begin
potomek^.ZavriSoubor;
Dispose(potomek);
potomek:=nil;
end;
Function TCtecka.CtiSlovo:string;
var s:string;
begin
if potomek<>nil then
begin
s:=potomek^.CtiSlovo;
if potomek^.konec then ZrusPotomka;
end else s:='';
if (chyba<>0) or (konec=true) then
begin CtiSlovo:='';konec:=true;Exit;end;
while s='' do
begin
{takhle slozite je to proto, aby se spravne osetrily prazdne radky}
if buffer='' then
if Eof(ff)
then begin konec:=true;CtiSlovo:='';Exit;end
else readln(ff,buffer);
s:=VytahniSlovo(buffer);
if NaVelka(s)='INCLUDE' then
begin
s:=VytahniSlovo(buffer);
ZalozPotomka(s);
if potomek^.chyba<>0
then begin ZrusPotomka;s:='';end
else begin
s:=potomek^.CtiSlovo;
end;
end;
end;
CtiSlovo:=s;
end;
{==========================================================================}
var c:TCtecka;
begin
c.OtevriSoubor('basen1.txt');
while not c.Konec do writeln(c.CtiSlovo);
c.ZavriSoubor;
readln;
end.
Ne, Wimby, takhle doopravdy ne!
Tímhle se dostáváš na hodně tenký led všelijakých divokých hacků v situaci, kdy se tyto úlohy dají řešit úplně normálně. Zítra, až příjdu z práce, ti to zkusím napsat nějakým pěkným srozumitelným kódem.
Celá algoritmus by se výrazně zjednodušil, kdybys akceptoval, že by byl dvojprůchodový. V prvním průchodu by se vyřešily všechny INCLUDE a ve druhém by proběhl samotný rozbor textu.
Máš jako namysli tohle?
Procedure T.B;
var podradna:T; {je lepsi udelat ji statickou, at se nemusis manualne starat o alokaci a dealokaci}
begin {tady zopakuj hlavni rutinu hlavniho programu, ale nebudeš volat HLAVNI, ale PODRADNOU}
podradna.Priprav;
while podradna.cislo < 10 then begin
if podradna.cislo = 7 then podradna.B;
write(podradna.A);
end;
{pri vychodu z procedury se podradna zrusi sama}
end;
Microsoft má pravdu. Jinak technika, že si jedna instance objetku vytváří nové instance, se používá běžně. (Ale overloading se nenazývá - pod tím se rozumí něco jiného)
Typické použití je u spojových seznamů. Jestli chceš praktickou ukázku, tak si stáhni moji jednotku Wokna32 http://www.laaca.borec.cz/soubory/wokna32.rar a tam se mrkni na jednotku Vaznik. Konkrétně na metodu InitNext.
(v dalších verzích se ale Vazník bude chovat jinak a i InitNext bude pracovat na jiném principu)
Goto je využitelný když třeba chceš neplánovaně vyskočit z nějakého hodně vnořeného bloku příkazů. Třeba:
for a:=0 to n do
for b:=0 to a do
for c:=1 to 10 do
if pole[a,b,c]=0 then Goto Dalsi_prohledavani_je_zbytecne_jdem_dal
Dalsi_prohledavani_je_zbytecne_jdem_dal:
Bohužel ne. Zkoušel jsem to dokonce rozběhat přes HX-DOS extender htttp://www.japheth.de ale anis tím to nejde. Používá moc služeb windows.
:smile18: :smile18: :smile18:
Jestli se dá o nějaké chybě říct, že je sexy, tak je to ta tvoje.
until odebirani = 2 or 3 or 4;
Nezapomeň že slovo "OR" je především operátor, podobně jako "+", "-" nebo "*".
Takže 2 or 3 or 4 = 7
Podmínku můžeš opravit dvěma způsoby: buďto
until (odebirani=2) or (odebirani=3) or (odebirani=4)
nebo
until odebirani in[2,3,4];
Ještě dodatek - pascal umožňuje volání funkcí i jako kdyby to byly procedury.
Takže máme-li funkci:
Function NapisCislo(s:string):boolean;
var i,j:integer;
Val(s,i,j);
if j<>0 then begin Writeln('Nejde o cislo!');NapisCislo:=false;end
else begin Writeln(i);NapisCislo:=true;end;
end;
Tak takovou funkci můžeme volat nejen b:=NapisCislo('chyba'), ale rovněž NapisCislo('chyba')
Takž vlastně klíčové slovo Procedure není vůbc potřeba :smile5:
Jestl i nechceš použít globální proměnnou, tak rekurzi nedefinuj jako proceduru, ale jako funkci. Pokud vrátí hodnutu FALSE, či nějakou jinou definovanou ukončovací hodnotu, tak to bude znamenat, že se má rekurze ukončit. Globální proměnné by se měly používat co nejméně a pokud to bez nich nejde, je nejrozumnější rekurzní proceduru/funkci i tuto proměnnou zabalit do společného objektu.
Typické použití rekurze by mělo vypadat nějak takhle:
Function SoucetCisel(i:integer):longint;
begin
if i=0 then SoucetCisel:=0
else SoucetCisel:=i+SoucetCisel(i-1);
end;
var n:byte;
begin
write('Zadej kladne prirozene cislo: ');
readln(n);
writeln('Soucet cisel 1 az ',n,' je: ',SoucetCisel(n));
readln;
end.
Kromě návratové hodnoty funkce je k řízení průběhu rekurze samozřejmě možné používat i odkazem předávané parametry - tedy parametry s var
Funkce se dá dobře zjednodušit a zpřehlednit:
function VelkeMale(jms:string):boolean;
var radek:string;
jls:text;
i:word;
begin
assign(jls,jms);
reset(jls);
while not eof(jls) do
begin
readln(jls,radek);
for i:=1 to Length(radek) do
if not (radek[i] in ['A'..'Z',' ']) then
begin
VelkeMale:=true;
Close(jls);
Exit;
end;
end;
close(jls);
VelkeMale:=false;
end; {VelkeMale}
Freepascal podporuje dynamická pole, klasický pascal vlastně taky, ale musí se na to trochu oklikou. Používá se tato deklarace:
type
PPole = ^TPole;
TPole = array[1..32000] of integer;
var
pole:ppole;
begin
GetMem(pole, pocet_prvku*sizeof(integer));
Správu takovýchto polí se doporučuje zabalit divnitř objektů. Dobrý příklad je např. objekt TCollection v jednotce Objects či Classes.
Tohle se ale nehodí pro intenzivně měněná pole. (to je ale problém i moderních dynamických polí). V takových případech se proto pole nahrazují spojovými seznamy.
Visty za to nemůžou, chyba je v použití zastaralé a už nepodporované direktivy překladače. Otevři si menu -> Options -> Compiler a tam v poli "Additional compiler args" umaž direktivu -Opentium3.
V případě, že to nepomůže, si otevři v textovém editoru soubor FP.CFG a tam všechny výskyty parametru "-Opentium3" odstraň manuálně.
Přečti si nápovědu k Freepascalu:
http://community.freepascal.org:10000/docs-html/ref/refch11.html#x140-14700011
Už mě prudí, jak se všude omílá mýtus, že pascal byl vymyšlený na výuku programování a tudíž v něm není možné tvořit seriózní projekty.
Niklaus Wirth, tvůrce pascalu vymyslel tři jazyky: pascal, modulu a oberon. Pascal byl nejjednodušší a byl opravdu určen na výuku s tím, že by programátor mohl přejít právě na modulu nebo oberon. Nicméně když se obrátil na Borland, aby mu napsali překladač, tak mu to rozmluvili s tím, že je to moc drahé a prostě do pascalu přidali profesionální konstrukce právě z moduly a vznikl turbo pascal. Turbo pascal byl tedy hned od počátku myšlen jako seriózní programovací jazyk.
Kromě toho, už do verze 5.5 byla přidána podpora objektů. Proto poznámky, že pascal je vhodný jen jako výukový nástroj jsou úplně mimo mísu. Nejen Object pascal, ale i klasický turbo pascal jsou s C++ plně srovnatelné.
Myslím, že taková tabulka je neveřejná a její umístění a zpracování vůbec se liší BIOS od BIOSu. Ve většině případů to navíc nešéfuje BIOS, ale národní TSR ovladač klávesnice. Logika je jasná - mapování scan kódy -> ASCII je záležitost národního prostředí. To je značně různorodá skupina, ale dokonce ani standard, t.j. KEYB.COM žádnou takovou tabulku nezpřístupňuje. V případě tvého problémového programu je nejspíš potíž v tom, že přesměrovává obsluhu INT 9 a po ukončení ji nevrací na původní vektor (anebo to dělá nějak nekorektně)
Já bych nic nekrokoval a celý program bych zjednodušil. Základem je opravdu použití typu record. A řazení bych napsal trochu polopatičtěji:
program razeni_podle_bodu;
uses crt;
type
Tzavodnik = record
jmeno:string[30];
body:integer;
stc:integer;
end;
var
Zavodnik:array[1..100] of TZavodnik;
temp:TZavodnik;
vstup,vystup:text;
n,i:integer;
bylyzmeny:boolean;
begin
clrscr;
assign(vstup,'vstup.txt');
reset(vstup);
n:=0;
while not(eof(vstup)) do
begin
n:=n+1;
readln(vstup,zavodnik[n].stc);
readln(vstup,zavodnik[n].jmeno);
readln(vstup,zavodnik[n].body);
end;
for i:=1 to n do writeln(i,', ',zavodnik[i].stc,', ',
zavodnik[i].jmeno,', ',
zavodnik[i].body);
readln;
repeat
bylyzmeny:=false;
for i:=1 to n-1 do
if zavodnik[i].body<zavodnik[i+1].body then
begin
temp:=zavodnik[i];
zavodnik[i]:=zavodnik[i+1];
zavodnik[i+1]:=temp;
bylyzmeny:=true;
end;
until bylyzmeny=false;
assign(vystup,'listina.txt');
rewrite(vystup);
writeln('Poradi, Startovni cislo, Jmeno, pocet bodu');
for i:=1 to n do writeln(i,', ',zavodnik[i].stc,', ',
zavodnik[i].jmeno,', ',
zavodnik[i].body);
readln;
end.
Jistě, je to podle vzoru předseda, ale končí to na souhlásku c, která je v češtině měkká. To je stejný případ jako slovo "bača".
Podle tvé logiky by druhý pád byl "bez bačy". Správně je pochopitelně "bez bači". Nebo jiný příklad - Saša. "Bez Sašy"? Samozřejmě ne.
Proto i bez Laaci, Venci či Jarka Nohavici.
Ano, v češtině je případ, kdy pravidla skloňování vzoru přebíjejí měkkost koncovky, ale to se týká jedině vzoru hrad.
Tedy "tác-tácy", "kibuc-kibucy", "kec-kecy"
[i]"...v programu od Laacy..."[/i]
Ale fuj. Laaca se skloňuje podle vzoru Venca. Takže od Venci - od Laaci
Řešení přes GetTime lze použít také (výhodou je dobrá přenositelnost programu), ale lepší je řídit se podle čítače. Trochu jsem upravil tvoji proceduru Engine:
procedure engine;
var a,b:longint;
n:word;
begin
n:=1; {kolik 55ms pulsu budeme cekat}
a:=MemL[Seg0040:$6c]; {zjisti aktualni hodnotu citace (presnost 55ms)}
klavesy;
steny;
kontrola_cihel;
kontrola_palka;
micek.x:= micek_old.x + rych.x*t;
micek.y:= micek_old.y + rych.y*t;
vykresli_kolo(micek_old.x,micek_old.y,rad,0);
vykresli_kolo(micek.x,micek.y,rad,15);
micek_old.x:=micek.x;
micek_old.y:=micek.y;
{vsechno u mame vykreslene, zbyva jenom eventualne pockat, aby hra nesla moc
rychle}
repeat
b:=MemL[Seg0040:$6c]; {znovu zjisti stav citace}
until (b<a) or (b>a+n); {porovnej to s hodnotou pred cyklem. Doba uplynula?}
end;
V pascalu samozřejmě operační systém napsat jde. Potíž může být, že Pascal 7.0 dělá jenom EXE soubory a ne COM soubory, ale v případě, že bys z nějakého důvodu opravdu chtěl .COM soubor, tak ho můžeš přeložit v Turbo pascalu 4.0 nebo nižším, který právě COM soubory tvoří. Co se týče bootování, souborových systémů nebo jiných hodně nízkoúrovňových věcí, tak se tomu elegantně vyhneš tím, že uděláš hybridní operační systém DOS-PascalOS. Zkrátka můžeš nechat nabootovat DOS a z něho ihned spustit svůj systém, který převezme funkce DOSu. Tedy něco jako Windows 95(98,Me). Díky tomu, že DOS běží v reálném módu je dokonce možné ho ukončit a ponechat v paměti jenom tvůj program. (takhle to dělala třeba česká Linuxová distribuce Monkey Linux)
Pro inspiraci doporučuju kouknout se na stránky operačního systému PCOS.
http://www.geocities.com/mercury0x000D/
Ty jo! Hodně, hodně dobrý!
A taky to máš výborně naprogramovaný a kód je elegantní a srozumitelný.
Jeden problém tam ale přece jenom je. Používáš textový režim 80x50, ale standardní DOSovské rozlišení je 80x25. Ty ale nevoláš žádnou proceduru pro nastavení 80x50. Tudíž já jsem před spuštěním tvojí hry musel napřed napsat "mode con: cols=80 lines=50"
Zkrátka, na začátek programu dej příkaz TextMode(c80+Font8x8) (je z jednotky Crt)
...a na konec TextMode(c80)
...anebo se na množiny vykašlat a řešit to přes druhé pole. Tedy že budeš mít pole kandidati s rozsahem 1..max kde budou všechna čísla, která budeš prověřovat a pole vyhovuji, které bude mít stejný rozsah a kde budou ta čísla, která vyhovují podmínkám.
Pole Vyhovuji bude ze začátku prázdné a budeš do něj postupně přidávat vyhovující prvky.
Aha, zadání je už jasné. Já bych to napsal takhle:
const SOUBOR='hokej.txt';
var t:text;
s1,s2,s3:string;
i,j,k:integer;
begin
Assign(t,SOUBOR);
reset(t);
repeat
readln(t,s3);
Val(s3,i,j); {vyuzijeme figl - zkusim prevest zapis na cislo}
if j=0 then {jestlize prevod probehl bez potizi, tak jde o ukonceni souboru ci o oddelovac utkani}
if i=0 then Break else {0 znamena konec souboru}
else {pozor, druhym ELSE se vracime na uroven "if j=0"}
begin {...takze prevod na cislo se nezdaril, vime tedy, ze jde o zapis golu a vime, kde zacina prvni pismeno}
s1:=Copy(s3,1,j-1); {vytahnu si cislice pred jmenem}
delete(s3,1,j-1); {z puvodniho retezce je vymazu}
insert(':',s1,Length(s1)-1); {doplnim dvojtecku}
{oddeleni jmena od skore bude vetsi problem}
k:=1;
repeat
Val(s3[k],i,j); {pomoci VAL budu proverovat jednotlive znaky zda to je cislice}
if j<>0 then inc(k); {kdyz to neni cislice, tak zvys citac}
until j=0; {jednou ale na cislici narazime}
s2:=Copy(s3,1,k-1); {co je pred ni je jmeno}
delete(s3,1,k-1); {co je za ni je skore}
insert(':',s3,2); {do skore pridam dvojtecku}
writeln(s1,' ',s2,' ',s3); {a vsechno to vypisu na obrazovku}
end;
until false;
Close(t); {zavri soubor}
readln; {pockej na stisk enteru}
end.
Mimochodem, "formát" údaje o skóre zápasu má chybu. Pokud tam bude "111", tak nelze určit, jestli je to 1:11 nebo 11:1. Tedy, ono to poznat jde, ale jenom jenom z kontextu k ostatním gólům.
Nefunguje odkaz na sejmi.jpg
Předpokládám, že tam je popsaný formát souboru VSTUP.TXT
Tudíž neznáme formát dat. Takže nám popiš formát dat a pošli odkaz na vzorový soubor VSTUP.TXT
Bez těchto informací ti doopravdy nemůžem pomoct. Procedura Nacteni mi příjde podezřelá; ze souboru načítáš znak po znaku, celý algoritmus je dost zašmodrchaný a smrdí to chybou. Jenže bez znalosti vstupních dat je to jenom spekulace. Mimochodem, nenapsal jsi, co přesně v tvém programu nefunguje.
Zadání znělo jasně. Nebyl čas lámat si hlavu, kdo je kdo. Chceš říct, soudruhu?... No, dvě dávky.
Zadání znělo jasně: "na vstupu 2 jednociferna cisla, vystup dvojciferne slozene z vstupnich jednocifernych..za odpovědi děkuji."
Druhé číslo tedy 2 a více ciferné být nemůže.
Pro rozšíření obzorů v pascalu:
Méně známé konstrukce 1 http://www.int21h.ic.cz/?id=17
Méně známé konstrukce 2 http://www.int21h.ic.cz/?id=99
první část je stará dva roky, druhá dvě hodiny :smile1:
No, a vymakanější verze s Line bude vypadat takto:
uses Crt;
Procedure Mys_init;assembler;
asm mov ax,0;int 33h;end;
Procedure Mys_On;assembler;
asm mov ax,1;int 33h;end;
Procedure Mys_Off;assembler;
asm mov ax,2;int 33h;end;
Procedure Mys_Stav(var x,y,stav:integer);assembler;
asm
mov ax,3;int 33h
push es
shr cx,3
shr dx,3
les di,x;mov es:[di],cx
les di,y;mov es:[di],dx
les di,stav;mov es:[di],bx
pop es
end;
Procedure SchovejKurzor;assembler;
asm mov ah,1;mov cx,2000h;int 10h;end;
Procedure ObnovKurzor;assembler;
asm mov ah,1;mov cx,0607h;int 10h;end;
Procedure NakresliZnak(x,y:byte);assembler;
{GotoXY a Write se na kresleni nehodi, protoze posouvaji kurzor}
{a muze dojit ke scrolingu. Proto to udelame jinak - pres BIOS}
asm
mov ah,2 {nastavi kurzor}
mov bx,0
mov dh,y {radka}
mov dl,x {sloupec}
int 10h {nastav pozici kurzoru}
mov ah,9
mov al,'*' {znak, ktery chceme zobrazit}
mov cx,1 {chceme zobrazit jeden}
mov bx,7 {jakou barvou - treba klasika, seda na cernem pozadi}
int 10h {kresli}
end;
procedure Line(x1,y1,x2,y2:word);
{Algoritmus na kresleni cary}
var dx,dy,krok,k,rx,ry:integer;
xprir,yprir,x,y:real;
begin
dx:=x2-x1;
dy:=y2-y1;
if (dx=0) and (dy=0) then NakresliZnak(x1,y1) else
begin
if abs(dx)>abs(dy) then krok:=abs(dx) else krok:=abs(dy);
xprir:=dx/krok;
yprir:=dy/krok;
x:=x1;
y:=y1;
for k:=1 to krok do
begin
x:=x+xprir;
y:=y+yprir;
rx:=round(x);
ry:=round(y);
NakresliZnak(rx,ry);
end;
end;
end;
{------------------------------------HLAVNI PROGRAM---------------------------------------------}
var x,y,s:integer;
sx,sy:integer;
begin
SchovejKurzor;
Mys_init;
Mys_On;
repeat
Mys_stav(x,y,s);
if s=1 then Line(sx,sy,x,y);
sx:=x;
sy:=y;
until s=2;
ObnovKurzor;
end.
A kurva!
Ty pracuješ v textovém režimu, tudíž nejsou k dispozici kreslicí funkce - v našem případě tedy Line. Není to nic, co by nás mohlo zastavit, ale znamená to komplikaci. Další věc - tvůj zdroják je dost nepřehledný, mísí se ti pascal a assembler. Je lepší snažit se je oddělovat.
A poslední poznámka - Randomize se správně volá jen jednou za program.
Jelikož nám chybí procedura Line, tak první verzi zdrojáku napíšu bez ní, kdy čáru budeme vykreslovat prostě pomocí jednotlivých znaků.
uses Crt;
Procedure Mys_init;assembler;
asm mov ax,0;int 33h;end;
Procedure Mys_On;assembler;
asm mov ax,1;int 33h;end;
Procedure Mys_Off;assembler;
asm mov ax,2;int 33h;end;
Procedure Mys_Stav(var x,y,stav:word);assembler;
asm
mov ax,3;int 33h
push es
shr cx,3;inc cx
shr dx,3;inc dx
les di,x;mov es:[di],cx
les di,y;mov es:[di],dx
les di,stav;mov es:[di],bx
pop es
end;
Procedure SchovejKurzor;assembler;
asm mov ah,1;mov cx,2000h;int 10h;end;
Procedure ObnovKurzor;assembler;
asm mov ah,1;mov cx,0607h;int 10h;end;
{------------------------------------HLAVNI PROGRAM---------------------------------------------}
var x,y,s:word;
begin
SchovejKurzor;
Mys_init;
Mys_On;
repeat
Mys_stav(x,y,s);
if s=1 then {S=1 znamena, ze je zmacknute leve mysitko}
begin
GotoXY(x,y);
write('*'); {nebo jakykoliv znak, ktery uznas za vhodne - treba plny obdelnicek}
end;
until s=2; {S=2 znamena, ze je zmacknute prave mysitko}
ObnovKurzor;
end.
Napiš sem zdroják nebo dej odkaz na něj, ať víme, s jakou grafickou knihovnou pracuješ a jakým způsobem obsluhuješ myš.
V principu se ale problém s kreslením čáry řeší přes Line, kdy propojuješ momentální pozici myši s předchozí pozicí myši. Jednoduchý PutPixel použít nejde, protože při rychlém pohybu s myší by se nevykreslila čára, ale sled teček.
MysCti(pozice_x,pozice_y,stav_tlacitek);
sx:=pozice_x;
sy:=pozice_y;
repeat
MysCti(pozice_x,pozice_y,stav_tlacitek);
if stav_tlacitek<>0 then Line(sx, sy, pozice_x, pozice_y);
sx:=pozice_x;
sy:=pozice_y;
until konec=true;
Rutinu je vhodné vylepšit o testování shodnosti SX vůči Pozice_X a SY vůči Pozice_Y. Pokud jsou obě dvojice shodné, znamená to, že se myš v posledním cyklu nepohla a tudíž není třeba kreslit. To vede k velkému urychlení programu.
Komentář o záporním znaménku...
...ten ehm... zruš.
Já jsem to původně napsal trošku jinak, kde se záporná známénka používala, myslel jsem to jako fígl, jak zajistit, aby v IF nemusela být dvojitá podmínka, ale nefungovalo to dobře, tak jsem to nakonec udělal bez něj.
Bez pojistky by to udělat šlo, ale fakt ti nebudu upravovat program z důvodu, aby učitel nepřišel na to, že jsi ho nepsal ty a že jsi ho vlastně oklamal.
Garret Razier to nenapsal moc dobře. Kód sice bude ve většině případů fungovat správně, ale kód je chybný. Problém je, že při posledním cyklu přistupuje k znaku většímu než je délka řetězce, jehož obsah není definován a může tam být cokoliv.
Kvůli podobným chybám (jde vlastně o překročení rozsahu pole) může i zhavarovat systém. V tomto případě se to, pravda, stát nemůže (ledaže by délka řetězce byla 255 znaků), protože typ string je defnován jako pole 256 znaků (1 bajt délka+ 255b data).
Také není šťastné použití výrazu ord(s[0])
Proč? Snižuje to čitelnost kódu a omezuje to kompatibilitu. Kvůli tomuhle nelze tvoji funkci používat např. pro typ Ansistring. (řetězec, který může obsahovat více než 255 znaků)
Lepší je třeba toto:
function PocetSlov(s:string):byte;
var i,j:byte;
b:boolean;
begin
j:=0;
b:=false;
for i:=1 to Length(s) do
if s[i]<>' ' then
if b=false then
begin
b:=true;
inc(j);
end
else {if B...}
else {if s[j]...}
b:=false;
PocetSlov:=j;
end;
Doporučuju tuhle strukturu:
var jidlo:array[1..10] of record nazev:string;pocet:byte;end;
Na začátku programu vynuluješ počítadlo:
for i:=1 to 10 do jidlo[i].pocet:=0;
Jestli chceš, tak můžeš definovat názvy jídel:
jidlo[1].nazev:='zemlbaba';jidlo[2].nazev:='borsc';....
No, a pak při snězení daného jídla přičteš jeho hodnotu Pocet
jidlo[n].pocet:=jidlo[n].pocet+1;
nebo to lze napsat poněkud úsporněji:
inc(jidlo[n].pocet);
Aha, tak už je to jasné!
Základní problém je to, že kuliček je moc, tedy více, než je hodnota maxkulicek
Proto je nutné
1) zvýšit hodnotu Maxkulicek
2) změnit typ BYTE na typ INTEGER, abychom mohli zpracovávat více než 255 kuliček.
3) pro jistotu dát pojistku proti překročení Maxkulicek
Další problém s tvým souborem KULICKY.TXT je to, že na konci obsahuje několik prázdnýxh řádek. To působí potíže proceduře Read(číslo), protože není schopná z takového řádku načíst číselnou hodnotu. Read je extrémně citlivá na správný formát vstupních dat. Proto je rozumné načítání kuliček změnit, aby to bylo blbuvzdornější. Změněný program bude vypadat takto:
const maxkulicek=1200;
var f:text;
s:string;
k:array[1..maxkulicek] of record x,y,z:real;barva:byte;end;
i,j,pocet:integer;
m,c,mc,u:real;
m1,m2,c1,c2,mc1,mc2:integer;
begin
pocet:=0; {zatim jsme zadne kulicky nenacetli}
Assign(f,'kulicky.txt');
Reset(f);
while not eof(f) do
begin
readln(f,s);
while (s[1] in [' ',#9]) and (s<>'') do
delete(s,1,1); {smaze pripadne mezery a taby}
if s='' then Break;
inc(pocet); {nova radka s novou kulickou}
if pocet>maxkulicek then
begin
pocet:=maxkulicek;
writeln('Soubor je prilis velky, bude zpracovano pouze prvnich, ',
maxkulicek,' kulicek.'#13#10);
Break;
end;
i:=pos(' ',s);
Val(Copy(s,1,i-1),k[pocet].x,j);
delete(s,1,i);
while s[1] in [' ',#9] do delete(s,1,1); {smaze pripadne mezery a taby}
i:=pos(' ',s);
Val(Copy(s,1,i-1),k[pocet].y,j);
delete(s,1,i);
while s[1] in [' ',#9] do delete(s,1,1); {smaze pripadne mezery a taby}
i:=pos(' ',s);
Val(Copy(s,1,i-1),k[pocet].z,j);
delete(s,1,i);
while s[1] in [' ',#9] do delete(s,1,1); {smaze pripadne mezery a taby}
Val(s[1],k[pocet].barva,j);
end;
Close(f);
m:=0;
c:=0;
mc:=0;
for i:=1 to pocet-1 do
for j:=i+1 to pocet do
begin
{vzdalenost 2 bodu v prostoru}
u:=sqrt(sqr(k[i].x-k[j].x)+sqr(k[i].y-k[j].y)+sqr(k[i].z-k[j].z));
{ukol pro pozorneho ctenare: proc asi davam ke vzdalenostem zaporne znamenko?}
if k[i].barva<>k[j].barva then
if (u<mc) or (mc=0) then begin mc:=u;mc1:=i;mc2:=j;end else else
if k[i].barva=0 then
if (u<m) or (m=0) then begin m:=u;m1:=i;m2:=j;end else else
if (u<c) or (c=0) then begin c:=u;c1:=i;c2:=j;end;
end;
writeln('CERVENY PAR:');
writeln('vzdalenost: ',c:3:3);
writeln('jde o: c.',c1,' & c.',c2);
writeln('jejich souradnice: ',k[c1].x:3:3,',',k[c1].y:3:3,',',k[c1].z:3:3,' & ',
k[c2].x:3:3,',',k[c2].y:3:3,',',k[c2].z:3:3);
writeln;
writeln('MODRY PAR:');
writeln('vzdalenost: ',m:3:3);
writeln('jde o: c.',m1,' & c.',m2);
writeln('jejich souradnice: ',k[m1].x:3:3,',',k[m1].y:3:3,',',k[m1].z:3:3,' & ',
k[m2].x:3:3,',',k[m2].y:3:3,',',k[m2].z:3:3);
writeln;
writeln('CERVENO-MODRY PAR:');
writeln('vzdalenost: ',mc:3:3);
writeln('jde o: c.',mc1,' & c.',mc2);
writeln('jejich souradnice: ',k[mc1].x:3:3,',',k[mc1].y:3:3,',',k[mc1].z:3:3,' & ',
k[mc2].x:3:3,',',k[mc2].y:3:3,',',k[mc2].z:3:3);
writeln;
readln;
end.
(ošetření proti případu, že je obsažen jen jeden druh kuliček jsem nepřidal - zůstává to na tobě)
O víkendu jsem napsal vyhodnocovač matematických výrazů. Protože to nebyla úplně sranda a protože by bylo zbytečný, kdyby s tím měl někdo další ty samý potíže a musel znovu objevovat Ameriku, tak jsem to sepsal do článku na INT21h
http://www.int21h.ic.cz/?id=98
Mircosofte, tvůj KUL.TXT nemá správný formát dat, protože jako identifikaci barvy tam máš hodnoty 12 a 10, kdežto povolené jsou jenom 1 a 0.
Ale je fakt, že já jsem opomněl pořešit případ, kdy jsou v souboru KUL.TXT jenom červené nebo naopak jenom modré kuličky. V takovém případě doopravdy vnikne chyba 201.
Tudíž kolega Tomano by mohl tyto kontoly doplnit :smile14:
Visty a starý Turbo pascal se moc nesnesou :-(
Nabízejí se tři možná řešení:
1) smazat Visty a nainstalovat nějaký normální operační systém (nejrozumnější)
2) nechat Visty, nainstalovat Dosbox http://www.dosbox.com/ a pascal provozovat v něm
3) používat Freepascal (verzi pro windows) http://www.freepascal.org/down/i386/win32-austria.var - asi nejschůdnější řešení. Rozdílu si ani nevšimneš, protože vývojové prostředí vypadá stejně a ušetříš si problémy s různými nekompatibilitami
Ne, v pohodě, jseš ve správném fóru. Konzolové aplikace v Delphi se od klasického pascalu liší jenom málo, tudíž writeln a readln normálně funguje.
(elegantnější se mi ale zdá použít Freepascal, který je s Delphi kompatibilní a jeho standardní IDE vypadá jako klasický pascal, to je ale jedno)
Struktura record je podle mě nevhodně navržená - místo pole by se sem mnohem lépe hodil record. Něco jako
type koreny = record
pocet_reseni:byte;
r1,r2,r3,r4:real;
end;
Taky bys měl uživateli dovolit, aby mohl zadat koeficient A jako 0, normálně rovnici vypočítat a nehudrovat, že nejde o kvadratickou rovnici.
Jo, a v zadání stojí, že hodnoty a výsledky budou přidávány (nikoliv předávány) do souboru kvadrov.log
Tudíš musíš připisovat do existujícího souboru, jenže ty pokaždé vytváříš nový.
Včera jsem se setkal s divným hlášením ASCII kódů pro numerickou klávesnici, pokud je držen Shift. Tedy Shift+numŠipka.
1) Když zmáčknu normální šipku doleva, tak dostanu kód 0 a 75, výsledně tedy 331.
2) Když zmáčknu numerickou šipku doleva, tak dostanu kód 0 a 75, výsledně tedy 331.
3) Když zmáčknu Shift+normální šipku doleva, dostanu rovněž 331
4) Když zmáčknu Shift+numerickou šipku doleva, dostanu 52 (ASCII kód "4")
V situaci č.4 se tedy klávesnice chová prapodivně. Chci se tedy zeptat, jestli to pozoruje i někdo další, nebo jestli je za tím můj ovladač klávesnice a jestli je to známá věc, jak to ošetřujete. Já jsem to pořešil hlídáním stavu Shiftu a případným překódováním, tedy takto:
if (w>45) and (w<58) and Je_shift then
case w of
46:w:=339;
47:w:=47; {o kodu 47 nevim nic}
48:w:=338;
49:w:=335;
50:w:=336;
51:w:=337;
52:w:=331;
53:w:=332;
54:w:=333;
55:w:=327;
56:w:=328;
57:w:=329;
end;
Nevím ale, jestli to bude fungovat s/bez nainstalované české/ruské/jiné klávesnice a jestli se to nebude prát s číslama na hlavní klávesnici.
Nejspíš bude.
Má někdo jiný nápad, jak to ošetřit?
Proč to řešit v kuloárech, šup s tím na fórum:
const maxkulicek=100;
var f:text;
k:array[1..maxkulicek] of record x,y,z:real;barva:byte;end;
i,j,pocet:byte;
m,c,mc,u:real;
m1,m2,c1,c2,mc1,mc2:byte;
begin
pocet:=0; {zatim jsme zadne kulicky nenacetli}
Assign(f,'kulicky.txt');
Reset(f);
while not eof(f) do
begin
inc(pocet); {nova radka s novou kulickou}
read(f,k[pocet].x); {nacti X souradnici}
read(f,k[pocet].y); {nacti Y souradnici}
read(f,k[pocet].z); {nacti Z souradnici}
readln(f,k[pocet].barva); {nacti barvu a ukonci radku}
end;
Close(f);
m:=0;
c:=0;
mc:=0;
for i:=1 to pocet-1 do
for j:=i+1 to pocet do
begin
{vzdalenost 2 bodu v prostoru}
u:=sqrt(sqr(k[i].x-k[j].x)+sqr(k[i].y-k[j].y)+sqr(k[i].z-k[j].z));
if k[i].barva<>k[j].barva then
if (u<mc) or (mc=0) then begin mc:=u;mc1:=i;mc2:=j;end else else
if k[i].barva=0 then
if (u<m) or (m=0) then begin m:=u;m1:=i;m2:=j;end else else
if (u<c) or (c=0) then begin c:=u;c1:=i;c2:=j;end;
end;
writeln('CERVENY PAR:');
writeln('vzdalenost: ',c:3:3);
writeln('jde o: c.',c1,' & c.',c2);
writeln('jejich souradnice: ',k[c1].x:3:3,',',k[c1].y:3:3,',',k[c1].z:3:3,' & ',
k[c2].x:3:3,',',k[c2].y:3:3,',',k[c2].z:3:3);
writeln;
writeln('MODRY PAR:');
writeln('vzdalenost: ',m:3:3);
writeln('jde o: c.',m1,' & c.',m2);
writeln('jejich souradnice: ',k[m1].x:3:3,',',k[m1].y:3:3,',',k[m1].z:3:3,' & ',
k[m2].x:3:3,',',k[m2].y:3:3,',',k[m2].z:3:3);
writeln;
writeln('CERVENO-MODRY PAR:');
writeln('vzdalenost: ',mc:3:3);
writeln('jde o: c.',mc1,' & c.',mc2);
writeln('jejich souradnice: ',k[mc1].x:3:3,',',k[mc1].y:3:3,',',k[mc1].z:3:3,' & ',
k[mc2].x:3:3,',',k[mc2].y:3:3,',',k[mc2].z:3:3);
writeln;
readln;
end.
Zpět k tématu.
Cherokee007, tvůj program funguje, nedodělky uprav podle toho, co psal Mircosoft a bude to dobrý.
Ještě doporučuju, upozornit na začátku programu uživatele, že bude zadávat 10 hodnot. Ono když člověk zadává už šestou hodnotu a neví, kdy to bude končit, tak je to dost frustrující.
Dále, smyčka FOR s jedním příkazem. V takovém případě není třeba uzavírat tento příkaz do bloku BEGIN END. Tedy, místo
for i := 1 to 10 do begin sucet := sucet + v[i];end;
stačí for i := 1 to 10 do sucet := sucet + v[i];
Zbytečně také používáš proceduru BubbleSort. To je učebnicový příklad tzv. použití kanónu na vrabce. Ty přece nepotřebuješ setřídit pole, ale jen vybrat největší hodnotu.
Prohození obsahu dvou proměnných umí úplně každý. Kdo to ale zvládne bez použití pracovní proměnné? :smile5:
(třetí procedura je obzvlášť půvabná)
Procedure Prohozeni1(var a,b:integer);
var t:integer;
begin
t:=a;
a:=b;
b:=t;
end;
Procedure Prohozeni2(var a,b:integer);
begin
a:=a+b;
b:=a-b;
a:=a-b;
end;
Procedure Prohozeni3(var a,b:integer);
begin
a:=a xor b;
b:=a xor b;
a:=a xor b;
end;
V čem vidíte problém? Výjimečně sem napíšu hotový program, ale uvědom si, že když nesestavíš takhle triviální program, tak na VŠ dopadneš špatně.
const max=20;
var pole:array[1..max] of integer;
a,i:integer;
begin
write('Kolik hodnot chces zadat?: ');
readln(i);
if (i<1) or (i>max) then Halt;
for a:=1 to i do
begin
write('cislo ',a,'?: ');
readln(pole[a]);
end;
writeln('Suda cisla jsou na nasledujicich pozicich:');
for a:=1 to i do
if not odd(pole[a]) then write(a,', ');
writeln(#8#8,' ');
readln;
end.
Program se bez problému přeloží i ve starém Turbo pascalu a funguje správně.
Akorát je tam slabina - a to, že pole A je indexované jenom do 10. Tedy - pokud má soubor IN.TXT více než deset řádek, tak se program zhroutí, neboť dojde k překročení rozsahu pole.
Hledám nadšence, který mi naprogramuje procedury PieSlice a Arc. Je na vás, jestli to uděláte pro VGA nebo VESA a pro jakou knihovnu. Já už si to přeberu a včlením do svojí jednotky. Pochopitelně, jméno přispěvatele bude uvedeno v úvodních komentářích k jednotce :-)
No, DJGPP je napsané v DJGPP, Freepascal je napsaný ve Freepascalu, zdrojáky jsou u obojího k dispozici, ale je pravda, že jsou to velikánská monstra. Tobě by se možná hodil zdroják Alice pascalu, který vznikl jako něčí diplomka:
http://www.templetons.com/brad/alice.html#source
Je to normálně v menu:
Options-->Environment-->Preferrences-->Video mode
Klíčové slovo inherited v Turbo pascalu JE
(ve verzi 7.0x)
Dobrý manuál o OOP v pascalu napsal Mircosoft:
http://www.mircosoft.ic.cz/texty/OOP.TXT
Neboj,pořád probíráte klasickýTurbo pascal :smile1:
Zkrátka, když se objekt definuje slovem object tak jde o klasický pascal. Když se definuje slovem class jde o Objectpascal, který můžeš přeložit pomocí Delphi, Kylix nebo Freepascalu.
kolotoc = object procedure roztoc(x:integer) end;
To je úplně nejzákladnější objektová konstrukce pascalu - to se pak dá dál rozvíjet.
No, 16-bitový PCX obrázky neexistujou. Jsou jenom 16-barevný, 256 barevný a Truecolor (24-bitový).
Zdaleka nejběžnější jsou 256 barevný, s truecolorama se setkáš vzácně a 16-barevné jsou vyloženě rarita. Jestli takovej přesto máš, tak ho doporučuju překonvertovat na 256 barevnej, protože s 16 barevnými většina programů neumí pracovat.
Teď k tvému dotazu. Použij nějakou existující knihovnu, nebo existující rutinu. Proč pořád znovu vynalézat kolo, že?
Doporučuju stránky Mircosofta, který na nich má pěknou a jednoduchou jednotu PCX:
http://www.mircosoft.ic.cz/ případně vlez na SWAG, kde je podobných zdrojáků kupa: http://www.bsdg.org/SWAG/GRAPHICS/index.html
Tahle úloha už z principu na počítači řešit nejde. Vždyť v IQ testech jde právě o to - rozpoznat pravidla posloupnosti. Tedy potřeba najít algorimus. Počítače nejsou od toho, aby nacházely algoritmy, ale aby prováděly algoritmy. Samozřejmě bys mohl zkusit udělat jakousi kuchařku, program, který dokáže identifikovat několik typů posloupností, ale v praxi by to bylo na nic, protože možností, podle kterých může být posloupnost sestavena, je nekonečně mnoho.
Není ale naopak problém napsat program, jestli zadané číslo může být členem nějaké dříve definované posloupnosti. Např. program, který zjistí, zda je zadaná hodnota členem Fibonacciho posloupnosti, zda je to prvočíslo, zda je to součet dvou předchozích prvočísel, atd.
>bud som to zle pochopil, alebo ty si NAOZAJ naivne myslis, ze sa rozoberaju algoritmy z hladiska casovej a paatovej zlozitosti aj na strednej skole?
Tos mě asi opravdu špatně pochopil. Vždyť jasně píšu: "vysoké škole"
Možná, že pascal, co používáte ve škole je fakt ještě z komunistických dob, protože poslední verze turbo pascalu: Borland pascal 7.00 a BP 7.01 zvýrazňování syntaxe umějí (oba jsou z roku 1993)
Já si ale opravdu myslím, že GUI prostředí jsou pro výuku programování ke škodě. Vždyť o co v programování jde: vyhledávání, třídění, stromové struktury, grafy a několik dalších věcí. Vokýnka to všechno jenom zatemní a student se pak nic nenaučí pořádně.
Koneckonců, ve všech oborech je to stejné: v matematice se taky napřed učíš písemně dělit, násobit, atd., doktoři se při studio taky napřed učí anatomii a fyziologii. To je jako, kdybys chtěl dávat medikům nějaký rychlokurzy, co dělá kterej prášek, pak je hodil do praxe a poradil jim, aby se na základy koukli za pochodu, když se náhodou vyskytne problém.
Jenže pak ti odchovanec z Pythonu příjde na vysokou školu a bude úplně v prdeli, protože tam se právě rozebírají algoritmy z hlediska časové a paměťové náročnosti.
Pascal a C++ jsou v podstatě rovnocenné. Pascal má jenom o něco přísnější syntaxi, takže nedovolí, aby si člověk vypěstoval moc programátorských zlozvyků. Nicméně to, že v pascalu všechny proměnné programu musejí být deklarované hned na začátku je blábol. V pascalu dělám asi 12 let a ničeho takového jsem si nevšiml. Taky není pravda, že IDE borland pascalu neumí zvýrazňování syntaxe. Blbost, umí.
Oproti C je pascal o něco rozplizlejší, má více klíčových slov, ale na druhou stranu, člověku stačí umět menší část jazyka aby mohl začít programovat než v C.
No, tak úplně hypoteticky přímo COM soubor udělat jde, ale proč bys to sakra dělal. To není ani o ň víc low-level než assembler. Nicméně jestli to chceš zkusit:
Vezmi si nějaký editor, který umí hexadecimální editaci, eventuálně přinejhorším alespoň editaci z ASCII tabulky a zadej tyto hexa hodnoty:
"B4 0B 33 DB B3 02 CD 10 C3" (bez uvozovek) a tento soubor ulož jako .COM (třeba POKUS.COM) - ten pak můžeš rovnou spustit.
Normální člověk si ale pořídí Turbo assembler, napíše tenhle zdroják:
.model tiny
.code
startupcode
mov ah,0bh
mov bx,2
int 10h
ret
end
který:
1) Přeloží (TASM pokus.asm)
2) Slinkuje (TLINK /t pokus.obj)
3) Spustí
Já jsem to napsal takhle:
;Program secte dve cisla. Zkompiluje se v TASM
.8086
.MODEL TINY
.CODE
ORG 100h
STARTUPCODE
JMP @START
r db 10 dup(?)
vstup db 10,0,0,0,0,0,0,0,0,0,0,0
ci1 dw ?
ci2 dw ?
crlf db 13,10,0
zadej1 db 'Zadej prvni cislo: ',0
zadej2 db 'Zadej druhe cislo: ',0
vysledek db 'Vysledek je: ',0
nicnezcislo db 'Zadavej pouze cisla !',13,10,0
;Procedura print - vytiskne retezec-----------------------------
print proc near ;retezec musi byt v DS:SI a koncit ASCII 0
push dx
@cycle:
mov dl,ds:[si]
inc si
cmp dl,0
jz @finished
mov ah,2
int 21h
jmp @cycle
@finished:
pop dx
ret
print endp
;---------------------------------------------------------------
;Procedura INT2STR - prevede cislo na zobrazitelny retezec
int2str proc near ;AX = hodnota, DS:SI = ASCIIZ retezec
push si
xor cx,cx
mov bx,10
mov di,0
@smycka1:
;------------------------------------------------------
xor dx,dx
div bx ;AX:=AX div 10; modulo v DX, vysl.beze zbytku v AX
add dx,48
inc cx
push dx ;nemuzu to dat do retezce rovnou, protoze by to bylo pozadu
;obratim to pomoci PUSH/POP
cmp ax,0
jnz @smycka1
;------------------------------------------------------
@smycka2:
pop dx
mov ds:[si],dl
inc si
loop @smycka2
@ukonceni:
mov al,0
mov ds:[si],al
pop si
ret
int2str endp
;------------------------------------------------------
;Procedura ZadejRetezec----------------------------
ZadejRetezec proc near
mov dx,si
mov ah,0ah
int 21h
inc si
ret
ZadejRetezec endp
;--------------------------------------------------
;Procedura PrevedRetezec
;Retezec prevede na cislo, ktere ymusti do DX.Kdyz v nem budou
;neciselne znaky, tak nastavi ZF na nulu
PrevedRetezec proc near
mov cl,ds:[si] ;delka retezce do cl
cmp cl,0 ;retezec je prazdny?
jz @zr_vynuluj
mov dx,0
mov ch,0
mov bx,1
add si,cx
std
@zr_cykl:
lodsb
mov ah,0
cmp al,48
jb @zr_vynuluj
cmp al,57
ja @zr_vynuluj
sub al,48
push dx
mul bx
pop dx
add dx,ax
push dx
mov ax,10
mul bx
mov bx,ax
pop dx
dec cx
jnz @zr_cykl
stc
jmp @zr_konec
@zr_vynuluj:
clc
@zr_konec:
cld
ret
PrevedRetezec endp
;======================================================
@Start:
lea si,zadej1
call print
lea si,vstup
call ZadejRetezec
call PrevedRetezec
jc @vse_v_poradku1
lea si,nicnezcislo
call print
jmp @konecprogramu
@vse_v_poradku1:
mov ci1,dx
lea si,crlf
call print
;------------------------------------------------------
lea si,zadej2
call print
lea si,vstup
call ZadejRetezec
call PrevedRetezec
jc @vse_v_poradku2
lea si,nicnezcislo
call print
jmp @konecprogramu
@vse_v_poradku2:
add dx,ci1
lea si,crlf
call print
lea si,vysledek
call print
mov ax,dx
lea si,r
call int2str
call print
@konecprogramu:
xor bx,bx
mov ax,4c00h
int 21h
end
Program má svoje omezení - neumí záporná či reálná čísla a pracuje jenom s šestnáctibitovými registry - výsledek tudíž nesmí být větší než 65535.