Title: Modul Coding Lengkap Pascal By Farah Alexandra
Description: Modul Coding Pascal Lengkap
By Farah Alexandra















array.pas
program array_example;
var
  simpleArray : array[1..3] of integer;
  complexArray : array[1..3, 1..3] of integer;
  arrayOfString : array[-3..-1] of string;
  i, j : integer;
begin
  {set value for simpleArray}
  for i:=2 to 3 do simpleArray[i] := i * i;
  {write to console}
  for i:=1 to 3 do writeln(simpleArray[i]);
  {set text for complexArray}
  for i:=2 to 3 do
    for j:=1 to 2 do complexArray[i, j] := i * j;
  writeln('complex array:');
  {write to console}
  for i:=1 to 3 do for j:=1 to 3 do writeln('[', i, ',', j, ']=', complexArray[i, j]);

  arrayOfString[-2] := 'hello pascal';
  writeln(arrayOfString[-3], arrayOfString[-2]);
  readln;
end.

{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}


case_of_statement.pas
program case_of_statement;
var
  n : integer;
begin
  repeat
    write('Enter number smaller than 5 (n <= 4) : ');
    readln(n);
    if n > 4 then
    begin
      writeln(n, '>', 4);
      writeln('Retry !');
    end;
  until n <= 4;
  case n of
    0 : writeln('zero');
    1 : writeln('one');
    2 : writeln('two');
    3 : writeln('three');
    4 : writeln('four');
  end;
  readln;
end.
{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}


command_break.pas
{This is a propram used to test "break" command
Used in loops, include:
    for..to...do..
    for..downto..do..
    while...do...
    repeat...until...
}
program break_command;
var
  i : Integer;
begin
  WriteLn('Test break in for..to..do statement: ');
  for i := 1 to 10 do
  begin
    Write(i, ' ');
    if i = 5 then
    begin
      WriteLn('Breaked');
      break;
    end;
  end;
  WriteLn();
  WriteLn('Test break in while..do statement: ');
  i := 1;
  while i < 10 do
  begin
    Write(i, ' ');
    i := i + 1;
    if i = 5 then
    begin
      WriteLn('Breaked');
      break;
    end;
  end;
  WriteLn();
  WriteLn('Test break in repeat...until statement: ');
  i := 1;
  repeat
    Write(i, ' ');
    if i = 5 then
    begin
      WriteLn('Breaked');
      break;
    end;
    inc(i);
  until i = 10;
  {pause screen}
  WriteLn('End of test');
end.

{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}


command_exit.pas
program command_exit;

procedure func;
begin
  WriteLn('Before exit');
  exit;
  WriteLn('After exit');
end;

begin
  func;
end.

{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}


const.pas
program constant;
const
  a = 10;
    //integer constant
  s = 'pascal';
    //string constant
  c = 'c';
    //char constant
  d : string[10] = 'asdhashdhasdhashd';
    //string constant
  e : integer = 100;
    //integer constant
  f : longint = 12112312;
    //longint constant
  g : real = 1.2;
    //real constant
  i = 1.2;
//real constant
  k = true;
    //boolean constant
  m : boolean = true and false; //boolean constant

begin
  readln;
end.
{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}



continue_command.pas
Program Example86;

{ Program to demonstrate the Continue function. }

Var
  I : longint;

begin
  I := 0;
  While I < 10 Do
  begin
    Inc(I);
    If I < 5 Then
      Continue;
    Writeln (i);
  end;
  I := 0;
  Repeat
    Inc(I);
    If I < 5 Then
      Continue;
    Writeln (i);
  Until I >= 10;
  For I:=1 to 10 do
  begin
    If I < 5 Then
      Continue;
    Writeln (i);
  end;
end.


dynamic_array.pas
program dynamic_array;
var
  a : array of array of integer;
    (* a 2 dimensional array *)
  i, j : integer;

begin
  setlength(a, 5, 5);

  for i:=0 to 4 do
    for j:=0 to 4 do
      a[i, j] := i * j;
  setlength(a, 6, 6);
  for i:=0 to 5 do
  begin
    for j:= 0 to 5 do
      write(a[i, j]: 2, ' ');
    writeln;
  end;
end.

enum_type.pas
program exEnumeration;
type
  beverage = (coffee, tea, milk, water, coke, limejuice);

var
  drink : beverage;

begin
  writeln('Which drink do you want?');
  drink := limejuice;

  writeln('You can drink ', drink);
