home *** CD-ROM | disk | FTP | other *** search
/ Prima Shareware 3 / DuCom_Prima-Shareware-3_cd1.bin / PROGRAMO / PASCAL / PASEX / BMP2PIC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-15  |  1.9 KB  |  80 lines
  1. { BMP to PIC cnv. by Paradise / Fate  }
  2. { paradise@bachus.umcs.lublin.pl      }
  3. {$i-}
  4.  
  5. type
  6.  scanline   = array [0..639] of byte;
  7.  
  8. var
  9.  bmppalette : array [0..255,1..4] of byte;
  10.  picpalette : array [0..255,1..3] of byte;
  11.  pfile      : file;
  12.  screen     : array [0..399] of ^scanline;
  13.  y,ystart   : integer;
  14.  inn,outn   : string;
  15.  
  16. procedure allocate_scanlines;
  17. begin
  18.  if memavail<640*400 then
  19.  begin
  20.    writeln('No enought memory! (needed 256kb free)');
  21.    halt;
  22.  end;
  23.  for y:=0 to 399 do getmem(screen[y],640);
  24. end;
  25.  
  26. procedure deallocate_scanlines;
  27. begin
  28.  for y:=0 to 399 do freemem(screen[y],640);
  29. end;
  30.  
  31. procedure load_bmp;
  32. begin
  33.  assign(pfile,inn);
  34.  reset(pfile,1);
  35.  if ioresult<>0 then
  36.  begin
  37.    deallocate_scanlines;
  38.    writeln('Disk or file error while loading input file!');
  39.    halt;
  40.  end;
  41.  seek(pfile,54);
  42.  blockread(pfile,bmppalette,1024);
  43.  for y:=399 downto 0 do blockread(pfile,screen[y]^,640);
  44.  for y:=0 to 255 do
  45.  begin
  46.   picpalette[y,1]:=bmppalette[y,3] shr 2;
  47.   picpalette[y,2]:=bmppalette[y,2] shr 2;
  48.   picpalette[y,3]:=bmppalette[y,1] shr 2;
  49.  end;
  50.  close(pfile);
  51. end;
  52.  
  53. procedure write_pic;
  54. begin
  55.  assign(pfile,outn);
  56.  rewrite(pfile,1);
  57.  blockwrite(pfile,picpalette,768);
  58.  for y:=0 to 399 do blockwrite(pfile,screen[y]^,640);
  59.  close(pfile);
  60. end;
  61.  
  62. begin
  63.  writeln;
  64.  writeln('BMP(640x480) to PIC(640x400) Converter (C) 1995 by Paradise / Fate ');
  65.  if paramcount<>1 then
  66.  begin
  67.    writeln('Usage: BMP2PIC.EXE <file.bmp>');
  68.    halt;
  69.  end;
  70.  inn:=paramstr(1);                     { name.bmp }
  71.  outn:=copy(inn,1,pos('.',inn))+'pic'; { name.pic }
  72.  ystart:=0; { you can change it from 0 to 80 }
  73.  writeln('Make sure that ',inn,' is correct 640x480x256 bmp file!');
  74.  writeln('Converting ',inn,' to ',outn,', wait... ');
  75.  allocate_scanlines;
  76.  load_bmp;
  77.  write_pic;
  78.  deallocate_scanlines;
  79.  writeln('That''s all folks!');
  80. end.