[Previous][Up] |
Writing a custom video driver is not difficult, and generally means implementing a couple of functions, which whould be registered with the SetVideoDriver function. The various functions that can be implemented are located in the TVideoDriver record:
TVideoDriver = Record InitDriver : Procedure; DoneDriver : Procedure; UpdateScreen : Procedure(Force : Boolean); ClearScreen : Procedure; SetVideoMode : Function (Const Mode : TVideoMode) : Boolean; GetVideoModeCount : Function : Word; GetVideoModeData : Function(Index : Word; Var Data : TVideoMode) : Boolean; SetCursorPos : procedure (NewCursorX, NewCursorY: Word); GetCursorType : function : Word; SetCursorType : procedure (NewType: Word); GetCapabilities : Function : Word; end;
Not all of these functions must be implemented. In fact, the only absolutely necessary function to write a functioning driver is the UpdateScreen function. The general calls in the Video unit will check which functionality is implemented by the driver.
The functionality of these calls is the same as the functionality of the calls in the video unit, so the expected behaviour can be found in the previous section. Some of the calls, however, need some additional remarks.
The following unit shows how to override a video driver, with a driver that writes debug information to a file. The unit can be used in any of the demonstration programs, by simply including it in the uses clause. Setting DetailedVideoLogging to True will create a more detailed log (but will also slow down functioning)
unit viddbg; Interface uses video; Procedure StartVideoLogging; Procedure StopVideoLogging; Function IsVideoLogging : Boolean; Procedure SetVideoLogFileName(FileName : String); Const DetailedVideoLogging : Boolean = False; Implementation uses sysutils,keyboard; var NewVideoDriver, OldVideoDriver : TVideoDriver; Active,Logging : Boolean; LogFileName : String; VideoLog : Text; Function TimeStamp : String; begin TimeStamp:=FormatDateTime('hh:nn:ss',Time()); end; Procedure StartVideoLogging; begin Logging:=True; Writeln(VideoLog,'Start logging video operations at: ',TimeStamp); end; Procedure StopVideoLogging; begin Writeln(VideoLog,'Stop logging video operations at: ',TimeStamp); Logging:=False; end; Function IsVideoLogging : Boolean; begin IsVideoLogging:=Logging; end; Var ColUpd,RowUpd : Array[0..1024] of Integer; Procedure DumpScreenStatistics(Force : Boolean); Var I,Count : Integer; begin If Force then Write(VideoLog,'forced '); Writeln(VideoLog,'video update at ',TimeStamp,' : '); FillChar(Colupd,SizeOf(ColUpd),#0); FillChar(Rowupd,SizeOf(RowUpd),#0); Count:=0; or:=0 to VideoBufSize div SizeOf(TVideoCell) do begin If VideoBuf^[i]<>OldVideoBuf^[i] then begin Inc(Count); Inc(ColUpd[I mod ScreenWidth]); Inc(RowUpd[I div ScreenHeight]); end; end; Write(VideoLog,Count,' videocells differed divided over '); Count:=0; or:=0 to ScreenWidth-1 do If ColUpd[I]<>0 then Inc(Count); Write(VideoLog,Count,' columns and '); Count:=0; or:=0 to ScreenHeight-1 do If RowUpd[I]<>0 then Inc(Count); Writeln(VideoLog,Count,' rows.'); If DetailedVideoLogging Then begin or:=0 to ScreenWidth-1 do If (ColUpd[I]<>0) then Writeln(VideoLog,'Col ',i,' : ',ColUpd[I]:3,' rows changed'); or:=0 to ScreenHeight-1 do If (RowUpd[I]<>0) then Writeln(VideoLog,'Row ',i,' : ',RowUpd[I]:3,' colums changed'); end; end; Procedure LogUpdateScreen(Force : Boolean); begin If Logging then DumpScreenStatistics(Force); OldVideoDriver.UpdateScreen(Force); end; Procedure LogInitVideo; begin OldVideoDriver.InitDriver(); Assign(VideoLog,logFileName); Rewrite(VideoLog); Active:=True; StartVideoLogging; end; Procedure LogDoneVideo; begin StopVideoLogging; Close(VideoLog); Active:=False; OldVideoDriver.DoneDriver(); end; Procedure SetVideoLogFileName(FileName : String); begin If Not Active then LogFileName:=FileName; end; Initialization GetVideoDriver(OldVideoDriver); NewVideoDriver:=OldVideoDriver; NewVideoDriver.UpdateScreen:=@LogUpdateScreen; NewVideoDriver.InitDriver:=@LogInitVideo; NewVideoDriver.DoneDriver:=@LogDoneVideo; LogFileName:='Video.log'; Logging:=False; SetVideoDriver(NewVideoDriver); end.