Вывести BMP файл на экран через ptcGraph

Вопросы программирования на Free Pascal, использования компилятора и утилит.

Модератор: Модераторы

Вывести BMP файл на экран через ptcGraph

Сообщение adm-fil » 13.05.2023 08:39:23

Здравствуйте!
Не могу найти в Сети рабочий модуль для чтения файлов формата bmp средствами free pascal или turbo pascal.
Прошу вашей помощи!

Нужно прочитать bmp-файл в память и вывести его потом на экран средствами модуля ptcGraph из состава free pascal. ( Этот модуль очень сильно совместим со старым модулем graph из borland turbo pascal. ).
Если нет кода по выводу bmp-файла на экран, то нужен хотя-бы код читающий его в оперативную память.
adm-fil
незнакомец
 
Сообщения: 2
Зарегистрирован: 13.05.2023 08:35:09

Re: Вывести BMP файл на экран через ptcGraph

Сообщение Сквозняк » 13.05.2023 13:51:21

adm-fil писал(а):Если нет кода по выводу bmp-файла на экран,

Код вывода картинки на экран сильно зависит от способа, которым задействуешь видеорежим. Их может быть множество, а у тебя используется какой-то определённый, древний.
adm-fil писал(а): то нужен хотя-бы код читающий его в оперативную память.

А вот это запросто! В fpc есть файл fpcbuild-2.6.4/fpcsrc/packages/fcl-image/examples/interpoldemo.pp
Меняется несколько строчек и вот он уже читает и масштабирует файл original.bmp сделанный только что в гимпе.
Код: Выделить всё
program interpoldemo;
// Interpolation demo for fcl-image by Bernd Kreuss. Mantis #22245
// Loads original.png (not included) and scales it back to 64x64

{$mode objfpc}{$H+}

uses
  Classes,
  sysutils,
  FPimage,
  FPImgCanv,
//  FPReadPNG,
// FPWritePNG;
FPReadBMP, FPWriteBMP;


var
  ImOriginal: TFPMemoryImage;
  ImScaled: TFPMemoryImage;
  CanvScaled: TFPImageCanvas;
//  Reader: TFPReaderPNG;
//  Writer: TFPWriterPNG;
  Reader: TFPReaderBMP;
  Writer: TFPWriterBMP;

begin
  ImOriginal := TFPMemoryImage.Create(0, 0);
  ImScaled := TFPMemoryImage.Create(64, 64);
//  Reader := TFPReaderPNG.create;
//  Writer := TFPWriterPNG.create;
  Reader := TFPReaderBMP.create;
  Writer := TFPWriterBMP.create;
//  Writer.UseAlpha := True;
//  ImOriginal.LoadFromFile('original.png', Reader);
    ImOriginal.LoadFromFile('original.bmp', Reader);

  CanvScaled := TFPImageCanvas.create(ImScaled);
  CanvScaled.StretchDraw(0,0,63,63, ImOriginal);

//  ImScaled.SaveToFile('scaled.png', Writer);
  ImScaled.SaveToFile('scaled.bmp', Writer);
  Reader.Free;
  Writer.Free;
  ImOriginal.Free;
  ImScaled.Free;
end.

Но если модулям всё равно, читать bmp или png, то лучше использовать png, потому что он со сжатием, имеет альфаканал и больше в почёте и больше где применяется.
Сквозняк
энтузиаст
 
Сообщения: 1109
Зарегистрирован: 29.06.2006 22:08:32

Re: Вывести BMP файл на экран через ptcGraph

Сообщение xchgeaxeax » 13.05.2023 21:57:34

Добавлю. В крайнем случае bmp файл можно прочитать и ручками. Его формат ну совсем уж без хитростей:
Код: Выделить всё
// Заголовок файла
bfType: array [0 .. 1] of AnsiChar; // 'BM'
bfFileSizeBytes: Cardinal; // Длина файла в байтах
bfReserved: array [0 .. 1] of Word;
bfOffsetPixels: Cardinal; // Смещение от начала файлов массива с данными пикселей
// Заголовок изображения
biSize: Cardinal; // Длина этого заголовка; может быть одним из значений:
biWidth, biHeight: Cardinal; // Размеры изображения в пикселях
biPlanes, biBitsCount: Word; // Количество слоёв и глубина одного слоя (бит)
biCompression: LongInt; // Тип сжатия изображения
biSizeImage: LongInt; // Размер сжатого изображения, байт; Если изображение без сжатия, тогда это значение будет равно 0
biXPelsPerMeter, biYPelsPerMeter: LongInt; //Количество пикселей на дюйм по ширине и высоте
biClrUsed, biClrImportant: Cardinal; // Параметры палитры цветов для изображения в форматах с 2**biBitsCount <= 256
// Далее идёт палитра цветов (если 2**biBitsCount <= 256)
bpColors: array [0 .. 2**biBitsCount - 1] of record
  red, green, blue, reserved: Byte;
end; // По 4 байта на цвет
// А вот на эти смещение в файле указывает bfOffsetPixels и отсюда начинаются данные по пикселям (снизу-вверх, построчно)
bpPixels: array [0 .. biWidth - 1] of array [0 .. biHeight - 1] of case 2**biBitCount of
  1: (quad: Byte); // Каждый пиксель это индекс в палитре цветов
  16: (double: Byte); // Каждый пиксель это индекс в палитре цветов
  256: (pixe: Byte); // Каждый пиксель это индекс в палитре цветов
  2**16: (pixel: Word); // Может иметь несколько разных форматов в зависимости от значения biCompression
  2**24: (pixel: packed record blue, greed, red: Byte; end;); // Тут пиксель это сам цвет в формате RGB (BGR)
  2**32: (pixel: packed record blue, greed, red, reserved: Byte; end;); // Тут пиксель это цвет в формате RGB (BGR)
