Pascal Programming Examples

square

pascal

 Var a,b,s:integer;
begin
 a:=6;
 b:=7;
 s:=a*b;
 writeln(s);
end.

helllo

pascal

Program Hello;
begin
  writeln('Привіт, світ!');
End.

Number Names

pascal

program numbernames;
//Jonas Yip
var
  aunit : array[1..9] of string = ('one','two','three','four','five','six','seven','eight','nine');
  tens : array[1..9] of string = ('ten','twenty','thirty','forty','fifthty','sixty','seventy','eighty','ninety');
  irregular : array[1..9] of  string = ('eleven','tweleve','thirteen','fourteen','fithteen','sixteen','seventeen','eighteen','nineteen');
  input : string;


function getUnit(nUnit : string) : string;
var
  unitDigit,error : integer;
  word : string;
begin
  val(nUnit,unitDigit,error);
  if (unitDigit <> 0) then
    word := aunit[unitDigit]
  else
    word := 'zero';
  getUnit := word;
end;

function getTenth(nTenth : string) : string;
var
  error,unitDigit,TenthDigit,number : integer;
  word : string;
begin
  val(nTenth,number,error);
  if (number>10) and (number <20) then
  begin
    val(nTenth[2],unitDigit,error);
    word := irregular[unitDigit];
  end
  else
    begin
      val(nTenth[1],TenthDigit,error);
      val(nTenth[2],unitDigit,error);
      word := tens[TenthDigit];
      if (unitDigit>0) then
        word := word + '-' + getUnit(nTenth[2]);
    end;
  getTenth := word;
end;
function getHundred(number : string) : string;
var
  error,hundrethDigit,uUnit,nTenth : integer;
  word,twoDigit : string;
begin
  if (number[2]='0') and (number[3]='0') then
    word := getUnit(number[1]) + ' hundred'
  else if (number[2]='0') then
    word := getUnit(number[1]) + ' hundred ' + getUnit(number[3])
  else
    begin
      twoDigit := number[2] + number[3];
      word := getUnit(number[1]) + ' hundred ' + getTenth(twoDigit);
    end;
  getHundred := word;
end;
function getThousand(number : string) : string;
begin
  getThousand := getUnit(number[1]) + ' thousand ' + getHundred(copy(number,2,3));
end;
function getTenThousand(number : string) : string;
var
  word : string;
begin
  if (number[3] = '0') and (number[4]='0') then
    word := getTenth(copy(number,1,2)) + ' thousand ' + getUnit(copy(number,5,1))
  else if (number[3] = '0') then
    word := getTenth(copy(number,1,2)) + ' thousand ' + getTenth(copy(number,4,2))
  else
    word := getTenth(copy(number,1,2)) + ' thousand ' + getHundred(copy(number,3,3));
  getTenThousand := word;
end;

function getHundredThousand(number : string) : string;
var
  word : string;
begin
  if (number[2] = '0') and (number[3] = '0') then
    word := getUnit(number[1]) + ' hundred ' + getHundred(copy(number,4,3))
  else if (number[2] = '0') then
    word := getUnit(number[1]) + ' hundred ' + getThousand(copy(number,3,4))
  else
    word := getUnit(number[1]) + ' hundred ' + getTenThousand(copy(number,2,5));
  getHundredThousand := word;
end;

function getMillion(number : string) : string;
var
  word : string;
begin
  word := getUnit(number[1]) + ' million ' + getHundredThousand(copy(number,2,6));
  getMillion := word;
end;
procedure numberName(numberStr : string);
var
  word : string;
  error,unitDigit,TenthDigit,number : integer;
begin
  case length(numberStr) of
    1 : word := getUnit(numberStr);
    2 : word := getTenth(numberStr);
    3 : word := getHundred(numberStr);
    4 : word := getThousand(numberStr);
    5 : word := getTenThousand(numberStr);
    6 : word := getHundredThousand(numberStr);
    7: word := getMillion(numberStr);
  end;
  writeln(word);
end;
procedure loop();
var
  count : integer;
  strNum : string;
begin
  for count := 1000000 to 9999999 do
  begin
    str(count,strNum);
    numberName(strNum);
  end;
end;
begin
  write('Enter number > ');
  readln(input);
  numberName(input);
  //loop();
  readln;

