technology

Pascal Compiler Online:

rextester / jdoodle / tutorialspoint /codingground /onlinecompiler

Open source compiler for PASCAL:

For many platforms, cpu and operating systems:free pascal / free pascal(sourceforge)/
Lazarus (Delphi IDE for Free Pascal) / Dev-Pascal (IDE for Free Pascal) / / X-Dev-Pascal (IDE for Free Pascal)
GNU Pascal
newpascal


Hello World!OperatorsInput/OutputTypes
Selection or conditional statements: if-else, case
Iterations statements: for, while, repeat-until
Jumps:break-continue
Procedures/FunctionsArraysStringsFilesPointersCRT FunctionsMath FunctionsGraphics

Operators

operatordescription
Arithmetic
+Addition
-Subtraction
*Multiplication
/Real division
divInteger division
modModulus
Relational
=Equal to
<>Not equal to
<Less than
>Greater than
<=Less than or equal to
>=Greater than or equal to
Logical or Boolean
notnot
andand
oror
right operands are evaluated only when necessary
and thenand
or elseor
Bit or Bitwise
˜not; ones complement
&and
|or
!or
<<shift left
>>shift right
Bit (Free Pascal)
notnot
andand
oror
xorxor
shlshift left
shrshift right


Hello World / hold the output screen

  • program Hello1;
    
    (*comment*)
    begin
       writeln('Hello, World!');
       readln;{wait for press ENTER}
    end. 
    
  • program Hello2;
    uses crt;
    
    begin
       clrscr;
       writeln('Hello, World!');
       readkey;{wait for press a key}
    end. 
    



INPUT and OUTPUT

  • program input1;
    uses crt;
    var
         a,b : integer;
    begin
         writeln('Enter two integers');
         read(a);
         read(b);
         write(a);
         write(b);
         readkey;
    end.
    
  • program input1;
    uses crt;
    var
         a,b : integer;
    begin
         writeln('Enter two integers');
         readln(a);
         read(b);
         writeln(a);
         write(b);
         readkey;
    end.
    



Types, Records

integerReal
Byte, Shortint, Smallint, Word, Integer, Cardinal, Longint, Longword, Int64, QWordReal, Single, Double, Extended, Comp, CurrencyBoolean, ByteBool, WordBool, LongBool

  • program types;
    
    type
        Str10 = String[10];
        Rec = Record
                    s1, s2 : Str10;
                    d1 : Double;
               End;
    
    var
        i,i2 : integer;
        r,r2 : real;
        rec1 : Rec;
        c : char;
        b: boolean;
    
    begin
       i:=43;
       r:=2.5678;
       c:='a';
       b:=true;
       rec1.s1 := '0123456789';
       rec1.s2 := 'abcdefghij';
       rec1.d1 := 5.1234567890123;
       writeln('i: ', i:15);
       writeln('r : ',r);
       writeln('trunc(r) : ',trunc(r));
       writeln('round(r) : ',round(r));
       writeln('int(r) : ',int(r));
       writeln('r : ',r:7:5);
       writeln('c :', c:10);
       writeln(maxint);
       r2 := i + r;
       writeln('i+r : ',r2:7:2);
       i2 := i + round(r);
       writeln('i+r : ',i2);
       writeln('i/r : ',i/r);
       writeln(i div round(r));
       writeln('b : ',b);
       Writeln (Pi);  {3.1415926}
       With rec1 do
       Begin
            Writeln(s1);
            Writeln(s2);
            Writeln(d1);
       End;
       Readln;
    end.
    
  • program Records;
    
    type
        Str10 = String[10];
        Rec = Record
                    s1, s2 : Str10;
                    lw : Longword;
               End;
    
    var
        rec1 : Rec;
    
    Procedure DisplayRec(myRec : Rec);
    Begin
         Writeln (myRec.s1);
         Writeln(myRec.s2);
         Writeln(myRec.lw);
    End;
    
    
    begin
       rec1.s1 := '0123456789';
       rec1.s2 := 'abcdefghij';
       rec1.lw := 321654987;
       DisplayRec(rec1);
       Readln;
    end.
    



