[next] [prev] [prev-tail] [tail] [up]

### 24.2 Functions and Procedures

The examples in this section make use of the unit vidutil, which contains the TextOut function. This function writes a text to the screen at a given location. It looks as follows:

Listing: videoex/vidutil.pp

unit vidutil;
Interface
uses
video;
{$ifndef cpu86}
{$error This example only works on intel 80x86 machines}
{$endif}
Procedure TextOut(X,Y : Word;Const S : String);
Implementation
Procedure TextOut(X,Y : Word;Const S : String);
Var
W,P,I,M : Word;
begin
P:=((X-1)+(Y-1)*ScreenWidth);
M:=Length(S);
If P+M>ScreenWidth*ScreenHeight then
M:=ScreenWidth*ScreenHeight-P;
For I:=1 to M do
VideoBuf^[P+I-1]:=Ord(S[i])+($07 shl 8);
end;
end.

#### ClearScreen

Declaration:
  procedure ClearScreen;
Description:
  ClearScreen clears the entire screen, and calls UpdateScreen (895) after that. This is done by writing spaces to all character cells of the video buffer in the default color (lightgray on black, color attribute $07).
Errors:
  None.
See also:
  InitVideo (891), UpdateScreen (895)

Listing: videoex/ex3.pp

program testvideo;
uses video,keyboard,vidutil;
{$ifndef cpu86}
{$error This example only works on intel 80x86 machines}
{$endif}
Var
i : longint;
k : TkeyEvent;
begin
InitVideo;
InitKeyboard;
For I:=1 to 10 do
TextOut(i,i, 'Press any key to clear screen');
UpdateScreen(false);
K:=GetKeyEvent;
ClearScreen;
TextOut(1,1,'Cleared screen. Press any key to end');
UpdateScreen(true);
K:=GetKeyEvent;
DoneKeyBoard;
DoneVideo;
end.

#### DefaultErrorHandler

Declaration:
  function DefaultErrorHandler(AErrorCode: Longint; AErrorInfo: Pointer): TErrorHandlerReturnValue;
Description:
  DefaultErrorHandler is the default error handler used by the video driver. It simply sets the error code AErrorCode and AErrorInfo in the global variables ErrorCode and ErrorInfo and returns errContinue.
Errors:
  None.
See also:

#### DoneVideo

Declaration:
  procedure DoneVideo;
Description:
  DoneVideo disables the Video driver if the video driver is active. If the videodriver was already disabled or not yet initialized, it does nothing. Disabling the driver means it will clean up any allocated resources, possibly restore the screen in the state it was before InitVideo was called. Particularly, the VideoBuf and OldVideoBuf arrays are no longer valid after a call to DoneVideo.

  The DoneVideo should always be called if InitVideo was called. Failing to do so may leave the screen in an unusable state after the program exits.

Errors:
  Normally none. If the driver reports an error, this is done through the ErrorCode variable.
See also:
  InitVideo (891)

For an example, see most other functions.

#### GetCapabilities

Declaration:
  function GetCapabilities: Word;
Description:
  GetCapabilities returns the capabilities of the current driver. It is an or-ed combination of the following constants:
  cpUnderLine
    The driver supports underlined characters.
  cpBlink
    The driver supports blinking characters.
  cpColor
    The driver supports colors.
  cpChangeFont
    The driver supports the setting of a screen font. Note, however, that a font setting API is not supported by the video unit.
  cpChangeMode
    The driver supports the setting of screen modes.
  cpChangeCursor
    The driver supports changing the cursor shape.

  Note that the video driver should not yet be initialized to use this function. It is a property of the driver.

Errors:
  None.
See also:
  GetCursorType (886), GetVideoDriver (888)

Listing: videoex/ex4.pp

Program Example4;
{ Program to demonstrate the GetCapabilities function. }
Uses video;
Var
W: Word;
Procedure TestCap(Cap: Word; Msg : String);
begin
Write(Msg,' : ');
If (W and Cap=Cap) then
Writeln('Yes')
else
Writeln('No');
end;
begin
W:=GetCapabilities;
Writeln('Video driver supports following functionality');
TestCap(cpUnderLine,'Underlined characters');
TestCap(cpBlink,'Blinking characters');
TestCap(cpColor,'Color characters');
TestCap(cpChangeFont,'Changing font');
TestCap(cpChangeMode,'Changing video mode');
TestCap(cpChangeCursor,'Changing cursor shape');
end.

