Anonymní profil Mirek – Programujte.com

K neuvěření

#2 liborb
Samozřejmě je tam property. Změna je povolená. Text tam je. Bude tam nějaký zakopaný pes.

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.

Dej sem ukázku kódu, ať se na to můžem mrknout.

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.

Kromě cyklu to jde i takhle:

Function CiselnaRada(i:integer):integer;

begin

if i=1 then CiselnaRada:=1 else CiselnaRada:=i+CiselnaRada(i-1);

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;

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.

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}

Nebo moje oblíbená prasárnička:

var cislo:longint;

...

writeln('Zadavej cisla. Zadanim nuly se skonci.');

 repeat

 readln(cislo);

if cislo=0 then Break;

{...zpracuj ho...}

 until 1=2;

...

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));

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ě.

For cyklus pro půl miliónu opakování je absolutně rutinní věc.
Ještě jsi toho asi naprogramoval málo :smile5:

Jo, pardon, svůj předchozí přípěvek jsem smazal. Byl mimo mísu, přehlédl jsem, že se téma netýká součinu, ale součtu. Tím ale tuplem platí, že tam pole nemají co dělat.

V knihkupectvích bývá kniha od Piotra Wróblewského Algoritmy - datové struktury a programovací techniky
Doporučuju přečíst si kapitolu Datové struktury a speciálně oddíl Univerzální slovníková struktura (od stránky 147)

Jo, to, co popisuješ, se nazývá slovníková struktura a skutečně se používá pro uchovánání slovníků. Používají ji třeba našeptávače nebo automatické korektory překlepů.

Přečti si nápovědu k Freepascalu:
http://community.freepascal.org:10000/docs-html/ref/refch11.html#x140-14700011

Bootloader by v pascalu vůbec nebyl problém.

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"

Jestli ti Mem nebere Freepascal, tak zkus dát na začátek programu "uses Go32".

[i]"...v programu od Laacy..."[/i]
Ale fuj. Laaca se skloňuje podle vzoru Venca. Takže od Venci - od Laaci

Cyklus "while" je v tomhle případě lepší nahradit cyklem "for".

Ř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.

Mimochodem, kdo psal zadání? Na jednu stranu je tam pěkně vymyšlená pointa, na druhou stranu opravdu prapodivná "čeština". Autorkou je vaše IVeTka?

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.

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:

V meníčku jdi na "Options" --- "Compiler" a zašktni "enable 286 instructions"
Další možnost je přidat na začátek programu tento řádek:
{$G+}

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;

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.

Mixxy: úplná blbost :smile17:

Udělej si PIF soubor k tvému programu a tam zašktni, aby program běžel přes celou obrazovku.

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;

NOP je taky perfektní pro crackování programů nebo hledání chyb. Když máš v hotovém EXE nebo COM instrukci, kterou chceš zrušit bez toho, abys musel překompilovat program, tak tuto instrukci v hexadecimálním editoru přepíšeš instrukcí NOP.

Doporučuju tuhle strukturu:

var jidlo:array[1..10] of record nazev:string;pocet:byte;end;

for i:=1 to 10 do jidlo[i].pocet:=0;

jidlo[1].nazev:='zemlbaba';jidlo[2].nazev:='borsc';....

jidlo[n].pocet:=jidlo[n].pocet+1;

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 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:

Jestli texty nejsou příliš rozsáhlé, tak prostě načti celý soubor do pole řetězců a pak už nemusíš prohledávat soubor, ale jenom to pole.

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;

Ty brďo, nemáš Windows Vista? O těch se proslýchá, že DOSovým programům nepovolují běh v celém okně...

Odpověď jsem napsal do jiného vlákna.
Mimochodem, mám dojem, že je proti zdejším pravidlům posílat stejný příspěvek do více vláken.

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.

Pro začátek se můžeš podívat na originální pascalácké příklady. Mrkni na .\EXAMPLES\DOC\collect*.pas

Jinak, ForEach v pascalu (včetně TP 6.0 a TP 7.0) je. (je to metoda objektu TCollection, jednotka Objects)

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;

Překladač u Freepascalu je:
C:\Freepascal\bin\win32\fpc.exe

případně:
C:\Freepascal\bin\go32v2\fpc.exe
C:\Freepascal\bin\linux\fpc.exe

Část napsaná kurzívou je vaše cesta k základnímu adresáři Freepascalu.

Načítání čísel od uživatele a jejich sčítání by klidně mohlo být v jednom cyklu. Je zbytečné dělat je dva.

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.

Šmarjá noho! Prosim tě, piš slovensky, tvoje čeština je příšerná.
A to doopravdy nejde, abychom ti napsali celý program. Napřed to zkus sá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

No pozor - v podstatě assembler = strojový kód. Assemblerové instrukce přesně odpovídají strojovým číselným hodnotám. Prostě místo takového: "90,CD,10" napíšu "nop; int 10h". Zápis je srozumitelnější, ale přesně odpovídá strojovému kódu.

Ono by to šlo napsat i úspornějc, ale takhle je to, myslím, srozumitelnější.

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