Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/SDI.ZIP/SDIMAGE.PAS

Pascal/Delphi Source File | 1988-11-26 | 29.6 KB | 797 lines

{ *********************************************************************** }
{                            SDImage  V1.02                               }
{                        as of 25 November 1988                           }
{                                                                         }
{    SDImage V1.01 is a graphics image save/display utility which allows  }
{  you to save graphic images to memory or disk and redisplay them.       }
{  Image files can be read in another program or at a later date by       }
{  referring to the file by it's reference number in DisplayImage.        }
{    This unit is only dependant upon the BGI Graph unit. All activity is }
{  performed through the BGI, so anything that BGI supports SDImage also  }
{  supports automatically. Image size is not a factor. SDImage            }
{  automatically handles images that are larger than 64K. In fact, it     }
{  can handle any size image without requiring massive heap storage.      }
{    If the image size exceeds the buffer size, it will be automatically  }
{  stored to a disk file. Thus a full VGA screen could be saved with      }
{  a buffer size of only 1K. Note: It will take longer to save/display    }
{  the image with smaller buffers since the image has to be stored and    }
{  retrieved to disk.                                                     }
{                                                                         }
{    The mechanism that SDImage uses to save an image to disk is one      }
{  file per image. Thus if you intend to save lots of images, I strongly  }
{  recommend that you place them in a seperate subdirectory to help keep  }
{  things uncluttered. Also be aware that SDImage will leave image files  }
{  laying around if you don't remove them yourself. Which is another      }
{  good reason for putting the image files in their own directory so      }
{  that you can quickly find them and delete them if this is a problem.   }
{                                                                         }
{    It should be further noted that to operate correctly, the image      }
{  buffer size that is used to read in an image must be the same size     }
{  (or larger) than the image buffer that was used to save the image.     }
{  Because of this, if the image buffer size is too small, SDImage will   }
{  automatically resize the image read buffer to the correct size.        }
{                                                                         }
{         Originally written by Michael Day 12 November 1988              }
{                    Copyright 1988 by Michael Day                        }
{                                                                         }
{       This version (V1.02) is released to the public domain             }
{                     as of 25 November 1988                              }
{ *********************************************************************** }
{ History:                                                                }
{ V1.01 - Original release                                                }
{ V1.02 - Corrected special effects bug                                   }

unit SDImage;
interface
uses graph;

const
      ImageError : word = 0;   {contains one of the possible errors below}

      NoImageError      = 0;   {Don't Worry, Be Happy! Everything's cool.}
      ImageDiskError    = 1;   {Either file not found or a bum disk}
      ImageBufNumTooBig = 2;   {Too big a number, See MaxImageBuf const}

{-------------------------------------------------------------------------}
{Save a graphic screen Image, using Image reference number "Img" and}
{working buffer "Buf". x1,y1,x2,y2 specify the screen area to save}
{If something goes wrong, this function will return false.}
{The lower four bits of "Style" controls the special effects.}
{The upper four bits of Style controls the disk/buffer action.}
{If bit 7 is on, then the image will always be forced to disk.}
{If bit 7 is off, then the image will stay in the buffer if it can.}
{If the image is bigger than the buffer then it is flushed to disk anyway.}
{Note: special effects only operate when the image is read from the disk.}
{In fact it works because it uses the disk buffering as an inherent part}
{of the effects control. EMS buffering is not currently implemented.}
{0=Pull Down, 1=Pull Up, 2=Pull Right, 3=Pull Left, 4=Merge Vertical,}
{5=Expand Vertical, 6=Merge Horizontal, 7=Expand Horizontal.}

function SaveImage(Img,Buf:word; x1,y1,x2,y2:integer; Style:word):boolean;

{-------------------------------------------------------------------------}
{Displays a graphic screen image using image reference number Img and}
{working buffer "Buf". If an image is residing in the buffer and is the}
{correct image, then it will be displayed from the buffer. If the image}
{is not the correct one, or there is no image currently saved in the}
{buffer, then the buffer will be flushed to disk and the requested image}
{will be read from the disk (if found) and displayed. If ImgClr is ture,}
{then the image will be cleared from the buffer after being displayed.}
{If the image came from disk, then the disk file will be erased as well.}
{If ImgClr is false, then the image buffer and disk are left as they}
{were found. If something goes wrong, this function will return false.}

function DisplayImage(Img,Buf:word; ImgClr:boolean):boolean;

{-------------------------------------------------------------------------}
{The SaveImage function will automatically allocate an image buffer of the}
{default size on the first use if none exists. If you wish to use a larger}
{or smaller buffer, then you must use AllocImageBuf to allocate the desired}
{image buffer size. If an image already exists in the buffer, it will be}
{lost. Any existing old buffer space will be automatically released.}
{If there is not enough heap space to allocate the buffer, this function}
{will return a false condition.}

function AllocImageBuf(Buf:word; Size:word):boolean;

{-------------------------------------------------------------------------}
{This releases the image buffer used with an image. You can call this to}
{pick up heap space if you don't need the buffer anymore. As always,}
{if the buffer is not allocated at the time SaveImage is called, then}
{the default sized buffer will be allocated. Thus if you don't mind a}
{slight slow down in the image process, you could call this after calling}
{DisplayImage to keep heap usage to a minimum. Though keep in mind that}
{if you release the buffer, any saved image in the buffer will be lost.}

function ReleaseImageBuf(Buf:word):boolean;

{-------------------------------------------------------------------------}
{This sets a new path to be used for the image files. If the path does not}
{exist, then it will be unchanged, and the function returns false.}
{the Default path is to use the current default directory (i.e. no path).}

function SetImagePath(Path:string):boolean;

{-------------------------------------------------------------------------}
{If an image is in the specified buffer, then the image will be flushed}
{to disk. This can be used in preperation to releasing the buffer in order}
{to gain more heap space. If the image could not be written to disk, then}
{the function is aborted and returns false.}

function FlushImage(Buf:word):boolean;

{-------------------------------------------------------------------------}
{An image can be deleted with this function. This will delete both images}
{in the buffer and/or on disk. Retuns false if the image cannot be deleted}

function DeleteImage(Img,Buf:word):boolean;


{ *********************************************************************** }

implementation

type
     string8  = string[8];
     string80 = string[80];
     ImgRect  = record Xmin,Ymin,Xmax,Ymax:integer; end;

     {- this gets saved to disk at the beginning of the image file -}
     ImageDefRec = record     {18 bytes}
       ImageNum    : word;    {image reference number in use}
       MaxImgSize  : word;    {size of buffer used to write the image}
       ImgArea     : ImgRect; {the overall image area definition}
       ImgType     : word;    {how to save/display (special effects)}
       StepSize    : word;    {how many pixel rows per segment}
       StepCount   : word;    {how many image segments used}
       WrkSize     : word;    {how big full image is; $ffff= over 64K}
     end;

     {- this is only used by the image buffer -}
     ImageBufRec = record     {16 bytes}
       MaxBufSize  : word;    {how big the image buffer is}
       RawImage    : pointer; {points to image buffer on heap}
       RawArea     : ImgRect; {image segment area}
       RawSize     : word;    {size of image segment; 0=empty buffer}
     end;

const  {variable constants}
      ImgFileError : boolean  = false; {a disk error of some sort occured}
      ImgPath      : string80 = '';    {Path used to get to the image files}

const  {fixed constants}
      MaxImageBuf  = 20;       {maximum allowed working buffers}
      MaxRawImage  = 5000;     {default image buffer size in bytes}
      ImgExpCount  = 5;        {Explode increment count}
      ImgName      = 'SDI';    {Image file name (five digits are added)}
      ImgNameTag   = '.IMG';   {Image file name tag (extent)}
      ImgFileWrite = true;     {Open an image file for writing}
      ImgFileRead  = false;    {Open an image file for reading}
      ImgAreaWrite = true;     {Write to the image file}
      ImgAreaRead  = false;    {Read from the image file}

var   {plain old variables}
     ImgBuf  : array[0..MaxImageBuf] of ImageBufRec; {buffer info}
     ImgDef  : array[0..MaxImageBuf] of ImageDefRec; {disk info}
     ImgFile : file;

{ ----------------------------------------------------------------------- }
{                                  ImgType                                }
{ +---+-----+---------+------+-------------+ +------+-------+-----+-----+ }
{ |bit|  3  |    2    |  1   |      0      | |  7   |   6   |  5  |  4  | }
{ +---+-----+---------+------+-------------+ +------+-------+-----+-----+ }
{ | 1 | --- | Xpd/Mrg | Horz | Xpd/Left/Dn | | Disk |  EMS  | --- | --- | }
{ +---+-----+---------+------+-------------+ +------+-------+-----+-----+ }
{ | 0 | --- |  Pull   | Vert | Mrg/Rght/Up | | Auto | NoEMS | --- | --- | }
{ +---+-----+---------+------+-------------+ +------+-------+-----+-----+ }

{Note: EMS is not currently implemented }

{ *********************************************************************** }
{                         misc support functions                          }
{ *********************************************************************** }

{--------------------------------------------------}
{convert a word to a zero filled string}
function z5str(W:word):string8;
var S:string8;
begin
  str(W,S);
  while length(S) < 5 do S := '0'+S;
  z5str := S;
end;

{--------------------------------------------------}
{check for invalid Buf # }
function ImageCheckOK(Buf:word):boolean;
begin
   if Buf > MaxImageBuf then
   begin
     ImageCheckOK := false;
     ImageError := ImageBufNumTooBig;
     Exit;
   end;
   ImageError := NoImageError;
   ImageCheckOK := true;
end;


{ *********************************************************************** }
{                           Internal disk functions                       }
{ *********************************************************************** }

{$I-}

{--------------------------------------------------}
{open an image file for reading or writing }
function OpenImageFile(Buf:word; ImgWrite:boolean):boolean;
var RawCount:word;
begin
  OpenImageFile := false;
  if IOResult = 0 then {nop} ;
  ImgFileError := true;
  Assign(ImgFile,ImgPath+ImgName+z5str(ImgDef[Buf].ImageNum)+ImgNameTag);
  if ImgWrite then
  begin
    ImgDef[Buf].MaxImgSize := ImgBuf[Buf].MaxBufSize;
    rewrite(ImgFile,1);
    BlockWrite(ImgFile, ImgDef[Buf], sizeof(ImgDef[Buf]), RawCount);
    if (IOResult <> 0) or (sizeof(ImgDef[Buf]) <> RawCount) then Exit;
  end
  else
  begin
    reset(ImgFile,1);
    BlockRead(ImgFile, ImgDef[Buf], sizeof(ImgDef[Buf]), RawCount);
    if (IOResult <> 0) or (sizeof(ImgDef[Buf]) <> RawCount) then Exit;
    if ImgDef[Buf].MaxImgSize > Imgbuf[Buf].MaxBufSize then
    begin
      if not AllocImageBuf(Buf,ImgDef[Buf].MaxImgSize) then Exit;
    end;
  end;
  ImgFileError := false;
  OpenImageFile := true;
end;

{--------------------------------------------------}
{close the image file 'cause we're done with it}
function CloseImageFile:boolean;
begin
  CloseImageFile := false;
  Close(ImgFile);
  if (IOResult <> 0) then ImgFileError := true;
  if ImgFileError then
  begin
    ImageError := ImageDiskError;
    Exit;
  end;
  CloseImageFile := true;
end;

{--------------------------------------------------}
{read/write the image segment from/to disk }
procedure RWrawImage(Buf:word; ImgWrt:boolean);
var RawCount:word;
begin
   with ImgBuf[Buf],RawArea do
   begin
     RawSize := ImageSize(Xmin,Ymin,Xmax,Ymax);
     if ImgWrt then
     begin
       GetImage(Xmin,Ymin,Xmax,Ymax,RawImage^);
       BlockWrite(ImgFile, RawImage^, RawSize, RawCount);
     end
     else
     begin
       BlockRead(ImgFile, RawImage^, RawSize, RawCount);
       PutImage(Xmin,Ymin,RawImage^,NormalPut);
     end;
     if RawCount <> RawSize then ImgFileError := true;
     RawSize := 0;
   end;
end;

{--------------------------------------------------}
procedure RWImageArea(Buf:byte; ImgWrt:boolean);
var Area1,Area2:ImgRect;
begin
   with ImgBuf[Buf],ImgDef[Buf],RawArea do
   begin
     RawArea := ImgArea;
     if WrkSize <= MaxBufSize then
     begin
       RWrawImage(Buf,ImgWrt);
       Exit;
     end;

     case (ImgType and $07) of

       $00 :  {Pull Down (Vertical)}
       begin
         Ymax := Ymin + pred(StepSize);
         while Ymax < ImgArea.Ymax do
         begin
           RWrawImage(Buf,ImgWrt);
           Ymin := Ymin + StepSize;
           Ymax := Ymax + StepSize;
         end;
         Ymax := ImgArea.Ymax;
         RWrawImage(Buf,ImgWrt);
       end;

       $01 :  {Pull Up (Vertical)}
       begin
         Ymin := Ymax - pred(StepSize);
         while Ymin > ImgArea.Ymin do
         begin
           RWrawImage(Buf,ImgWrt);
           Ymin := Ymin - StepSize;
           Ymax := Ymax - StepSize;
         end;
         Ymin := ImgArea.Ymin;
         RWrawImage(Buf,ImgWrt);
       end;

       $02 :  {Pull Right (Horizontal)}
       begin
         Xmax := Xmin + pred(StepSize);
         while Xmax < ImgArea.Xmax do
         begin
           RWrawImage(Buf,ImgWrt);
           Xmin := Xmin + StepSize;
           Xmax := Xmax + StepSize;
         end;
         Xmax := ImgArea.Xmax;
         RWrawImage(Buf,ImgWrt);
       end;

       $03 :  {Pull Left (Horizontal)}
       begin
         Xmin := Xmax - pred(StepSize);
         while Xmin > ImgArea.Xmin do
         begin
           RWrawImage(Buf,ImgWrt);
           Xmin := Xmin - StepSize;
           Xmax := Xmax - StepSize;
         end;
         Xmin := ImgArea.Xmin;
         RWrawImage(Buf,ImgWrt);
       end;

       $04 :  {Mrg Vertical}
       begin
         begin
           Area1 := ImgArea;
           Area2 := ImgArea;
           Area1.Ymax := Area1.Ymin + pred(StepSize);
           Area2.Ymin := Area2.Ymax - pred(StepSize);
           while Area1.Ymax < Area2.Ymin do
           begin
             RawArea := Area1;
             RWrawImage(Buf,ImgWrt);
             Area1.Ymin := Area1.Ymin + StepSize;
             Area1.Ymax := Area1.Ymax + StepSize;
             RawArea := Area2;
             RWrawImage(Buf,ImgWrt);
             Area2.Ymin := Area2.Ymin - StepSize;
             Area2.Ymax := Area2.Ymax - StepSize;
           end;
           RawArea := Area1;
           while RawArea.Ymax < Area2.Ymax do
           begin
             RWrawImage(Buf,ImgWrt);
             Ymin := Ymin + StepSize;
             Ymax := Ymax + StepSize;
           end;
           Ymax := Area2.Ymax;
           RWrawImage(Buf,ImgWrt);
         end;
       end;

       $05 :  {Xpd Vertical}
       begin
         begin
           Area1 := ImgArea;
           Area2 := ImgArea;
           Area1.Ymax := ImgArea.Ymin+((ImgArea.Ymax-ImgArea.Ymin)shr 1);
           Area1.Ymin := Area1.Ymax - pred(StepSize);
           Area2.Ymin := succ(Area1.Ymax);
           Area2.Ymax := Area2.Ymin + pred(StepSize);
           while (Area1.Ymin>ImgArea.Ymin) and (Area2.Ymax<ImgArea.Ymax) do
           begin
             if (Area1.Ymin > ImgArea.Ymin) then
             begin
               RawArea := Area1;
               RWrawImage(Buf,ImgWrt);
               Area1.Ymin := Area1.Ymin - StepSize;
               Area1.Ymax := Area1.Ymax - StepSize;
             end;
             if (Area2.Ymax < ImgArea.Ymax) then
             begin
               RawArea := Area2;
               RWrawImage(Buf,ImgWrt);
               Area2.Ymin := Area2.Ymin + StepSize;
               Area2.Ymax := Area2.Ymax + StepSize;
             end;
           end;
           RawArea := Area1;
           if (RawArea.Ymax > ImgArea.Ymin) then
           begin
             RawArea.Ymin := ImgArea.Ymin;
             RWrawImage(Buf,ImgWrt);
           end;
           RawArea := Area2;
           if (RawArea.Ymin < ImgArea.Ymax) then
           begin
             RawArea.Ymax := ImgArea.Ymax;
             RWrawImage(Buf,ImgWrt);
           end;
         end;
       end;

       $06 :  {Mrg Horizontal}
       begin
         begin
           Area1 := ImgArea;
           Area2 := ImgArea;
           Area1.Xmax := Area1.Xmin + pred(StepSize);
           Area2.Xmin := Area2.Xmax - pred(StepSize);
           while Area1.Xmax < Area2.Xmin do
           begin
             RawArea := Area1;
             RWrawImage(Buf,ImgWrt);
             Area1.Xmin := Area1.Xmin + StepSize;
             Area1.Xmax := Area1.Xmax + StepSize;
             RawArea := Area2;
             RWrawImage(Buf,ImgWrt);
             Area2.Xmin := Area2.Xmin - StepSize;
             Area2.Xmax := Area2.Xmax - StepSize;
           end;
           RawArea := Area1;
           while RawArea.Xmax < Area2.Xmax do
           begin
             RWrawImage(Buf,ImgWrt);
             Xmin := Xmin + StepSize;
             Xmax := Xmax + StepSize;
           end;
           Xmax := Area2.Xmax;
           RWrawImage(Buf,ImgWrt);
         end;
       end;

       $07 :  {Xpd Horizontal}
       begin
         begin
           Area1 := ImgArea;
           Area2 := ImgArea;
           Area1.Xmax := ImgArea.Xmin+((ImgArea.Xmax-ImgArea.Xmin)shr 1);
           Area1.Xmin := Area1.Xmax - pred(StepSize);
           Area2.Xmin := succ(Area1.Xmax);
           Area2.Xmax := Area2.Xmin + pred(StepSize);
           while (Area1.Xmin > ImgArea.Xmin) and (Area2.Xmax < ImgArea.Xmax) do
           begin
             if (Area1.Xmin > ImgArea.Xmin) then
             begin
               RawArea := Area1;
               RWrawImage(Buf,ImgWrt);
               Area1.Xmin := Area1.Xmin - StepSize;
               Area1.Xmax := Area1.Xmax - StepSize;
             end;
             if (Area2.Xmax < ImgArea.Xmax) then
             begin
               RawArea := Area2;
               RWrawImage(Buf,ImgWrt);
               Area2.Xmin := Area2.Xmin + StepSize;
               Area2.Xmax := Area2.Xmax + StepSize;
             end;
           end;
           RawArea := Area1;
           if (RawArea.Xmax > ImgArea.Xmin) then
           begin
             RawArea.Xmin := ImgArea.Xmin;
             RWrawImage(Buf,ImgWrt);
           end;
           RawArea := Area2;
           if (RawArea.Xmin < ImgArea.Xmax) then
           begin
             RawArea.Xmax := ImgArea.Xmax;
             RWrawImage(Buf,ImgWrt);
           end;
         end;
       end;


     end; {case}
   end; {with}
end;

{--------------------------------------------------}
{write an image to buffer/disk }
function WriteImage(Buf:word):boolean;
var Iss,Ssc:word;
begin
   WriteImage := false;
   with ImgBuf[Buf],ImgDef[Buf] do
   begin
     with ImgArea do
     begin
       if ImgType and $02 = $00 then  {- $00=vertical action, $02=horizontal -}
       begin
         Ssc := Ymax-Ymin;                             {total image rows used}
         Iss :=  ImageSize(Xmin,Ymin,Xmax,succ(Ymin)); {image row size (bytes)}
       end
       else                        {Ssc= total row count}
       begin                       {Iss= row size in bytes}
         Ssc := Xmax-Xmin;
         Iss := ImageSize(Xmin,Ymin,succ(Xmin),Ymax);
       end;
       if MaxBufSize < Iss then                 {gotta have at least one rows}
         if not AllocImageBuf(Buf,Iss) then Exit;  {worth of buffer space}
       StepSize := MaxBufSize div Iss;
       StepCount := Ssc div StepSize;
       if Ssc mod StepSize > 0 then inc(StepCount);
     end;

     if OpenImageFile(Buf,ImgFileWrite) then
        RWImageArea(Buf,ImgAreaWrite);

     if not CloseImageFile then
     begin
       Erase(ImgFile);
       RawSize := 0;
       if IOResult <> 0 then {nop} ;
       Exit;
     end;
   end;
   WriteImage := true;
end;


{--------------------------------------------------}
{Read an image from the disk}
function ReadImage(Buf:word; ImgClr:boolean):boolean;
begin
   ReadImage := false;
   with ImgBuf[Buf],ImgDef[Buf] do
   begin
     if OpenImageFile(Buf,ImgFileRead) then
       RWImageArea(Buf,ImgAreaRead);

     if not CloseImageFile then Exit;
     if ImgClr then Erase(ImgFile);
     if IOResult <> 0 then Exit;
   end;
   ReadImage := true;
end;

{$I+}


{ *********************************************************************** }
{                         External access functions                       }
{ *********************************************************************** }

{-------------------------------------------------------------------------}
{                          AllocImageBuf                                  }
{-------------------------------------------------------------------------}
{This allocates a buffer for use with an image. You must call this before}
{you can use an image buffer if you want it to be a different size than}
{the default. If the buffer is not allocated at the time SaveImage is}
{called, then the default sized buffer will be allocated.}

function AllocImageBuf(Buf:word; Size:word):boolean;
begin
  AllocImageBuf := false;
  if not ImageCheckOK(Buf) then Exit;
  with ImgBuf[Buf] do
  begin
    if RawImage <> nil then
      freemem(RawImage,MaxBufSize);
    RawSize := 0;
    MaxBufSize := 0;
    If MaxAvail < Size then Exit;
    GetMem(RawImage,Size);
    MaxBufSize := Size;
    ImgDef[Buf].MaxImgSize := Size;
  end;
  AllocImageBuf := true;
end;


{-------------------------------------------------------------------------}
{                        ReleaseImageBuf                                  }
{-------------------------------------------------------------------------}
{This releases the image buffer used with an image. You can call this to}
{pick up heap space if you don't need the buffer anymore. As always,}
{if the buffer is not allocated at the time SaveImage is called, then}
{the default sized buffer will be allocated. Thus if you don't mind a}
{slight slow down in the image process, you could call this after calling}
{DisplayImage to keep heap usage to a minimum.}

function ReleaseImageBuf(Buf:word):boolean;
begin
  ReleaseImageBuf := false;
  if not ImageCheckOK(Buf) then Exit;
  with ImgBuf[Buf] do
  begin
    if RawImage <> nil then
      freemem(RawImage,MaxBufSize);
    RawImage := nil;
    RawSize := 0;
    MaxBufSize := 0;
  end;
  ReleaseImageBuf := true;
end;


{-------------------------------------------------------------------------}
{                          SetImagePath                                   }
{-------------------------------------------------------------------------}
{This sets a new path to be used for the image files. If the path does not}
{exist, then it will be created. If an error occurs the function returns }
{a false condition. The Default path is to use the current default directory}
{(i.e. no path).}

{$I-}

function SetImagePath(Path:string):boolean;
var TPath:string;
begin
  SetImagePath := false;
  GetDir(0,TPath);
  ChDir(Path);
  if IOResult <> 0 then MkDir(Path);
  ChDir(TPath);
  if IOResult = 0 then ImgPath := Path+'\';
  if IOResult <> 0 then Exit;
  SetImagePath := true;
end;

{$I+}

{-------------------------------------------------------------------------}
{                          FlushImage                                     }
{-------------------------------------------------------------------------}
{if there is an image in the buffer, flush it to disk}

function FlushImage(Buf:word):boolean;
var RawCount : word;
begin
  FlushImage := false;
  if not ImageCheckOK(Buf) then Exit;
  with ImgBuf[Buf] do
  begin
    if RawSize > 0 then
    begin
      if OpenImageFile(Buf,ImgFileWrite) then
      begin
        BlockWrite(ImgFile, RawImage^, RawSize, RawCount);
        if RawCount <> RawSize then ImgFileError := true;
      end;
      RawSize := 0;
      if not CloseImageFile then Exit;
    end;
  end;
  FlushImage := true;
end;


{-------------------------------------------------------------------------}
{                         DeleteImage                                     }
{-------------------------------------------------------------------------}
{This deletes images in the buffer and on disk. Any image that might}
{be in the buffer is lost. Any image disk file that exists by the given}
{number will be deleted. If an error occurs during the delete, such }
{as the requested image is not found, the function will return false.}

{$I-}

function DeleteImage(Img,Buf:word):boolean;
var RawCount : word;
begin
  DeleteImage := false;
  if not ImageCheckOK(Buf) then Exit;
  with ImgBuf[Buf] do
  begin
    RawSize := 0;
    if OpenImageFile(Buf,ImgFileWrite) then {nop} ;
    if CloseImageFile then Erase(ImgFile);
    RawSize := 0;
    if ImgFileError or (IOResult <> 0) then Exit;
  end;
  DeleteImage := true;
end;

{$I+}

{-------------------------------------------------------------------------}
{                          SaveImage                                      }
{-------------------------------------------------------------------------}
{ Saves the screen image under the box. This can be called to save the}
{ screen image before writing the box to the screen. Use DisplayImage to}
{ restore the image. The lower four bits of "Style" controls the special}
{ effects. The upper four bits of Style controls the disk/buffer action.}
{ If bit 7 is on, then the image will always be forced to disk.}
{ If bit 7 is off, then the image will stay in the buffer if it can.}
{ If the image is bigger than the buffer then it is flushed to disk anyway.}
{ Note: special effects only operate when the image is read from the disk.}
{ In fact it works because it uses the disk buffering as an inherent part}
{ of the effects control. EMS buffering is not currently implemented.}
{ 0=Pull Down, 1=Pull Up, 2=Pull Right, 3=Pull Left, 4=Merge Vertical,}
{ 5=Expand Vertical, 6=Merge Horizontal, 7=Expand Horizontal.}

function SaveImage(Img,Buf:word; x1,y1,x2,y2:integer; Style:word):boolean;
begin
   SaveImage := false;
   if not ImageCheckOK(Buf) then Exit;
   if not FlushImage(Buf) then Exit;  {flush image buffer}
   if ImgBuf[Buf].RawImage = nil then
     if not AllocImageBuf(Buf,MaxRawImage) then Exit;

   with ImgDef[Buf],ImgArea do
   begin
     ImageNum := Img;
     ImgType := Style;
     Xmin := x1;
     Ymin := y1;
     Xmax := x2;
     Ymax := y2;
     ImgBuf[Buf].RawArea := ImgArea;
     StepSize := Ymax-Ymin;
     StepCount := 1;
     WrkSize := ImageSize(Xmin,Ymin,Xmax,Ymax);
     if WrkSize = 0 then WrkSize := $ffff;

     if (ImgType and $80 = 0) and (WrkSize < ImgBuf[Buf].MaxBufSize) then
     begin    {- save image to heap buffer -}
       ImgBuf[Buf].RawSize := WrkSize;
       GetImage(Xmin,Ymin,Xmax,Ymax,ImgBuf[Buf].RawImage^);
     end
     else
     begin    {- write the image to disk -}
       if not WriteImage(Buf) then Exit;
     end;
   end;
   SaveImage := true;
end;

{-------------------------------------------------------------------------}
{                             DisplayImage                                }
{-------------------------------------------------------------------------}
{ Restores a previously saved box screen image. See SaveImage. }
{ If the desired image is in the buffer, then it comes from there.}
{ Otherwise the disk is searched for the desired image.}
{ If ImgClr is true, then the image buffer/file will be erased after}
{ the image has been displayed.}

function DisplayImage(Img,Buf:word; ImgClr:boolean):boolean;
begin
   DisplayImage := false;
   if not ImageCheckOK(Buf) then Exit;

   with ImgBuf[Buf] do
   begin
     if (Img = ImgDef[Buf].ImageNum) and (RawSize <> 0) then
     begin
       PutImage(RawArea.Xmin,RawArea.Ymin,RawImage^,NormalPut);
       if ImgClr then RawSize := 0;
     end
     else
     begin
       if not FlushImage(Buf) then Exit;  {flush image buffer if not same}
       ImgDef[Buf].ImageNum := Img;
       if not ReadImage(Buf,ImgClr) then Exit;  {read the requested image}
     end;
   end;
   DisplayImage := true;
end;


{ *********************************************************************** }
{ initialization }
begin
  fillchar(ImgBuf,sizeof(ImgBuf),0);
  fillchar(ImgDef,sizeof(ImgDef),0);
end.