Sample Console Application - GuessANumber

[djjd47130]

I just learned how to make a console application, and as practice, took some very basic source code I found and worked around it.

This is a game to guess a randomized number. The Maximum number is randomly generated each time as well, to keep it well and scrambled. The number of guesses allowed is also randomly generated on each round.

For the record, my best score was 11 guesses where the number was 1373 out of 4672. I only had 11 guesses allowed that round There's a trick to it, but I'll let you figure it out...

Enjoy!

program GuessANumber;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
  Min, Max, Tries, rn, un, cnt: Integer;
  Guessed, Passed, DoContinue, DoExit, DoNext: Boolean;
  Entered: String;

begin
  DoContinue:= True;
  while (DoContinue) do begin
    Randomize;     
    Min:= 1;
    Max:= Trunc(Random(5000)+100);
    Tries:= Trunc(Random(20)+10);
    rn:= Trunc(Random(Max-Min)+Min);
    WriteLn;
    WriteLn('Computer has picked a number from '+
      IntToStr(Min)+' to '+IntToStr(Max)+'. Can you guess it?');
    WriteLn('You have a total of '+IntToStr(Tries)+' tries!');
    Write('   Try a Number: ');
    cnt:= 0;
    un:= 0;
    Guessed:= False;
    Passed:= False;
    DoExit:= False;
    DoNext:= False;
    while (Guessed = False) and (Passed = False)
      and (DoExit = False) and (DoNext = False) do
    begin
      inc(Cnt);
      ReadLn(Entered);
      if UpperCase(Entered) = 'EXIT' then begin
        DoExit:= True;
        WriteLn('   You gave up!');
        WriteLn('   The number was: '+IntToStr(Rn));
      end else
      if UpperCase(Entered) = 'NEXT' then begin
        DoNext:= True;
      end else begin
        Un:= StrToIntDef(Entered, Min-1);
        if Un = Rn then begin
          Guessed:= True;
          WriteLn('   Correct!');
          WriteLn('   It took you '+IntToStr(cnt)+' times to guess!');
        end else
        if (Cnt >= Tries) and (Guessed = False) then begin
          Passed:= True;
          WriteLn('   You failed!');
          WriteLn('   The number was: '+IntToStr(Rn));
        end else   
        if Un > Rn then begin
          Write('    Try Smaller: ');
        end else
        if Un < Rn then begin
          Write('     Try Larger: ');
        end else begin

        end;
      end;
    end;
    WriteLn;
    if not DoNext then begin
      Write('Would you like to try again? (Y/N): ');
      ReadLn(Entered);
      if (UpperCase(Entered) = 'N')
        or (UpperCase(Entered) = 'NO') then DoContinue:= False;
    end;
  end;                           
  WriteLn;
  WriteLn('Thank you for playing!');
  WriteLn('  Original code found at: ');
  WriteLn('    [URL unfurl="true"]http://delphi.about.com/od/objectpascalide/l/aa091101b.htm');[/URL]
  WriteLn('  Project Completed by JD: ');
  WriteLn('    [URL unfurl="true"]http://www.jdsoftwareinc.com');[/URL]
  WriteLn;
  WriteLn('Press enter to exit...');
  ReadLn;
end.

JD Solutions

 

[Glenn9999]

A little point for learning's sake. Writeln/Write and Readln/Read go to console by default when you don't specify the file handle. Basically, though, both are pretty universal for about everything you push through it. They are more or less unchanged from the Pascal days and you can do everything with them in Delphi you could do there.

 WriteLn('Computer has picked a number from '+
      IntToStr(Min)+' to '+IntToStr(Max)+'. Can you guess it?');

Try:

writeln('Computer has picked a number from ', min, 
' to ', max, '.  Can you guess it?');

The other neat trick is that you can do is specify formatting characters (if applicable). For example, if I want to push something out a number of characters, you can do something like:

writeln(min:10, max:10);

