home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TP_ADV.ZIP / LIST1011.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-07-31  |  8.8 KB  |  202 lines
  1. Unit BGISave2;
  2. { This unit will save an image on the graphics screen to the  }
  3. { disk file passed as a parameter.  Because the size of an    }
  4. { image retreived by the GetImage procedure can be larger     }
  5. { 64K, it is necessary to get the image and restore it in     }
  6. { several steps.  It is possible to save an EGA screen in two }
  7. { steps, but the VGA screen in VGA Hi res mode is simply too  }
  8. { large to store in two steps.  Therefore, it is necessary to }
  9. { store such a screen in four steps.  Why four?  Because if   }
  10. { I was to use 3 steps, it is much harder arrive at an exact  }
  11. { size to make all 3 clips identical in size.                 }
  12. { The first thing the routine will do is save the Y position  }
  13. { of each of the four sections as a word into the image file. }
  14. { This is then followed by the exact information stored by    }
  15. { Turbo Pascal's GetImage procedure.                          }
  16. { To restore the image from the disk file, the restore        }
  17. { routine will first read from the file the four Y positions  }
  18. { stored in the file, and then recalculate the image size     }
  19. { based on the values read.  Later versions will add to the   }
  20. { file the size of each of the four image chunks, thereby     }
  21. { removing the need to pass the X2 and Y2 parameters to the   }
  22. { RestoreImage procedure.                                     }
  23.  
  24. Interface
  25.  
  26. Uses Graph;
  27.  
  28. Procedure SaveImage( X1, Y1, X2, Y2 : Word; FileName : String );
  29. { This is the routine that is called to save an image to the  }
  30. { specified disk file.  It first determines if the image size }
  31. { can be retrieved by on call to GetImage.  This is           }
  32. { determined by a call to the ImageSize function, and if what }
  33. { is returened is less then what can be store in one block on }
  34. { the heap, one call is made to GetImage and this info is     }
  35. { written to the file.                                        }
  36.  
  37. Procedure RestoreImage( X1,Y1,X2,Y2,PutPat : Word; FileName : String );
  38. { This routine is called to restore a previously store image. }
  39. { It is currently necessary to pass the X2 and Y2 parameters  }
  40. { to the proecdure, so it can recalculate the size of each    }
  41. { of the four image chuncks.  Later version will be rewritten }
  42. { so as to remove this requirement.                           }
  43.  
  44. Implementation
  45.  
  46. Uses Dos;     { Necessary to implement the Exist function.    }
  47.  
  48. Var
  49.   ImSize : LongInt;
  50.  
  51. Function Exists( FName : String ) : Boolean;
  52. { Checks for the existance of the image file.                 }
  53.  
  54. Var
  55.   Files : String;
  56.  
  57. Begin
  58.   Files := FSearch( FName, '' );
  59.   Exists := Files <> '';
  60. End;
  61.  
  62. Procedure SaveBlock( X1,Y1,X2,Y2 : Word; Var F : File );
  63. { THis procedure will save the block of the screen defined by }
  64. { X1 Y1 X2 Y2 into the file specified by F.                   }
  65. Var
  66.   P : Pointer;     { Location in heap to store the image      }
  67.   ISize : Word;    { Size of Image to be stored on the heap   }
  68.  
  69. Begin
  70.   ISize := ImageSize( X1,Y1,X2,Y2 );{ Determine size of Image }
  71.   GetMem( P,ISize );                { Get the Memory to store }
  72.   GetImage( X1,Y1,X2,Y2,P^ );       { Get the image           }
  73.   BlockWrite( F, P^, ISize );       { Write the Image to F    }
  74.   FreeMem( P, ISize );              { Release the heap memory }
  75. End;
  76.  
  77. Procedure StoreExtendedImage( X1,Y1,X2,Y2 : Word; FName : String );
  78. { This procedure will break the requested image block into    }
  79. { the four smaller blocks.  This is necessary because some    }
  80. { images are too large to store in one call to the GetImage   }
  81. { procedure.  In such cases, we will store the image in four  }
  82. { different blocks within the output file.                    }
  83. Var
  84.   F : File;       { Output file variable.                     }
  85.   YPos : Array[0..4] of Word; { Location to store Y coords    }
  86.   YRemain,        { Remainder of division for image size      }
  87.   Y : Word;       { Size of each block along Y coords         }
  88.   I : Byte;       { Loop control variable.                    }
  89.  
  90. Begin
  91.   Y := ( Y2 - Y1 ) Div 4; { Calculate the Y increment.        }
  92.   YRemain := ( Y2 - Y1 ) Mod 4; { Remainder of calculation    }
  93.   YPos[0] := Y1 - 1; { Start at one less than what was passed }
  94.   For I := 1 to 3 Do { Figure the other three starting Y vals }
  95.     YPos[I] := YPos[I-1] + Y;
  96.   YPos[4] := YPos[3] + Y + YRemain + 1;{ Tweek the last Y val }
  97.   Assign( F, FName );    { Associate the File                 }
  98.   Rewrite( F, 1 );       { Open it up for output              }
  99.   BlockWrite( F, YPos, SizeOf( YPos ) ); { Write the setup    }
  100.   For I := 0 to 3 Do     { Save each block into file          }
  101.     SaveBlock( X1,( YPos[I] + 1 ),X2,YPos[I + 1], F );
  102.   Close( F );            { Close it.                          }
  103. End;
  104.  
  105. Procedure StoreImage( X1,Y1,X2,Y2 : Word; FName : String );
  106. { This procedure will save the image if it is small enough    }
  107. { to fit into one block of memory on the Heap.                }
  108. Var
  109.   P : Pointer;                { Memory location to keep image }
  110.   F : File;                   { Output file variable          }
  111.  
  112. Begin
  113.   GetMem( P, ImSize );        { Reserve memory for image      }
  114.   GetImage( X1,Y1,X2,Y2,P^ ); { Save image to Heap area       }
  115.   Assign( F, FName );         { Open the disk file            }
  116.   Rewrite( F, 1 );
  117.   BlockWrite( F, P^, ImSize );{ Save the info into file       }
  118.   Close( F );
  119. End;
  120.  
  121. Procedure SaveImage( X1, Y1, X2, Y2 : Word; FileName : String );
  122. Begin
  123.   ImSize := ImageSize( X1, Y1, X2, Y2 );{ Check size of Image }
  124.                                       { Is it in valid range? }
  125.   If( ( ImSize > 0 ) And ( ImSize < 65535 ) ) Then
  126.     StoreImage( X1,Y1,X2,Y2,FileName )
  127.   Else
  128.     StoreExtendedImage( X1,Y1,X2,Y2,FileName );
  129. End;
  130.  
  131. Procedure RetrieveImage( FName : String; P : Pointer );
  132. { This procedure will restore an image if it was small enough }
  133. { to be stored with one call to GetImage.                     }
  134. Var
  135.   F : File;               { Input File variable               }
  136.  
  137. Begin
  138.   Assign( F, FName );     { Associate the filename with F     }
  139.   Reset( F, ImSize );     { Open the file for input           }
  140.   BlockRead( F, P^, 1 );  { Read in the image.                }
  141.   Close( F );             { Close the File                    }
  142. End;
  143.  
  144. Procedure PlaceImage( X1,Y1,X2,Y2,PutPat : Word; Var F : File );
  145. { This procedure calculates the size of each image block and  }
  146. { reads the appropriate information from the file.            }
  147. Var
  148.   P : Pointer;         { Pointer to where the image is stored }
  149. Begin
  150.   ImSize := ImageSize( X1,Y1,X2,Y2 ); { Calculate the size    }
  151.   GetMem( P, ImSize );     { Allocate the necessary memory    }
  152.   BlockRead( F, P^, ImSize );{ Input the info from disk       }
  153.   PutImage( X1,Y1,P^,PutPat );{ Place it onto the screen      }
  154.   FreeMem( P, ImSize );    { Deallocate the heap memory       }
  155. End;
  156.  
  157. Procedure RestoreExtendedImage( X1,Y1,X2,Y2,PutPat : Word;
  158.                                 FileName : String );
  159. { Driving procedure that will restore each of the four small  }
  160. { images inside the file.                                     }
  161. Var
  162.   F : File;           { File that stores the image            }
  163.   P : Pointer;        { Location to store each of the images  }
  164.   YPos : Array[0..4] of Word; { Holds each Y position         }
  165.   I : Byte;           { Loop control variable                 }
  166.  
  167. Begin
  168.   Assign( F, FileName ); { Associate the filename with F      }
  169.   Reset( F,1 );          { Open the file for Input            }
  170.   BlockRead( F, YPos, SizeOf( YPos ) ); { Read the info       }
  171.   For I := 0 to 3 Do     { Now restore each of the images     }
  172.     PlaceImage( X1,( YPos[I] + 1 ),X2,YPos[I + 1],PutPat, F );
  173.   Close( F );            { Close the file                     }
  174. End;
  175.  
  176. Procedure RestoreImage( X1,Y1,X2,Y2,PutPat : Word;
  177.                         FileName : String );
  178. { This is the procedure that will determine how the image was }
  179. { originally stored.  If it was done with one GetImage call,  }
  180. { then this procedure will restore that one image.  Otherwise }
  181. { it will call RestoreExtendedImage.                          }
  182. Var
  183.   F : File of Byte; { Open file as byte to determine its size }
  184.   BufPtr : Pointer; { Buffer to store the image read          }
  185.  
  186. Begin
  187.   Assign( F, FileName );
  188.   Reset( F );       { Open the file for input                 }
  189.   ImSize := FileSize( F ); { Determine the files size         }
  190.   Close( F );       { Close the file                          }
  191.   If( ImSize <= 65520 ) Then
  192.   Begin             { If it is small enough then restore it   }
  193.     GetMem( BufPtr, ImSize ); { Get the memory to store image }
  194.     RetrieveImage( FileName, BufPtr ); { Read image from file }
  195.     PutImage( X1,Y1,BufPtr^,PutPat );  { Restore it to screen }
  196.   End
  197.   Else              { Otherwise, must restore in four steps   }
  198.     RestoreExtendedImage( X1,Y1,X2,Y2,PutPat,FileName );
  199. End;
  200.  
  201. End.
  202.