Control Flow

Selection or conditional or Choice statements:

  • program if1;
    uses crt;
    var
         a,b : integer;
    begin
         writeln('Enter an integer');
         readln(a);
         if( a <5 ) then
             write(a);
             writeln(' is less than 5');
         readkey;
    end.
    
  • program ifelse1;
    uses crt;
    var
       a : integer;
    
    begin
       writeln('Enter an integer');
       readln(a);
       clrscr;
       gotoXY(7,10);
       write(a);
       if( a < 5 ) then
          writeln(' is less than 5':20 )
       else
          writeln( ' is greater than 5':20 );
       readkey;
    end.
    
  • program elseif2;
    uses crt;
    var
       a : integer;
    
    begin
       writeln('Enter an integer');
       readln(a);
       clrscr;
       write (a);
       if (a = 0)  then
          writeln(' is 0' )
       else if ((a > 5) and (a <10)) then
          writeln(' is OK' )
       else if( a = 10 ) then
          writeln(' is 10' )
       else
          writeln(' is > 10' );
       Readkey;
    end.
    
  • program case2;
    uses crt;
    var
       a : integer;
    
    begin
       writeln('Enter your grade:(1-10)');
       readln(a);
       clrscr;
       write (a);
       case (a) of
            5: writeln(' almost good');
            6: writeln(' good');
            7,8: writeln(' better than good');
            9,10: writeln(' excellent');
       else
          writeln(' try again');
       end;
       Readkey;
    end.
    

Looping or iteration statements:

  • program whileLoop;
    uses crt;
    var
       a : integer;
    
    begin
       writeln('Enter a integer (1-20)');
       readln(a);
       while  a > 0  do
       begin
          writeln(a:2,'* 2= ', a*2:5);
          a := a-1;
       end;
       Readkey;
    end.
    
  • program forLoop;
    uses crt;
    var 
     a:char; 
    begin 
      for a:='a' to 'z' do 
          write(a:5, '=', ord(a));
      Readkey;
    end.
    

  • program repeatLoop;
    uses crt;
    var
       a:byte;
    
    begin
       a := 30;
       repeat
          write(chr(a));
          a := a + 1
       until a = 127;
       Readkey;
    end.
    
  • 
    


break and continue

  • program Break1;
    uses crt;
    var
       a: integer;
    
    begin
       writeln('Enter a integer (1-20)');
       readln(a);
       while  a < 23 do
       begin
          writeln('a: ':7, a);
          a:=a +1;
          if(a mod 7=0) then
          break;
       end;
       Readkey;
    end.
    
  • program Continue1;
    uses crt;
    var
       a: integer;
    
    begin
       writeln('Enter a integer (1-20)');
       readln(a);
       while  a < 23 do
       begin
          a:=a +1;
          if(a mod 3=0) then
          continue;
          writeln('a: ':7, a);
       end;
       Readkey;
    end.
    


Procedures and Functions

  • program Procedure1;
    uses crt;
    var
       a, b, max: integer;
    procedure fMax(x, y: integer; var m: integer);
    begin
       if x > y then
          m:= x
       else
          m:= y;
    end;
    
    begin
       writeln(' Enter two numbers: ');
       readln( a, b);
       fMax(a, b, max);
       writeln(' Maximun: ', max);
       Readkey;
    end.
    
  • program Function1;
    uses crt;
    var
       a, b, c: integer;
    function min(x, y: integer): integer;
    var
      m: integer;
    begin
       if x < y then
          m:= x
       else
          m:= y;
       min := m;
    end;
    
    begin
       writeln(' Enter two numbers: ');
       readln( a, b);
       c:=min(a,b);
       writeln(' Minimun: ', c);
       Readkey;
    end.
    