#### GetCursorType

Declaration:
  function GetCursorType: Word;
Description:
  GetCursorType returns the current cursor type. It is one of the following values:
  crHidden
    The cursor is currently hidden.
  crUnderLine
    The cursor is currently the underline character.
  crBlock
    The cursor is currently the block character.
  crHalfBlock
    The cursur is currently a block with height of half the character cell height.

  Note that not all drivers support all types of cursors.

Errors:
  None.
See also:
  SetCursorType (893), GetCapabilities (885)

Listing: videoex/ex5.pp

Program Example5;
{ Program to demonstrate the GetCursorType function. }
Uses video,keyboard,vidutil;
Const
Cursortypes : Array[crHidden..crHalfBlock] of string =
('Hidden','UnderLine','Block','HalfBlock');
begin
InitVideo;
InitKeyboard;
TextOut(1,1,'Cursor type: '+CursorTypes[GetCursorType]);
TextOut(1,2,'Press any key to exit.');
UpdateScreen(False);
GetKeyEvent;
DoneKeyboard;
DoneVideo;
end.

#### GetLockScreenCount

Declaration:
  Function GetLockScreenCount : integer;
Description:
  GetLockScreenCount returns the current lock level. When the lock level is zero, a call to UpdateScreen (895) will actually update the screen.
Errors:
  None.
See also:
  LockScreenUpdate (891), UnlockScreenUpdate (895), UpdateScreen (895)

Listing: videoex/ex6.pp

Program Example6;
{ Program to demonstrate the GetLockScreenCount function. }
Uses video,keyboard,vidutil;
Var
I : Longint;
S : String;
begin
InitVideo;
InitKeyboard;
TextOut(1,1,'Press key till new text appears.');
UpdateScreen(False);
Randomize;
For I:=0 to Random(10)+1 do
LockScreenUpdate;
I:=0;
While GetLockScreenCount<>0 do
begin
Inc(I);
Str(I,S);
UnlockScreenUpdate;
GetKeyEvent;
TextOut(1,1,'UnLockScreenUpdate had to be called '+S+' times');
UpdateScreen(False);
end;
TextOut(1,2,'Press any key to end.');
UpdateScreen(False);
GetKeyEvent;
DoneKeyboard;
DoneVideo;
end.

#### GetVideoDriver

Declaration:
  Procedure GetVideoDriver (Var Driver : TVideoDriver);
Declaration:
  GetVideoDriver retrieves the current videodriver and returns it in Driver. This can be used to chain video drivers.
Errors:
  None.
See also:
  SetVideoDriver (894)

For an example, see the section on writing a custom video driver.

#### GetVideoMode

Declaration:
  procedure GetVideoMode(var Mode: TVideoMode);
Description:
  GetVideoMode returns the settings of the currently active video mode. The row,col fields indicate the dimensions of the current video mode, and Color is true if the current video supports colors.
Errors:
  None.
See also:
  SetVideoMode (894), GetVideoModeData (891)

Listing: videoex/ex7.pp

Program Example7;
{ Program to demonstrate the GetVideoMode function. }
Uses video,keyboard,vidutil;
Var
M : TVideoMode;
S : String;
begin
InitVideo;
InitKeyboard;
GetVideoMode(M);
if M.Color then
TextOut(1,1,'Current mode has color')
else
TextOut(1,1,'Current mode does not have color');
Str(M.Row,S);
TextOut(1,2,'Number of rows : '+S);
Str(M.Col,S);
TextOut(1,3,'Number of columns : '+S);
Textout(1,4,'Press any key to exit.');
UpdateScreen(False);
GetKeyEvent;
DoneKeyboard;
DoneVideo;
end.

#### GetVideoModeCount

Declaration:
  Function GetVideoModeCount : Word;
Description:
  GetVideoModeCount returns the number of video modes that the current driver supports. If the driver does not support switching of modes, then 1 is returned.

  This function can be used in conjunction with the GetVideoModeData (891) function to retrieve data for the supported video modes.

Errors:
  None.
See also:
  GetVideoModeData (891), GetVideoMode (889)

Listing: videoex/ex8.pp

