[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]

(*
Write a unit, that assigns an text file to the Graphics Screen and then
assign output with this proc, then use rewrite(output) and you can
use write/writeln in Graphics mode as well. Don't forget
Assign(output,'');rewrite(output) or
CrtAssign(output);rewrite(output) when back in Text Mode!
You can even implement read/readln in graphics mode, but this is more
 complicated.
One difference to text mode: use MoveTo instead of GotoXY!

I've neither my unit nor the TP manual available just now,
but it works like this (output only!):
*)
unit GrpWrite;

interface

uses Graph,Dos,BGIFont,BGIDriv;

procedure GraphAssign(var F:text);

implementation
{$R-,S-}

var
  GraphDriver, GraphMode, Error : integer;
  a : string;

procedure Abort(Msg : string);
begin
  Writeln(Msg, ': ', GraphErrorMsg(GraphResult));
  Halt(1);
end;

{$F+} {DO NOT FORGET}

function GraphFlush(var F:TextRec):integer;
begin
  GraphFlush := 0;
end;

function GraphClose(var F:TextRec):integer;
 begin
   GraphClose := 0;
 end;       {There's nothing to close}


function GraphWrite(var F:TextRec):integer;
 var
  s : string;
  P : word;
 begin
 with F do
 begin
   P := 0;
   while P<BufPos do
   begin
     OutText(BufPtr^[P]);
     Inc(P);
   end;
   BufPos := 0;
 end;
{               (may need more than one OutText...)}
  (*... {Clear buffer}*)
  GraphWrite := 0;
 end;


function GraphOpen(var F:TextRec):integer;
 begin
   { Register all the drivers }
  if RegisterBGIdriver(@CGADriverProc) < 0 then
    Abort('CGA');
  if RegisterBGIdriver(@EGAVGADriverProc) < 0 then
    Abort('EGA/VGA');
  if RegisterBGIdriver(@HercDriverProc) < 0 then
    Abort('Herc');
  if RegisterBGIdriver(@ATTDriverProc) < 0 then
    Abort('AT&T');
  if RegisterBGIdriver(@PC3270DriverProc) < 0 then
    Abort('PC 3270');


  { Register all the fonts }
  if RegisterBGIfont(@GothicFontProc) < 0 then
    Abort('Gothic');
  if RegisterBGIfont(@SansSerifFontProc) < 0 then
    Abort('SansSerif');
  if RegisterBGIfont(@SmallFontProc) < 0 then
    Abort('Small');
  if RegisterBGIfont(@TriplexFontProc) < 0 then
    Abort('Triplex');

  GraphDriver := Detect;                  { autodetect the hardware }
  InitGraph(GraphDriver, GraphMode, '');  { activate graphics }
  if GraphResult <> grOk then             { any errors? }
  begin
    Writeln('Graphics init error: ', GraphErrorMsg(GraphDriver));
    Halt(1);
  end;
  with F do
  begin
  Closefunc:=@GraphClose;
  InOutFunc:=@GraphWrite;
  FlushFunc:=@GraphFlush;
  end;
  GraphOpen := 0;
(*  ... {Initialisations, see your TP manual}*)
 end;
{$F-}
procedure GraphAssign;
 begin
  with TextRec(F) do
   begin
     Mode := fmClosed;
     BufSize := SizeOf(Buffer);
     BufPtr := @Buffer;
     Name[0] := #0;
     OpenFunc:= @GraphOpen;
    {You can make some initialisations already here}
   end
 end;
end.
=================WRTGRTST.PAS follows==================
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 16384,0,655360}
uses Crt,
     Graph,     { library of graphics routines }
     GrWrite;
var
  GraphDriver, GraphMode, Error : integer;
  a : string;
  GrOutput:Text;

procedure Abort(Msg : string);
begin
  Writeln(Msg, ': ', GraphErrorMsg(GraphResult));
  Halt(1);
end;

begin
 GraphAssign(Output);  {Standard output to graphics screen}
 {$I-}
 rewrite(Output); {actually calls GraphOpen}
  {$I+}
 if IoResult <> 0 then halt;

(* ....*)
 MoveTo(65,90);
 a := 'this is a string';
 write('this is an embedded string');   {write to graphics screen}
 MoveTo(65,120);
 write(' and this is the second');
 Close(Output); {nothing shows on the screen until this is executed}
 ReadLn(a);
 CloseGraph;
 {Standard output to text screen}
 Assign(output,'');
 rewrite(output);
 GotoXY(5,20); {THIS WORKS}
 write(a);{nothing happens here}             {write to textscreen}
end.

[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]