[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]

program loadbmp;

{ only 256 colors }

uses dos,crt,graph;

{ the driver is include in "play256.zip" on my pascal-homepage }
{ http://quintus.universal.nl/users/dickmann/pascal.htm }

var
  regs                  :registers;
  maxx,maxy,p,x,y       :integer;
  f                     :file;
  header                :record
                           bm:array[0..1] of char;
                           groottebestand       :longint;
                           reserve              :longint;
                           offset               :longint;
                           groottebeeldinfo     :longint;
                         end;
  beeldinfo             :record
                           breedte,hoogte       :longint;
                           vlakken,bitsperpixel :word;
                           hor,ver              :longint;
                           aantalkleuren        :longint;
                         end;
  bytesperlijn,oudpos   :longint;
  rgbi                  :array[1..256] of record bb,gg,rr,ii :byte;end;
  rgb                   :array[1..256] of record r,g,b :byte;end;
  lijn                  :array[1..1024] of byte;


procedure load_bmp(xx,yy :integer;filenaam :string);

procedure set256palette(var rgb_buffer);

begin
  with regs do begin
    ax :=$1012;
    bx :=0;
    cx :=256;
    es :=seg(rgb_buffer);
    dx :=ofs(rgb_buffer);
    intr($10,regs);
  end;
end;

begin
  maxx :=getmaxx-1;maxy :=getmaxy-1;
  assign(f,filenaam+'.bmp');
  {$I-} reset(f,1); {$I+}
  if ioresult =0 then begin
    blockread(f,header,sizeof(header));
    fillchar(beeldinfo,sizeof(beeldinfo),0);
    blockread(f,beeldinfo,header.groottebeeldinfo -4);
    with beeldinfo,header do begin
      bytesperlijn :=breedte *bitsperpixel;
      if (bytesperlijn and 31) =0 then bytesperlijn :=bytesperlijn shr 3
        else bytesperlijn :=succ(bytesperlijn shr 5)shl 2;
      if aantalkleuren =0 then aantalkleuren :=1 shl bitsperpixel;

      if bitsperpixel <>8 then exit;
      blockread(f,rgbi,4*aantalkleuren);
      for p :=1 to aantalkleuren do with rgb[p],rgbi[p] do begin
        r :=rr shr 2;
        g :=gg shr 2;
        b :=bb shr 2;
      end;
      set256palette(rgb);

      with header,beeldinfo do begin
        if hoogte <= maxy then oudpos :=offset
          else oudpos :=offset +bytesperlijn *(hoogte -maxy);
        if breedte < maxx then maxx :=breedte;
        if hoogte <maxy then maxy :=hoogte;
        for y :=yy+(maxy-1) downto yy do begin
          seek(f,oudpos);
          blockread(f,lijn,maxx);
          for x :=xx to (maxx)+xx do putpixel(x,y,lijn[x-xx]);
          inc(oudpos,bytesperlijn);
        end;
      end;

      close(f);
    end;
  end;
end;

procedure Setvideo(scherm :byte);

var  AutoDetect : pointer;  GrMd,GrDr  : integer;

{$F+}
function DetectVGA0 : Integer;
begin detectvga0 :=0;end;
function DetectVGA1 : Integer;
begin detectvga1 :=1;end;
function DetectVGA2 : Integer;
begin detectvga2 :=2;end;
function DetectVGA3 : Integer;
begin detectvga3 :=3;end;
function DetectVGA4 : Integer;
begin detectvga4 :=4;end;
{$F-}

begin
  AutoDetect := @DetectVGA2;
  case scherm of
    0:AutoDetect := @DetectVGA0;
    1:AutoDetect := @DetectVGA1;
    2:AutoDetect := @DetectVGA2;
    3:AutoDetect := @DetectVGA3;
    4:AutoDetect := @DetectVGA4;
  end;
  GrDr := InstallUserDriver('SVGA256',AutoDetect);
  GrDr := Detect;
  InitGraph(GrDr,GrMd,'');
end;


begin
  setvideo(2);
     { 0 = 320x200 / 1 = 640x400 / 2 = 640x480 }
     { 3 = 800x600 / 4 = 1024x768 pixels }

  load_bmp(0,0,'demo');   { no extension }
  readln;
  closegraph;
  halt;
end.

[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]