Who wants to be a millionaire
Delphi & Pascal (česká wiki)
Category: KMP (Club of young programmers)
Author: Tony Yeung
Program: Millionaire.pas
File exe: Millionaire.exe
need: HotSeat.dat
Author: Tony Yeung
Program: Millionaire.pas
File exe: Millionaire.exe
need: HotSeat.dat
Who wants to be a millionaire.
{ 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.