Arrays

  • program Array1;
    uses crt;
    var
       n: array [1..26] of char;
       i, j: integer;
    
    begin
       for i := 1 to 26 do
           n[ i ] := char(i+96);
       for j:= 1 to 26 do
          writeln('[', j, '] = ', n[j] );
       Readkey;
    end.
    
  • program Array2;
    uses crt;
    var 
       a: array [0..2, 0..2] of integer;
       i,j : integer;  
    
    begin  
       for i:=0 to 2 do
          for j:=0 to 2 do
             a[i,j]:= i*10+j;
       
       for i:=0 to 2 do
       begin  
          for j:=0 to 2 do
             write(a[i,j]:3);
          writeln;  
       end;  
       Readkey;
    end.
    

  • program array3;
    uses crt;
    const
       size = 4;
    type
       a = array [1..size] of integer;
    var
       input:  a;
       mean: real;
    function am( var arr: a) : real;
    var
       i :1..size;
       sum: integer;
    begin
       sum := 0;
       for i := 1 to size do
          sum := sum + arr[i];
       am := sum / size;
    end;
    begin
       writeln(' Enter four numbers: ');
       readln( input[1], input[2],input[3],input[4]);
       mean := am( input ) ;
       writeln( 'Arithmetic Mean is: ', mean:10:2);
       Readkey;
    end.
    



Strings

  • program string1;
    uses crt;
    var
       str1: string;
       str2: packed array [1..10] of char;
       str3: string[10];
       str4: pchar;
       str5:ansistring;
    
    begin
       str1 := 'abcd';
       str2 := 'ABCD';
       
       writeln('Enter your Name');
       readln(str3);
       
       str4:='hhhh';
       str5:='1234';
       
       writeln(str1,str2);
       writeln(str3);
       writeln(str4,str5);
       Readkey;
    end.
    
  • program string2;
    
    Var
      str1 : String;
      i: integer;
    Begin
      str1 := 'abcdefghijklmnopqrstuvwxyz';
      for i:=1 to 26 do
        write(char(str1[i]):2);
      Writeln;
      Writeln(byte(str1[0]));
      Writeln(Length(str1));
      Writeln(str1[byte(str1[0])]);
    
      Readln;
    end.
    

  • program string2;
    
    Var
      str1,str2, str3, str4, str5, str6 : String;
      i , error : integer;
      r : real;
    Begin
      str1 := 'abcdefghijklmnopqrstuvwxyz';
      str2 := '0123456789';
      r := -0.789;
      for i:=1 to length(str1) do
        write(char(str1[i]):2);
      Writeln;
      Writeln(Pos('f', str1));
    	If Pos('5', str1) <= 0 Then
    		Writeln('"5" is not found.');
       str4 := Copy(str1, 10, 7);
       Writeln(str4);
       Delete(str1, 4,5);
       Writeln(str1);
       Insert('12345',str1,4);
       Writeln(str1);
       str3 := Concat(str1, str2);
       Writeln(str3);
       Writeln(str3+str4);
       str5 := UpCase(str1);{LowerCase}
       Writeln(str5);
       Str(r, str6);
       Writeln(str6);
       Val(str2, r, error);
       If error > 0 Then
      	Write('Error in conversion.')
       Else
    	Write(r);
       Readln;
    end.
    



