home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
BGIRES.ZIP
/
BGIRES.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-07-11
|
9KB
|
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.