Program Example8;
{ Program to demonstrate the GetVideoModeCount function. }
Uses video,keyboard,vidutil;
Procedure DumpMode (M : TVideoMode; Index : Integer);
Var
S : String;
begin
Str(Index:2,S);
inc(Index);
TextOut(1,Index,'Data for mode '+S+': ');
if M.Color then
TextOut(19,Index,' color,')
else
TextOut(19,Index,'No color,');
Str(M.Row:3,S);
TextOut(28,Index,S+' rows');
Str(M.Col:3,S);
TextOut(36,index,S+' columns');
end;
Var
i,Count : Integer;
m : TVideoMode;
begin
InitVideo;
InitKeyboard;
Count:=GetVideoModeCount;
For I:=1 to Count do
begin
GetVideoModeData(I-1,M);
DumpMode(M,I-1);
end;
TextOut(1,Count+1,'Press any key to exit');
UpdateScreen(False);
GetKeyEvent;
DoneKeyboard;
DoneVideo;
end.

#### GetVideoModeData

Declaration:
  Function GetVideoModeData(Index : Word; Var Data: TVideoMode) : Boolean;
Description:
  GetVideoModeData returns the characteristics of the Index-th video mode in Data. Index is zero based, and has a maximum value of GetVideoModeCount-1. If the current driver does not support setting of modes (GetVideoModeCount=1) and Index is zero, the current mode is returned.

  The function returns True if the mode data was retrieved succesfully, False otherwise.

Errors:
  In case Index has a wrong value, False is returned.
See also:
  GetVideoModeCount (889), SetVideoMode (894), GetVideoMode (889)

For an example, see GetVideoModeCount (889).

#### InitVideo

Declaration:
  procedure InitVideo;
Description:
  InitVideo Initializes the video subsystem. If the video system was already initialized, it does nothing. After the driver has been initialized, the VideoBuf and OldVideoBuf pointers are initialized, based on the ScreenWidth and ScreenHeight variables. When this is done, the screen is cleared.
Errors:
  if the driver fails to initialize, the ErrorCode variable is set.
See also:
  DoneVideo (885)

For an example, see most other functions.

#### LockScreenUpdate

Declaration:
  Procedure LockScreenUpdate;
Description:
  LockScreenUpdate increments the screen update lock count with one. As long as the screen update lock count is not zero, UpdateScreen (895) will not actually update the screen.

  This function can be used to optimize screen updating: If a lot of writing on the screen needs to be done (by possibly unknown functions), calling LockScreenUpdate before the drawing, and UnlockScreenUpdate (895) after the drawing, followed by a UpdateScreen (895) call, all writing will be shown on screen at once.

Errors:
  None.
See also:
  UpdateScreen (895), UnlockScreenUpdate (895), GetLockScreenCount (887)

For an example, see GetLockScreenCount (887).

#### SetCursorPos

Declaration:
  procedure SetCursorPos(NewCursorX, NewCursorY: Word);
Description:
  SetCursorPos positions the cursor on the given position: Column NewCursorX and row NewCursorY. The origin of the screen is the upper left corner, and has coordinates (0,0).

  The current position is stored in the CursorX and CursorY variables.

Errors:
  None.
See also:
  SetCursorType (893)

Listing: videoex/ex2.pp

program example2;
uses video,keyboard;
{$ifndef cpu86}
{$error This example only works on intel 80x86 machines}
{$endif}
Var
P,PP,D : Integer;
K: TKeyEvent;
Procedure PutSquare (P : INteger; C : Char);
begin
VideoBuf^[P]:=Ord(C)+($07 shl 8);
VideoBuf^[P+ScreenWidth]:=Ord(c)+($07 shl 8);
VideoBuf^[P+1]:=Ord(c)+($07 shl 8);
VideoBuf^[P+ScreenWidth+1]:=Ord(c)+($07 shl 8);
end;
begin
InitVideo;
InitKeyBoard;
P:=0;
PP:=-1;
Repeat
If PP<>-1 then
PutSquare(PP,' ');
PutSquare(P,'#');
SetCursorPos(P Mod ScreenWidth,P div ScreenWidth);
UpdateScreen(False);
PP:=P;
Repeat
D:=0;
K:=TranslateKeyEvent(GetKeyEvent);
Case GetKeyEventCode(K) of
kbdLeft : If (P Mod ScreenWidth)<>0 then
D:=-1;
kbdUp : If P>=ScreenWidth then
D:=-ScreenWidth;
kbdRight : If ((P+2) Mod ScreenWidth)<>0 then
D:=1;
kbdDown : if (P<(VideoBufSize div 2)-(ScreenWidth*2)) then
D:=ScreenWidth;
end;
Until (D<>0) or (GetKeyEventChar(K)='q');
P:=P+D;
until GetKeyEventChar(K)='q';
DoneKeyBoard;
DoneVideo;
end.