Files

  • program WritingFiles;
    type
      dataFile= Record
          str1: String;
          r1: Real;
          i1: Integer;
      end;
    var
      data1: dataFile;
      f: file of dataFile;
    begin
      Assign(f,'file1.dat');
      Rewrite(f); {Erase(f)}
      With data1 do 
      Begin
        str1 := 'str1 str1 str1 str1';
        r1 := pi;
        i1 := 100;
      End;
      Write(f,data1);
      Close(f);
    end.
    
  • program ReadingFiles;
    type
      dataFile= Record
          str1: String;
          r1: Real;
          i1: Integer;
      end;
    var
      data1: dataFile;
      f: file of dataFile;
    begin
      Assign(f,'file1.dat');
      reset(f);
      while not eof(f) do
       begin
            read(f,data1);
            writeln('str1: ', data1.str1);
            writeln('real: ', data1.r1);
            writeln('integer: ', data1.i1);
      end;
      close(f);
      readln;
    end.
    

  • program WritingTextFiles;
    
    var
      filename: string;
      file1: text;
    begin
      writeln('File name: ');
      readln(filename);
      assign(file1, filename+'.txt');
      rewrite(file1);
      writeln(file1, 'aaa aaa aaa aaa aaa');
      writeln(file1, 'bbb bbb bbb bbb');
      writeln(file1, 'ccc ccc ccc');
      writeln('End of writing');
      close(file1);
      readln;
    end.
    
  • program AppendTextFiles;
    
    var
      filename: string;
      file1: text;
    begin
      writeln('File name: ');
      readln(filename);
      assign(file1, filename+'.txt');
      append(file1);
      writeln(file1, '1111 1111 1111');
      writeln(file1, '2222 2222');
      writeln('End of writing');
      close(file1);
      readln;
    end.
    

  • program ReadingTextFiles;
    
    var
      filename, data: string;
      file1: text;
    begin
      writeln('File name: ');
      readln(filename);
      assign(file1, filename+'.txt');
      reset(file1);
      Repeat
         readln(file1, data);
         writeln(data);
      until Eof(file1);
      close(file1);
      readln;
    end.
    
  • 
    

  • program WritingBinaryFiles;
    uses crt;
    type
       Rec = record
                      color    : string[20];
                      number     : byte;
                  end;
    
    var
       f : file of Rec;
       c : char;
       r : Rec;
       s : string;
       n : integer;
    begin
       clrscr;
       write('file name : ');
       readln(s);
       assign(f,s);
       reset(f);
       n:=IOResult;
       if n<>0 then
       begin
             rewrite(f);
             n:=IOResult;
             if n<>0 then
             begin
                  writeln('Error ');
                  halt;
             end;
       end
       else
       begin
          n:=filesize(f);
          seek(f,n); {pointer to the last record}
       end;
       c:='y';
       while not (c='n') do
       begin
          clrscr;
          writeln('File position : ',filepos(f));
          write('Color    = '); readln(r.color);
          write('Number     = '); readln(r.number);
          write(f,r); {binary:write text:writeln}
          write('Other record (Y/N) ?');
          repeat
             c:=lowercase(readkey);
          until c in ['y','n'];
          writeln(c);
       end;
       close(f);
    end.
    
  • program ReadingBinaryFiles;
    uses crt;
    type
       Rec = record
                      color    : string[20];
                      number     : byte;
                  end;
    
    var
       f : file of Rec;
       c : char;
       r : Rec;
       s : string;
       n : integer;
    begin
       clrscr;
       write('file name : ');
       readln(s);
       assign(f,s);
       reset(f);
       n:=IOResult;
       if n<>0 then
       begin
             reset(f);
             n:=IOResult;
             if n<>0 then
             begin
                  writeln('Error ');
                  halt;
             end;
       end
       else
       begin
          n:=filesize(f);
          seek(f,0); {pointer to the first record}
       end;
       repeat
          clrscr;
          read(f,r);
          writeln('File position : ',filepos(f));
          write(' Color    = ', r.color);
          write(' Number     = ',r.number);
          writeln;
          writeln('Other record (y/n) ?');
          repeat
             c:=lowercase(readkey);
          until c in ['y','n'];
          writeln(c);
       until c='n';
       close(f);
    end.
    




Pointers

  • Program Pointers1;
    var
      i1: integer;
      iptr1, iptr2: ^integer;
      y1, y2: ^word;
    begin
      i1 := 100;
      iptr1 := @i1;
      writeln('i1: ', i1, ' iptr1 : ', iptr1^);
      iptr1^ := 200;
      iptr2 :=nil;
      writeln('i1: ', i1, ' iptr1 : ', iptr1^);
      y1 := addr(iptr1);
      y2 := addr(iptr2);
      writeln('addr1 : ', y1^, ' addr2 : ', y2^ );
      readln;
    end.
    
  • 
    




