home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / grafik / lbm / iff / _loadiff.pas next >
Encoding:
Pascal/Delphi Source File  |  1992-01-29  |  7.5 KB  |  293 lines
  1. Unit _LoadIff;      (* requires TP 5.0 or higher *)
  2.  
  3. (* ******************************************************************** *)
  4. (* Diese Unit ermöglicht das Einladen von DPaint (*.IFF, *.LBM) Bildern *)
  5. (* in einer Auflösung von 320x200 Bildpunkten bei 256 Farben            *)
  6. (*                                                                      *)
  7. (* (c) by ICE-BLOCK / InfernO-crew in 1992                              *)
  8. (* For some swapping (Demos, Pascal-Sources etc.) contact me at:        *)
  9. (* PLK 050808 C, W-6110 Dieburg, United Germany                         *)
  10. (* ******************************************************************** *)
  11.  
  12. Interface
  13.  Procedure LoadIFF(Name:String);
  14.  Procedure ShowIff;
  15.  Procedure VGA_Mode_On;
  16.  Procedure VGA_Mode_Off;
  17.  
  18. Implementation
  19.  
  20. Uses Dos, Crt;
  21.  
  22. Type
  23.  LBMPuffer=array[0..65534] of Byte;
  24.  NeuPuffer=array[0..63999] of Byte;
  25.  
  26. Var
  27.  FarbPuffer: Array[0..767] of Byte;
  28.  NameLBM   : String[80];
  29.  InFile    : File;
  30.  HI,LO,
  31.  Handle,
  32.  BildLaenge,
  33.  addr      : Word;
  34.  BildType,
  35.  Fehler    : Byte;
  36.  Regs      : Registers;
  37.  LBMP      : ^LBMPuffer;
  38.  NEUP      : ^NEUPuffer;
  39.  
  40. (* *********************************************** *)
  41. (* Procedure VGA_JA_NEIN  -> VGA-Karte vorhanden ? *)
  42. (* *********************************************** *)
  43.  
  44. Procedure VGA_JA_NEIN;
  45. begin
  46.  Regs.AX:=$1a00;
  47.  Intr($10,Regs);
  48.  If Regs.al<>$1a then
  49.   begin
  50.    Fehler:=1;
  51.    TextColor(4);
  52.    GotoXY(2,20);
  53.    Write('Keine VGA-Karrte !!');
  54.    Exit;
  55.   end;
  56. end;
  57.  
  58. (* ************************************************* *)
  59. (* Procedure LBMDateiLaden  -> öffnet die Bilddatei  *)
  60. (* ************************************************* *)
  61.  
  62. Procedure LBMDateiLaden;
  63. Var
  64.  GeleseneRecords:Word;
  65. begin
  66.  Assign(Infile,NameLBM);
  67.  {$i-}
  68.  Reset(Infile,65535);
  69.  BlockRead(InFile,LBMP^,1,GeleseneRecords);
  70.  {$i+}
  71.  If IOResult<>0 then
  72.   begin
  73.    fehler:=1;
  74.    TextColor(LightRed+128);
  75.    TextBackground(Blue);
  76.    GotoXY(2,20);
  77.    Write('Fehler bein lesen des Programms !!');
  78.    exit;
  79.   end;
  80.  Close(InFile);
  81. end;
  82.  
  83. (* ********************************************************************* *)
  84. (* Procedure PruefenGrafikFormat  -> ist die Datei eine IFF 320x200x256  *)
  85. (*                                   Datei ?                             *)
  86. (* ********************************************************************* *)
  87.  
  88. Procedure PruefenGrafikFormat;
  89. begin
  90.  If (LBMP^[20]=1) and (LBMP^[21]=$40) and
  91.     (LBMP^[22]=0) and (LBMP^[23]=$C8) and
  92.     (LBMP^[46]=3) and (LBMP^[47]=0)
  93.     then Fehler:=0 else Fehler:=1;
  94.     If LBMP^[8]=$49 then BildType:=1
  95.     else BildType:=2;
  96. end;
  97.  
  98. (* ******************************************************************* *)
  99. (* Procedure FarbDatenEinlesen  -> Läd die Farbtabelle in den Speicher *)
  100. (* ******************************************************************* *)
  101.  
  102. Procedure FarbDatenEinlesen;
  103. Var I:Integer;
  104. begin
  105.  For i:=48 to 816 do
  106.   FarbPuffer[i-48]:=LBMP^[i];
  107. end;
  108.  
  109. (* ********************************************************************** *)
  110. (* Procedure BildLaengeErmitteln  -> Ermittelt die Länge der eigentlichen *)
  111. (*                                   Bilddaten                            *)
  112. (* ********************************************************************** *)
  113.  
  114. Procedure BildLaengeErmitteln;
  115. Var
  116.  Hilfe:Word;
  117.  I:LongInt;
  118. begin
  119.  For i:=0 to 69996 do begin
  120.   If (LBMP^[i]=$42) and (LBMP^[i+1]=$4f)
  121.   and (LBMP^[i+2]=$44) and (LBMP^[i+3]=$59)
  122.   then addr:=i+6;
  123.  end;
  124.  BildLaenge:=LBMP^[addr]+LBMP^[addr+1];
  125.  Hilfe:=BildLaenge;
  126.  BildLaenge:=BildLaenge SHL 8;
  127.  BildLaenge:=BildLaenge OR $00ff;
  128.  Hilfe:=Hilfe SHR 8;
  129.  Hilfe:=Hilfe OR $00ff;
  130.  BildLaenge:=BildLaenge AND Hilfe;
  131. end;
  132.  
  133. (* ********************************************************************* *)
  134. (* Procedure FarbinformationenAnpassen  -> Initialisiert die Farbtabelle *)
  135. (* ********************************************************************* *)
  136.  
  137. Procedure FarbinformationenAnpassen;
  138. Var i:Integer;
  139. begin
  140.  For i:=0 to 767 do begin
  141.   FarbPuffer[i]:=FarbPuffer[i] SHR 2;
  142.  end;
  143. end;
  144.  
  145. (* ***************************************************************** *)
  146. (*Procedure BildDatenDekomprimieren  -> Umwandeln in Bildschirmdaten *)
  147. (* ***************************************************************** *)
  148.  
  149. Procedure BildDatenDekomprimieren;
  150. Var
  151.  Zaehler:Word;
  152.  a:Byte;
  153.  i,j,k:LongInt;
  154.  
  155. begin
  156.  Zaehler:=0;
  157.  i:=Addr+2;
  158.  j:=0;
  159.   Repeat
  160.    If LBMP^[i]<$80 then begin
  161.     j:=LBMP^[i];
  162.      for K:=1 to J+1 do begin
  163.       Neup^[Zaehler]:=LBMP^[i+k];
  164.       Zaehler:=Zaehler+1;
  165.      end;
  166.     i:=i+j+2;
  167.    end
  168.    else begin
  169.     a:=LBMP^[i];
  170.     a:=-a;
  171.     a:=a+1;
  172.     j:=a;
  173.      For K:=1 to J do begin
  174.       NEUP^[Zaehler]:=LBMP^[i+1];
  175.       Zaehler:=Zaehler+1;
  176.      end;
  177.     i:=i+2;
  178.    end;
  179.   until Zaehler>63999;
  180.  If BildType=2 then begin
  181.   For i:=0 to 63999 do LBMP^[i]:=Neup^[i];
  182.  end;
  183. end;
  184.  
  185. (* ************************************************************* *)
  186. (*Procedure BildDatenDecodieren  -> Umwandeln in Bildschirmdaten *)
  187. (* ************************************************************* *)
  188.  
  189. Procedure BildDatenDecodieren;
  190. Var
  191.  I1,Zaehler,m,j:Longint;
  192.  k,l,n:Integer;
  193.  Plane,BildByte:array[0..7] of Byte;
  194. begin
  195.  Zaehler:=0;
  196.   for m:=0 to 199 do begin
  197.    i1:=m*320;
  198.     for j:=0 to 39 do begin
  199.      Plane[0]:=Neup^[i1+j];
  200.      Plane[1]:=Neup^[i1+j+40];
  201.      Plane[2]:=Neup^[i1+j+80];
  202.      Plane[3]:=Neup^[i1+j+120];
  203.      Plane[4]:=Neup^[i1+j+160];
  204.      Plane[5]:=Neup^[i1+j+200];
  205.      Plane[6]:=Neup^[i1+j+240];
  206.      Plane[7]:=Neup^[i1+j+280];
  207.      l:=128;
  208.       For K:=0 to 7 do begin
  209.        BildByte[k]:=0;
  210.         If Plane[0] and l=l then BildByte[k]:=BildByte[k]+1;
  211.         If Plane[1] and l=l then BildByte[k]:=BildByte[k]+2;
  212.         If Plane[2] and l=l then BildByte[k]:=BildByte[k]+4;
  213.         If Plane[3] and l=l then BildByte[k]:=BildByte[k]+8;
  214.         If Plane[4] and l=l then BildByte[k]:=BildByte[k]+16;
  215.         If Plane[5] and l=l then BildByte[k]:=BildByte[k]+32;
  216.         If Plane[6] and l=l then BildByte[k]:=BildByte[k]+64;
  217.         If Plane[7] and l=l then BildByte[k]:=BildByte[k]+128;
  218.        LBMP^[Zaehler]:=BildByte[k];
  219.        Zaehler:=Zaehler+1;
  220.        l:=l shr 1;
  221.       end;
  222.     end;
  223.   end;
  224. end;
  225.  
  226. (* ********************************************************************* *)
  227. (* Procedure ShowIff -> Bildschirmadaten in den Bildschirmspeicher laden *)
  228. (* ********************************************************************* *)
  229.  
  230. Procedure ShowIff;
  231. Var i:LongInt;
  232. begin
  233.  Regs.ax:=$1012;
  234.  Regs.bx:=0;
  235.  Regs.cx:=256;
  236.  Regs.dx:=Ofs(FarbPuffer);
  237.  Regs.es:=Seg(FarbPuffer);
  238.  Intr($10,Regs);
  239.   For i:=0 to 63999 do Mem[$a000:i]:=LBMP^[i];
  240. end;
  241.  
  242. Procedure VGA_Mode_On;
  243. begin
  244.  Regs.AX:=$0013;
  245.  Intr($10,regs);
  246. end;
  247.  
  248. Procedure VGA_Mode_Off;
  249. begin
  250.  Regs.ax:=$0003;
  251.  Intr($10,Regs);
  252. end;
  253.  
  254. (* ****************************************************************** *)
  255. (* Procedure LoadIFF -> Bild einladen und für die Anzeige vorbereiten *)
  256. (* ****************************************************************** *)
  257.  
  258. Procedure LoadIFF(Name:String);
  259. begin
  260.  NameLBM:=Name;
  261.  New(LBMP);
  262.  New(NEUP);
  263.  Fehler:=0;
  264.  VGA_JA_NEIN;
  265.   If Fehler=1 then Halt(2);
  266.  LBMDateiLaden;
  267.  PruefenGrafikFormat;
  268.   If Fehler=1 then Halt(3);
  269.  FarbDatenEinlesen;
  270.  BildLaengeErmitteln;
  271.  FarbInformationenAnpassen;
  272.  BildDatenDekomprimieren;
  273.   If BildType=1 then BildDatenDecodieren;
  274. end;
  275.  
  276. Begin
  277. (* (c) by ICE-BLOCK in 1992                                    *)
  278. (* Copy it free as PD - but don't change the copyright-message *)
  279. end.
  280.  
  281.  
  282.  
  283.  
  284.  
  285.  
  286.  
  287.  
  288.  
  289.  
  290.  
  291.  
  292.  
  293.