Картинка из файла на экран Опции

[pashist]

Как можно осуществить вывод картинки простого bmp-шника на экран? Допустим, я нарисовал в Paint'e рисунок, и хочу его отобразить на экране в игре. Как это сделать?

[volvo]

FAQ: Модули для вывода графики. (bmp, Pcx ...)

[Bokul]

В связи с тем что сайт сейчас не работает и, как следствие, оттуда ничего не можна скачать даю еще ссылку:
http://forum.pascal.net.ru/index.php?showtopic=1677

[pashist]

Помогите, плиз, изменить модуль. Мне нужно, чтобы модуль выводил картинку на заданные координаты, и чтобы эти координаты являлись вырхним левым углом картинки. Как в PutImage, если я задаю x и y равные 0, 0, то картинка выводится, начиная с левого верхнего угла экрана. Я дописал модуль, чтобы он выводил картинку в координаты. Но че-т он немного не туда выводит

{
  Модуль, предназначенный для чтения BMP картинок из файла.
  Поддерживаются 16-тицветные картинки без сжатия
}
Unit bmp;

interface

Procedure BMPDisplay(const FileName: String; x,y: Integer);

implementation

Uses Graph;

Type
 TBitMapHeader =
  Record
   bfType :             Word;        { Метка файла BM }
   bfSize :             LongInt;     { Длина файла в байтах }
   bfReserved :         LongInt;     { Резервные должны быть = 0 }
   bfOffBits :          LongInt;     { Смещение области данных }
   biSize :             LongInt;     { Длина BITMAP_INFO заголовка }
   biWidth :            LongInt;     { Ширина изображения в пикселах }
   biHeight :           LongInt;     { Высота изображения в пикселах }
   biPlanes :           Word;        { Цветовые плоскости = 1 }
   biBitCount :         Word;        { Количество битов на пиксел 1,4,8,24 }
   biCompression :      LongInt;     { Тип сжатия данных }
   biSizeImage :        LongInt;     { Размер изображения в байтах }
   biXPelsPerMeter :    LongInt;     { Разрешение по горизонтали }
   biYPelsPerMeter :    LongInt;     { Разрешение по вертикали }
   biClrUsed :          LongInt;     { Количество используемых цветов }
   biClrImportant :     LongInt;     { Количество основных цветов }
  End;

 TRGBQuad =                   { Описание цвета }
  Record
   rgbBlue,                   { Интенсивность голубого }
   rgbGreen,                  { Интенсивность зеленого }
   rgbRed,                    { Интенсивность красного }
   rgbReserved :        Byte; { Резервный }
  End;

Type TByteArray = Array[0..50000] of byte;

Procedure Display1 (Var f : File; const BitMapHeader : TBitMapHeader);
Begin
 WriteLn ('Монохромный режим не поддерживается.');
End;

Procedure Display4 (Var f : File; const BitMapHeader : TBitMapHeader; x,y: Integer);
Var i,j : Integer;
Var RGBQuad : TRGBQuad;
Var TwoPixel : Byte;
Var Black : Byte;
Var Line : ^TByteArray;
Var number : Word;
Var BeginX,BeginY,EndY : Integer;
    CurrentX: Integer;
Begin
 If GetMaxColor < 15 then
  Begin
   WriteLn ('В данном видеорежиме невозможно отображение 16 цветов.');
   Exit;
  End;

 Black := 16;
 With BitMapHeader do
  begin
   For i:= 0 to 15 do         { Чтение и изменение палитры }
    Begin
     BlockRead(f,RGBQuad,SizeOf(RGBQuad));
     If (LongInt(RGBQuad)=0) then Black := i;
     With RGBQuad do
      SetRGBPalette(i, rgbRed shr 2, rgbGreen shr 2, rgbBlue shr 2);
     SetPalette(i,i);
    End;

   Number := (biWidth div 2 + 3) and not 3;  { Длина одной строки в байтах }
   BeginX := x; {(GetMaxX - biWidth) div 2;}
   BeginY := y;{GetMaxY - (GetMaxY - biHeight) div 2;}
   EndY := BeginY+biHeight;{BeginY+1-biHeight;}
  End;

 GetMem (Line,number+1);          { Выводим изображение }
 For j:=BeginY downto EndY do
  Begin
   BlockRead(f,Line^[1],number);
   CurrentX := BeginX;
   For i:=1 to number do
    Begin
     TwoPixel := Line^[i];
     If TwoPixel shr 4 <> Black then { Черный цвет считаем прозрачным }
      PutPixel(CurrentX,j,TwoPixel shr 4);
     Inc(CurrentX);
     If TwoPixel and 15 <> Black then
      PutPixel(CurrentX,j,TwoPixel and 15);
     Inc(CurrentX);
    End;
  End;
 FreeMem (Line,number+1);
