Pascal Programming Examples

marksix

pascal

PROGRAM mark_six;

CONST
  NumBalls = 49;

VAR
  pick  : array[1..6] of integer;  (* store user's guess *)
  draw  : array[1..7] of integer;  (* Store 7 numbers drawn *)
  i     : integer;  (* loop counter *)

(* This procedure was done for you to ramdomly draw 7 numbers *)
PROCEDURE DrawNumbers;
   VAR
     pool  : array[1..NumBalls] of integer;
     position, temp : integer;
   BEGIN
      FOR i:=1 TO NumBalls DO
         pool[i] := i;
      randomize;
      FOR i := 1 to NumBalls DO BEGIN
        position := random(NumBalls) + 1;
        temp := pool[position];
        pool[position] := pool[i];
        pool[i] := temp
      END;
      FOR i := 1 to 7 DO
        draw[i] := pool[i]
   END;

(* This procedure sorts the first 6 numbers and display all the 7 numbers after sorting *)
PROCEDURE SortandDisplay;
   VAR pass, temp: integer;
   BEGIN
    for pass:=1 to 5 do
     for i:=1 to 6-pass do
      if pick[i]>pick[i+1]
       then begin
        temp:=pick[i];
   
   
    
   END;



(* This procedure searches for any match and print the result of the game *)
PROCEDURE AnnounceResult;
   VAR
   BEGIN

   END;



BEGIN (* Main Program *)
   write('Pick 6 numbers (1-', NumBalls, '): ');
   FOR i:=1 TO 6 DO
      read(pick[i]);
   readln;

   DrawNumbers;
   SortandDisplay;
   AnnounceResult
END.

aaaa

pascal

Program HelloWorld(output);
begin
  writeln('Hello, world!');
end.

NumberNames

pascal

program NumberNames;

uses sysutils;

var
  number: string;
  pos, digitCounter: integer;
  digitNames: array [0..19] of string = ('', 'one', 'two', 'three', 'four', 'five', 'six', 'seven', 'eight', 'nine', 'ten', 'eleven', 'twelve', 'thirteen', 'fourteen', 'fifteen', 'sixteen', 'seventeen', 'eighteen', 'nineteen');
  tens: array [0..9] of string = ('', '', 'twenty', 'thirty', 'forty', 'fifty', 'sixty', 'seventy', 'eighty', 'ninety');
  thousands: array [0..2] of string = ('', ' thousand ', ' million ');
  numberName: array [1..99] of string;

begin
  writeln('Enter a number between 1 and 1 million');
  readln(number);
  while length(number) mod 3 <> 0 do
    number := concat('0', number);
  pos := length(number);
  digitCounter := 1;
  while pos > 0 do
    begin
      if digitCounter mod 3 = 1 then
        numberName[pos] := digitNames[strtoint(number[pos])]
      else if digitCounter mod 3 = 2 then
        begin
          if number[pos] = '1' then
            numberName[pos + 1] := digitNames[strtoint(concat(number[pos], number[pos + 1]))]
          else
            begin
              numberName[pos] := tens[strtoint(number[pos])];
              if (numberName[pos] <> '') and (numberName[pos + 1] <> '') then
                numberName[pos] := concat(numberName[pos], ' ');
            end;
        end
      else
        begin
          numberName[pos] := digitNames[strtoint(number[pos])];
          if numberName[pos] <> '' then
            numberName[pos] := concat(numberName[pos], ' hundred ');
          if (numberName[pos] <> '') or (numberName[pos + 1] <> '') or (numberName[pos + 2] <> '') then
            numberName[pos + 2] := concat(numberName[pos + 2], thousands[(digitCounter div 3) - 1]);
        end;
      pos -= 1;
      digitCounter += 1;
    end;
  for pos := 1 to length(number) do
    write(numberName[pos]);
  readln;
end.

Ñ„Ñ„Ñ„Ñ„

pascal

Program h;
var a,b,c,d: integer;
begin
  write('Введите число секунд: ');
  readln(a);
  a:=9780;
  writeln(a);
  b:=a div 3600;
  c:=(a-b*3600) div 60;
  d:=a-b*3600-c*60;
  write(b,' ч. ', c, ' мин. ', d, ' c. ');
end.

Compile and Execute Pascal Online

pascal

Program HelloWorld(output);
begin
  writeln('Hello, world!');
  readln()
end.

Compile and Execute Pascal Online

pascal

Var a,b,c,x:integer;
begin 
    x:=random (899) +100; 
    writeln('x= ', x); 
    a:= x div 100;  {первая цифра}
    b:=(x mod 100) div 10;  {вторая цифра}
    c:= x mod 10;  {третья цифра}
    writeln(a,',',b,',',c); 
end.

uloha14-sustavy

pascal

uses crt;
var n,s,i,f,m,x,g:integer;
    a:array [1..100] of integer;
    c,male:char;

procedure sustavy;
begin
i:=1;
f:=0;
g:=n;
 repeat
 x:=g mod s;
 g:=g div s;
 a[i]:=x;
 i:=i+1;
 f:=f+1;
 until g=0;
for i:=f downto 1 do
write('' ,a[i]);
writeln;
end;


begin
clrscr;
writeln('zadajte cislo z intervalu <32,127>');
readln(n);
writeln('previest do sustavy (2-9): ');
readln(s);
sustavy;
c:=chr(n);
writeln('ascii znak ',c);
if n>= 97 then writeln('opacny znak je ' , upcase(c))
          else  begin n:=n+32; male:=chr(n); writeln('opacny znak je ' ,male); end;
{sustavy;}
readln;
end.

decode

pascal

Program decrypt;
const
max=122;
min=65;
var input:string;
var character:char;

function decrypt:string;
var i,ascii :integer;
var result:string;
begin
result:='the real string is ';
i:=1;
while i<=length(input) do
  begin
      character:=input[i];
        ascii:=ord(character)-3;
      if ascii>=min then
        begin
          result:=result+chr(ascii);
          i:=i+1;
        end
      else if (ascii=32) then
        begin
          result:=result+' ';
          i:=i+1;
        end
        else
          begin
            ascii:=min-ascii+max;
            result:=result+chr(ascii);
            i:=i+1;
          end;
  end;
decrypt:=result;
end;  
begin
  readln(x);
  writeln(decrypt);

end.

encode(final)

pascal

Program encrypt;
const
max=122;
min=65;
var input:string;
var character:char;

function encode:string;
var i,ascii :integer;
var result:string;
begin
result:='the string is ';
i:=1;
while i<=length(input) do
  begin
      character:=input[i];
      ascii:=ord(character)+3;
      if ascii<=max then
        begin
        result:=result+chr(ascii);
        i:=i+1;
        end
        else
          begin
            ascii:=ascii-max+min;
            result:=result+chr(ascii);
            i:=i+1;
          end;
  end;
encode:=result;
end;  
begin(*main program*)
  readln(x);
  writeln(encode);

end.

input_and_separation

pascal

Program readln_and_separate;
  var
    result : array[1..100] of string;
  var
    input:string;
  var 
    i:integer;
begin
i:=1;
writeln('plz write:');
readln(input);
while i<=length(input) do
  begin
    result[i]:=copy(input,i,1);
    writeln(result[i]);
    i:=i+1;
  end;

end.

Follow

Newsletter