Program LinearGame02
This version uses our unit CrtUtils to change the window size and the font. It is quick hack that serves our present purpose, using the undocumented function SetConsoleFont in kernel32.dll.
You can experiment with the integer argument supplied to ChangeFont in LinearGame02.See our notes on program LinearGame01 in the previous section for the rules of the game. Compile the program using Lazarus (which has a crt unit) rather than Delphi.
program LinearGame02; uses Crt, CrtUtils; const MAX_X = 20; var c : char; CurrentPos : integer = 1; NumOfMoves : integer = -1; MoveDist : integer = 2; Cells : array[1 .. MAX_X] of integer = (15, Blue, 15, Green, 15, Green, Blue, Green, 15, 15, Green, Blue, 15, 15, Blue, Blue, 15, 15, 15, 15); //Draws the background with the colours in the Cells array. procedure DrawBackground; var i : integer; begin for i := 1 to MAX_X do begin GoToXY(i, 1); TextBackground(Cells[i]); write(' '); end; end; //Calculates the position to move to (if necessary). function EndPos(KeyCode, StartPos : integer) : integer; begin Result := StartPos; case KeyCode of 77 : if StartPos < MAX_X then Result := StartPos + 1; 116 : if StartPos < (MAX_X - MoveDist + 1) then Result := StartPos + MoveDist; end; end; //Makes a move by drawing a yellow cell at position Dest. procedure Move(Dest : integer); begin DrawBackground; goToXY(Dest, 1); TextBackground(Yellow); write(' '); NumOfMoves := NumOfMoves + 1; end; begin Resize(20, 2); //The following gives Lucida Console 36 on our Windows Vista. ChangeFont(1); //Try with different numbers if 1 does not work. CursorOff; Move(1); repeat c := readkey; if ord(c) > 0 then begin CurrentPos := EndPos(ord(c), CurrentPos); Move(CurrentPos); case Cells[CurrentPos] of Green : MoveDist := MoveDist * 2; Blue : MoveDist := 5; end; end; until CurrentPos = MAX_X; gotoXY(1, 2); write('Moves: ', NumOfMoves); readln; end.
Code of CrtUtils Unit
unit CrtUtils; interface uses crt, windows; procedure Resize(NewWidth, NewHeight : integer); function SetConsoleFont(hOutput: HANDLE; fontIndex: DWORD) : integer; stdcall; external 'kernel32'; procedure ChangeFont(FontNum : integer); implementation procedure Resize(NewWidth, NewHeight : integer); var BuffInfo : CONSOLE_SCREEN_BUFFER_INFO; OutputHandle : HANDLE; WinRect : SMALL_RECT; BuffSize : COORD; begin OutputHandle := GetStdHandle(STD_OUTPUT_HANDLE); GetConsoleScreenBufferInfo(OutputHandle, @BuffInfo); WinRect := BuffInfo.srWindow; BuffSize := BuffInfo.dwSize; BuffSize.X := NewWidth; BuffSize.Y := NewHeight; WinRect.Right := NewWidth - 1; WinRect.Bottom := NewHeight - 1; SetConsoleWindowInfo(OutputHandle, TRUE, WinRect); SetConsoleScreenBufferSize(OutputHandle, BuffSize); end; procedure ChangeFont(FontNum : integer); var OutputHandle : HANDLE; begin OutputHandle := GetStdHandle(STD_OUTPUT_HANDLE); SetConsoleFont(OutputHandle, FontNum); end; end.