Pascal syntax highlighting
Pascal is a procedural programming language designed for teaching structured programming. Delphi is an Object Pascal dialect used for rapid application development.
Example:
program HelloWorld;
{ This is a simple Pascal program }
uses
SysUtils;
var
message: String;
begin
message := 'Hello, World!';
WriteLn(message);
ReadLn;
end.
Example:
program Variables;
var
{ Integer types }
age: Integer;
count: LongInt;
small: ShortInt;
{ Real types }
price: Real;
temperature: Double;
precise: Extended;
{ Character and string types }
initial: Char;
name: String;
{ Boolean }
flag: Boolean;
{ Pointer }
ptr: Pointer;
begin
age := 25;
price := 19.99;
initial := 'A';
name := 'Alice';
flag := True;
ptr := nil;
WriteLn('Age: ', age);
WriteLn('Price: ', price:0:2);
WriteLn('Name: ', name);
WriteLn('Flag: ', flag);
end.
Example:
program Constants;
const
PI = 3.14159;
MAX_SIZE = 100;
COMPANY_NAME = 'Acme Corp';
{ Typed constants (initialized variables in Delphi) }
Counter: Integer = 0;
Initialized: Boolean = False;
begin
WriteLn('PI: ', PI);
WriteLn('Max Size: ', MAX_SIZE);
WriteLn('Company: ', COMPANY_NAME);
{ In Delphi, typed constants can be modified }
Counter := Counter + 1;
WriteLn('Counter: ', Counter);
end.
Example:
program Operators;
var
a, b, result: Integer;
x, y: Real;
flag1, flag2: Boolean;
begin
{ Arithmetic operators }
a := 10;
b := 3;
result := a + b; { 13 }
result := a - b; { 7 }
result := a * b; { 30 }
result := a div b; { 3 - integer division }
result := a mod b; { 1 - remainder }
x := 10.0;
y := 3.0;
WriteLn(x / y); { 3.333... - real division }
{ Comparison operators }
WriteLn(a = b); { False }
WriteLn(a <> b); { True - not equal }
WriteLn(a > b); { True }
WriteLn(a < b); { False }
WriteLn(a >= b); { True }
WriteLn(a <= b); { False }
{ Logical operators }
flag1 := True;
flag2 := False;
WriteLn(flag1 and flag2); { False }
WriteLn(flag1 or flag2); { True }
WriteLn(flag1 xor flag2); { True }
WriteLn(not flag1); { False }
{ Bitwise operators }
result := 8 shl 1; { 16 - shift left }
result := 8 shr 1; { 4 - shift right }
end.
Example:
program ControlFlow;
var
i, x, choice: Integer;
begin
{ If-Then-Else }
x := 10;
if x > 0 then
WriteLn('Positive')
else if x < 0 then
WriteLn('Negative')
else
WriteLn('Zero');
{ Case statement }
choice := 2;
case choice of
1: WriteLn('Option One');
2: WriteLn('Option Two');
3: WriteLn('Option Three');
else
WriteLn('Invalid option');
end;
{ For loop (ascending) }
for i := 1 to 5 do
WriteLn('Count: ', i);
{ For loop (descending) }
for i := 5 downto 1 do
WriteLn('Countdown: ', i);
{ While loop }
i := 1;
while i <= 5 do
begin
WriteLn('While: ', i);
i := i + 1;
end;
{ Repeat-Until loop }
i := 1;
repeat
WriteLn('Repeat: ', i);
i := i + 1;
until i > 5;
end.
Example:
program SubPrograms;
{ Procedure without parameters }
procedure Greet;
begin
WriteLn('Hello!');
end;
{ Procedure with parameters }
procedure DisplaySum(a, b: Integer);
begin
WriteLn('Sum: ', a + b);
end;
{ Procedure with var parameter (pass by reference) }
procedure Swap(var x, y: Integer);
var
temp: Integer;
begin
temp := x;
x := y;
y := temp;
end;
{ Function returning a value }
function Add(a, b: Integer): Integer;
begin
Add := a + b; { Assign to function name }
end;
{ Function with Result variable (Delphi) }
function Multiply(a, b: Integer): Integer;
begin
Result := a * b;
end;
{ Recursive function }
function Factorial(n: Integer): Integer;
begin
if n <= 1 then
Factorial := 1
else
Factorial := n * Factorial(n - 1);
end;
var
x, y, sum: Integer;
begin
Greet;
DisplaySum(5, 3);
x := 10;
y := 20;
Swap(x, y);
WriteLn('x = ', x, ', y = ', y);
sum := Add(7, 8);
WriteLn('Sum: ', sum);
WriteLn('5! = ', Factorial(5));
end.
Example:
program Arrays;
var
numbers: array[1..5] of Integer;
matrix: array[1..3, 1..3] of Integer;
dynamic: array of Integer;
i, j: Integer;
begin
{ Static array }
numbers[1] := 10;
numbers[2] := 20;
numbers[3] := 30;
numbers[4] := 40;
numbers[5] := 50;
for i := 1 to 5 do
WriteLn('numbers[', i, '] = ', numbers[i]);
{ Multi-dimensional array }
for i := 1 to 3 do
for j := 1 to 3 do
matrix[i, j] := i * j;
{ Dynamic array (Delphi) }
SetLength(dynamic, 10);
for i := 0 to High(dynamic) do
dynamic[i] := i * i;
for i := 0 to High(dynamic) do
WriteLn('dynamic[', i, '] = ', dynamic[i]);
end.
Example:
program Records;
type
TPerson = record
name: String;
age: Integer;
salary: Real;
end;
TPoint = record
x, y: Integer;
end;
var
person: TPerson;
point: TPoint;
begin
{ Initialize record }
person.name := 'Alice';
person.age := 30;
person.salary := 50000.00;
WriteLn('Name: ', person.name);
WriteLn('Age: ', person.age);
WriteLn('Salary: ', person.salary:0:2);
{ Using with statement }
with person do
begin
WriteLn(name);
WriteLn(age);
end;
{ Record assignment }
point.x := 10;
point.y := 20;
WriteLn('Point: (', point.x, ', ', point.y, ')');
end.
Example:
program Pointers;
type
PInteger = ^Integer;
PNode = ^TNode;
TNode = record
data: Integer;
next: PNode;
end;
var
ptr: PInteger;
head: PNode;
value: Integer;
begin
{ Allocate memory }
New(ptr);
ptr^ := 42;
WriteLn('Value: ', ptr^);
Dispose(ptr);
{ Linked list node }
New(head);
head^.data := 100;
head^.next := nil;
WriteLn('Node data: ', head^.data);
Dispose(head);
{ GetMem/FreeMem (alternative) }
GetMem(ptr, SizeOf(Integer));
ptr^ := 99;
WriteLn('Value: ', ptr^);
FreeMem(ptr);
end.
Example:
program Strings;
var
str1, str2, result: String;
len: Integer;
ch: Char;
begin
{ String assignment and concatenation }
str1 := 'Hello';
str2 := 'World';
result := str1 + ' ' + str2;
WriteLn(result);
{ String length }
len := Length(result);
WriteLn('Length: ', len);
{ String indexing (1-based) }
ch := result[1]; { 'H' }
WriteLn('First char: ', ch);
{ String comparison }
if str1 = str2 then
WriteLn('Equal')
else
WriteLn('Not equal');
{ String functions }
WriteLn(UpperCase(str1));
WriteLn(LowerCase(str2));
WriteLn(Copy(result, 1, 5)); { 'Hello' }
WriteLn(Pos('World', result)); { 7 }
Delete(result, 1, 6); { Remove 'Hello ' }
WriteLn(result); { 'World' }
Insert('Beautiful ', result, 1);
WriteLn(result); { 'Beautiful World' }
end.
Example:
program FileIO;
var
textFile: TextFile;
line: String;
number: Integer;
begin
{ Write to file }
AssignFile(textFile, 'output.txt');
Rewrite(textFile);
WriteLn(textFile, 'Line 1');
WriteLn(textFile, 'Line 2');
WriteLn(textFile, 'Line 3');
CloseFile(textFile);
{ Read from file }
AssignFile(textFile, 'input.txt');
Reset(textFile);
while not Eof(textFile) do
begin
ReadLn(textFile, line);
WriteLn(line);
end;
CloseFile(textFile);
{ Append to file }
AssignFile(textFile, 'output.txt');
Append(textFile);
WriteLn(textFile, 'Appended line');
CloseFile(textFile);
end.
Example:
program OOP;
type
{ Base class }
TAnimal = class
private
FName: String;
protected
procedure SetName(const Value: String);
public
constructor Create(const AName: String);
destructor Destroy; override;
procedure MakeSound; virtual; abstract;
property Name: String read FName write SetName;
end;
{ Derived class }
TDog = class(TAnimal)
public
procedure MakeSound; override;
procedure Fetch;
end;
TCat = class(TAnimal)
public
procedure MakeSound; override;
end;
{ TAnimal implementation }
constructor TAnimal.Create(const AName: String);
begin
inherited Create;
FName := AName;
end;
destructor TAnimal.Destroy;
begin
WriteLn(FName, ' destroyed');
inherited;
end;
procedure TAnimal.SetName(const Value: String);
begin
FName := Value;
end;
{ TDog implementation }
procedure TDog.MakeSound;
begin
WriteLn(Name, ' says: Woof!');
end;
procedure TDog.Fetch;
begin
WriteLn(Name, ' is fetching the ball');
end;
{ TCat implementation }
procedure TCat.MakeSound;
begin
WriteLn(Name, ' says: Meow!');
end;
var
dog: TDog;
cat: TCat;
animal: TAnimal;
begin
{ Create objects }
dog := TDog.Create('Buddy');
cat := TCat.Create('Whiskers');
{ Use objects }
dog.MakeSound;
dog.Fetch;
cat.MakeSound;
{ Polymorphism }
animal := dog;
animal.MakeSound; { Calls TDog.MakeSound }
{ Free objects }
dog.Free;
cat.Free;
end.
Example:
program Exceptions;
var
x, y, result: Integer;
begin
try
x := 10;
y := 0;
result := x div y; { Division by zero }
except
on E: EDivByZero do
WriteLn('Error: Division by zero');
on E: Exception do
WriteLn('Error: ', E.Message);
end;
{ Try-Finally for cleanup }
try
{ Resource allocation }
WriteLn('Allocating resources...');
finally
{ Cleanup code always executes }
WriteLn('Cleaning up resources...');
end;
{ Raising exceptions }
try
raise Exception.Create('Custom error message');
except
on E: Exception do
WriteLn('Caught: ', E.Message);
end;
end.
Example:
{ MathUtils.pas - Unit definition }
unit MathUtils;
interface
function Add(a, b: Integer): Integer;
function Subtract(a, b: Integer): Integer;
function Multiply(a, b: Integer): Integer;
function Divide(a, b: Real): Real;
implementation
function Add(a, b: Integer): Integer;
begin
Result := a + b;
end;
function Subtract(a, b: Integer): Integer;
begin
Result := a - b;
end;
function Multiply(a, b: Integer): Integer;
begin
Result := a * b;
end;
function Divide(a, b: Real): Real;
begin
if b <> 0 then
Result := a / b
else
raise Exception.Create('Division by zero');
end;
end.
{ Main program using the unit }
program UnitExample;
uses
MathUtils;
var
x, y, sum: Integer;
begin
x := 10;
y := 5;
sum := Add(x, y);
WriteLn('Sum: ', sum);
WriteLn('Difference: ', Subtract(x, y));
WriteLn('Product: ', Multiply(x, y));
WriteLn('Quotient: ', Divide(x, y):0:2);
end.
Example:
program Sets;
type
TDay = (Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday);
TDays = set of TDay;
var
workdays, weekend: TDays;
today: TDay;
begin
{ Initialize sets }
workdays := [Monday, Tuesday, Wednesday, Thursday, Friday];
weekend := [Saturday, Sunday];
today := Wednesday;
{ Set membership }
if today in workdays then
WriteLn('It''s a workday')
else
WriteLn('It''s the weekend');
{ Set operations }
WriteLn('Union: ', workdays + weekend);
WriteLn('Intersection: ', workdays * weekend);
WriteLn('Difference: ', workdays - weekend);
end.
Example:
program Enumerations;
type
TColor = (Red, Green, Blue, Yellow);
TSize = (Small, Medium, Large);
var
color: TColor;
size: TSize;
begin
color := Red;
size := Medium;
{ Case with enumeration }
case color of
Red: WriteLn('Color is Red');
Green: WriteLn('Color is Green');
Blue: WriteLn('Color is Blue');
Yellow: WriteLn('Color is Yellow');
end;
{ Enumeration ordering }
if color < Blue then
WriteLn('Color comes before Blue');
{ Iterate through enumeration }
for color := Red to Yellow do
WriteLn(Ord(color));
end.