End;

Procedure Display8 (Var f : File; const BitMapHeader : TBitMapHeader);
Begin
 WriteLn ('Режим 256 цветов не поддерживается.');
End;

Procedure Display24 (Var f : File; const BitMapHeader : TBitMapHeader);
Begin
 WriteLn ('Режим 24 битного цвета не поддерживается.');
End;

Procedure BMPDisplay(const FileName: String; x,y: Integer);
Var f: File;
    BitMapHeader : TBitMapHeader;
Begin
 Assign(f,FileName);
 {$I-}
 FileMode:=0;  { Открываем файл для чтения }
 Reset(f,1);
 {$I+}

 If IOResult<>0 Then
  Begin
   WriteLn ('Нет такого файла.');
   Exit;
  End;

 BlockRead(f,BitMapHeader,SizeOf(BitMapHeader));
 With BitMapHeader do
  Begin
   If (bfType<>19778) or (bfReserved<>0) or (biPlanes<>1) then
    Begin
     WriteLn ('Неверный формат BMP файла.');
     Close(f);
     Exit;
    End;
   If biCompression<>0 Then
    Begin
     WriteLn ('Файл сохранен со сжатием данных.');
     Close(f);
     Exit;
    End;
   ClearDevice;
   Case biBitCount of
    1  : Display1  (f, BitMapHeader);
    4  : Display4  (f, BitMapHeader, x,y);
    8  : Display8  (f, BitMapHeader);
    24 : Display24 (f, BitMapHeader);
   else
    Begin
     WriteLn ('Неверный формат BMP файла.');
     Close(f);
     Exit;
    End;
   End;
  End;
 Close(f);
End;
End.

[volvo]

Я дописал модуль, чтобы он выводил картинку в координаты. Но че-т он немного не туда выводит

Исправь присвоение значений:

   BeginX := x;{ Здесь было правильно }
   BeginY := y + biHeight; { <--- А здесь нужно вот так }
   EndY := y + 1; { <--- Ну, и здесь соответственно }

У тебя же в цикле по J значение BeginY должно быть больше, чем EndY... DownTo ведь используется...

[pashist]

Когда я задаю координаты 0, 0, то изображение сдвигается влево на 1 пиксель. Я конечно написал

 BeginX := x+1;

, но правильно ли это?

[volvo]

изображение сдвигается влево на 1 пиксель

Относительно чего сдвигается? Вообще-то в BGI начальные координаты экрана не (1, 1) а (0, 0). Или ты хочешь сказать, что у тебя вообще не отображается самый левый столбец изображения? Так я только что проверил - все столбцы отображаются...

[volvo]

P.S.
Кстати, ты пошел по пути наибольшего сопротивления Есть другой способ, который должен работать вообще без внесения изменений в модуль:

SetViewPort(x, y, GetMaxX, GetMaxY, ClipOn);
BmpDisplay('TEST.BMP');

[pashist]

Или ты хочешь сказать, что у тебя вообще не отображается самый левый столбец изображения?

Именно так.

Так я только что проверил - все столбцы отображаются...

Так я же исправил код, написав BeginX:=x+1

[volvo]

Так я же исправил код, написав BeginX:=x+1

Ну ты, может, и исправил. Я даже не перекомпилировал модуль, после того как внес изменения, указанные в посте №5 ...