Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/BGIRES.ZIP/BGIRES.PAS

Pascal/Delphi Source File | 1992-07-11 | 9.0 KB | 306 lines

unit bgires;

{ Unit to handle .BGI files in a resource file. }

interface

uses
  objects,graph                       { standard units }

{$ifndef NOSTREAMS} ,streams {$endif}; { my streams unit }

procedure ResInitGraph(var graphdriver,graphmode:integer;
                       var resfile:TResourcefile;
                       pathtodriver:string);
{ Attempts to load the given driver (which may be Detect) from the
  resource file, register it, and call initgraph.  PathToDriver will
  only be used if the driver isn't in the resource file. }

function PutDriver(filename:string;var resfile:TResourcefile;
                   keep:boolean):integer;
{ Puts driver 'filename' into the given resource file.  If keep is true,
  leaves it loaded in memory.  If keep is false, deletes it from memory, but
  leaves Graph unstable.  Returns a graphics error constant.}

function PutAllDrivers(path:string;var resfile:TResourcefile;
                       keep:boolean):integer;
{ Puts all the standard drivers into the given resource file; assumes
  that it can find them all in the given path (terminated with a backslash,
  e.g. "c:\drivers\".  Returns all graphics error constants from PutDriver
  or'd together.}

procedure DelDriver(Graphdriver:integer;var resfile:TResourcefile);
{ Deletes the driver with the given number from the resource file.  Numbers
  are those used by InitGraph, i.e. CGA=1, VGA=9, etc.
  NB:  Some drivers handle several devices, so for example deleting VGA will also
       take out EGA.  The standard list is:

         File          Graphdriver constants

         CGA.BGI:      CGA, MCGA
         EGAVGA.BGI:   EGA, EGA64, EGAMono, VGA
         IBM8514.BGI:  IBM8514
         HERC.BGI:     HercMono
         ATT.BGI:      ATT400
         PC3270.BGI:   PC3270 }

type
  PResourcefile2 = ^TResourcefile2;
  TResourcefile2 = object(TResourcefile)
    { A resource file that knows how to pack itself. }

    procedure Pack;
    { Packs in place.  This works even if the resource file
    is embedded in a larger file, e.g. an .EXE file with overlays and
    resources.  Note that whatever follows the resource file will be moved;
    something like the overlay manager would need to be reinitialized
    afterwards.

    This really belongs in the Streams or Objects unit; it will be
    moved there in future versions. }
  end;

  PBGIDriver = ^TBGIDriver;
  Tbgidriver = object(TObject)
    location : pointer;  { Where the .bgi file is loaded }
    size : word;         { The size of the file }
    number : integer;    { Internal driver number }

    constructor init(filename : string);
    destructor done; virtual;
    { Dispose of memory used by driver.
      NB:  leaves Graph unit unstable :-( }

    constructor load(var S:TStream);
    procedure store(var S:TStream);
  end;

  { These constants are in separate blocks so that you don't link any of
    them unless you need them. }

const
  drivernum : array[1..10] of word = (0,0,1,1,1,2,3,4,1,5);
  { These are the internal driver numbers for graphdriver values 1 to 10. }
const
  drivernames : array[0..5] of String[11] =
   ('CGA.BGI', 'EGAVGA.BGI', 'IBM8514.BGI',
    'HERC.BGI', 'ATT.BGI', 'PC3270.BGI');
const
  { Stream registration number and record for TBGIDriver }
  BGITypeCode = $4247;   { 'BG' }
  RBGIDriver : TStreamRec = (
          ObjType: BGItypecode;
          VmtLink: Ofs(TypeOf(TBGIDriver)^);
          Load:    @TBGIDriver.Load;
          Store:   @TBGIDriver.Store
          );

implementation

constructor TBGIDriver.init(filename:string);
var
  src : TDosstream;
  success : boolean;
begin
  success := false;
  src.init(filename,stOpenRead);
  if src.status = stOk then
  begin
    size   := src.getsize;           { Assumes size <= 64K }
    if maxavail >= size then
    begin
      getmem(location,size);
      src.read(location^,size);
      if src.status = stOk then
      begin
        number := RegisterBGIDriver(location);
        if number >= 0 then
          success := true;
      end;
      if not success then
        freemem(location,size);
    end;
  end;
  src.done;
  if not success then
    fail;
end;

destructor TBGIDriver.done;
begin
  freemem(location,size);   { Dangerous!  Graph still thinks the driver
                              is there. }
  TObject.done;
end;

constructor TBGIDriver.load(var S:TStream);
begin
  S.read(size,sizeof(size));
  if memavail >= size then
  begin
    getmem(location, size);
    S.read(location^, size);
    if S.status = stOK then
    begin
      number := RegisterBGIDriver(location);
      if number >= 0 then
        exit;  { Success! }
    end;
    freemem(location, size);
  end;
  fail;
end;

procedure TBGIDriver.store(var S:TStream);
begin
  S.write(size,sizeof(size));
  S.write(location^,size);
end;

procedure ResInitGraph(var graphdriver,graphmode:integer;
                     var resfile:TResourcefile;
                     pathtodriver:string);
var
  name : string;
  bgi : PBGIDriver;
begin
  if graphdriver = Detect then
    DetectGraph(graphdriver,graphmode);
  if (1 <= graphdriver) and (graphdriver <= 10) then
  begin
    str(drivernum[graphdriver],name);
    name := 'bgi'+name;
    bgi := PBGIDriver(resfile.Get(name));
  end;
  initgraph(graphdriver,graphmode,pathtodriver);
end;

function PutDriver(filename:string;var resfile:TResourcefile;keep:boolean):integer;
{ Puts driver 'filename' into the given resource file.  Leaves it loaded
  in memory if keep is true; otherwise, deletes it (but leaves Graph unit
  unstable). }
var
  BGI : TBGIDriver;
  num : string;
begin
  if BGI.init(filename) then
  begin
    str(BGI.number,num);
    resfile.Put(@BGI,'bgi'+num);
    if resfile.stream^.status = stOk then
      PutDriver := grOK
    else
      PutDriver := grError;
    if not keep then
      BGI.done;
  end
  else
    PutDriver := grFileNotfound;
end;

function PutAllDrivers(path:string;var resfile:TResourceFile;keep:boolean):integer;
{ Puts all the standard drivers into the given resource file; assumes
  that it can find them all in the given path (terminated with a backslash,
  e.g. "c:\drivers\" }
var
  result : integer;
begin
  PutAllDrivers :=    PutDriver(path+'ATT.BGI',resfile,keep)
                   or PutDriver(path+'CGA.BGI',resfile,keep)
                   or PutDriver(path+'EGAVGA.BGI',resfile,keep)
                   or PutDriver(path+'HERC.BGI',resfile,keep)
                   or PutDriver(path+'IBM8514.BGI',resfile,keep)
                   or PutDriver(path+'PC3270.BGI',resfile,keep);
end;

procedure DelDriver(graphdriver:integer;var resfile:TResourcefile);
{ Deletes the driver with the given number from the resource file.  Numbers
  are those used by InitGraph. }
var
  num : string;
begin
  if (1 <= graphdriver) and (graphdriver <= 10) then
  begin
    str(drivernum[graphdriver],num);
    resfile.delete('bgi'+num);
  end;
end;


procedure TResourcefile2.Pack;

type
  {$ifndef ver60}
  This declaration may be TP 6.0 specific!!
  {$endif}

  resrec = record    { These are the fields of Objects.TResourceFile,
                       including the private ones. }
    vmtptr : word;
    stream : PStream;
    modified : boolean;
    basepos : longint;
    indexpos: longint;
    index : TResourceCollection;
  end;

  TResFileHeader = record
    Signature: array[1..4] of char;
    ResFileSize: Longint;
    IndexOffset: Longint;
  end;

var
  temp : PStream;
  oldstream : PStream;
  header : TResFileHeader;
  size,basepos : longint;
  i : integer;
  selfrec : resrec absolute self;
begin
  flush;
  basepos := selfrec.basepos;
  stream^.seek(basepos);
  stream^.read(header,sizeof(header));
  if header.signature <> 'FBPR' then
    exit;  { Don't do any packing, just quit }

  size := stream^.GetSize - basepos;     { get the size for temp }

{$ifndef NOSTREAMS}
  temp := Tempstream(12,size, forspeed);
{$else}
  { If you don't have Streams, you can make the following poor substitution
    by defining NOSTREAMS: }
  temp := New(PDOSStream,init('bgires.tmp',stCreate));
  { but if you do, you'll have to manually erase bgires.tmp when the demo is
    done. }
{$endif}
  if temp = nil then
    exit;  { Again, can't proceed, so quit. }
  oldstream := switchto(temp, true);     { pack res to temp }
  flush;

  oldstream^.seek(basepos + 8 + header.resfilesize);    { copy the rest of oldstream }
  temp^.seek(temp^.getsize);
  temp^.copyfrom(oldstream^, oldstream^.getsize - oldstream^.getpos);

  oldstream^.seek(basepos);                  { copy it all back to the old
                                               stream }
  temp^.seek(0);
  oldstream^.copyfrom(temp^, temp^.getsize);
  oldstream^.truncate;

  { Reinstall the old stream into res, and get rid of temp }
  stream := oldstream;
  selfrec.basepos  := basepos;

  dispose(temp,done);
end;

{ Startup code registers the TBGIDriver type. }

begin
  Registertype(RBGIDriver);
end.