Программа читает файл test.bmp (16 цветов, может быть сделан обычным Paint) из текущей папки и выводит его на грфаический экран VGA. Можно указать "прозрачный" фоновый цвет. Как и любые программы, работающие с DOS-графикой, на современном компьютере запускается из-под эмулятора, например, DOSbox. Дополнительо подключается русифицированный графический шрифт trip.chr.

Листинг программы

uses Graph;

const VGAPath='EGAVGA.BGI';
      FontPath='';

procedure GraphError;
begin
 CloseGraph;
 Writeln('Graphics error:', GraphErrorMsg(GraphResult));
 Writeln('Press ENTER...');
 Readln;
 Halt (GraphResult);
end;

procedure InitVGA;
var Driver, Mode: integer;
    DriverF: file;
    DriverP: pointer;
begin
 Assign(DriverF, VGAPath);
 Reset(DriverF, 1);
 GetMem(DriverP, FileSize(DriverF));
 BlockRead(DriverF, DriverP^, FileSIze(DriverF));
 if RegisterBGIdriver(DriverP)<0 then GraphError;
 Driver:=VGA; Mode:=VGAHi;
 InitGraph(Driver, Mode,'');
 if GraphResult < 0 then GraphError;
end;

function InitFont (Name:string):integer;
var Num: Integer;
    FontF: file;
    FontP: pointer;
begin
 Assign(FontF, FontPath + Name);
 Reset(FontF, 1);
 GetMem(FontP, FileSize(FontF));
 BlockRead(FontF, FontP^, FileSize(FontF));
 Num:=RegisterBGIfont(FontP);
 if Num < 0 then GraphError;
 InitFont:=Num;
end;

function Draw (x0,y0:integer; fname:string; transparent:boolean):integer;
{ x0,y0 - Ї®§жЁп нЄа ­  ¤«п ®в®Ўа ¦Ґ­Ёп
  fname - Ё¬п д ©«  BMP
  transparent - ­г¦­  «Ё Їа®§а з­®бвм
}
label bye;
const color: array [0..15] of byte=(0,4,2,6,1,5,3,7,8,12,10,14,9,13,11,15);
type bmpinfo=record
 h1,h2:char;
 size,reserved,offset,b,width,height:longint;
 plans,bpp:word;
end;
var f:file of bmpinfo;
 bmpf:file of byte;
 res:integer;
 info:bmpinfo;
 x,y:integer;
 b,bh,bl:byte;
 nb,np:integer;
 tpcolor:byte;
 i,j:integer;
begin
 assign(f,fname);
 {$I-}
 reset (f);
 {$I+}
 res:=IoResult;
 if res <> 0 then begin
  Draw:=-1;
  goto bye;
 end;
 read (f,info);
 close (f);
 if info.bpp<>4 then begin
  Draw:=-2;
  goto bye;
 end;
 x:=x0;
 y:=y0+info.height;
 nb:=(info.width div 8)*4;
 if (info.width mod 8) <> 0 then nb:=nb+4;
 assign (bmpf,fname);
 reset (bmpf);
 seek (bmpf,info.offset);
 if transparent then begin
  read (bmpf,b);
  tpcolor:=b shr 4;
  seek (bmpf,info.offset);
 end
 else tpcolor:=17;
 for i:=1 to info.height do begin
  np:=0;
  for j:=1 to nb do begin
   read (bmpf,b);
   if np<info.width then begin
    bh:=b shr 4;
    if bh <> tpcolor then putpixel (x,y,color[bh]);
    inc (x);
    inc(np);
   end; 
   if np<info.width then begin
    bl:=b and 15;
    if bl <> tpcolor then putpixel (x,y,color[bl]);
    inc(x);
    inc(np);
   end;
  end;
  x:=x0;
  dec(y);
 end;
 close (bmpf);
 Draw:=info.height;
bye:
end;

begin
 InitVga;
 InitFont ('trip.chr');
 Draw (0,0,'test.bmp',True);
 Draw (129,129,'test.bmp',False);
 SetTextJustify (CenterText, CenterText);
 SetTextStyle (TriplexFont,HorizDir,4);
 SetColor(Red);
 Outtextxy (getmaxx div 2,getmaxy div 2,'ЏаЁўҐв, Windows!');
 ReadLn;
 CloseGraph;
end.

Скриншот вывода (часть экрана)

Архив со всеми нужными файлами

 pas_bmp.zip (27 Кб)

гостевая; E-mail