end;
Подробнее смотрите тут
xchgeaxeax
новенький
 
Сообщения: 90
Зарегистрирован: 11.05.2023 03:51:40

Re: Вывести BMP файл на экран через ptcGraph

Сообщение delphius » 14.05.2023 21:03:41

Пример программы, которая выводит изображение из файла (только bmp 24bit uncompressed)
Никаких дополнительных подключаемых модулей, чистый fpc

Код: Выделить всё
program BMPViewer;
uses ptcGraph;

var
  GraphDriver, GraphMode: smallint;

procedure DrawBMP(FileName: string; X, Y: Integer);
type
  TBitmapFileHeader = packed record
    bfType: Word;
    bfSize: Longint;
    bfReserved1: Word;
    bfReserved2: Word;
    bfOffBits: Longint;
  end;
  TBitmapInfoHeader = packed record
    biSize: DWORD;
    biWidth: Longint;
    biHeight: Longint;
    biPlanes: Word;
    biBitCount: Word;
    biCompression: DWORD;
    biSizeImage: DWORD;
    biXPelsPerMeter: Longint;
    biYPelsPerMeter: Longint;
    biClrUsed: DWORD;
    biClrImportant: DWORD;
  end;
  TRGB = packed record
    B, G, R: Byte;
  end;
  TRGBArray = array[Word] of TRGB;
  PRGBArray = ^TRGBArray;
  TRGBTriple = packed record
    rgbtBlue: Byte;
    rgbtGreen: Byte;
    rgbtRed: Byte;
  end;
var
  BitmapFile: file;
  BitmapFileHeader: TBitmapFileHeader;
  BitmapInfoHeader: TBitmapInfoHeader;
  Palette: array[0..255] of TRGBTriple;
  BitmapLine: PRGBArray;
  W, H: Integer;
  I, J: Integer;
  Padding: array[0..3] of Byte;
  PaddingSize: Integer;

function RGB(R, G, B: Byte): Longint;
begin
  Result := (R or (G shl 8) or (B shl 16));
end;

begin
  Assign(BitmapFile, FileName); // открытие файла
  Reset(BitmapFile, 1);
  BlockRead(BitmapFile, BitmapFileHeader, SizeOf(BitmapFileHeader)); // чтение заголовка файла
  BlockRead(BitmapFile, BitmapInfoHeader, SizeOf(BitmapInfoHeader)); // чтение заголовка изображения

  W := BitmapInfoHeader.biWidth; // ширина изображения
  H := BitmapInfoHeader.biHeight; // высота изображения

  if BitmapInfoHeader.biBitCount <= 8 then // если глубина цвета меньше или равна 8 битам
    BlockRead(BitmapFile, Palette, (1 shl BitmapInfoHeader.biBitCount) * SizeOf(TRGBTriple)); // чтение палитры

  GetMem(BitmapLine, W * SizeOf(TRGB)); // выделение памяти под строку пикселей

  PaddingSize := (4 - (W * SizeOf(TRGB)) mod 4) mod 4; // Если длина строки не кратна 4 байтам,
  //то в конце строки добавляются дополнительные байты (называемые “отступами” или “паддингом”),
  //чтобы выровнять длину строки по границе 4 байт.

  for I := H - 1 downto 0 do
  begin
    BlockRead(BitmapFile, BitmapLine^, W * SizeOf(TRGB));
    BlockRead(BitmapFile, Padding, PaddingSize);
    for J := 0 to W - 1 do
      PutPixel(X + J, Y + I, RGB(BitmapLine^[J].B, BitmapLine^[J].G, BitmapLine^[J].R));
  end;

  FreeMem(BitmapLine); // освобождение памяти
  Close(BitmapFile); // закрытие файла
end;


begin
  DetectGraph(GraphDriver, GraphMode); //Автодетекция подходящего драйвера и режима
  InitGraph(GraphDriver, GraphMode, ''); // инициализация графического режима

  DrawBMP('image.bmp', 0, 0); // чтение и вывод BMP-файла на экран

  Readln; // ожидание нажатия клавиши
  CloseGraph; // выход из графического режима
end.


Хитрости с размерами окон при использовании модуля ptcGraph
Видео, демонстрирующее работу Custom Graph Window Size at Startup
delphius
постоялец
 
Сообщения: 122
Зарегистрирован: 18.03.2020 13:40:11

Re: Вывести BMP файл на экран через ptcGraph

Сообщение adm-fil » 15.05.2023 14:29:35

delphius писал(а):Пример программы, которая выводит изображение из файла (только bmp 24bit uncompressed)
Никаких дополнительных подключаемых модулей, чистый fpc

Спасибо большое! Код подошёл и работает!
adm-fil
незнакомец
 
Сообщения: 2
Зарегистрирован: 13.05.2023 08:35:09

Re: Вывести BMP файл на экран через ptcGraph

Сообщение delphius » 15.05.2023 14:51:54

adm-fil писал(а):Спасибо большое! Код подошёл и работает!

Помните только, что это просто пример)

А я привел ручной способ, под конкретный узкий формат, чтобы просто объяснить один из возможных вариантов реализации... :idea:
delphius
постоялец
 
Сообщения: 122
Зарегистрирован: 18.03.2020 13:40:11


Вернуться в Free Pascal Compiler

Кто сейчас на конференции

Сейчас этот форум просматривают: Google [Bot] и гости: 25

Рейтинг@Mail.ru