end.

Compile and Execute Pascal Online

pascal

//  Brandon Treno
//  DONT FORGET TO FILL OUT A HEADER AND COMMENTS
//  ..................................................
//

Program ElectionResults(input, output);
{$mode objfpc} // directive to be used for defining classes
{$m+}		   // directive to be used for using constructor

// Begin Candidate class 
type
    Candidate = class
    private
        name: string;
        votes: integer;
        
    public
        constructor create(_name: string; _votes: integer);
        function getName(): string;
        function getVotes(): integer;
end;

type
    // array of Candidates
    CandidateArray = array of Candidate;

// Variables
var
    totalVotes, numCandidates, i: integer;
    candidates: CandidateArray;

// Candidate class functions + constructor
constructor Candidate.create(_name: string; _votes: integer);
begin
    name := _name;
    votes := _votes;
end;

function Candidate.getName(): string;
begin
    getName := name;
end;

function Candidate.getVotes(): integer;
begin
    getVotes := votes;
end;

// Functions and Procedures
(*reads 2 lines of stdin, makes a candidate obj, and returns the votes received*)
function readCand(): Candidate;

var
    name: string;
    votes: integer;
    can: Candidate;

begin
    readln(name);
    readln(votes);
    
    can.create(name, votes);
    readCand := can;
end;

// procedure to make a candidate object add it to array and increment
// totalVotes
// function to find the percentage of total votes
begin
    //get num at start of file and set length of Candidate array
    readln(numCandidates);
    setLength(candidates, numCandidates);
    
    //initialize
    totalVotes := 0;
    
    //read all candidate names and votesReceived; store in candidates[i]
    for i := 1 to numCandidates do
    begin
        candidates[i] := readCand();
        
        totalVotes := totalVotes + candidates[i].getVotes();
        writeln(totalVotes);
    end;
    
    
end.

FizzBuzz

pascal

program Fizzbuzz;
//Jonas Yip
uses Math,StrUtils;
var Max_Number,i,Base_1,Base_2 : integer;
    Boo_Fizz,Boo_Buzz,Boo_FizzBuzz,Output,Index : string; //Boo - Boolean
procedure Start;
begin
  write('Maxinmum Number | Base 1 | Base 2 // i.e 10 2 3 ');
  try
     readln(Max_Number,Base_1,Base_2);
  except try
         Start;
  finally end;
  end; //Validation end
  for i:=1 to Max_Number do //Loop!
    begin
      Str(i,Index); //Change i into a string
      //[Note] Declaring datatypes in the ternary condition operators
      Boo_Fizz := IfThen((i mod Base_1) = 0, 'Fizz', Index); //Ternary operator
      Boo_Buzz := IfThen((i mod Base_2) = 0, 'Buzz', Index);
      Boo_FizzBuzz := IfThen(((i mod Base_1) = 0) and ((i mod Base_2) = 0), 'FizzBuzz', Index);
      Output := IfThen(Boo_Fizz = Boo_Buzz, Index, 'False'); //Pre assigned first
      if (Boo_FizzBuzz = 'FizzBuzz') then
         Output := Boo_FizzBuzz //Check first
      else if (Boo_Buzz = 'Buzz') then
         Output := Boo_Buzz
      else if (Boo_Fizz = 'Fizz') then
         Output := Boo_Fizz; //Last statement
      writeln(Output);
    end;
  Start;
end;
begin
  Start;
  readln;
end.

Logic Gate

pascal

program LogicGate;
//Jonas Yip
uses Math,StrUtils,SysUtils;
var
  First_Input,Second_Input,Output : integer;
  Gate : string;
  B_First , B_Second : integer;
procedure Start;
begin
    writeln('Choose a gate AND, OR, NOT, XOR, NAND, NOR');
    readln(Gate);
    if MatchStr(Gate, ['AND','OR','NOT','XOR','NAND','NOR']) then begin //A Match
      write('First input '); //Validation
      try
      readln(First_Input);
      try except
        Start; //Loops
        end;
      finally //Continues if everything is fine
      B_First := IfThen(((First_Input= 0) or (First_Input = 1)), 1, 0);
      if(Gate <> 'NOT') and (B_First = 1) then begin //NOT gate has one input
              write('Second input ');
              try
                 readln(Second_Input);
              except
                Start; //Restart
              end;
              end;
      //Condition for two inputs

      end;
    end

    else
    Start; //Loops
