Comparison Programs

An equivalent Pascal program follows this VB module.

Imports System.IO
Module Module1
    'Program to be converted to Pascal
    Structure TAgeRec
        <VBFixedString(15)> Dim Surname As String
        Dim Age As Integer
    End Structure
    Dim AgeRec, AgeRecArray(2) As TAgeRec
    Dim iChoice As Integer
    Dim strChoice As String

    Sub Maths()
        Dim Int1, Int2, Sum, Product, IntQuotient, Remainder As Integer
        Dim Quotient As Double
        Console.Write("Please enter a small integer. ")
        Int1 = Console.ReadLine
        Console.Write("Please enter a smaller integer. ")
        Int2 = Console.ReadLine
        Sum = Int1 + Int2
        Product = Int1 * Int2
        Quotient = Int1 / Int2
        IntQuotient = Int1 \ Int2
        Remainder = Int1 Mod Int2
        Console.WriteLine("Their sum is " & Sum & ".")
        Console.WriteLine("Their product is " & Product & ".")
        Console.WriteLine("First int / Second int = " & FormatNumber(Quotient, 2))
        Console.WriteLine("Quotient after integer division = " & IntQuotient)
        Console.WriteLine("Remainder after integer division = " & Remainder)
    End Sub

    Sub StringManipulation()
        Dim Forename, Surname, FullName As String
        Dim SpacePos, NameLength As Integer
        Console.Write("Please enter your forename, a space then your surname. ")
        FullName = Console.ReadLine()
        SpacePos = InStr(FullName, " ")
        Forename = Left(FullName, SpacePos - 1)
        NameLength = Len(FullName)
        Surname = Right(FullName, NameLength - SpacePos)
        Console.WriteLine("Hello, " & Forename & "!")
        Console.WriteLine("Your surname is " & Surname & ".")
    End Sub

    Sub ProcessArrays()
        Dim IntArray(2), Count As Integer
        IntArray(0) = 0
        IntArray(1) = 10
        IntArray(2) = 20
        Console.WriteLine()
        For Count = 0 To 2
            Console.WriteLine("IntArray(" & Count & ") = " & IntArray(Count))
        Next
        Console.WriteLine()
        Dim Hookes(1, 4), Col, Row As Integer
        For Col = 0 To 4
            Hookes(0, Col) = 100 * Col
        Next
        Hookes(1, 0) = 244 : Hookes(1, 1) = 286 : Hookes(1, 2) = 325
        Hookes(1, 3) = 368 : Hookes(1, 4) = 405
        Console.Write("Mass (g)                ")
        For Row = 0 To 1
            If Row = 1 Then Console.Write("Length of spring (mm) ")
            For Col = 0 To 4
                Console.Write(Hookes(Row, Col) & " ")
            Next Col
            Console.WriteLine()
        Next Row
    End Sub

    Sub ProcessRecords()
        'Assign values to fields of record
        AgeRec.Surname = "Wallace"
        AgeRec.Age = 17
        'Assign record to array of records
        AgeRecArray(0) = AgeRec
        'Assign values to fields of records in an array
        AgeRecArray(1).Surname = "Murphy"
        AgeRecArray(1).Age = 18
        AgeRecArray(2).Surname = "McLeod"
        AgeRecArray(2).Age = 19
        Dim Count As Integer
        Console.WriteLine("Surname: Age")
        For Count = 0 To 2
            Console.WriteLine(AgeRecArray(Count).Surname & ": " _
                              & AgeRecArray(Count).Age)
        Next
    End Sub

    Sub ProcessDates()
        Dim BirthDate$
        Dim DateOfBirth As Date
        Dim Days As Long

        Console.WriteLine("Today's date: " & Today)
        Console.WriteLine("Today's date in long date format: " _
                          & Format(Today, "Long Date"))
        Console.Write("Please enter your date of birth. ")
        BirthDate$ = Console.ReadLine
        DateOfBirth = CDate(BirthDate$)
        Days = DateDiff("d", DateOfBirth, Now)
        Console.WriteLine("You have lived for " & Days & " days.")
    End Sub
    Function SphereVol(ByVal Radius As Double) As Double
        SphereVol = (4 * Math.PI * Radius ^ 3) / 3
    End Function

    Sub SaveTextFile()
        Const PATHNAME = "F:\test.txt"
        Dim txtWriter As New StreamWriter(PATHNAME)
        Console.WriteLine("Writing to text file")
        txtWriter.WriteLine("Text file saved using VB Express.")
        txtWriter.WriteLine("This is the second (and last) line of text.")
        txtWriter.Close()
    End Sub

    Sub ReadTextFile()
        Const PATHNAME = "F:\test.txt"
        Dim CurrentString$
        Dim txtReader As New StreamReader(PATHNAME)
        Do While txtReader.Peek() <> -1
            CurrentString$ = txtReader.ReadLine()
            Console.WriteLine(CurrentString$)
        Loop
        'Alternative code
        'CurrentString$ = txtReader.ReadToEnd
        'Console.WriteLine(CurrentString$)
        txtReader.Close()
    End Sub

    Sub SaveFileOfIntegers()
        Dim fs As New FileStream("F:\itest.dat", FileMode.Create, FileAccess.Write)
        Dim bWriter As New BinaryWriter(fs)
        Dim Int As Integer = 1
        Dim Count As Integer
        Dim IntArray() As Integer = {10, 20, 30, 40, 50}
        Console.WriteLine("Writing integers to file")
        bWriter.Write(Int)
        For Count = 0 To 4
            bWriter.Write(IntArray(Count))
        Next
        bWriter.Close()
        fs.Close()
    End Sub

    Sub ReadFileOfIntegers()
        Dim fs As New FileStream("F:\itest.dat", FileMode.Open, FileAccess.Read)
        Dim bReader As New BinaryReader(fs)
        Dim CurrentInt As Integer
        Console.Write("Integers read from file: ")
        Do While bReader.PeekChar() <> -1
            CurrentInt = bReader.ReadInt32()
            Console.Write(CurrentInt & " ")
        Loop
        Console.Write(CurrentInt & " ")
        Console.WriteLine()
        Console.Write("Third integer on file, obtained by random access: ")
        'Zero based byte positions.  Integer occupies 4 bytes.
        bReader.BaseStream.Seek((3 - 1) * 4, 0)
        CurrentInt = bReader.ReadInt32()
        Console.WriteLine(CurrentInt)
        bReader.Close()
        fs.Close()
    End Sub

    Sub SaveFileOfRecords()
        ProcessRecords()
        Dim Count As Integer
        FileOpen(1, "F:\rtest.txt", OpenMode.Random, , , Len(AgeRecArray(0)))
        Console.WriteLine("Writing records to file")
        For Count = 0 To 2
            FilePut(1, AgeRecArray(Count))
        Next
        FileClose(1)
    End Sub

    Sub ReadFileOfRecords()
        Dim Count As Integer
        FileOpen(1, "F:\rtest.txt", OpenMode.Random, , , Len(AgeRecArray(0)))
        Console.WriteLine("Surname        Age")
        For Count = 1 To 3
            FileGet(1, AgeRec, Count)
            Console.WriteLine(AgeRec.Surname & AgeRec.Age)
        Next
        FileClose(1)
    End Sub

    Sub Main()
        Do Until iChoice = 13
            Do Until iChoice > 0
                Console.WriteLine()
                Console.WriteLine("Please select one of the following options.")
                Console.WriteLine("1 - Use mathematical operators")
                Console.WriteLine("2 - Manipulate strings")
                Console.WriteLine("3 - Process dates")
                Console.WriteLine("4 - Process arrays")
                Console.WriteLine("5 - Process records")
                Console.WriteLine("6 - Call a function")
                Console.WriteLine("7 - Save a text file")
                Console.WriteLine("8 - Read a text file")
                Console.WriteLine("9 - Save a file of integers")
                Console.WriteLine("10 - Read a file of integers")
                Console.WriteLine("11 - Save a file of records")
                Console.WriteLine("12 - Read a file of records")
                Console.WriteLine("13 - Exit")
                strChoice = Console.ReadLine
                iChoice = Val(strChoice)
            Loop
            Select Case iChoice
                Case 1
                    Maths()
                Case 2
                    StringManipulation()
                Case 3
                    ProcessDates()
                Case 4
                    ProcessArrays()
                Case 5
                    ProcessRecords()
                Case 6
                    Dim SphereRadius, Volume As Double
                    Console.Write("Please give the radius of the sphere in m. ")
                    SphereRadius = Console.ReadLine
                    Volume = SphereVol(SphereRadius)
                    Console.WriteLine("Its volume is " & Format(Volume, "Fixed") _
                                      & " cubic metres.")
                Case 7
                    SaveTextFile()
                Case 8
                    ReadTextFile()
                Case 9
                    SaveFileOfIntegers()
                Case 10
                    ReadFileOfIntegers()
                Case 11
                    SaveFileOfRecords()
                Case 12
                    ReadFileOfRecords()
            End Select
            If iChoice < 13 Then iChoice = 0
        Loop
    End Sub
