Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
{ SBMP.PAS                                        Copyright (c) ... }
{                                                                   }
{ Unit pro hru zizala. Rutiny pro vykrslovani BMP obrazku           }
{ grafickem modu.                                                   }
{                                                                   }
{ Author: Neznamy                                                   }
{ Date  : 19.02.2020                           http://www.trsek.com }
 
unit SBmp;
 
interface
 
 Uses Dos,Graph,Crt;
 
 Procedure Obrazek(sX,sY:integer;Nazev:String);
 
implementation
 
 
 Procedure Obrazek(sX,sY:integer;Nazev:String);
  type
     RGB_entry = record
                     R, G, B: byte;
                 end;
     RGB_palette = array [0..255] of RGB_entry;
   var
    reg   : registers;
    Barva : Byte;
 
  procedure SetPalette (var nova_paleta: RGB_palette);
   begin
     with reg do
      begin
        ah := $10;
        al := $12;
        bx := 0;
        cx := 256;
        dx := ofs(nova_paleta);
        es := seg(nova_paleta);
      end;
     intr($10, reg);
   end;
 
 procedure GetPalette (var nova_paleta: RGB_palette);
   begin
     with reg do
       begin
         ah := $10;
         al := $17;
         bx := 0;
         cx := 255;
         dx := ofs(nova_paleta);
         es := seg(nova_paleta);
       end;
     intr($10, reg);
   end;
 
 
  Var f:Text;
    B:Byte;
    Znak:Char;
    X,Y,MaxX,MaxY,X1:Integer;
    Paleta: RGB_Palette;
  Begin
   DirectVideo:=False;  { Moznost vypisu textu na obrazovku pri graf.rezimu}
   Assign(f,Nazev); { Otevreni zdrojoveho souboru }
   Reset(f);                              { Otevreni pro cteni }
 
   { -- Nacteni Hlavicky -- }
 
   For X:=1 to 19 do Read(F,Znak);
 
       { Zjisteni maximalni x-ove souradnice }
   X:=Ord(Znak);
   Read(F,Znak);
   MaxX:=((256*Ord(Znak))+X)+sX;
 
   For X:=1 to 3 do
       begin
        Read(F,Znak);
       end;
 
       { Zjisteni maximalni Y-onove souradnice }
   Y:=Ord(Znak);
   Read(F,Znak);
   MaxY:=((256*Ord(Znak))+Y);
 
   For X:=1 to 29 do Read(F,Znak);
 
   GetPalette(Paleta);
   For X:=0 to 255 do
       With Paleta[X] do
       begin
        B:=0;
        G:=0;
        R:=0;
       end;
   SetPalette(Paleta);
 
   For X:=0 to 255 do                     { Vlastni cteni palety }
    begin
     Read(F,Znak);
     Read(F,Znak);
     Paleta[X].B:=Ord(Znak) div 4;
     Read(F,Znak);
     Paleta[X].G:=Ord(Znak) div 4;
     Read(F,Znak);
     Paleta[X].R:=Ord(Znak) div 4;
    end;
 
   X:=sX;Y:=sY+MaxY;
 
   Repeat
     Read(F,Znak);                  { Cti znak }
     Barva:=Ord(Znak);              { Barva je rovna cisle znaku v ASCII }
     PutPixel(X,Y,Barva);          { Kresli ze zdola nahoru }
     X:=X+1;
     If X=MaxX then begin X:=sX; Y:=Y-1; end;
   Until (Y<sY);              { Ukonci, jestli bude obrazek mimo obrazovku}
 
   Close(F);                   { Zavri soubor }
 
 
   SetPalette(Paleta);                       { Nastaveni palety }
 
   end;
 
END.