end;
begin // //
  while true do begin //Indefinite loop
      Start;  //Validation loop
      //if((First_Input <> 0) or (First_Input <> 1)) or ((Second_Input <> 1) or (Second_Input <> 0)) then Start;
      case Gate of //Gate selection
           'AND' : Output := IfThen((First_Input=1) and (Second_Input=1),1,0); //Ternary operator
           'OR' : Output := IfThen((First_Input=1) or (Second_Input=1), 1,0);
           'NOT' : Output := IfThen(First_Input=1,0,1);
           'XOR' : Output := IfThen(((First_Input=1) and (Second_Input=1) or
             (First_Input=0) and (Second_Input=0)),0,1);
           'NAND' : Output := IfThen((First_Input=1) and (Second_Input=1),0,1);
           'NOR' : Output := IfThen((First_Input=0) and (Second_Input=0),1,0);
      else;

      end;
      writeln('Output : ',Output);
      readln;

  end;
end.

hw1

pascal

var num,times,re:integer;
    begin
    times:=0;
    writeln('Input a number?');
    readln(num);
    writeln('Initial value is ', num);
    while num > 1 do
        begin 
        re:= num mod 2;
            if re =0 then
            num:= num/2 else
                num:= num*3 + 1;
                times:= times+1 
                end
    end.

Sum_series

pascal

//Write a program in Pascal to find the sum of the series 1 +11 + 111 + 1111 + .. n terms.
Program sum_series;
var t, n, i, total, sum :integer;
begin
   t:= 1;
   writeln('Input the number of terms: ');
   readln(n);
   for i:= 1 to n do
      begin
         write(t);
         if (i < n) then
             write(' + ');
         sum := sum + t;
         t := (t *10) + 1;
      end;
   writeln;   
   writeln('The sum is : ', sum);
end.

fett

pascal

Program NoName; 

Var 
  b,x,z,c,v,q,w,e:integer; 
   n:array [ 1..3 ] of integer; 
   s:array [ 1..6 ] of integer; 
   a:array [ 1..7 ] of boolean; 

Begin 
  b:=1; a[7]:=false;
  for x:=1 to 6 do 
    Begin 
      ReadLn( s[x]);
      a[x]:=false; 
    end; 
  for z:=1 to 4 do
    for x:=z+1 to 5 do
      for c:=x+1 to 6 do 
        Begin 
          a[z]:=true; 
          a[x]:=true; 
          a[c]:=true; 
          for v:=1 to 6 do 

              if a[v]=false then 
                Begin 

                  n[b]:=v;
                  b:=b+1; 
                end; 

          q:=n[1]; 
          w:=n[2]; 
          e:=n[3]; 
          b:=1; 
          for v:=1 to 3 do 
            n[v]:=0; 
              if s[z]+s[x]+s[c]=s[q]+s[w]+s[e] then
              a[7]:= true;
          for v:=1 to 6 do 
            a[v]:=false;
        end; 
        If a[7]=false then 
        WriteLn( 'NO' )
        else
        WriteLn( 'YES' );
end.

Credit Card Validator

pascal

program CreditCardValidator; // COPY INTO LAZARUS TO RUN

uses sysutils;

var
  cardNum: string;
  total, digit, currentDigit: integer;

begin
  while true do
    begin
      writeln('Enter a 16-digit credit card number: ');
      readln(cardNum);
      total := 0;
      for digit := 1 to 15 do
        begin
          if digit mod 2 = 1 then
            begin
              currentDigit := strtoint(cardnum[digit]) * 2;
                while length(inttostr(currentDigit)) <> 1 do
                  currentDigit := strtoint(inttostr(currentDigit)[1]) + strtoint(inttostr(currentDigit)[2]);
              total += currentDigit;
            end
          else
            total += strtoint(cardNum[digit]);
        end;
      if strtoint(cardNum[16]) = 10 - (total mod 10) then
        writeln('Credit card valid!')
      else
        writeln('Invalid credit card!');
    end;
end.

Follow

Newsletter