End Module
program Converted;
  {$APPTYPE CONSOLE}
  //Program converted to Pascal from VB 2010 Express
uses
  SysUtils, StrUtils;
type
  TAgeRec = record
    Surname : string[15];
    Age : integer
  end;
var
  AgeRec : TAgeRec;
  AgeRecArray: Array[0 .. 2] of TAgeRec;
  iChoice, ErrorCode  : integer;
  strChoice : string;
  SphereRadius, Volume : real;
  mySingle : single;
  IntArray : array[0 .. 4] of integer = (10, 20, 30, 40, 50);

procedure Maths;
var
  Int1, Int2, Sum, Product, IntQuotient, Remainder : Integer;
  Quotient : real;
begin
  write('Please enter a small integer. ');
  readln(Int1);
  write('Please enter a smaller integer. ');
  readln(Int2);
  Sum := Int1 + Int2;
  Product := Int1 * Int2;
  Quotient := Int1 / Int2;
  IntQuotient := Int1 DIV Int2;
  Remainder := Int1 MOD Int2;
  writeln('Their sum is ', Sum, '.');
  writeln('Their product is ', Product, '.');
  writeln('First int / Second int = ', Quotient : 6 : 2);
  writeln('Quotient after integer division = ', IntQuotient);
  writeln('Remainder after integer division = ', Remainder);