0000000001111111111222222222233333333334
1234567890123456789012345678901234567890
        20        20

It consumes the number of characters involved if the formatting code is less than that.

The other interesting thing with writeln is floating point printing. If I do this:

var
  testfloat: extended;

testfloat := pi;
writeln(testfloat);

I normally get this (scientific notation):

3.14159265358979E+0000

but I can do the write like this:

writeln(testfloat:0:2);

and get this:

3.14

The first number listed above is like the text formatting example.

writeln(testfloat:10:2);

produces

0000000001111111111222222222233333333334
1234567890123456789012345678901234567890
      3.14

Knowing those formatting codes were valuable when it came to writing text files and text prints of reports and such.

Hope that helps some.


It is not possible for anyone to acknowledge truth when their salary depends on them not doing it.

 

[djjd47130]

I've made a bunch of modifications, and here's what I have now...

Only thing is trying to figure out the best way to calculate a relevant score?

program GuessANumber;

{$APPTYPE CONSOLE}

uses     
{$IFDEF MSWINDOWS}
  Windows,
{$ENDIF}
{$IFDEF LINUX}
  Types, Libc,
{$ENDIF}
  SysUtils, Classes, Messages, Registry;

const
  MaxScores = 20;

type
  TScore = class(TPersistent)
  public
    Index: Integer;
    Name: String;
    Tries: Integer;
    MaxTries: Integer;
    Min: Integer;
    Max: Integer;
    Num: Integer;
    Skill: Integer;
    Score: Integer;
    DT: TDateTime;
  end;

var
  Skill: Integer;
  Min, Max, Tries, rn, un, cnt: Integer;
  DoClose: Boolean;
  Guessed, Passed, DoContinue, DoExit, DoNext: Boolean;
  Entered: String;
  Scores: TStringList;
  TempIndex: Integer;
                    

procedure GetScores;
var
  Reg: TRegistry;
  L: TStringList;
  X: Integer;
  Key: String;
  TKey: String;
  S: TScore;