CRT Functions

  • program Cathode_Ray;
    uses crt;
    
    begin
      Textbackground(white);
      ClrScr;
      Window(10,10,50,20);
      WriteLn('default color');
      TextColor(Red);
      WriteLn('Red');
      TextColor(Green);
      WriteLn('Green');
      TextColor(Blue);
      WriteLn('Blue');
      Window(1,1,80,25);{Full Screen: 80x25}
      Writeln('Press a key');
      ReadKey;
      TextColor(White);
      TextBackground(Red);
      WriteLn('Red background');
      TextBackground(Green);
      WriteLn('Green background');
      TextBackground(Blue);
      WriteLn('Blue background');
      LowVideo;
      WriteLn('LowVideo');
      HighVideo;
      WriteLn('HighVideo');
      NormVideo;
      WriteLn('NormVideo');
      Writeln(' X=',WhereX,' Y=',WhereY);
      Delay(1000);
      Write(' 1 ');
      Delay(1000);
      Write(' 2 ');
      Delay(1000);
      Write(' 3 ');
      GotoXY(20,10);
      Textbackground(5);
      Writeln('x :20, y :10');
      Readln;
    end.
    
  • Program Arrow;
    uses Crt;
     
    var
      key : char;
    begin
      writeln('Press Up/Down-Left/Right, Esc=Quit');
      repeat
        key:=ReadKey;
        case key of
         #0 : begin {Extended keys}
                key:=ReadKey;
                case key of
                 #72 : WriteLn('Up');
                 #80 : WriteLn('Down');
                 #75 : WriteLn('Left');
                 #77 : WriteLn('Right');
                end;
              end;
        #27 : WriteLn('ESC');
        else Writeln('NO Arrow key');
        end;
      until key=#27 {Esc}
    end.
    

  • program keyboard;
    uses CRT;
    var 
       key: char;
       ExtChar: boolean; 
    begin 
       key := #0;
       writeln('Press any key or key combination');
       writeln('To quit, press Escape.'); 
       while key<>#27 do begin {Escape}
          key := ReadKey;
          ExtChar := key=#0; {Extended}
          if ExtChar then begin 
             key := ReadKey;
             write('Extended key: ');
          end
          else 
             write('Ordinary key: ');
             writeln(key,' ASCII: ',Ord(key));
       end;
    end. 
    
  • 
    




Math Functions

  • Program Maths;
    Uses math;
    
    Type
      arr = Array[1..100] of Integer;
    var
      x,y: real;
      a,b,i: integer;
      arr1: arr;
    
    begin
      x:=pi/6;
      Writeln(' sin ( ',radtodeg(x):4:2,' ) = ', sin(x):4:2);
      Writeln(' cos ( ',radtodeg(x):4:2,' ) = ', cos(x):4:2);
      Writeln(' tan ( ',radtodeg(x):4:2,' ) = ', tan(x):4:2);
    
      x:=5.7;
      y:=3;
      Writeln(Ceil(x));
      Writeln(Log10(x):4:2);
      Writeln(Lnxp1(x):4:2);
      Writeln(Logn(x,3):4:2);
      Writeln(Log2(x):4:2);
      Writeln(power(x,y):4:2);
    
    
      a:=3;
      b:=517;
      Writeln(max(a,b));
      Writeln(min(a,b));
    
      Writeln(Random(b));
    
      Randomize;
      for I:=low(arr1) to high(arr1) do
        begin
          arr1[i]:=Random(100);
          write( arr1[i],' ');
        end;
      Writeln;
      Writeln('max : ',MaxValue(arr1));
      Writeln('min : ',MinValue(arr1));
      Readln;
    end.
    
  • 
    