end;

procedure StringManipulation;
var
  Forename, Surname, FullName : String;
  SpacePos, NameLength : Integer;
begin
  write('Please enter your forename, a space then your surname. ');
  readLn(FullName);
  SpacePos := pos(' ', FullName);
  Forename := leftStr(FullName, SpacePos - 1);
  NameLength := length(FullName);
  Surname := rightStr(FullName, NameLength - SpacePos);
  writeln('Hello, ', Forename, '!');
  writeln('Your surname is ', Surname, '.');
end;

procedure ProcessArrays;
var
  Count, Col, Row: Integer;
  IntArray : array[0 .. 2] of integer;
  Hookes: array[0 .. 1, 0 .. 4] of integer;
begin
  IntArray[0] := 0;
  IntArray[1] := 10;
  IntArray[2] := 20;
  writeln;
  for Count := 0 to 2 do
    writeln('IntArray[', Count, '] = ', IntArray[Count]);
  writeln;
  for Col := 0 to 4 do
    Hookes[0, Col] := 100 * Col;
  Hookes[1, 0] := 244 ; Hookes[1, 1] := 286 ; Hookes[1, 2] := 325;
  Hookes[1, 3] := 368 ; Hookes[1, 4] := 405;
  write('Mass (g)                ');
  for Row := 0 to 1 do
    begin
      if Row = 1 then
        write('Length of spring (mm) ');
      for Col := 0 to 4 do
        write(Hookes[Row, Col], ' ');
      writeln;
    end;
end;

procedure ProcessRecords;
var
  Count : integer;
begin
  //Assign values to fields of record
  AgeRec.Surname := 'Wallace';
  AgeRec.Age := 17;
  //Assign record to array of records
  AgeRecArray[0] := AgeRec;
  //Assign values to fields of records in an array
  AgeRecArray[1].Surname := 'Murphy';
  AgeRecArray[1].Age := 18;
  AgeRecArray[2].Surname := 'McLeod';
  AgeRecArray[2].Age := 19;
  writeln('Surname: Age');
  for Count := 0 to 2 do
    writeln(AgeRecArray[Count].Surname, ': ',
             AgeRecArray[Count].Age);
end;

procedure ProcessDates;
var
  strBirthDate, strToday : string;
  DateOfBirth : TDateTime;
  Days : integer;
begin
  strToday := DateToStr(Date);
  writeln('Today''s date: ', strToday);
  writeln('Today''s date in long date format: ',
          FormatDateTime(LongDateFormat, Date));
  write('Please enter your date of birth. ');
  readln(strBirthDate);
  DateOfBirth := strToDate(strBirthDate);
  Days := trunc(Date - DateOfBirth);
  writeln('You have lived for ', Days, ' days.');
