• Здраво и добредојдовте на форумот на IT.mk.

    Доколку сеуште не сте дел од најголемата заедница на ИТ професионалци и ентузијасти во Македонија, можете бесплатно да се - процесот нема да ви одземе повеќе од 2-3 минути, а за полесна регистрација овозможивме и регистрирање со Facebook и Steam.

Nekolku programi [PASCAL]

  • Ја почнал/а темата
  • #1

Aleks

Gaining Experience
18 мај 2007
5,748
288
Eve dve programi(sega za sega) koi gi rabotev vo shkolo(t.e. na drug nacin izraboteni), pa pomisliv da gi postiram oti mozebi na nekoj drug kje mu trebaat. Ne se zavrsheni do kraj, koga kje gi zavrsham kje gi smenam ovie

pozz


Programa za naogjanje na sprotiven broj na vneseniot (koristenje na ednodimenzionalna niza, readkey i readkey kodovi (ne e bash shkolski stil, vo shkolo ja rabotev so MOD, DIV ama vaka 1 100 pati polesno)):

Код:
program sprotiven;
uses
    crt;
var
   niza: ARRAY[1..1024] of char;
   N:char; X,A:Integer;
begin
     ClrScr;
     WriteLn('Vnesete nekoj broj ');
     X:=1;

     repeat
       niza[X]:=readkey;
       Write(niza[X]);
       N:=niza[X];
       X:=X+1;
     until(N=#13);
     WriteLn;
     WriteLn('Sprotivniot broj e: ');
     FOR A:=X DOWNTO 1 DO
         begin
              Write(niza[A]);
         end;
     ReadLn;
end.
Programa za pisuvanje na broevite poodelno i so bukvi (pak isti princip, i pak ne e kako shkolskite programi.. Poednostavna e=) ):

Код:
program test;
uses
    crt;
var
   niza : array[1..100] of char;
   N,V: Char;
   X,A: integer;
begin
ClrScr;
X:=1;
WriteLn('Vnesete Eden broj ');

     repeat
       niza[X]:= readkey;
       Write(niza[X]);
       N:=niza[X];
       X:=X+1
     until(N=#13);
     WriteLn; WriteLn;

     WriteLn('Toj Broj se sostoi od: ');

     FOR A:=1 TO X DO
     begin
          CASE niza[A] of
               '1' : WriteLn(niza[A],' - Eden');
               '2' : WriteLn(niza[A],' - Dva');
               '3' : WriteLn(niza[A],' - Tri');
               '4' : WriteLn(niza[A],' - Cetiri');
               '5' : WriteLn(niza[A],' - Pet');
               '6' : WriteLn(niza[A],' - Sest');
               '7' : WriteLn(niza[A],' - Sedum');
               '8' : WriteLn(niza[A],' - Osum');
               '9' : WriteLn(niza[A],' - Devet');
               '0' : WriteLn(niza[A],' - Nula');
          end;
     end;
     WriteLn('Bye Bye =)');
     readln;
end.
 

CpuMan

Intern
23 ноември 2008
37
0
@Aleks ova readkey ne mi e jasno zosto se koristi i zaso ima staveno # ovde
Код:
until (N=#13)
moze li malko objasnuvanje :)
 

brzi

Gaining Experience
18 април 2007
217
108
brzi's setup  
Processor & Cooler
i7 4790k | CM 420 Evo
Motherboard
Asus Z97K
Storage
120GB Kingston HyperX Savage | WD Blue 1TB
PSU
DeepCool DQ750ST 750W
RAM
16GB HyperX Beast 2400MHz
Video card
Sapphire RX480 4GB OC+
Case
Sama Titan
Mouse
Asus ROG G900
Keyboard
CM Storm QuickFire Stealth
Audio
Bose SoundTrue AE2
OS
Win 10
readkey cita vnes od tastatura
vo negoviot primer programata cita vneseni podatoci se dodeka korisnikot ne vnese nisto i pritisne enter.
 
  • Ја почнал/а темата
  • #9

Aleks

Gaining Experience
18 мај 2007
5,748
288
да да ... се смешав со друга задача .. ги заборавив овие .)
 

brzi

Gaining Experience
18 април 2007
217
108
brzi's setup  
Processor & Cooler
i7 4790k | CM 420 Evo
Motherboard
Asus Z97K
Storage
120GB Kingston HyperX Savage | WD Blue 1TB
PSU
DeepCool DQ750ST 750W
RAM
16GB HyperX Beast 2400MHz
Video card
Sapphire RX480 4GB OC+
Case
Sama Titan
Mouse
Asus ROG G900
Keyboard
CM Storm QuickFire Stealth
Audio
Bose SoundTrue AE2
OS
Win 10