begin
  for X:= 0 to Scores.Count - 1 do
    TScore(Scores.Objects[X]).Free;
  Scores.Clear;
  L:= TStringList.Create;
  Reg:= TRegistry.Create(KEY_READ or KEY_WRITE);
  try
    Reg.RootKey:= HKEY_LOCAL_MACHINE;
    Key:= 'Software\JD\GuessANumber\';
    if Reg.KeyExists(Key+'Scores\') then begin
      if Reg.OpenKey(Key+'Scores\', True) then begin
        Reg.GetKeyNames(L);
        Reg.CloseKey;
      end;
      L.Sorted:= True;
      L.Sort;
      for X:= 0 to L.Count - 1 do begin
        TKey:= Key+'Scores\'+L[X]+'\';
        if Reg.OpenKey(TKey, True) then begin
          S:= TScore.Create;
            S.Index:= X;
            S.Name:= Reg.ReadString('Name');
            S.Tries:= Reg.ReadInteger('Tries');
            S.MaxTries:= Reg.ReadInteger('MaxTries');
            S.Min:= Reg.ReadInteger('Min');
            S.Max:= Reg.ReadInteger('Max');
            S.Num:= Reg.ReadInteger('Num');
            S.Skill:= Reg.ReadInteger('Skill');
            S.Score:= Trunc(100 - ((S.Tries / S.MaxTries)*100))+1;
            S.DT:= Reg.ReadDateTime('DT');
          Scores.AddObject(IntToStr(S.Index), S);
          Reg.CloseKey;
        end;
      end;
    end;
  finally
    L.Free;
    Reg.Free;
  end;
end;

procedure SaveScores;
var
  Reg: TRegistry;
  S: TScore;    
  Key, TKey: String;
  X: Integer;
begin
  Reg:= TRegistry.Create(KEY_READ or KEY_WRITE);
  try
    Scores.Sorted:= True;
    Scores.Sort;
    Reg.RootKey:= HKEY_LOCAL_MACHINE; 
    Key:= 'Software\JD\GuessANumber\';
    TKey:= Key + 'Scores\';
    if Reg.KeyExists(TKey) then
      Reg.DeleteKey(TKey);
    for X:= 0 to Scores.Count - 1 do begin
      S:= TScore(Scores.Objects[X]);
      TKey:= Key+'Scores\'+IntToStr(S.Index)+'\';
      if Reg.OpenKey(TKey, True) then begin
        Reg.WriteString('Name', S.Name);
        Reg.WriteInteger('Tries', S.Tries);
        Reg.WriteInteger('MaxTries', S.MaxTries);
        Reg.WriteInteger('Max', S.Max);
        Reg.WriteInteger('Min', S.Min);
        Reg.WriteInteger('Num', S.Num);
        Reg.WriteInteger('Skill', S.Skill);
        Reg.WriteDateTime('DT', S.DT);
        Reg.CloseKey;
      end;
    end;
  finally
    Reg.Free;
  end;
end;
     
procedure SaveScore(S: TScore);
begin
  WriteLn('Saving score...');
  GetScores;
  S.Index:= Scores.Count;
  Scores.AddObject(IntToStr(S.Index), S);
  SaveScores;
  WriteLn('Score saved.');
end;

function StrLen(Value: String; ALength: Integer): String;
begin
  Result:= Copy(Value, 1, ALength);
  while Length(Result) < ALength do
    Result:= Result + ' ';
end;
     
function StrLenR(Value: String; ALength: Integer): String;
begin
  Result:= Copy(Value, 1, ALength);
  while Length(Result) < ALength do
    Result:=  ' ' +Result;
end;

procedure ListScores;
var
  X: Integer;
  S: TScore;
  Str: String;
begin
  WriteLn;
  WriteLn('Scores:');
  WriteLn('  '+
    'Date/Time               '+
    'Name           '+
    'Tries       '+
    'Number         '+
    'Score'
  );
  for X:= 0 to Scores.Count - 1 do begin
    S:= TScore(Scores.Objects[X]);
    Str:= '  '+FormatDateTime('mm/dd/yy hh:nn:ss am/pm', S.DT)+'  '+
      StrLen('  '+S.Name, 15)+'  '+StrLenR(IntToStr(S.Tries), 2)+'/'+
      StrLen(IntToStr(S.MaxTries), 4)+'   '+
      StrLenR(IntToStr(S.Num),6)+'/'+StrLen(IntToStr(S.Max), 6)+'  '+
      StrLenR(IntToStr(S.Score),6);
    WriteLn(Str);
  end;
end;

function ListMenu: Integer;
var
  S: String;
begin
  WriteLn;
  WriteLn('GuessANumber Main Menu');
  WriteLn('  1 Start new game');
  WriteLn('  2 Show Scores');
  WriteLn('  3 Commands');
  WriteLn('  4 Exit');
  Write('> ');
  ReadLn(S);
  Result:= StrToIntDef(S, 0);
end;

procedure ListCommands;
begin
  WriteLn('Commands:');
  WriteLn('  exit - Exits the round');
  WriteLn('  next - Starts a new round');
end;

procedure DoGame(ASkill: Integer);
var
  Scr: TScore;
begin
  Skill:= ASkill;
  while (Skill < 1) or (Skill > 5) do begin
    WriteLn;
    Write('Please enter your skill level (1=Beginner...5=Expert): ');
    ReadLn(Entered);
    Skill:= StrToIntDef(Entered, -1);
  end;
  DoContinue:= True;
  while (DoContinue) do begin
    Randomize;
    Min:= 1;
    case Skill of
      1: begin
        Max:= Trunc(Random(500)+50);
        Tries:= Trunc(Random(20)+20);
      end;       
      2: begin
        Max:= Trunc(Random(1000)+100);
        Tries:= Trunc(Random(20)+15);
      end;
      3: begin
        Max:= Trunc(Random(2000)+100);
        Tries:= Trunc(Random(15)+10);
      end;
      4: begin
        Max:= Trunc(Random(5000)+500);
        Tries:= Trunc(Random(10)+10);
      end;
      5: begin
        Max:= Trunc(Random(10000)+2000);
        Tries:= Trunc(Random(5)+10);
      end;
    end;
    rn:= Trunc(Random(Max-Min)+Min);
    WriteLn;
    WriteLn('Computer has picked a number from ',
      Min, ' to ', Max, '. Can you guess it?');
    WriteLn('You have a total of ',Tries, ' tries!');
    Write('   Try a Number: ');
    cnt:= 0;
    un:= 0;
    Guessed:= False;
    Passed:= False;
    DoExit:= False;
    DoNext:= False;
    while (Guessed = False) and (Passed = False)
      and (DoExit = False) and (DoNext = False) do
    begin
      inc(Cnt);
      ReadLn(Entered);
      if UpperCase(Entered) = 'EXIT' then begin
        DoExit:= True;
        WriteLn('   You gave up!');
        WriteLn('   The number was: ', Rn);
      end else
      if UpperCase(Entered) = 'NEXT' then begin
        DoNext:= True;
      end else begin
        Un:= StrToIntDef(Entered, Min-1);
        if Un = Rn then begin
          Guessed:= True;
          WriteLn('   Correct!');
          WriteLn('   It took you ', cnt, ' times to guess!');
        end else
        if (Cnt >= Tries) and (Guessed = False) then begin
          Passed:= True;
          WriteLn('   You failed!');
          WriteLn('   The number was: ', Rn);
        end else   
        if Un > Rn then begin
          Write('    Try Smaller: ');
        end else
        if Un < Rn then begin
          Write('     Try Larger: ');
        end else begin

        end;
      end;
    end;
    WriteLn;
    if not DoNext then begin
      if Guessed then begin
        Scr:= TScore.Create;
        try
          Write('Enter your name: ');
          ReadLn(Entered);
          Scr.Name:= Entered;
          Scr.Tries:= Cnt;
          Scr.MaxTries:= Tries;
          Scr.Min:= Min;
          Scr.Max:= Max;
          Scr.Num:= Rn;
          Scr.Skill:= Skill;
          Scr.DT:= Now;
          SaveScore(Scr);
        finally
          //Scr.Free;
        end;
      end;
      Write('Would you like to try again? (Y/N): ');
      ReadLn(Entered);
      if (UpperCase(Entered) = 'N')
        or (UpperCase(Entered) = 'NO') then DoContinue:= False;
    end;
  end;
end;

//------------------------------------------------------------------------------

begin
  Scores:= TStringList.Create;
  try
    WriteLn('Welcome to Guess A Number!');
    DoContinue:= True;
    DoClose:= False;
    while DoClose = False do begin
      case ListMenu of
        1: begin
          DoGame(0);
        end;
        2: begin
          GetScores;
          ListScores;
        end;
        3: begin
          ListCommands;
        end;
        4: begin
          DoClose:= True;
        end;
        else begin

        end;
      end;

    end;
    WriteLn;
    WriteLn('Thank you for playing!');
    WriteLn('  Original code found at: ');
    WriteLn('    [URL unfurl="true"]http://delphi.about.com/od/objectpascalide/l/aa091101b.htm');[/URL]
    WriteLn('  Project Completed by JD: ');
    WriteLn('    [URL unfurl="true"]http://www.jdsoftwareinc.com');[/URL]
    WriteLn;
    WriteLn('Press enter to exit...');
    ReadLn;
  finally       
    for TempIndex:= 0 to Scores.Count - 1 do
      TScore(Scores.Objects[TempIndex]).Free;
    Scores.Free;
  end;
end.

JD Solutions