home *** CD-ROM | disk | FTP | other *** search
/ Computer Club Elmshorn Atari PD / CCE_PD.iso / mac / 0300 / CCE_0385.ZIP / CCE_0385.PD / SAVE_IMG / SAVEIMG.M < prev    next >
Text File  |  1991-06-29  |  2KB  |  52 lines
  1. MODULE Test;   
  2.  
  3.  (* Test-Programm für GemImage-Moduln 
  4.     Mit einer File-Select-Box kann ein 32KByte-Bild ausgewählt werden,
  5.     das dann mit <BitImageSpeichern> als IMG-Bild gespeichert wird.
  6.   
  7.     (c) by JauTeam 1991
  8.   *)
  9.                
  10.  FROM MOSGlobals IMPORT FileStr;     
  11.  FROM Files      IMPORT File, Open, Access, Close;
  12.  FROM Binary     IMPORT ReadLargeBlock;
  13.  FROM Terminal   IMPORT WritePg;
  14.  FROM XBIOS      IMPORT ScreenPhysicalBase;
  15.  FROM GemImage   IMPORT BitImageSpeichern, SmallHeader;
  16.  FROM JauGem     IMPORT GemInit, GemExit;
  17.  FROM FileNames  IMPORT PathConc;
  18.  FROM SYSTEM     IMPORT ADDRESS;
  19.  FROM Strings    IMPORT Assign, Append;
  20.  FROM Directory  IMPORT DefaultPath;
  21.  FROM AESMisc    IMPORT SelectFile;
  22.  
  23.  VAR header           : SmallHeader;
  24.      datei            : File;
  25.      screen           : POINTER TO ARRAY [0..31999] OF SET OF [0..7];
  26.      name,pfad,datname: FileStr;
  27.      ok               : BOOLEAN;
  28.      
  29.  BEGIN
  30.   GemInit; 
  31.   name:='';
  32.   Assign(DefaultPath(),pfad,ok);              
  33.   Append('*.*',pfad,ok);
  34.   SelectFile(pfad,name,ok);
  35.   IF ok THEN
  36.    screen:=ScreenPhysicalBase();
  37.    datname:=PathConc(pfad,name);
  38.    Open(datei,datname,readOnly);
  39.    ReadLargeBlock(datei,screen^);
  40.    Close(datei);
  41.    WITH header DO
  42.     version:=1;
  43.     pixelbreite:=372;
  44.     pixelhoehe:=372;
  45.     bildbreite:=640;
  46.     bildhoehe:=400;
  47.    END(*WITH*);
  48.   ok:= BitImageSpeichern(screen,header,'DEMO.IMG'); 
  49.   END(*IF*);
  50.   GemExit;  
  51.  END Test.
  52.