end.
{https://www.tutorialspoint.com/pascal/pascal_variable_types.htm}


file_reader.pas
var
  fi, fo : text;
  data : string;

begin
  //write data to file 'file.inp'
  Assign(fo, 'file.inp');
  Rewrite(fo);
  Writeln(fo, 'test data');
  Close(fo);

  //read data from file 'file.inp'
  Assign(fi, 'file.inp');
  Reset(fi);
  ReadLn(fi, data);
  close(fi);

  //write to screen
  WriteLn(data);
end.

file_writer.pas
var
  f : text;
  i : Integer;
begin
  //open file for ouput
  assign(f, 'file.out');
  rewrite(f);

  //write data
  for i := 1 to 1000 do
  begin
    write(f, random(i), ' ');
    writeln(f);
  end;

  //close file
  close(f);
end.

for_downto_statement.pas
program for_downto_statement;
var
  i, n : integer;
begin
  writeln('Enter small number: ');
  readln(n);
  for i := n downto 1 do writeln('i = ', i);
  readln;
end.

{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}


for_in_statement.pas
type
  MonthType = (January, February, March, April,
                May, June, July, August, September,
                October, November, December);
var
  a : array[1..3] of integer = (1, 2, 3);
  b : set of char = ['a', 'c', 'd'];
  c : char;
  i : integer;
  m : MonthType;

begin
  //for each array
  for i in a do write(i, ' '); //1 2 3
  writeln;

  //for each set
  for c in b do write(c, ' '); //a c d
  writeln;

  //for each enum
  for m := January to December do write(m, ' ');
  readln;
end.





for_to_statement.pas
program for_to_statement;
var
  i, n : integer;
begin
  writeln('Enter small number: ');
  readln(n);
  for i := 1 to n do writeln('i = ', i);
  readln;
end.

{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}


function.pas
function get : integer;
begin
  randomize;
  WriteLn('Test function');
  get := random(1000);
end;

begin
  writeln(get);
  readln;
end.


hello.pas
program hello_world;
begin
  Writeln('Hello World');
  Readln;
end.

{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}


if_else_statement.pas
program if_else;
var
  num1, num2 : integer;
begin
  writeln('Enter first number: ');
  readln(num1);
  writeln('Enter second number: ');
  readln(num2);
  if (num1 < num2) then
    writeln(num1, ' < ', num2)
  else if (num1 > num2) then
    writeln(num1, ' > ', num2)
  else
    write(num1, ' = ', num2);

  readln;
end.

{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}


in_out.pas
{How to use "Readln" and "Write" procedure}
program test_io;
var
  a : integer;
  n : string;
begin
  write('> Enter your name: ');
  readln(n);
  writeln('Your name is ', n);

  writeln('> Enter your age: ');
  readln(a);
  writeln('Your age is ', a);
  //print multi variable to console
  writeln('Name: ', n, '; Age: ', a);
  readln;
end.

{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}


output_format.pas
program test;
uses crt;

var
  i, j : Integer;
begin
  i := 1;
  j := 3;
  writeln(i / j : 3 : 2);
  {Comment...}
end.


procedure.pas
program test_procedure;

procedure print(s : string);
begin
  writeln('> ', s);
end;

begin
  print('test procedure');
  readln;
end.

{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}

record.pas
program length_of_line;
type
  point = record
    startX, startY : Real;
  end;

  line = record
    p1 : point;
    p2 : point;
  end;
var
  mPoint1, mPoint2 : point;
  mLine : line;

{Get length of line}
function getLength(L : line) : real;
var
  result : real;
begin
  Result := sqrt(Sqr(L.p1.startX + L.p2.startX) + Sqr(L.p1.startY + L.p2.startY));
  getLength := Result;
end;

begin
  mPoint1.startX := 1;
  mPoint1.startY := 2;
  mPoint2.startX := 3;
  mPoint2.startY := 5.2;

  mLine.p1 := mPoint1;
  mLine.p2 := mPoint2;

  WriteLn(getLength(mLine));

  readln;
end.


repeat_until_statement.pas
program repeat_until_statement;
var
  i : integer;
  sum : integer;
BEGIN
  i := 0;
  sum := 0;
  writeln('Sum of 1 to 100 is: ');
  repeat
    inc(i);
    inc(sum, i);
  until i = 100;
  writeln(sum);
  readln;
END.

{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}





set_operate.pas
program SetOpDemo;

type
  TCharSet = set of Char;

var
  S1, S2, S3 : TCharSet;
  Result : Boolean;

begin
  S1 := ['a', 'b', 'c'];
  S2 := ['c', 'd', 'e'];
  S3 := S1 + S2; { S3 = ['a', 'b', 'c', 'd', 'e'] }
  S3 := S1 * S2; { S3 = ['c'] }
  S3 := S1 - S2; { S3 = ['a', 'b'] }
  S3 := S1 >< S2; { S3 = ['a', 'b', 'd', 'e'] }

  S1 := ['c', 'd', 'e'];
  Result := S1 = S2; { False }
  Result := S1 < S2; { False }
  Result := S1 <= S2; { True }

  S1 := ['c', 'd'];
  Result := S1 <> S2; { True }
  Result := S2 > S1; { True }
  Result := S2 >= S1   { True }
end.

{http://www.gnu-pascal.de/gpc/Set-Operations.html}


set_type.pas
var
  a : set of Char;
begin
  a := ['a', 'v', 's'];
end.


string_test.pas
program string_test;
var
  name : string;
  tmp : char;
  i : Integer;
begin
  {print to console}
  writeln('enter your full name (first case): ');

  {Input data into variable name}
  readln(name);

  {print upper case}
  for i := 1 to length(name) do
  begin
    tmp := upcase(name[i]);
    Write(tmp);
  end;

  writeln;
  {tran le duy -> Tran Le Duy}
  name := ' ' + name;
  for i := 1 to Length(name) do
  begin
    if name[i] = ' ' then name[i + 1] := upcase(name[i + 1]);
  end;

  {print to console}
  writeln(name);
  readln;
end.
{Input: tran le duy
Output:
    TRAN LE DUY
    Tran Le Duy}
{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}


while_do_statement.pas
program while_do_statement;
var
  i : integer;
  sum : integer;
BEGIN
  i := 1;
  sum := 0;
  While i <= 1000 do
  begin
    sum := sum + i;
    i := i + 1;
  end;
  write('Sum of 1 to 1000 is: ');
  write(sum);
  readln;
END.

{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}
with_command.pas
type
  student = record
    name : string;
    address : string;
    grade : integer;
  end;

var
  s : student;

function getInfo(s : student) : string;
begin
  exit('name: ' + s.name + '; address: ' + s.address);
end;

begin
  with s do
  begin
    name := 'John';
    address := 'main street';
    grade := 20;
  end;

  writeln(getInfo(s));

  s.name := 'John';
  s.address := 'main street';
  s.grade := 20;

  writeln(getInfo(s));
end.

Byte.pas
{This program will be test function "byte"
    function byte(<condition>)
    return 1 if <condition> is true, else return 0
}
program byteFunction;
var
  b : Boolean;
begin
  b := false;
  WriteLn(b, ' ', byte(b));
  b := true;
  WriteLn(b, ' ', byte(b));
  {pause screen}
  readln;
end.

{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}

CharToAscii.pas
program CharToAscii;
var
  character : char;
  ascii : integer;
begin
  ascii := ord('a');
  writeln('a in ascii is ', ascii);
  character := chr(87);
  writeln('ascii 87 is character ', character);
  readln;
end.
{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}


ConcatString.pas
Program ConcatString;

{ Program to demonstrate the Concat function. }
Var
  S : String;

begin
  S := Concat('This can be done', ' Easier ', 'with the + operator !');
  WriteLn(s);
end.
Copy.pas
Program Copy;

{ Program to demonstrate the Copy function. }

Var
  S, T : String;

begin
  T := '1234567';
  S := Copy (T, 1, 2); { S:='12'   }
  writeln(s);
  S := Copy (T, 4, 2); { S:='45'   }
  writeln(s);
  S := Copy (T, 4, 8); { S:='4567' }
  writeln(s);
end.



Cos.pas
Program Cos;

{ Program to demonstrate the Cos function. }

Var
  R : Real;

begin
  R := Cos(Pi); { R:=-1 }
  writeln(R);
  R := Cos(Pi / 2); { R:=0  }
  WriteLn(R);
  R := Cos(0); { R:=1  }
  WriteLn(R);
end.




Dec.pas
Program Dec;

{ Program to demonstrate the Dec function. }

Var
  I : Integer;
  L : Longint;
  W : Word;
  B : Byte;
  Si : ShortInt;

begin
  I := 1;
  L := 2;
  W := 3;
  B := 4;
  Si := 5;
  Dec(i); { i:=0  }
  Dec(L, 2); { L:=0  }
  Dec(W, 2); { W:=1  }
  Dec(B, -2); { B:=6  }
  Dec(Si, 0); { Si:=5 }
  Write(i, ' ', L, ' ', W, ' ', B, ' ', Si);
end.


Delete.pas
Program Delete;

{ Program to demonstrate the Delete function. }

Var
  S : String;

begin
  S := 'This is not easy !';
  Delete (S, 9, 4); { S:='This is easy !' }
  writeln(s);
end.
Eoln.pas
var
  myFile : TextFile;
  letter : char;
  text : string;

begin
  // Try to open the Test.txt file for writing to
  AssignFile(myFile, 'Test.txt');
  ReWrite(myFile);

  // Write lines of text to the file
  WriteLn(myFile, 'Hello');
  WriteLn(myFile, 'To you');

  // Close the file
  CloseFile(myFile);

  Reset(myFile);
  while not Eof(myFile) do
  begin
    readln(myFile, text);
    writeln(text);
  end;
  CloseFile(myFile);

  // Reopen the file for reading
  Reset(myFile);

  // Display the file contents
  while not Eof(myFile) do
  begin
    // Proces one line at a time
    writeln('Start of a new line :');
    while not Eoln(myFile) do
    begin
      Read(myFile, letter); // Read and display one letter at a time
      write(letter);
    end;
    ReadLn(myFile, text);
    writeln(text);
  end;

  // Close the file for the last time
  CloseFile(myFile);
end.

{http://www.delphibasics.co.uk/RTL.asp?Name=Eoln}


Exit.pas
Program Exit;

{ Program to demonstrate the Exit function. }

Procedure DoAnExit (Yes : Boolean);

{ This procedure demonstrates the normal Exit }

begin
  Writeln ('Hello from DoAnExit !');
  If Yes then
  begin
    Writeln ('Bailing inType early.');
    exit;
  end;
  Writeln ('Continuing to the end.');
end;

Function Positive (Which : Integer) : Boolean;

{ This function demonstrates the extra FPC feature of Exit :
  You can specify a return value for the function }

begin
  if Which > 0 then
    exit (True)
  else
    exit (False);
end;

begin
  { This call will go to the end }
  DoAnExit (False);
  { This call will bail inType early }
  DoAnExit (True);
  if Positive (-1) then
    Writeln ('The compiler is nuts, -1 is not positive.')
  else
    Writeln ('The compiler is not so bad, -1 seems to be negative.');
end.


Frac.pas
Program Frac;

{ Program to demonstrate the Frac function. }

Var
  R : Real;

begin
  Writeln (Frac (123.456): 0 : 3); { Prints  O.456 }
  Writeln (Frac (-123.456): 0 : 3); { Prints -O.456 }
end.


Function.pas
program testFunc;

//return sqrt(number)
function square_root(a : integer) : real;
begin
  square_root := sqrt(a);
end;

begin
  writeln('sqrt(4) = ', square_root(4));
  readln;
end.
{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}


IncDec.pas
program IncDec;
var
  a : integer;
begin
  a := 1;
  Write('a = ', a);
  inc(a);
  Writeln('a + 1 = ', a);
  dec(a);
  Writeln('a - 1 = ', a);
  readln;
end.

{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}
Insert.pas
Program Insert;

{ Program to demonstrate the Insert function. }

Var
  S : String;

begin
  S := 'Free Pascal is difficult to use !';
  Insert ('NOT ', S, pos('difficult', S));
  writeln (s);
end.


Keypressed.pas
Program Keypressed;
uses Crt;

{ Program to demonstrate the KeyPressed function. }

begin
  WriteLn('Waiting until a key is pressed');
  repeat
  until KeyPressed;
  { The key is not Read,
    so it should also be outputted at the commandline}
end.
{http://www.freepascal.org/docs-html/rtl/crt/keypressed.html}


Length.pas
Program Length;

{ Program to demonstrate the Length function. }

type
  somebytes = array [6..10] of byte;

  somewords = array [3..10] of word;

Var
  S : String;
  I : Integer;
  bytes : somebytes;
  words : somewords;

begin
  S := '';
  for i:=1 to 10 do
  begin
    S := S + '*';
    Writeln (Length(S): 2, ' : ', s);
  end;
  Writeln('Bytes : ', length(bytes));
  Writeln('Words : ', length(words));
end.



Pos.pas
Program Pos;

{ Program to demonstrate the Pos function. }

Var
  S : String;

begin
  S := 'The first space in this sentence is at position : ';
  Writeln (S, pos(' ', S));
  S := 'The last letter of the alphabet doesn''t appear in this sentence ';
  If (Pos ('Z', S) = 0) and (Pos('z', S) = 0) then
    Writeln (S);
end.

Random.pas
program Random;
var
  i : integer;
begin
  randomize;
  for i := 1 to 10 do
    writeln(random(1000));
  readln;
end.

{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}


ReadKey.pas
Program ReadKey;
uses Crt;

{ Program to demonstrate the ReadKey function. }

var
  ch : char;
begin
  writeln('Press a/b, q=Quit');
  repeat
    ch := ReadKey;
    case ch of
      #0 :
      begin
        ch := ReadKey; {Read ScanCode}
        case ch of
          #97 : WriteLn('pressed a');
          #98 : WriteLn('pressed b');
        end;
      end;
      #113 : WriteLn('quit');
    end;
  until ch = #113 {quit}
end.

{More information: https://en.wikipedia.org/wiki/ASCII}

Round.pas
Program Round;

{ Program to demonstrate the Round function. }

begin
  Writeln (Round(1234.56)); { Prints 1235     }
  Writeln (Round(-1234.56)); { Prints -1235    }
  Writeln (Round(12.3456)); { Prints 12       }
  Writeln (Round(-12.3456)); { Prints -12      }
  Writeln (Round(2.5)); { Prints 2 (down) }
  Writeln (Round(3.5)); { Prints 4 (up)   }

end.


SetLength.pas
var
  a : array of integer;
  i : integer;
begin
  SetLength(a, 10);
  for i := 0 to 9 do
    a[i] := i;
  for i := 0 to 9 do
    writeln('a[', i, ']=', a[i]);
end.


Sin.pas
Program Sin;

{ Program to demonstrate the Sin function. }

begin
  Writeln (Sin(Pi): 0 : 1); { Prints 0.0 }
  Writeln (Sin(Pi / 2): 0 : 1); { Prints 1.0 }
end.


SizeOf.pas
Program SizeOf;

{ Program to demonstrate the SizeOf function. }
Var
  I : Longint;
  S : String [10];

begin
  Writeln (SizeOf(I)); { Prints 4  }
  Writeln (SizeOf(S)); { Prints 11 }
end.


Sqr.pas
Program Sqr;

{ Program to demonstrate the Sqr function. }
Var
  i : Integer;

begin
  For i:=1 to 10 do
    writeln(Sqr(i): 3);
end.


Sqrt.pas
Program Sqrt;

{ Program to demonstrate the Sqrt function. }

begin
  Writeln (Sqrt(4): 0 : 3); { Prints 2.000 }
  Writeln (Sqrt(2): 0 : 3); { Prints 1.414 }
end.




Str.pas
Program Str;

{ Program to demonstrate the Str function. }
Var
  S : String;

Function IntToStr (I : Longint) : String;

Var
  S : String;

begin
  Str (I, S);
  IntToStr := S;
end;

begin
  S := '*' + IntToStr(-233) + '*';
  Writeln (S);
end.


Str2.pas
var
  number : longint;
  s : string;
begin
  number := 7;
  Str(number, s);
  Writeln(s);
end.


StringToIn.pas
program StringToInt;
const
  number = 1101010;
var
  s : string;
begin
  str(number, s);
  writeln('Number is ', number);
  writeln('String is ', s);
  readln;
end.

{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}

Trunc.pas
program Trunc;

begin
  WriteLn (Frac (12.345) : 1 : 5); { 0.34500 }
  WriteLn (Int (12.345) : 1 : 5); { 12.00000 }
  WriteLn (Round (12.345) : 1); { 12 }
  WriteLn (Trunc (12.345) : 1); { 12 }

  WriteLn (Frac (-12.345) : 1 : 5); { -0.34500 }
  WriteLn (Int (-12.345) : 1 : 5); { -12.00000 }
  WriteLn (Round (-12.345) : 1); { -12 }
  WriteLn (Trunc (-12.345) : 1); { -12 }

  WriteLn (Frac (12.543) : 1 : 5); { 0.54300 }
  WriteLn (Int (12.543) : 1 : 5); { 12.00000 }
  WriteLn (Round (12.543) : 1); { 13 }
  WriteLn (Trunc (12.543) : 1); { 12 }

  WriteLn (Frac (-12.543) : 1 : 5); { -0.54300 }
  WriteLn (Int (-12.543) : 1 : 5); { -12.00000 }
  WriteLn (Round (-12.543) : 1); { -13 }
  WriteLn (Trunc (-12.543) : 1); { -12 }
end.


UpCase.pas
program UpCase;

{ Program to demonstrate the upcase function. }

var
  c : char;

begin
  for c:='a' to 'z' do
    write(upcase(c));
  Writeln;
end.


earse.pas
Program Example20;

{ Program to demonstrate the Erase function. }

Var
  F : Text;

begin
  { Create a file with a line of text in it}
  Assign (F, 'test.txt');
  Rewrite (F);
  Writeln (F, 'Try and find this when I''m finished !');
  close (f);
  { Now remove the file }
  Erase (f);
end.


odd.pas
Program Example43;

{ Program to demonstrate the Odd function. }

begin
  If Odd(1) Then
    Writeln ('Everything OK with 1 !');
  If Not Odd(2) Then
    Writeln ('Everything OK with 2 !');
end.
{http://www.freepascal.org/docs-html/rtl/system/odd.html}


random_2.pas
Program Example49;

{ Program to demonstrate the Random and Randomize functions. }

Var
  I, Count, guess : Longint;
  R : Real;

begin
  Randomize; { This way we generate a new sequence every time
               the program is generate}
  Count := 0;
  For i:=1 to 1000 do
    If Random > 0.5 then inc(Count);
  Writeln ('Generated ', Count, ' numbers > 0.5');
  Writeln ('inType of 1000 generated numbers.');
  count := 0;
  For i:=1 to 5 do
  begin
    write ('Guess a number between 1 and 5 : ');
    readln(Guess);
    If Guess = Random(5) + 1 then inc(count);
  end;
  Writeln ('You guessed ', Count, ' inType of 5 correct.');
end.

CRT

Program Example8;
uses Crt;

{ Program to demonstrate the ClrScr function. }

begin
  Writeln('Press any key to clear the screen');
  readln;
  ClrScr;
  Writeln('Have fun with the cleared screen');
end.


Program color_argb;
Uses Crt;

var
  generator : android_graphics_Color;
  a, color : integer;

Begin
  for a := 0 to 255 do
  begin
    color := generator.argb(a, 0, 0, 255);
    textBackground(color); //ARGB color
    write(' ');
  end;
  for a := 0 to 255 do
  begin
    color := generator.argb(a, 0, 255, 0);
    textBackground(color); //ARGB color
    write(' ');
  end;
  for a := 0 to 255 do
  begin
    color := generator.argb(a, 255, 0, 0);
    textBackground(color); //ARGB color
    write(' ');
  end;
  ReadLn;
End.


Program color_rgb;
Uses Crt;

var
  colorFactory : android_graphics_Color;
  r, g, b, color : integer;

Begin
  for r := 0 to 25 do
    for g := 0 to 25 do
      for b := 0 to 25 do
      begin
        color := colorFactory.rgb(r * 10, g * 10, b * 10);
        textBackground(color); //RGB color
        write(' ');
      end;
  ReadLn;
End.





Program Example15;
uses Crt;

{ Program to demonstrate the Delay function. }
var
  i : longint;
begin
  WriteLn('Counting Down');
  for i:=10 downto 1 do
  begin
    WriteLn(i);
    {Wait one second}
    Delay(1000);
  end;
  WriteLn('BOOM!!!');
end.
{http://www.freepascal.org/docs-html/rtl/crt/delay.html}



Program Example6;
uses Crt;

{ Program to demonstrate the GotoXY function. }
begin
  ClrScr;
  GotoXY(10, 10);
  Write('10,10');
  GotoXY(20, 20);
  Write('20,20');
  GotoXY(1, 22);
  readln;
end.
{http://www.freepascal.org/docs-html/rtl/crt/gotoxy.html}


Program high_low_text;
uses Crt;

{ Program to demonstrate the LowVideo, HighVideo, NormVideo functions. }

begin
  LowVideo;
  WriteLn('This is written with LowVideo');
  HighVideo;
  WriteLn('This is written with HighVideo');
  NormVideo;
  WriteLn('This is written with NormVideo');
end.


sound.pas
Program Example16;
uses Crt;

{ Program to demonstrate the Sound and NoSound function. }

var
  i : longint;
begin
  WriteLn('You will hear some tones from your speaker');
  while (i < 15000) do
  begin
    inc(i, 500);
    Sound(i);
    Delay(100);
  end;
  WriteLn('Quiet now!');
  {Stop noise}
  NoSound;
end.
{http://www.freepascal.org/docs-html/rtl/crt/nosound.html}


text_color.pas
Program ExampleTextColor;
uses Crt;

{ Program to demonstrate the TextColor function. }

begin
  WriteLn('This is written in the default color');
  TextColor(Red);
  WriteLn('This is written in Red');
  TextColor(White);
  WriteLn('This is written in White');
  TextColor(LightBlue);
  WriteLn('This is written in LightBlue');
  TextColor(Green);
  WriteLn('This is written in Green');
  TextColor(Brown);
  WriteLn('This is written in Brown');
  TextColor(Blue);
  WriteLn('This is written in Blue');
  TextColor(Cyan);
  WriteLn('This is written in Cyan');
  TextColor(Red);
  WriteLn('This is written in Red');
  TextColor(Magenta);
  WriteLn('This is written in Magenta');
  TextColor(LightGray);
  WriteLn('This is written in LightGray');
  TextColor(DarkGray);
  WriteLn('This is written in DarkGray');
  TextColor(LightBlue);
  WriteLn('This is written in LightBlue');
  TextColor(LightGreen);
  WriteLn('This is written in LightGreen');
  TextColor(LightCyan);
  WriteLn('This is written in LightCyan');
  TextColor(LightRed);
  WriteLn('This is written in LightRed');
  TextColor(LightMagenta);
  WriteLn('This is written in LightMagenta');
  TextColor(Yellow);
  WriteLn('This is written in Yellow');
  TextColor(Black);
  WriteLn('This is written in Black');
  ReadLn;
end.
{http://www.freepascal.org/docs-html/rtl/crt/textcolor.html}


textbackground.pas
Program ExampleBgColor;

uses Crt;

{ Program to demonstrate the TextBackground function. }

begin
  WriteLn('This is written in with the default background color');
  TextBackground(Green);
  WriteLn('This is written in with a Green background');
  TextBackground(Brown);
  WriteLn('This is written in with a Brown background');
  TextBackground(Blue);
  WriteLn('This is written in with a Blue background');
  TextBackground(Cyan);
  WriteLn('This is written in with a Cyan background');
  TextBackground(Red);
  WriteLn('This is written in with a Red background');
  TextBackground(Magenta);
  WriteLn('This is written in with a Magenta background');
  TextBackground(LightGray);
  WriteLn('This is written in with a LightGray background');
  TextBackground(DarkGray);
  WriteLn('This is written in with a DarkGray background');
  TextBackground(LightBlue);
  WriteLn('This is written in with a LightBlue background');
  TextBackground(LightGreen);
  WriteLn('This is written in with a LightGreen background');
  TextBackground(LightCyan);
  WriteLn('This is written in with a LightCyan background');
  TextBackground(LightRed);
  WriteLn('This is written in with a LightRed background');
  TextBackground(LightMagenta);
  WriteLn('This is written in with a LightMagenta background');
  TextBackground(Yellow);
  WriteLn('This is written in with a Yellow background');
  TextBackground(Black);
  WriteLn('Back with a black background');
  ReadLn;

end.
{http://www.freepascal.org/docs-html/rtl/crt/textbackground.html}


WhereXY.pas
Program Example7;
uses Crt;

{ Program to demonstrate the WhereX and WhereY functions. }

begin
  Writeln('Cursor postion: X=', WhereX, ' Y=', WhereY);
end.
{http://www.freepascal.org/docs-html/rtl/crt/wherex.html}
GetDate.pas
Program Example2;
uses Dos;

{ Program to demonstrate the GetDate function. }

const
  DayStr : array[0..6] of string[3] = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
  MonthStr : array[1..12] of string[3] = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
var
  Year, Month, Day, WDay : word;
begin
  GetDate(Year, Month, Day, WDay);
  WriteLn('Current date');
  WriteLn(DayStr[WDay], ', ', Day, ' ', MonthStr[Month], ' ', Year, '.');
end.

GetTime.pas
program GetTime;
uses dos, crt;

var
  a, b, c, d : integer;

function print(w : integer) : string;
var
  s : string;
begin
  Str(w, s);
  if w < 10 then
    print := '0' + s
  else
    print := s;
end;

begin
  while not keyPressed do
  begin
    clrscr;
    GetTime(a, b, c, d);
    gotoXY(15, 8);
    textColor(White);
    WriteLn('Current time');
    gotoXY(17, 9);
    textColor(Yellow);

    WriteLn(print(a), ':', print(b), ':', print(c));
    delay(1000);
  end;
  readln;
end.
{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}




PackTime.pas
Program Example4;
uses Dos;

{ Program to demonstrate the PackTime and UnPackTime functions. }

var
  DT : DateTime;
  Time : longint;
begin
  with DT do
  begin
    Year := 2017;
    Month := 11;
    Day := 11;
    Hour := 11;
    Min := 11;
    Sec := 11;
  end;
  PackTime(DT, Time);
  WriteLn('Packed Time : ', Time);
  UnPackTime(Time, DT);
  WriteLn('Unpacked Again:');
  with DT do
  begin
    WriteLn('Year  ', Year);
    WriteLn('Month ', Month);
    WriteLn('Day   ', Day);
    WriteLn('Hour  ', Hour);
    WriteLn('Min   ', Min);
    WriteLn('Sec   ', Sec);
  end;

//  readln;
end.




Graph

Program draw_arc;
Uses Crt, Graph;

Var
  graphicsDriver, graphicsMode : integer;
Begin
  graphicsDriver := Detect;
  InitGraph(graphicsDriver, graphicsMode, '');

  Randomize;
  SetColor(Random(15) + 1); {Set paint color}

  {Draw arc}
  arc(200, 200, 0, 90, 100);

  ReadLn;
  CloseGraph;
End.
bar.pas
Program draw_bar;
Uses Crt, Graph;

Var
  graphicsDriver, graphicsMode : integer;
Begin
  graphicsDriver := Detect;
  InitGraph(graphicsDriver, graphicsMode, '');
  Randomize;
  SetColor(Random(15) + 1); {Set paint color}


  {Draw bar}
  bar(100, 100, 300, 200);

  ReadLn;
  CloseGraph;
End.

bar3d.pas
Program Graphika12;
Uses Graph;

Var
  graphicsDriver, graphicsMode : integer;
Begin
  graphicsDriver := Detect;
  InitGraph(graphicsDriver, graphicsMode, '');
  setcolor (5);
  setlinestyle(2, 0, 3);
  setfillstyle (6, 7);
  bar3d (100, 100, 300, 500, 50, topoff);
  readln;
  closegraph;
end.




circle.pas
program draw_circle;
uses graph;

Var
  graphicsDriver, graphicsMode : integer;
  Radius : Integer;
Begin
  graphicsDriver := Detect;
  InitGraph(graphicsDriver, graphicsMode, '');
  setlinestyle(0, 0, 3);

  for Radius:=1 to 23 do Circle(320, 240, Radius * 10);

  readln;
  ClearDevice; {clear screen}

  SetColor(LightMagenta); {set paint color}

  for Radius:=1 to 23 do Arc(320, 240, 0, 280, Radius * 10);

  readln;
  closegraph;

end.

Program ellipse;
Uses Crt, Graph;

Var
  graphicsDriver, graphicsMode : integer;
Begin
  graphicsDriver := Detect;
  InitGraph(graphicsDriver, graphicsMode, '');

  Randomize;
  SetColor(Random(15) + 1); {Set paint color}


  {Draw bar}
  ellipse(200, 200, 0, 270, 200, 100);

  ReadLn;
  CloseGraph;
End.


Program draw_fill_ellipse;
Uses Crt, Graph;

Var
  graphicsDriver, graphicsMode : integer;
Begin
  graphicsDriver := Detect;
  InitGraph(graphicsDriver, graphicsMode, '');

  Randomize;
  SetColor(Random(15) + 1); {Set paint color}

  fillEllipse(200, 200, 150, 50);

  ReadLn;
  CloseGraph;
End.


uses graph;

Var
  graphicsDriver, graphicsMode : integer;
Begin
  graphicsDriver := Detect;
  InitGraph(graphicsDriver, graphicsMode, '');

  setFillStyle(3, Blue);
  Bar3D(150, 130, 440, 470, 100, topon);

  FloodFill(300, 125, Cyan);
  readln;
  closegraph;
end.


get_image.pas
uses Graph;

var
  P : Pointer;
  Size : Word;

Var
  graphicsDriver, graphicsMode : integer;
Begin
  graphicsDriver := Detect;
  InitGraph(graphicsDriver, graphicsMode, '');

  SetFillStyle(XHatchFill, Cyan);
  Bar(0, 0, GetMaxX, GetMaxY);
  Size := ImageSize(10, 20, 30, 40);
  GetMem(P, Size);
  GetImage(10, 20, 30, 40, P^);
  ReadLn;
  ClearDevice;
  PutImage(100, 100, P^, NormalPut);
  ReadLn;
  CloseGraph;
end.
{http://pascal.net.ru/GetImage}


Uses Graph, CRT;

var
  d, r, k, j, x, y : Integer;
begin

  d := Detect;
  InitGraph(d, r, ' ');


  x := GetMaxX div 6; {Положение графика}
  y := GetMaxY div 5; {на экране}
  for j := 0 to 2 do{Два ряда}
    for k := 0 to 3 do{По четыре квадрата}
    begin
      Rectangle((k + 1) * x, (j + 1) * y, (k + 2) * x, (j + 2) * y);
      SetFillStyle(k + j * 4, j + 1);
      Bar((k + 1) * x + 1, (j + 1) * y + 1, (k + 2) * x - 1, (j + 2) * y - 1)
    end;
  ReadLn();
  CloseGraph;

end.


line.pas
Program draw_line;
Uses Crt, Graph;

Var
  graphicsDriver, graphicsMode,
    i, startX, startY, maxColor, color : Integer;
Begin
  graphicsDriver := Detect;
  InitGraph(graphicsDriver, graphicsMode, '');

  Randomize;
  startX := getMaxX();
  startY := getMaxY();
  maxColor := getMaxColor();

  While (not keypressed) do
  Begin
    delay(50);
    color := random(maxColor) + 1;
    setColor(color);
    line(random(startX), random(startY), random(startX), random(startY));
  end;

  ReadLn;
  CloseGraph;
End.


line_style.pas
Program line_style;
uses Graph;

var
  Gd, Gm : Integer;
  X1, Y1, X2, Y2 : Integer;
begin
  Gd := Detect;
  InitGraph(Gd, Gm, ' ');

  SetColor(blue);

  //    draws a solid line.
  SetLineStyle(SolidLn, 0, ThickWidth);
  rectangle(10, 10, 300, 110);

  //    Draws a dotted line.
  SetLineStyle(DottedLn, 0, ThickWidth);
  rectangle(10, 120, 300, 220);

  //    draws a non-broken centered line.
  SetLineStyle(CenterLn, 0, ThickWidth);
  rectangle(10, 230, 300, 330);

  //    draws a dashed line.
  SetLineStyle(DashedLn, 0, ThickWidth);
  rectangle(10, 340, 300, 440);

  ReadLn;
  CloseGraph;
End.



program moveToExample;
Uses Graph;

Var
  Gd, Gm : Integer;
Begin
  Gd := Detect;
  InitGraph(Gd, Gm, '');

  MoveTo(0, 0);
  LineTo(GetMaxX, GetMaxY);

  ReadLn;
  CloseGraph;
End.


Program outtext_sample;
Uses Crt, Graph;

Var
  graphicsDriver, graphicsMode : integer;
Begin
  graphicsDriver := Detect;
  InitGraph(graphicsDriver, graphicsMode, '');

  Randomize;
  SetColor(Random(15) + 1); {Set text color}

  OutTextXY(20, 20, 'Welcome to the new generation of Pascal Programming:');
  OutTextXY(20, 30, 'Pascal Graphics!!');
  OutTextXY(25, 70, 'You will learn more graphics procedures and');
  OutTextXY(25, 80, 'functions, later in this lesson :-)');

  Readln;
  CloseGraph;
End.


{Sample code for the PieSlice procedure.}
uses Graph;

const
  Radius = 30;
var
  Gd, Gm : Integer;
begin
  Gd := Detect;
  InitGraph(Gd, Gm, ' ');

  PieSlice(100, 100, 0, 270, Radius);
  Readln;
  CloseGraph;
end.
{http://putka.upm.si/langref/turboPascal/04B7.html}




program draw_pixel;
Uses Crt, Graph;

Var
  graphicsDriver, graphicsMode,
    color, maxColor, startX, startY : Integer;
Begin
  graphicsDriver := Detect;
  InitGraph(graphicsDriver, graphicsMode, '');

  startX := getMaxX;
  startY := getMaxY;
  maxColor := getMaxColor;

  randomize;
  While (not keypressed) do
  Begin
    color := random(maxColor) + 1;
    putPixel(random(startX), random(startY), color);
  end;
  Closegraph;
End.


Program rect;
Uses Crt, Graph;

Var
  graphicsDriver, graphicsMode, i : Integer;
Begin
  graphicsDriver := Detect;
  InitGraph(graphicsDriver, graphicsMode, '');

  Randomize;
  SetColor(Random(15) + 1); {Set text color}

  rectangle(10, 10, 200, 200);

  ReadLn;
  CloseGraph;
End.


sector.pas
{Sample code for the Sector procedure.}
uses Graph;

const
  R = 50;
var
  Driver, Mode : Integer;
  Xasp, Yasp : Word;
begin
  Driver := Detect; { Put in graphics mode }
  InitGraph(Driver, Mode, ' ');

  Sector(GetMaxX div 2, GetMaxY div 2, 0, 234, R, R);

  Readln;
  CloseGraph;
end.
{http://putka.upm.si/langref/turboPascal/04D0.html}


uses Graph;

var
  Gd, Gm : Integer;

begin
  Gd := Detect;
  InitGraph(Gd, Gm, '');

  SetTextJustify(CenterText, CenterText);
  OutTextXY(Succ(GetMaxX) div 2, Succ(GetMaxY) div 3, 'CenterText');

  SetTextJustify(LeftText, CenterText);
  OutTextXY(0, Succ(GetMaxY) div 3, 'LeftText');

  SetTextJustify(RightText, CenterText);
  OutTextXY(Succ(GetMaxX), Succ(GetMaxY) div 3, 'RightText');
  ReadLn;
  CloseGraph;
end.


uses Graph;

var
  Gd, Gm : Integer;
  Row : Integer;
  Title : String;
  Size : Integer;

begin
  Gd := Detect;
  InitGraph(Gd, Gm, '');

  Row := 0;
  Title := 'Turbo Graphics';
  Size := 1;
  while TextWidth(Title) < GetMaxX do
  begin
    OutTextXY(0, Row, Title);
    Inc(Row, TextHeight('M'));
    Inc(Size);
    SetTextStyle(DefaultFont, HorizDir, Size);
  end;
  ReadLn;
  CloseGraph;
end.

{http://pascal.net.ru/TextWidth}






Math (Sin, Cos, Tan)

Program Example1;

{ Program to demonstrate the arccos function. }

Uses math;

Procedure WriteRadDeg(X : float);

begin
  Writeln(X: 8 : 5, ' rad = ', radtodeg(x): 8 : 5, ' degrees.')
end;

begin
  WriteRadDeg (arccos(1));
  WriteRadDeg (arccos(sqrt(3) / 2));
  WriteRadDeg (arccos(sqrt(2) / 2));
  WriteRadDeg (arccos(1 / 2));
  WriteRadDeg (arccos(0));
  WriteRadDeg (arccos(-1));
end.
{https://www.freepascal.org/docs-html/rtl/math/arccos.html}


Program Example3;

{ Program to demonstrate the arcosh function. }

Uses math;

begin
  Writeln(arcosh(1) : 0 : 6);
  Writeln(arcosh(2) : 0 : 6);
end.


Program Example4;

{ Program to demonstrate the arsinh function. }

Uses math;

begin
  Writeln(arsinh(0));
  Writeln(arsinh(1));
end.
{https://www.freepascal.org/docs-html/rtl/math/arsinh.html}


Program Example5;

{ Program to demonstrate the artanh function. }

Uses math;

begin
  Writeln(artanh(0) : 0 : 5);
  Writeln(artanh(0.5) : 0 : 5);
end.
{https://www.freepascal.org/docs-html/rtl/math/artanh.html}

Program Example13;

{ Program to demonstrate the floor function. }

Uses math;

begin
  Writeln(Ceil(-3.7)); // should be -4
  Writeln(Ceil(3.7)); // should be 3
  Writeln(Ceil(-4.0)); // should be -4
end.


Program Example10;

{ Program to demonstrate the cycletorad function. }

Uses math;

begin
  // Should print 1/2
  writeln(cos(cycletorad(1 / 6)));
  // should be sqrt(2)/2
  writeln(cos(cycletorad(1 / 8)));
end.
{http://www.freepascal.org/docs-html/rtl/math/cycletorad.html}


Program Example11;

{ Program to demonstrate the degtograd function. }

Uses math;

begin
  writeln(degtograd(90));
  writeln(degtograd(180));
  writeln(degtograd(270))
end.
{http://www.freepascal.org/docs-html/rtl/math/degtograd.html}


Program Example34;

{ Program to demonstrate the power function. }

Uses Math;

procedure dopower(x, y : float);

begin
  writeln(x: 8 : 6, '^', y: 8 : 6, ' = ', power(x, y): 8 : 6)
end;

begin
  dopower(2, 2);
  dopower(2, -2);
  dopower(2, 0.0);
end.


Program Example48;

{ Program to demonstrate the Tanh function. }

Uses math;

begin
  writeln(tanh(0));
  writeln(tanh(1));
  writeln(tanh(-1));
end.
{http://www.freepascal.org/docs-html/rtl/math/tanh.html}





Complete Program
AnalogClock
program clock;
{ --------
  Analog clock demo for Pascal N-IDE
  by: Mr Bee -- @pak_lebah
}
uses
  CRT, Graph, SysUtils, DOS, Math;

type
    // screen orientation

  TOrientation = (oPortrait, oLandscape);

    // clock structure

  TPoint = record
    x, y : integer;
    // x,y coordinat
  end;

  TAngle = record
    a : float;
    // angle
    r : integer;
    // radius
  end;

var
  o : TOrientation;
  c : TPoint;
  a : TAngle;

// color selection shortcut
function color(r, g, b : byte) : integer;
var
  cs : android_graphics_Color;
  c : integer;
begin
  c := cs.rgb(r, g, b);
  color := c;
end;

// angle (degree) point inside a circle
function point(c : TPoint; a : TAngle) : TPoint;
var
  r : TPoint;
begin
  r.x := round(c.x + a.r * sin(degToRad(a.a)));
  r.y := round(c.y + a.r * cos(degToRad(a.a)));
  point := r;
end;

// clock-wise point inside a circle
function hand(c : TPoint; a : TAngle) : TPoint;
var
  p : TPoint;
begin
  a.a := -a.a - 180; // adjust to screen
  p := point(c, a);
  hand := p;
end;

procedure drawText;
var
  t : string = 'Analog Clock';
  h, n, s, z, w : Word;
  j, m, d, e : string;
  yr, mo, dy, wd : Word;
begin
  setTextStyle(defaultFont, horizDir, 3);
  setTextJustify(leftText, topText);
  setColor(15);
  w := textWidth(t) div 2;
  if o = oPortrait then
    outTextXY(c.x - w, c.y - a.r - 50, t)
  else
    outTextXY(c.x - a.r - w * 2 - 50, c.y, t);
  // show digital time
  getTime(h, n, s, z);
  j := intToStr(h);
  if length(j) = 1 then j := '0' + j;
  m := intToStr(n);
  if length(m) = 1 then m := '0' + m;
  d := intToStr(s);
  if length(d) = 1 then d := '0' + d;
  e := intToStr(z);
  if length(e) = 1 then e := '0' + e;
  t := j + ':' + m + ':' + d + '.' + e;
  w := textWidth(t) div 2;
  if o = oPortrait then
    outTextXY(c.x - w, c.y + a.r + 80, t)
  else
    outTextXY(c.x + a.r + 50, c.y, t);
  getDate(yr, mo, dy, wd);
  // FORMAT DOES NOT WORK!!!
  //t := format('%-2.2d-%-2.2d-%-2.2d',[dy,mo,yr]);
  //outTextXY(c.x-w,c.y+a.r+140,t)
end;

procedure handHour(h, n : integer);
var
  p : TPoint;
  r : TAngle;
begin
  if h > 11 then h := h - 12;
  r := a;
  r.a := (h + n / 60) * 30;
  r.r := r.r div 2 - 12;
  p := hand(c, r);
  // hand
  setColor(lightBlue);
  setLineStyle(solidLn, 0, 24);
  setFillStyle(solidFill, lightBlue);
  line(c.x, c.y, p.x, p.y);
  // rounded tip
  setLineStyle(solidLn, 0, 1);
  //pieSlice(p.x,p.y,0,360,11);
end;

procedure handMinute(n, s : integer);
var
  p : TPoint;
  r : TAngle;
begin
  r := a;
  r.a := (n + (s / 60)) * 6;
  r.r := r.r - 50;
  p := hand(c, r);
  // hand
  setColor(lightGreen);
  setLineStyle(solidLn, 0, 12);
  setFillStyle(solidFill, lightGreen);
  line(c.x, c.y, p.x, p.y);
  // rounded tip
  setLineStyle(solidLn, 0, 1);
  //pieSlice(p.x,p.y,0,360,5);
end;

procedure handSecond(s, z : integer);
var
  p : TPoint;
  r : TAngle;
begin
  r := a;
  r.a := (s + (z / 100)) * 6;
  setColor(red);
  setFillStyle(solidFill, red);
  // hand
  r.r := a.r - 20;
  p := hand(c, r);
  setLineStyle(solidLn, 0, 4);
  line(c.x, c.y, p.x, p.y);
  // circle tip
  {r.r := a.r-30;
  p := hand(c,r);
  circle(p.x,p.y,10);}
  // calculate tail
  r.a := r.a - 180;
  r.r := 60;
  p := hand(c, r);
  // tail
  setLineStyle(solidLn, 0, 4);
  line(c.x, c.y, p.x, p.y);
  // center
  pieSlice(c.x, c.y, 0, 360, 20);
end;

procedure drawFace;
var
  i : integer;
  p : TPoint;
  r : TAngle;
begin
  // style
  setTextJustify(centerText, centerText);
  setTextStyle(defaultFont, horizDir, 3);
  setLineStyle(solidLn, 0, 2);
  setFillStyle(solidFill, color(24, 24, 24));
  setColor(7);
  r := a;
  // border
  //circle(c.x,c.y,a.r);
  pieSlice(c.x, c.y, 0, 360, a.r);
  // center
  //circle(c.x,c.y,10);
  // tick marks
  i := 0;
  r.r := r.r - 30;
  repeat
    i := i + 1;
    r.a := i * 6; // second degree
    p := hand(c, r);
      // hour ticks
    if i * 6 mod 30 = 0 then
      fillEllipse(p.x, p.y, 1, 1)
    else
      putPixel(p.x, p.y, 7);
  until i > 60;
  // hour marks
  i := 0;
  r.r := r.r - 30;
  repeat
    i := i + 1;
    r.a := i * 30; // hour degree
    p := hand(c, r);
    outTextXY(p.x, p.y, intToStr(i));
  until i >= 12;
end;

procedure getOrientation;
begin
  c.x := getMaxX div 2;
  c.y := getMaxY div 2;
  if c.x > c.y then o := oLandscape
  else o := oPortrait;
  if o = oLandscape then
    a.r := c.y - 10 else a.r := c.x - 10;
end;

procedure openScreen;
var
  gd, gm : integer;
begin
  gd := detect;
  setBufferEnable(true);
  initGraph(gd, gm, '');
end;

procedure closeScreen;
begin
  closeGraph;
end;

var
  h, n, s, z : word;
begin
  openScreen;
  getOrientation;

  repeat
    clearBuffer;
    drawText;
    drawFace;
    getTime(h, n, s, z);

    handHour(h, n);
    handMinute(n, s);
    handSecond(s, z);
    drawBuffer;
  until keyPressed;

  closeScreen;
end.


Ball.pas
program Ball;
uses  CRT, GRAPH;

    { Mini-Game | Мини-Игра }

VAR
  X, Y, F : INTEGER;
  G, S : CHAR;

procedure MoveLeft;
begin
  dec(x, 30);
  clearDevice;
  for F:=0 to 20 do
  begin
    circle(x, y, F);
    circle(x, y, F);
    circle(x, y, F);
  end;
  if x < 0 then x := getMaxX;
end;

procedure MoveRight;
begin
  inc(x, 30);
  clearDevice;
  for F:=0 to 20 do
  begin
    circle(x, y, F);
    circle(x, y, F);
    circle(x, y, F);
  end;
  if x > getMaxX then x := 0;
end;

procedure MoveUp;
begin
  dec(y, 30);
  clearDevice;
  for F:=0 to 20 do
  begin
    circle(x, y, F);
    circle(x, y, F);
    circle(x, y, F);
  end;
  if y < 0 then y := getMaxY;
end;

procedure MoveDown;
begin
  inc(y, 30);
  clearDevice;
  for F:=0 to 20 do
  begin
    circle(x, y, F);
    circle(x, y, F);
    circle(x, y, F);
  end;
  if y > getMaxY then y := 0;
end;

BEGIN
  randomize;
  if getMaxX > getMaxY then exit;
  writeln('Русский | English   (1 | 2)');
  s := readkey;
  if getMaxX > getMaxY then exit;
  if s = '2' then
  begin
    x := getMaxX div 2;
    y := getMaxY div 2;
    initGRAPH(detect, detect, '');
    CursorOFF;
    clrSCR;
    ClearDevice;
    setCOLOR(-6656);
    setTextStyle(0, 0, 5);
    outTextXY(125, 75, 'g');
    outTextXY(50, 177, 'c');
    outTextXY(125, 180, 'v');
    outTextXY(200, 165, 'b');
    setCOLOR(-16743292);
    outTextXY(125, 270, '+');
    setCOLOR(-1);
    for F:=0 to 20 do
    begin
      circle(x, y, F);
      circle(x, y, F);
      circle(x, y, F);
    end;
    setCOLOR(-16758009);
    While True Do
    begin
      if getMaxX > getMaxY then exit;
      g := ReadKEY;
      if getMaxX > getMaxY then exit;
      if g = 'g' then
      begin
        MoveUp;
        MoveUp;
      end else
        if g = 'v' then
        begin
          MoveDown;
          MoveDown;
        end else
          if g = 'c' then
          begin
            MoveLeft;
            MoveLeft;
          end else
            if g = '+' then setCOLOR(random(getMaxColor)) else
              if g = 'b' then
              begin
                MoveRight;
                MoveRight;
              end else write;
    end;
  end
  else if s = '1' then
  begin
    x := round(getMaxX / 2);
    y := round(getMaxY / 2);
    initGRAPH(detect, detect, '');
    CursorOFF;
    clrSCR;
    ClearDevice;
    setCOLOR(-6656);
    setTextStyle(0, 0, 5);
    outTextXY(125, 75, 'н');
    outTextXY(60, 150, 'п');
    outTextXY(125, 230, 'и');
    outTextXY(190, 151, 'о');
    setCOLOR(-16743292);
    outTextXY(125, 320, '+');
    setCOLOR(-1);
    for F:=0 to 20 do
    begin
      circle(x, y, F);
      circle(x, y, F);
      circle(x, y, F);
    end;
    setCOLOR(-16758009);
    While True Do
    begin
      if getMaxX > getMaxY then exit;
      g := ReadKEY;
      if getMaxX > getMaxY then exit;
      if g = 'н' then MoveUp else
        if g = 'и' then MoveDown else
          if g = 'п' then MoveLeft else
            if g = '+' then setCOLOR(random(getMaxColor)) else
              if g = 'о' then MoveRight else write;
    end;
  end else exit;
END.


assigment.pas
{http://wiki.freepascal.org/Programming_Assignment}

(* Author:    Tao Yue
   Date:      19 June 1997
   Description:
      Find the sum and average of five predefined numbers
   Version:
      1.0 - original version
*)

program SumAverage;

const
  NumberOfIntegers = 5;

var
  A, B, C, D, E : integer;
  Sum : integer;
  Average : real;

begin
  (* Main *)
  A := 45;
  B := 7;
  C := 68;
  D := 2;
  E := 34;
  Sum := A + B + C + D + E;
  Average := Sum / NumberOfIntegers;
  writeln ('Number of integers = ', NumberOfIntegers);
  writeln ('Number1 = ', A);
  writeln ('Number2 = ', B);
  writeln ('Number3 = ', C);
  writeln ('Number4 = ', D);
  writeln ('Number5 = ', E);
  writeln ('Sum = ', Sum);
  writeln ('Average = ', Average)
end.


program bounceBalls;

{ --------
  Bouncing balls demo for Pascal N-IDE
  by: Mr Bee -- @pak_lebah
}

uses
  CRT, Graph;

type
  TBall = record
    bc, br : integer;
    bx, by : integer;
    dx, dy : integer;
    mx, my : integer;
    nx, ny : integer;
    gl, gu : boolean;
  end;

const
  nBall = 9; // number of balls

var
  Balls : array[1..nBall] of TBall;

function randomColor : integer;
var
  cs : android_graphics_Color;
begin
  randomColor := cs.rgb(random(224) + 32,
                         random(224) + 32, random(224) + 32);
end;

procedure MoveBall(var aBall : TBall);
begin
  with aBall do
  begin
    // direction
    if gl then bx := bx - dx
    else bx := bx + dx;
    if gu then by := by - dy
    else by := by + dy;
    // bouncing
    if bx < nx then
    begin
      bx := nx;
      gl := false;
    end;
    if bx > mx then
    begin
      bx := mx;
      gl := true;
    end;
    if by < ny then
    begin
      by := ny;
      gu := false;
    end;
    if by > my then
    begin
      by := my;
      gu := true;
    end;
  end;
end;

procedure DrawBall(aBall : TBall);
begin
  with aBall do
  begin
    SetColor(bc);
    SetFillStyle(SolidFill, bc);
    PieSlice(bx, by, 0, 360, br);
  end;
end;

procedure InitBalls(w, h : integer);
var
  i : integer;
begin
  for i := 1 to nBall do
    with Balls[i] do
    begin
      bc := randomColor; // color
      br := random(34) + 23; // radius
      bx := random(w - br) + br; // start x
      by := random(h - br) + br; // start y
      dx := random(13) + 1; // speed x
      dy := random(13) + 1; // speed y
      mx := w - br - 1; // max x
      my := h - br - 1; // max y
      nx := br + 1; // min x
      ny := br + 1; // min y
      gl := random(2) = 0; // move left
      gu := random(2) = 0; // move up
    end;
end;

var
  cs : android_graphics_Color;
  i, c : integer;
  mx, my : integer;
begin
  // enable double buffered
  setBufferEnable(true);
  InitGraph(detect, 0, '');
  mx := GetMaxX;
  my := GetMaxY;

  // create balls
  Randomize;
  InitBalls(mx, my);
  SetLineStyle(SolidLn, 0, ThickWidth);

  // balls animation
  while not keyPressed do
  begin
    // re-initiate if orientation change
    {if (GetMaxX <> mx) or (GetMaxY <> my) then
    begin
      mx := getMaxX;
      my := getMaxY;
      InitBalls(mx,my);
    end;}

    // draw background box
    SetColor(15);
    c := cs.argb(100, 1, 1, 1);
    setFillStyle(solidFill, c);
    Bar(0, 0, mx, my);
    // draw background text
    SetTextStyle(boldFont, horizDir, 9);
    SetTextJustify(centerText, centerText);
    outTextXY(mx div 2, my div 2, '⚽️ Hello 😊');

    // draw balls
    for i := 1 to nBall do
      DrawBall(Balls[i]);
    // move balls
    for i := 1 to nBall do
      MoveBall(Balls[i]);

    // redraw buffer to screen
    drawBuffer;
  end;
end.


program factorial;

function factorial(i : integer) : integer;
begin
  if i = 1 then
    factorial := 1
  else
    factorial := factorial(i - 1) * i;
end;

begin
  write('10! = ', factorial(10));
  readln;
end.

{if you want to improve this code, please send code to me
tranleduy1233@gmail.com}


(* Author:    Tao Yue
   Date:      19 July 1997
   Description:
      Find the first 10 Fibonacci numbers
   Version:
      1.0 - original version
*)

{
Problem 1
Find the first 10 numbers in the Fibonacci sequence.
The Fibonacci sequence starts with two numbers: 1 1

Each subsequent number is formed by adding the two numbers before it.
 1+1=2, 1+2=3, 2+3=5, etc. This forms the following sequence:
1 1 2 3 5 8 13 21 34 55 89 144 ...
}

program Fibonacci;

var
  Fibonacci1, Fibonacci2 : integer;
  temp : integer;
  count : integer;

begin
  (* Main *)
  writeln ('First ten Fibonacci numbers are:');
  count := 0;
  Fibonacci1 := 0;
  Fibonacci2 := 1;
  repeat
    write (Fibonacci2: 7);
    temp := Fibonacci2;
    Fibonacci2 := Fibonacci1 + Fibonacci2;
    Fibonacci1 := Temp;
    count := count + 1
  until count = 10;
  writeln;

  (* Of course, you could use a FOR loop or a WHILE loop
     to solve this problem. *)

end.     (* Main *)


(* Author:    Tao Yue
   Date:      13 July 2000
   Description:
      Display all powers of two up to 20000, five per line
   Version:
      1.0 - original version
*)

{
Problem 2
Display all powers of 2 that are less than 20000.
Display the list in a properly formatted manner,
with commas between the numbers. Display five
numbers per line. The output should look like:
    1, 2, 4, 8, 16,
32, 64, 128, 256, 512,
1024, 2048, 4096, 8192, 16384
}

program power_of_two;

const
  numperline = 5;
  maxnum = 20000;
  base = 2;

var
  number : longint;
  linecount : integer;

begin
  (* Main *)
  writeln ('Powers of ', base, ', 1 <= x <= ', maxnum, ':');
  (* Set up for loop *)
  number := 1;
  linecount := 0;
  (* Loop *)
  while number <= maxnum do
  begin
    linecount := linecount + 1;
    (* Print a comma and space unless this is the first
       number on the line *)
    if linecount > 1 then
      write (', ');
    (* Display the number *)
    write (number);
    (* Print a comma and go to the next line if this is
       the last number on the line UNLESS it is the
       last number of the series *)
    if (linecount = numperline) and not (number * 2 > maxnum) then
    begin
      writeln (',');
      linecount := 0
    end;
    (* Increment number *)
    number := number * base;
  end; (* while *)
  writeln;

  (* This program can also be written using a
     REPEAT..UNTIL loop. *)

end.     (* Main *)





text_animate.pas
program animateGraph;

{ --------
  Text animation on graphics
  by: Mr Bee -- @pak_lebah
}

uses CRT, Graph;

const
    // global value setup
  THE_TEXT = 'PASCAL ON ANDROID';
  V_MOTION = 20;
    // motion speed
  D_MOTION = 1;   // motion delay

type
    // letter structure

  TLetter = record
    l : string;
    // character
    x, y : integer;
    // position
    w, h : integer;
    // dimension
    c : integer;
    // color
  end;

  TLetters = array of TLetter;

var
  goSpread : boolean;
    // motion direction
  goStraight : boolean;
    // animation mode
  doneX, doneY, done : boolean; // anim state

// generate random color
function randomColor : integer;
var
  cs : android_graphics_Color;
begin
  randomColor :=
                cs.argb(255, random(192) + 64,
                         random(192) + 64, random(192) + 64);
end;

// spread letters all over the screen
procedure spread(var l : TLetters);
var
  i : integer;
begin
  for i := 0 to high(l) do
  begin
    // random all over the screen
    l[i].x := random(getMaxX - l[i].w) + 1;
    l[i].y := random(getMaxY - l[i].h) + 1;
    l[i].c := randomColor;
  end;
end;

// gather all letters into a text
procedure gather(var l : TLetters);
var
  tw, th : integer;
    // text dimension
  tx, ty : integer;
    // text position
  i : integer;
  s : string;
begin
  // compute text dimension
  s := '';
  tw := 0;
  for i := 0 to high(l) do s += l[i].l;
  for i := 0 to high(l) do tw += l[i].w;
  th := textHeight(s);
  tx := random(getMaxX - tw) + 1;
  ty := random(getMaxY - th) + 1;
  // align text onto new position
  tw := 0;
  for i := 0 to high(l) do
  begin
    l[i].x := tx + tw;
    l[i].y := ty; // horz aligned
    l[i].c := randomColor;
    tw += l[i].w;
  end;
end;

// animate on x position
procedure animX(var f, t : TLetters);
var
  i, v : integer;
begin
  v := V_MOTION;
  doneX := true;
  for i := 0 to high(f) do
  begin
    // move left
    if f[i].x > t[i].x then
    begin
      f[i].x := f[i].x - v;
      if f[i].x < t[i].x then
        f[i].x := t[i].x;
    end
        // move right
    else if f[i].x < t[i].x then
    begin
      f[i].x := f[i].x + v;
      if f[i].x > t[i].x then
        f[i].x := t[i].x
    end
    else
      f[i].x := t[i].x;
    // save state
    doneX := doneX and (f[i].x = t[i].x);
  end;
end;

// animate on y position
procedure animY(var f, t : TLetters);
var
  i, v : integer;
begin
  v := V_MOTION;
  doneY := true;
  for i := 0 to high(f) do
  begin
    // move up
    if f[i].y > t[i].y then
    begin
      f[i].y := f[i].y - v;
      if f[i].y < t[i].y then
        f[i].y := t[i].y;
    end
        // move down
    else if f[i].y < t[i].y then
    begin
      f[i].y := f[i].y + v;
      if f[i].y > t[i].y then
        f[i].y := t[i].y
    end
    else
      f[i].y := t[i].y;
    // save state
    doneY := doneY and (f[i].y = t[i].y);
  end;
end;

// animate text
procedure animate(var f, t : TLetters);
begin
  if goStraight then
  begin
    if not doneX then animX(f, t);
    if not doneY then animY(f, t);
  end else
  begin
    if goSpread then
    begin
      // go vertical first
      if not doneY then
        animY(f, t)
      else begin
        if not doneX then
          animX(f, t);
      end;
    end else
    begin
      // go horizontal first
      if not doneX then
        animX(f, t)
      else begin
        if not doneY then
          animY(f, t);
      end;
    end;
  end;
  // animation state
  done := doneX and doneY;
end;

// print letters on the screen
procedure print(l : TLetters);
var
  i : integer;
begin
  for i := 0 to high(l) do
  begin
    setColor(l[i].c);
    outTextXY(l[i].x, l[i].y, l[i].l);
  end;
end;

// convert string to animated letters
function toLetters(s : string) : TLetters;
var
  i, w : integer;
  l : TLetters;
begin
  w := 1;
  setLength(l, length(s));
  for i := 0 to length(s) - 1 do
  begin
    l[i].l := s[i + 1];
    l[i].w := textWidth(l[i].l) + 3;
    l[i].h := textHeight(l[i].l) + 2;
    l[i].x := w;
    l[i].y := l[i].h;
    l[i].c := randomColor;
    // space doesn't have width
    if l[i].l = ' ' then
      l[i].w := textWidth('H') + 2;
    // i is too thin
    if upCase(l[i].l) = 'I' then
      l[i].w := l[i].w + 2;
    w += l[i].w;
  end;
  toLetters := l;
end;

// remove text footprint
procedure clear(l : TLetters);
var
  cs : android_graphics_Color;
  i : integer;
begin
  clearBuffer;
  for i := 0 to high(l) do
  begin
    setColor(cs.rgb(32, 32, 32));
    outTextXY(l[i].x, l[i].y, l[i].l);
  end;
end;

// copy letter colors
procedure copyColor(var f, t : TLetters);
var
  i : integer;
begin
  for i := 0 to high(f) do
    t[i].c := f[i].c;
end;

// screen setup
procedure openScreen;
var
  gd, gm : integer;
begin
  randomize;
  // setup graph mode
  gd := detect;
  setBufferEnable(true);
  initGraph(gd, gm, '');
  setTextJustify(leftText, bottomText);
  setTextStyle(gothicFont, horizDir, 3);
end;

// screen closing
procedure closeScreen;
begin
  closeGraph;
end;

{+++ MAIN PROGRAM +++}

var
  f, t : TLetters;
begin
  // setup
  openScreen;
  goSpread := true;
  goStraight := true;
  f := toLetters(THE_TEXT);
  t := toLetters(THE_TEXT);
  gather(f); // from (origin)
  spread(t); // to (target)

  // animate
  repeat
      // draw
    clear(t);
    print(f);
    drawBuffer;
    delay(D_MOTION);

      // check done
    if done then
    begin
      // switch destination
      copyColor(t, f);
      goSpread := not goSpread;
      if goSpread then spread(t)
      else gather(t);

      // freeze for 1 second
      delay(1000);
      // reset state
      doneX := false;
      doneY := false;
      done := false;

      // switch mode
      if random(2) = 1 then
        goStraight := not goStraight;
    end;

      // motion
    animate(f, t);
  until keyPressed;

  // close down
  closeScreen;
end.


towers_of_hanoi.pas
{http://wiki.freepascal.org/Programming_Assignment_4}

(* Author:    Tao Yue
   Date:      13 July 2000
   Description:
      Solves the Towers of Hanoi
   Version:
      1.0 - original version
*)

program TowersofHanoi;

var
  numdiscs : integer;

(* *******************************************************)

procedure DoTowers (NumDiscs, OrigPeg, NewPeg, TempPeg : integer);
(* Explanation of variables:
      Number of discs -- number of discs on OrigPeg
      OrigPeg -- peg number of the tower
      NewPeg -- peg number to move the tower to
      TempPeg -- peg to use for temporary storage
*)

begin
  (* Take care of the base case -- one disc *)
  if NumDiscs = 1 then
    writeln (OrigPeg, ' ---> ', NewPeg)
      (* Take care of all other cases *)
  else
  begin
    (* First, move all discs except the bottom disc
       to TempPeg, using NewPeg as the temporary peg
       for this transfer *)
    DoTowers (NumDiscs - 1, OrigPeg, TempPeg, NewPeg);
    (* Now, move the bottommost disc from OrigPeg
       to NewPeg *)
    writeln (OrigPeg, ' ---> ', NewPeg);
    (* Finally, move the discs which are currently on
       TempPeg to NewPeg, using OrigPeg as the temporary
       peg for this transfer *)
    DoTowers (NumDiscs - 1, TempPeg, NewPeg, OrigPeg)
  end
end;

(********************************************************)


begin
  (* Main *)
  write ('Please enter the number of discs in the tower ===> ');
  readln (numdiscs);
  writeln;
  DoTowers (numdiscs, 1, 3, 2)
end.     (* Main *)


Android

uses
  aSensor, crt;

var
  x, y, z : real;
begin
  clrscr;
  writeln('Press any key to stop program');
  {1 = All,
  2 = Accelerometer,
  3 = Magnetometer,
  4 = Light,
  5 = Pressure,
  6 = Gravity,
  7 = Humidity,
  8 = Temperature}

  {Start sensor monitor, Accelerometer}
  startSensor(2);
  while not keypressed do
  begin
    {Get x, y, z value}
    x := getXAccelerometer;
    y := getYAccelerometer;
    z := getZAccelerometer;

    {Print to console}
    writeln('  x = ', x: 3 : 3);
    writeln('  y = ', y: 3 : 3);
    writeln('  z = ', z: 3 : 3);
    {Clear screen}
    delay(100);
    clrscr;
  end;
  stopSensor;
end.

{For more information of Accelerometer sensor,
 see wiki https://en.wikipedia.org/wiki/Accelerometer
or search with keyword "Acceleromeer sensor"
If you want to improve this sample, please send code to me
Tranleduy1233@gmail.com}


uses aBattery, crt;

var
  status, health, level : Integer;
  plugType : Integer;
  tech : string;
  vol : Integer;
  temp : Integer;

procedure printStatus(i : Integer);
begin
  {Returns the most recently received battery status data:
  1 - unknown;
  2 - charging;
  3 - discharging;
  4 - not charging;
  5 - full;}
  write('Battery status: ');
  case i of
    1 : writeln('unknown');
    2 : writeln('charging');
    3 : writeln('discharging');
    4 : writeln('not charging');
    5 : writeln('full');
  end;
end;

procedure printHealth(i : integer);
begin
  {Returns the most recently received battery health data:
  1 - unknown;
  2 - good;
  3 - overheat;
  4 - dead;
  5 - over voltage;
  6 - unspecified failure;}
  case i of
    1 : writeln('unknown');
    2 : writeln('good');
    3 : writeln('overheat');
    4 : writeln('not dead');
    5 : writeln('over voltage');
    6 : writeln('unspecified failure');
  end;
end;

procedure printPlugType(i : Integer);
begin
  {Returns the most recently received plug type data:
  -1 - unknown
  0 - unplugged;
  1 - power items is an AC charger
  2 - power items is a USB port
  }
  case i of
    -1 : writeln('unknown');
    0 : writeln('unplugged');
    1 : writeln('power source is an AC charger');
    2 : writeln('power source is a USB port');
  end;
end;

procedure printLevel(i : Integer);
begin
  writeln('battery level (percentage): ', i, ' %');
end;

procedure printTechnology(tech : string);
begin
  writeln('Battery technology data: ', tech);
end;

procedure printVoltage(vol : Integer);
begin
  writeln('Voltage: ', vol);
end;

procedure printTemp(temp : Integer);
begin
  writeln('Temperature: ', vol);
end;

begin
  {Start monitor}
  batteryStartMonitoring;
  {Wait 1 second for collection info}
  delay(1000);

  status := batteryGetStatus;
  printStatus(status);

  health := batteryGetHealth;
  printHealth(health);

  level := batteryGetLevel;
  printLevel(level);

  plugType := batteryGetPlugType;
  printPlugType(plugType);

  tech := batteryGetTechnology;
  printTechnology(tech);

  temp := batteryGetTemperature;
  printTemp(temp);

  vol := batteryGetVoltage;
  printVoltage(vol);

  {stop}
  batteryStopMonitoring;
  readln;
end.

{declare library for use clipboard on Android}
uses aClipboard;

var
  s, clip : string;

begin
  writeln('Please enter text: ');
  readln(s);

  {Put text in the clipboard.}
  setClipboard(s);

  {Read text from the clipboard.}
  clip := getClipboard;
  writeln(clip);
end.



{declare library for use clipboard on Android}
uses aClipboard;

var
  s, clip : string;

begin
  writeln('Please enter text: ');
  readln(s);

  {Put text in the clipboard.}
  setClipboard(s);

  {Read text from the clipboard.}
  clip := getClipboard;
  writeln(clip);
end.



uses aTone;

var
  phone : string;
  time : integer;
begin
  writeln('Enter your phone number (or 1234567890): ');
  readln(phone);

  time := 1000; {1000 milisecond}

  generateTones(phone, time);

  readln;
end.


getlink.pas
var
  url : java_net_URL;
  a : string;
  conn : java_net_URLConnection;
  br : java_io_BufferedReader;
    is :
  java_io_InputStreamReader;
  inputLine : String;
begin
  a := 'http://vnoi.info/';
  New(url, a);
  conn := url.openConnection();

  New( is, conn.getInputStream());
  New(br, is);

  while inputLine <> null do
  begin
    inputLine := br.readLine();
    writeln(inputLine);
  end;

  br.close();

  readln;
end.


media_player.pas
uses aMedia, crt;

var
  key : string;
begin
  key := 'myMusic';

  {open a media file, replace url of your media}
  assignMedia('path to file media', key);

  playMedia(key);

  {pause 10 second}
  delay(10000);

  closeMedia(key);
end.


{Declare library}
uses aNotify;

begin
  writeln('Look! Status bar has a new notify');
  notify('This is a title', 'This is a message');
  readln;
end.


uses
  aHtml;

var
  result : string;
begin
  result := getContentHtml('https://www.google.com.vn/');
  writeln(result);
end.


uses aRecognition;

var
  result : string;
begin
  writeln('Hello, please speak something: ');

  {Wait...}
  result := speechToText;

  {Print to console}
  writeln(result);
  readln;
end.


uses aTTSpeech;

var
  input : String;
begin
  {Please enable network, audio permission, speaker ...}

  writeln('Enter your text: ');
  readln(input);

  {Text to speech, wait....}
  speak(input);

  readln;

  {Stop the speak}
  stopSpeak();
end.


vibrate.pas
uses aVibrate, crt;

var
  i : integer;
begin
  for i := 1 to 10 do
  begin
    writeln('vibrate 200 ms');
    vibrate(200);
    delay(500);
  end;

  readln;
  {Stop}
  cancelVibrate;
end.
Android Dialog

Uses
  aDialog;

Var
  title, hint, msg : string;
Begin
  title := 'Hello';
  msg := 'This is Pascal NIDE';

  DialogAlert(title, msg, true); //<==

  Readln;
End.


uses
  aDialog;

var
  result : org_json_JSONObject;
  year, month, day : Integer;
begin
  //yyyy/mm/dd
  result := dialogGetDate(2017, 7, 12);

  year := result.getInt('year');
  month := result.getInt('month');
  day := result.getInt('day');

  writeln('date = ', day, '/', month, '/', year);
end.


Uses
  aDialog;

Var
  title, hint, result : string;
Begin
  title := 'What''s your name?';
  hint := 'Enter here';

  result := dialogGetInput(title, hint, ''); //<==

  Writeln('hello' + result);
  Readln;
End.


Uses
  aDialog;

Var
  title, hint, result : string;
Begin
  title := 'What is your password?';
  hint := 'enter here';

  result := dialogGetPassword(title, hint);

  Writeln('Your password is', result);
  Readln;
End.


dialog_time.pas
Uses
  aDialog;

Var
  result : org_json_JSONObject;
  Minute : Integer;
  Hour : Integer;
Begin
  //  hh/mm 24h
  result := dialogGetTime(10, 20, true);

  Hour := result.getInt('hour');
  Minute := result.getInt('minute');

  Writeln('time =', hour, ':', minute);
End.

AndroidXzing
{Please install plugin BarCode before run this sample}
uses barCode;

var
  result : string;
begin
  writeln('Starting scan bar code....');
  result := scanBarCode;
  writeln('Scanned :' + result);
end.




Android Location

{declare library aLocation}
uses
  aLocation, crt;

{declare type java}
type
  map = java_util_Map;

{https://docs.oracle.com/javase/7/docs/api/java/util/Map.html}

  list = java_util_List;

    {https://docs.oracle.com/javase/7/docs/api/java/util/List.html}

  obj = java_lang_Object;

  loc = android_location_Location;
    {https://developer.android.com/reference/android/location/Location.html}
var
  i : Integer;
  data : map; {Location data will be saved here}

{This method will be print data to console,
include latitude, longitude,....}
procedure printData(data : map);
var
  providers : list;
  i : Integer;
  name : obj;
    //the name of provider
  info : loc; //store data of location
begin
  {Each provider has a set of criteria under
  which it may be used; for example, some providers
  require GPS hardware and visibility to a number
  of satellites; others require the use of the
  cellular radio, or access to a specific carriers
  network, or to the internet.}

  {Returns available providers on the phone}
  providers := locationProviders();

  for i := 0 to providers.size() - 1 do
  begin
    name := providers.get(i); //get name of provider in position i

    if (data.get(name) <> null) then //if the data of provider is exist
    begin
      cast(info, data.get(name));
      //print long,lat to console
      writeln('Latitude = ', info.getLatitude());
      writeln('Longitude = ', info.getLongitude());
    end;
  end;
  writeln('...');
end;


begin
  writeln('Please enable GPS, network,...');

  {Starts collecting location data.
  The first parameter is minimum time between updates in milliseconds
  The second parameter is minimum distance between updates in meters}
  startLocating(100, 10);

  //wait for 60 second
  for i := 1 to 60 do
  begin
    delay(1000); //wait for collect info
    data := readLocation(); //read data
    printData(data); //print data to console
  end;

  //stop collect data
  stopLocating();
end.


uses
  aLocation;

var
  list_provider : java_util_List;
  i : Integer;
begin
  //Returns available providers on the phone
  list_provider := locationProviders();

  for i := 0 to list_provider.size() - 1 do
    writeln(list_provider.get(i));
end.
People: Farah Alexandra