end;

function SphereVol (Radius : real) : real;
begin
   SphereVol := (4 * PI * SQR(Radius) * Radius)/3;
end;

procedure SaveTextFile;
const
  PATHNAME = 'F:\test.txt';
var
  TFile : TextFile;
begin
  assignFile(TFile, PATHNAME);
  rewrite(TFile);
  writeln('Writing to text file');
  writeln(TFile, 'Text file saved using Pascal.');
  writeln(TFile, 'This is the second (and last) line of text. ');
  closeFile(TFile);
end;

procedure ReadTextFile;
const
  PATHNAME = 'F:\test.txt';
var
  TFile : TextFile;
  CurrentString : string;
begin
  Assignfile(TFile, PATHNAME);
  reset(TFile);
  while not eof(TFile) do
    begin
      readln(TFile, CurrentString);
      writeln(CurrentString);
    end;
  closeFile(TFile);
end;

procedure SaveFileOfIntegers;
var
 Int, Count : integer;
 IFile : file of integer;
begin
  Int := 1;
  assignFile(IFile, 'F:\itest.dat');
  rewrite(IFile);
  writeln('Writing integers to file');
  write(IFile, Int);
  for Count := 0 to 4 do
    write(IFile, IntArray[Count]);
  closeFile(IFile);
end;

procedure ReadFileOfIntegers;
var
 CurrentInt : integer;
 IFile : file of integer;
begin
  assignFile(IFile, 'F:\itest.dat');
  reset(IFile);
  write('Integers read from file: ');
  while not eof(IFile) do
    begin
      read(IFile, CurrentInt);
      write(CurrentInt, ' ');
    end;
  writeln;
  write('Third integer on file, obtained by random access: ');
  //Zero based integer positions.
  seek(IFile, 3 - 1);
  read(IFile, CurrentInt);
  writeln(CurrentInt);
  closeFile(IFile);
end;

procedure SaveFileOfRecords;
var
  Count : integer;
  RFile : file of TAgeRec;
begin
  ProcessRecords;
  assignFile(RFile, 'F:\rtestpas.txt');
  rewrite(RFile);
  writeln('Writing records to file');
  for Count := 0 to 2 do
    write(RFile, AgeRecArray[Count]);
  closeFile(RFile);
end;

procedure ReadFileOfRecords;
var
  Count : integer;
  RFile : file of TAgeRec;
begin
  assignFile(RFile, 'F:\rtestpas.txt');
  reset(RFile);
  writeln('Surname        Age');
  for Count := 0 to 2 do
    begin
      read(RFile, AgeRec);
      writeln(AgeRec.Surname, 
              AgeRec.Age : 17 - length(AgeRec.Surname));
    end;
  closeFile(RFile);
end;

begin
  repeat
    repeat
      writeln(#13#10'Please select one of the following options.');
      writeln('1 - Use mathematical operators');
      writeln('2 - Manipulate strings');
      writeln('3 - Process dates');
      writeln('4 - Process arrays');
      writeln('5 - Process records');
      writeln('6 - Call a function');
      writeln('7 - Save a text file');
      writeln('8 - Read a text file');
      writeln('9 - Save a file of integers');
      writeln('10 - Read a file of integers');
      writeln('11 - Save a file of records');
      writeln('12 - Read a file of records');
      writeln('13 - Exit');
      readln(strChoice);
      val(strChoice, iChoice, ErrorCode);
    until ErrorCode = 0;
    case iChoice of
      1: Maths;
      2: StringManipulation;
      3: ProcessDates;
      4: ProcessArrays;
      5: ProcessRecords;
      6: begin
           write('Please give the radius of a sphere in m. ');
           readln(SphereRadius);
           Volume := SphereVol(SphereRadius);
           writeln('Its volume is ', Volume : 8 : 2, ' cubic metres.')
         end;
      7: SaveTextFile;
      8: ReadTextFile;
      9: SaveFileOfIntegers;
      10: ReadFileOfIntegers;
      11: SaveFileOfRecords;
      12: ReadFileOfRecords;
     end;
  until iChoice = 13;
end.
Programming - a skill for life!

Converting from Visual Basic to Pascal