Graphics

  • Program Graphics;
    uses crt,graph;
    
    procedure initG;
      var
        gd, gm : SmallInt;
      begin
        gd:=VGA; gm:=VGAHi;
        initgraph(gd, gm, '.\BGI'); {VGAHi (640x480x16)}
        gd:=graphresult;
        if gd<>grOK then
        begin
          writeln('Error : ');
          writeln(grapherrormsg(gd));
          halt;
        end;
      end;
    procedure closeG;
      begin
        closegraph;
        writeln('Closed');
      end;
    
    begin
      initG;
      setbkcolor(white);
      cleardevice;
      delay(1000);
      setcolor(red);
      settextstyle(1,0,1);
      {*font:0 to 9, direction: hor:0,ver:1,  size: 1 to 10*}
      outtext('MARIA');
      outtextxy(100,10,'FRANCISCO');
      delay(1000);
      setcolor(blue);
      settextjustify(0,3); {horizont,vertical}
      outtextxy(200,50,'Top left justification');
      settextjustify(2,2);
      outtextxy(200,60,'Top right justification');
      settextjustify(1,2);
      outtextxy(200,70,'Top center justification');
      delay(1000);
      setcolor(12);
      setusercharsize(3,1,1,1);{hor:a/b, ver:c/d}
      outtextxy(100,100,'hor3/1,ver1,1');
      setusercharsize(1,1,3,1);
      outtextxy(100,120,'hor1/1,ver1/3');
      readkey;
      closeG;
    end.
    
  • Program Graphics1;
    
    uses crt,graph;
    
    const
      shape1 : array[1..8] of word = ( 10,300 , 90,300 , 50,350, 10,300 );
      shape2 : array[1..8] of word = ( 20,400 , 80,400 , 50,450, 20,400 );
    procedure initG;
      var
        gd, gm : SmallInt;
      begin
        gd:=VGA; gm:=VGAHi;
        initgraph(gd, gm, '.\BGI'); {VGAHi (640x480x16)}
        gd:=graphresult;
        if gd<>grOK then
        begin
          writeln('Error : ');
          writeln(grapherrormsg(gd)); halt;
        end;
      end;
    procedure closeG;
      begin
        closegraph;
        writeln('Good bye!');
      end;
    
    begin
      initG;
      setbkcolor(cyan);
      cleardevice;
      delay(1000);
      line (0,0,639,479);
      rectangle(200,20, 400,100); {rectangle(x1,y1,x2,y2);}
      setcolor(11);
      rectangle(100,100,300,200);
      setfillstyle(6,5);{pattern number:0 to 12, fill color}
      floodfill(150,150,11);  {start:x,y. border color }
      setfillstyle(1,red);
      bar(20,200,50,150);{bar(x1,y1,x2,y2);}
      drawpoly(4,shape1); {number vertex+1,array of coordinates (X,Y)}
      setfillstyle(1,blue);
      fillpoly(4,shape2);
      readkey;
      closeG;
    end.
    

  • Program Graphics2;
    
    uses crt,graph;
    var
      x, i: integer;
      ptr: pointer;
      size : word;
    procedure initG;
      var
        gd, gm : SmallInt;
      begin
        gd:=VGA; gm:=VGAHi;
        initgraph(gd, gm, '.\BGI'); {VGAHi (640x480x16)}
        gd:=graphresult;
        if gd<>grOK then
        begin
          writeln('Error : ');
          writeln(grapherrormsg(gd));
          halt;
        end;
      end;
    procedure closeG;
      begin
        closegraph;
        writeln('Good bye!');
      end;
    
    begin
      initG;
      for i:=0 to 15 do
      begin
           setbkcolor(i);
           cleardevice;
           delay(500);
      end;
      setviewport(100,100,400,400, true); {(x1,y1,x2,y2,true/false);}
      setcolor(2);
      line(0,0,639,479);
      randomize;
      putpixel(200,200,14);
      for x := 100 to 300 do
      begin
        putpixel(x,150,(random(15)));
      end;
      setrgbpalette(1, 255,255,10); {palettnumber,R,G,B}
      rectangle(10,10, 50,50);
    
      size:=imagesize(0,0,55,55);
      getmem(ptr,size);               { Reserve the buffer }
      getimage(0,0,50,50,ptr^);  { from(x1,y1,x2,y2)}
      delay(1000);
      putimage(200,50,ptr^,0);    { to(x1,y1,x2,y2) }
      delay(1000);
      putimage(200,200,ptr^,0);
      freemem(ptr,size);              { Free the buffer }
      readkey;
      closeG;
    end.
    
  • Program Graphics3;
    
    uses crt,graph;
    
    procedure initG;
      var
        gd, gm : SmallInt;
      begin
        gd:=VGA; gm:=VGAHi;
        initgraph(gd, gm, '.\BGI'); {VGAHi (640x480x16)}
        gd:=graphresult;
        if gd<>grOK then
        begin
          writeln('Error : ');
          writeln(grapherrormsg(gd)); halt;
        end;
      end;
    procedure closeG;
      begin
        readkey;
        closegraph;
        writeln('Good bye!');
      end;
    
    begin
      initG;
      setbkcolor(white);
      cleardevice;
      delay(1000);
      setcolor(brown);
      setfillstyle(1,magenta);
      circle(80,180,50);  {circle(x1,y1,radius);}
      ellipse(150,200,0,360,30,40);{ellipse(x1,y1,from,to,hr,vr)}
      arc(180,250,0,90,60);{arc(x,y,p,q,radius)}
      delay(1000);
      pieslice(150,150,20,95,100);{pieslice(x,y,p,q,radius)}
      delay(1000);
      setfillstyle(1,yellow);
      sector(300,200,30,330,20,20);{sector(x1,y1,from,to,hr,vr)}
      closeG;
    end.
    

  • Program GraphicsAnimation;
    uses crt,graph;
    var
         gd, gm : SmallInt;
         x, y, error: integer;
         ptr, ptr2     : pointer;
         size, i : word;
    
    procedure initG;
    begin
        gd:=VGA; {gd:=detect;}
        gm:=VGAHi;
        initgraph(gd, gm, '');
    
        error:=graphResult;
        if (error<>grOK) then
        begin
          writeln('Error: 640x480x16 is not supported ');
          delay(5000);
          halt;
        end;
    end;
    procedure closeG;
    begin
        freeMem(ptr,size);
        freeMem(ptr2,size);
        readkey;
        closeGraph;
        writeln('Press return to exit');
        readln;
    end;
    procedure drawSprite;
    begin
       setFillStyle(SolidFill, White);
       fillEllipse(10, 10, 10, 10);{x, y, rx, ry}
       size:=imageSize(0,0,20,20);{x1, y1, x2, y2}
       getMem(ptr,size);  { Allocate memory on heap }
       getMem(ptr2,size);  { Allocate memory on heap }
       getImage(0,0,20,20,ptr^);{Copy image to buffer}
       setFillStyle(SolidFill, Black);
       bar(0, 0, 20, 20); {Delete} {filled_rectangle(x1, y1, x2, y2)}
    end;
    procedure animate;
    begin
      x:=10;
      y:=10;
      for i:=1 to 500 do
      begin
         putImage(x, y, ptr^,0);{copyPut,xorPut,orPut,andPut,notPut}
         getImage(x, y+100, x+20, y+120, ptr2^);{Copy background image to buffer}
         putImage(x, y+100, ptr^,0);
         putImage(x, y+300, ptr^,0);
         delay(10);
         bar(x,y,x+20,y+20);{Delete}
         putImage(x, y+100, ptr2^,0);
         bar(x,y+300,x+20,y+320);{Delete}
         inc(x);
      end;
    end;
    
    begin
      initG;
      setFillStyle(ltSlashFill, Blue);
      bar(0, 0, 640, 240);{filled_rectangle(x1, x2, y1, y2)}
      drawSprite;
      animate;
      closeG;
    end.