Simulátor hry kto chce by milionárom

Kategórie: KMP (Programy mladých programátorů)

Autor: Tony Yeung
Program: Millionaire.pas
Soubor exe: Millionaire.exe
Potřebné: HotSeat.dat

{ MILIONAIRE.PAS                           Copyright (c) Tony Yeung }
{ Who wants to be a millionaire.                                    }
{                                                                   }
{ Datum:16.10.2009                             http://www.trsek.com }
 
Program millionaire;
 
{ $ APPTYPE CONSOLE}
 
{
    IT113 Assignment - Who wants to be a millionaire.
    Author:  Tony Yeung
    Date: 16 October 2009
    Version 1
}
 
uses
{  SysUtils,
  OurCrt;}
  crt, dos;
 
type
   hotSeat_record=record
   lastname:string[12];
   firstname:string[12];
   address: string[25];
end;
 
{//**************************** User Variables ****************************}
 
var User_Choice:Integer;
  hotSeat_file:file of hotSeat_record;
  hotSeat:array[1..100]of hotSeat_record;
  numberRecords:integer;
  numbers: array[1..6] of integer;
  generate: boolean;
 
{//**************************** Procedure Load ****************************}
 
procedure load;
var
   count:integer;
begin
    assign(hotSeat_file,'hotSeat.dat');
    reset(hotSeat_file);
    numberRecords:= filesize(hotSeat_file);
  for count:=  1 to numberRecords do
  begin
    read(hotSeat_file,hotSeat[count]);
  end;
end;
 
{//**************************** Procedure Contestantslist ****************************}
 
procedure ContestantsList;
 
var
   count:integer;
 
begin
  numberRecords:= filesize(hotSeat_file);
 
  writeln;
  writeln('...Last Name..First Name.............Address........');
  writeln;
  for count:=  1 to (filesize(hotSeat_file)) do
  begin
  writeln(hotSeat[count].firstname:12,hotSeat[count].lastname:12,
  hotSeat[count].address:20);
{  sleep(100);}
  delay(100);
  End;
  readln;
end;
 
{//**************************** Procedure Generate6Finalists ****************************}
 
procedure Generate6finalists;
var
  count,temp:integer;
 
begin
  writeln('Here are the 6 finalist''s numbers');
  randomize;
  for count:= 1 to 6 do
  begin
    temp:=random(numberRecords)+1;
    while(temp=numbers[1])
    or (temp=numbers[2])
    or (temp=numbers[3])
    or (temp=numbers[4])
    or (temp=numbers[5])
    or (temp=numbers[6]) do
    begin
      temp:=random(numberRecords)+1;
    end;
    numbers[count]:=temp;
    generate := true;
  end;
 
  for count := 1 to 6 do
    begin
      writeln;
      writeln('     ***<$$$$$>****  ' ,(numbers[count]), '  ****<$$$$>****');
      writeln;
      {sleep(100);}
      delay(100);
    end;
    writeln('              GOOD LUCK !!!!!!!');
    readln;
    clrscr;
end;
 
{//**************************** Procedure ShowFinalists ****************************}
 
procedure ShowFinalists;
  var
  count: integer;
  begin
  if (generate = true)  then
  begin
    WriteLn('3 pressed,finding and listing the finalists...');
    WriteLn;
    for count:=1 to 6 do
    begin
      writeln(hotSeat[numbers[count]].firstname:12,
      hotSeat[numbers[count]].lastname:12, hotSeat[numbers[count]].address:20);
      writeln;
 
      {sleep(200);}
      delay(200);
    end
  end
  else
      writeln('Please generate finalist number first!');
    readln;
  end;
 
{//**************************** Procedure Save ****************************}
 
procedure save;
  var
  count: integer;
  begin
    reset(hotSeat_file);
    for count:=1 to filesize(hotSeat_file) do
      begin
       write(hotSeat_file,hotSeat[count]);
      end;
  end;
 
{//**************************** Procedure ChangeDetails ****************************}
 
procedure ChangeDetails;
  var
  count: integer;
  firstname,lastname,newaddress: string[12];
  name: boolean;
 
 
  begin
    name:=false;
 
        writeln('4 pressed,changing the address a friend details...');
 
        writeln('Please enter your first name.');
        readln(firstname);
        writeln('Please enter your last name.');
        readln(lastname);
 
        for count:=1 to filesize(hotSeat_file) do
        begin
         if (hotSeat[count].lastname=lastname) and
         (hotSeat[count].firstname=firstname) then
        begin
        writeln('Well. We''ve found your records.');
        writeln('Please enter your new address');
        readln(newaddress);
        hotSeat[count].address:=newaddress;
        name:=true
        end;
        end;
        if name=false then
        begin
        writeln('Sorry!  We do not have your records from your database.');
        end;
        writeln;
        write('Press <ENTER> to save changes and return to the main menu.');
 
        save;
        readln;
  end;
 
{//**************************** Procedure EnrolContestant ****************************}
 
procedure EnrolContestant;
  var   lastname:string[12];
        firstname :string[12];
        address:string[12];
        count :integer;
        name :boolean;
 
  begin
    name:=false;
    writeln('Please enter your first name - if you''re new.');
    readln(firstname);
    writeln('Please enter your last name.');
    readln(lastname);
    writeln('Lastly, please enter your address number.');
    readln(address);
    writeln('Please press <ENTER>');
    for count:=1 to filesize(hotSeat_file) do
    begin
    if (hotSeat[count].lastname=lastname) and
    (hotSeat[count].firstname=firstname) then
    begin
        name:=true;
        writeln('You''re a contestant already.');
    end;
    end;
    if (name = false) then
    begin
        numberRecords:= numberRecords+ 1;
        hotSeat[filesize(hotSeat_file)].firstname:=firstname;
        hotSeat[filesize(hotSeat_file)].lastname:=lastname;
        hotSeat[filesize(hotSeat_file)].address:=address;
        writeln('Please press <ENTER> to save your details and return to main menu.');
        readln;
        save;
    end;
  end;
 
{//**************************** Procedure GetOutOfHere ****************************}
 
procedure GetOutOfHere;
  begin
    writeln('0 pressed,exiting...');
    {Sleep(5000);}
    delay(5000);
    clrscr;
  end;
 
{//**************************** Procedure Menu ****************************}
 
 procedure Menu;
begin
 
      writeln('               M E N U');
      writeln('Please enter an integer in the range 1...5');
      writeln;
      writeln('  1 List all the contestants');
      writeln('  2 Generate the 6 finalist''s numbers');
      writeln('  3 Find and list the finalists');
      writeln('  4 Change the address a friend details');
      writeln('  5 Enrol a new contestant');
      writeln('  0 Exit');
 
 
      Readln(User_Choice);
 
      case (User_Choice) of
         1:ContestantsList;
         2:Generate6finalists;
         3:ShowFinalists;
         4:ChangeDetails;
         5:EnrolContestant;
         0:GetOutOfHere;
        end;
end;
 
{//**************************** The Main Program ****************************}
 
begin {//main body}
 Load;
 repeat
  menu;              {Shows the Menu on the screen}
 until User_Choice = 0;  {Allows program user to Exit program}
end.