#### SetCursorType

Declaration:
  procedure SetCursorType(NewType: Word);
Description:
  SetCursorType sets the cursor to the type specified in NewType.
  crHidden
    the cursor is not visible.
  crUnderLine
    the cursor is a small underline character (usually denoting insert mode).
  crBlock
    the cursor is a block the size of a screen cell (usually denoting overwrite mode).
  crHalfBlock
    the cursor is a block half the size of a screen cell.
Errors:
  None.
See also:
  SetCursorPos (892)

#### SetVideoDriver

Declaration:
  Function SetVideoDriver (Const Driver : TVideoDriver) : Boolean;
Description:
  SetVideoDriver sets the videodriver to be used to Driver. If the current videodriver is initialized (after a call to InitVideo) then it does nothing and returns False.

  A new driver can only be installed if the previous driver was not yet activated (i.e. before a call to InitVideo (891)) or after it was deactivated (i.e after a call to DoneVideo).

  For more information about installing a videodriver, see section 24.3, page 897.

Errors:
  If the current driver is initialized, then False is returned.
See also:
  The example video driver in section 24.3, page 897

For an example, see the section on writing a custom video driver.

#### SetVideoMode

Declaration:
  Function SetVideoMode(Mode: TVideoMode) : Boolean;
Description:
  SetVideoMode sets the video mode to the mode specified in Mode:

         TVideoMode = record
           Col,Row : Word;
           Color   : Boolean;
         end;

  If the call was succesful, then the screen will have Col columns and Row rows, and will be displaying in color if Color is True.

  The function returns True if the mode was set succesfully, False otherwise.

  Note that the video mode may not always be set. E.g. a console on Linux or a telnet session cannot always set the mode. It is important to check the error value returned by this function if it was not succesful.

  The mode can be set when the video driver has not yet been initialized (i.e. before InitVideo (891) was called) In that case, the video mode will be stored, and after the driver was initialized, an attempt will be made to set the requested mode. Changing the video driver before the call to InitVideo will clear the stored video mode.

  To know which modes are valid, use the GetVideoModeCount (889) and GetVideoModeData (891) functions. To retrieve the current video mode, use the GetVideoMode (889) procedure.

Errors:
  If the specified mode cannot be set, then errVioNoSuchMode may be set in ErrorCode
See also:
  GetVideoModeCount (889) GetVideoModeData (891) GetVideoMode (889)

#### UnlockScreenUpdate

Declaration:
  Procedure UnlockScreenUpdate;
Description:
  UnlockScreenUpdate decrements the screen update lock count with one if it is larger than zero. When the lock count reaches zero, the UpdateScreen (895) will actually update the screen. No screen update will be performed as long as the screen update lock count is nonzero. This mechanism can be used to increase screen performance in case a lot of writing is done.

  It is important to make sure that each call to LockScreenUpdate (891) is matched by exactly one call to UnlockScreenUpdate

Errors:
  None.
See also:
  LockScreenUpdate (891), GetLockScreenCount (887), UpdateScreen (895)

For an example, see GetLockScreenCount (887).

#### UpdateScreen

Declaration:
  procedure UpdateScreen(Force: Boolean);
Description:
  UpdateScreen synchronizes the actual screen with the contents of the VideoBuf internal buffer. The parameter Force specifies whether the whole screen has to be redrawn (Force=True) or only parts that have changed since the last update of the screen.

  The Video unit keeps an internal copy of the screen as it last wrote it to the screen (in the OldVideoBuf array). The current contents of VideoBuf are examined to see what locations on the screen need to be updated. On slow terminals (e.g. a L I N U X telnet session) this mechanism can speed up the screen redraw considerably.

Errors:
  None.
See also:
  ClearScreen (883)

For an example, see most other functions.

[next] [prev] [prev-tail] [front] [up]