maximilian

Gaining Experience
26 март 2008
1,064
74
Еве ви го алгоритамот QuickSort во Pascal:

Код:
PROGRAM Sort(input, output);
    CONST
        { Max array size. }
        MaxElts = 50;
    TYPE 
        { Type of the element array. }
        IntArrType = ARRAY [1..MaxElts] OF Integer;

    VAR
        { Indexes, exchange temp, array size. }
        i, j, tmp, size: integer;

        { Array of ints }
        arr: IntArrType;

    { Read in the integers. }
    PROCEDURE ReadArr(VAR size: Integer; VAR a: IntArrType);
        BEGIN
            size := 1;
            WHILE NOT eof DO BEGIN
                readln(a[size]);
                IF NOT eof THEN 
                    size := size + 1
            END
        END;

    { Use quicksort to sort the array of integers. }
    PROCEDURE Quicksort(size: Integer; VAR arr: IntArrType);
        { This does the actual work of the quicksort.  It takes the
          parameters which define the range of the array to work on,
          and references the array as a global. }
        PROCEDURE QuicksortRecur(start, stop: integer);
            VAR
                m: integer;

                { The location separating the high and low parts. }
                splitpt: integer;

            { The quicksort split algorithm.  Takes the range, and
              returns the split point. }
            FUNCTION Split(start, stop: integer): integer;
                VAR
                    left, right: integer;       { Scan pointers. }
                    pivot: integer;             { Pivot value. }

                { Interchange the parameters. }
                PROCEDURE swap(VAR a, b: integer);
                    VAR
                        t: integer;
                    BEGIN
                        t := a;
                        a := b;
                        b := t
                    END;

                BEGIN { Split }
                    { Set up the pointers for the hight and low sections, and
                      get the pivot value. }
                    pivot := arr[start];
                    left := start + 1;
                    right := stop;

                    { Look for pairs out of place and swap 'em. }
                    WHILE left <= right DO BEGIN
                        WHILE (left <= stop) AND (arr[left] < pivot) DO
                            left := left + 1;
                        WHILE (right > start) AND (arr[right] >= pivot) DO
                            right := right - 1;
                        IF left < right THEN 
                            swap(arr[left], arr[right]);
                    END;

                    { Put the pivot between the halves. }
                    swap(arr[start], arr[right]);

                    { This is how you return function values in pascal.
                      Yeccch. }
                    Split := right
                END;

            BEGIN { QuicksortRecur }
                { If there's anything to do... }
                IF start < stop THEN BEGIN
                    splitpt := Split(start, stop);
                    QuicksortRecur(start, splitpt-1);
                    QuicksortRecur(splitpt+1, stop);
                END
            END;
                    
        BEGIN { Quicksort }
            QuicksortRecur(1, size)
        END;

    BEGIN
        { Read }
        ReadArr(size, arr);

        { Sort the contents. }
        Quicksort(size, arr);

        { Print. }
        FOR i := 1 TO size DO
            writeln(arr[i])
    END.
 
  • Ја почнал/а темата
  • #12

Aleks

Gaining Experience
18 мај 2007
5,748
288
Binary to Decimal

Код:
program BinToDec;

var
  Broj:String;
  dolzina,p:Integer;
  I,dec,K,R:Integer;
  ValErr:Integer;
begin
  WriteLn('Vnesete nekoj binaren broj: ');
  ReadLn(Broj);

  dolzina:=length(Broj);
  dec:=0;
  R:=1;

  for i:=1 to dolzina do
    begin
      r:=1;

      for K:=1 to dolzina-i do
        begin
          R:=R*2;
        end;

    val(Broj[i],p,valerr);
    //writeln('p vo ciklus br. ',i,' e ',p,' a r:= ',r);
    dec:=dec+(p*r);

    end;

  WriteLn('Decimalniot broj kje e : ',Dec);
end.
 
10 ноември 2009
2
0
Здраво на сите

јас сум нов на форумов денеска го отворив профилов. па ве молам ако можи некој да ми прати код за КВАДРАТНА РАВЕНКА.
Ми треба за утре. ФАЛА
 
19 август 2009
440
14
Да но секогаш не се решенија. Треба и да се проверат дали се решенија. Може да биде само едно или да нема. Проверката се прави преку решавање или преку наоѓање на интервал и споредба дали добиените решенија се наоѓаат во тој интервал.
 

Нови мислења

Последни Теми

Статистика

Теми
43,557
Мислења
823,248
Членови
28,062
Најнов член
Nacev
На врв Дно