Загрузка bmp

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

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

Re: Загрузка bmp

Сообщение Mavlyudov » 14.07.2022 02:31:50

Vlad04
В Делфи такого нету.

Сквозняк
Alex2013

Спасибо.
Вот два кода. Первый рабочий. Читает картинку через TBitmap, раскарашивает ее заданной палитрой цветов.
Второй нерабочий. Сделал чтение bmp файла как текстового файла.
Что-то не так с цветом или массивом, не могу понять. Буду рад, если поможете.
Само чтение bmp файла в этом коде правильное. Делал отрисовку тестовой картинки на форму через Canvas, работало.

Рабочий
Код: Выделить всё
program Project1;
{$APPTYPE CONSOLE}
uses
  Classes,
  Graphics;
const
W=1392;
H=1032;
Var
  X,Y,I:Integer;
  Color:Tcolor;

type
   RGB=Record
   b,g,r: Byte;
   End;
type
  TPixels=Array[0..0] of RGB;
   PPixels= ^TPixels;
var
  Row: PPixels;
  Palette: Array[0..255] of RGB;

Type
TGradients=Record
brightness: Byte;
Color: RGB;
end;

var
Gradients: Array[0..8] of TGradients;
TempBitMap:TBitMap;
xMin, yMin, xMax, yMax:integer;
Interval:Integer;
k:double;
I1,I2:Byte;
C1,C2:RGB;

Begin
Gradients[8].Color.r:=255;
Gradients[8].Color.g:=255;
Gradients[8].Color.b:=255;
Gradients[8].brightness:=255;

Gradients[7].Color.r:=255;
Gradients[7].Color.g:=16;
Gradients[7].Color.b:=0;
Gradients[7].brightness:=254;

Gradients[6].Color.r:=255;
Gradients[6].Color.g:=255;
Gradients[6].Color.b:=0;
Gradients[6].brightness:=196;

Gradients[5].Color.r:=0;
Gradients[5].Color.g:=255;
Gradients[5].Color.b:=0;
Gradients[5].brightness:=164;

Gradients[4].Color.r:=0;
Gradients[4].Color.g:=255;
Gradients[4].Color.b:=255;
Gradients[4].brightness:=134;

Gradients[3].Color.r:=0;
Gradients[3].Color.g:=0;
Gradients[3].Color.b:=255;
Gradients[3].brightness:=71;

Gradients[2].Color.r:=255;
Gradients[2].Color.g:=0;
Gradients[2].Color.b:=255;
Gradients[2].brightness:=40;

Gradients[1].Color.r:=0;
Gradients[1].Color.g:=0;
Gradients[1].Color.b:=0;
Gradients[1].brightness:=0;

Gradients[0].Color.r:=0;
Gradients[0].Color.g:=0;
Gradients[0].Color.b:=0;
Gradients[0].brightness:=8;

TempBitMap:=TBitmap.Create;
TempBitMap.PixelFormat:=pf24bit;
TempBitMap.Width:=W;
TempBitMap.Height:=H;
TempBitMap.LoadFromFile('33.BMP');

For Interval:=0 to High(Gradients)-1 do
begin
  I1:=Gradients[Interval].brightness;
  I2:=Gradients[Interval+1].Brightness;
  C1:=Gradients[Interval].Color;
  C2:=Gradients[Interval+1].Color;
   For i:=i1 to i2 do
    Begin
     k:=(i-i1)/(i2-i1);
     Palette[i].r:=Round(c1.r*(1-k)+c2.r*k);
     Palette[i].g:=Round(c1.g*(1-k)+c2.g*k);
     Palette[i].b:=Round(c1.b*(1-k)+c2.b*k);
    End;
end;

  For Y:=0 To H-1 Do
    Begin
      Row:=TempBitMap.Scanline[Y];
      For X:=0 To W-1 Do
       begin
        COLOR:=TempBitMap.Canvas.Pixels[x,y];
        Row^[X]:=Palette[Color];
       end;
    End;
TempBitMap.SaveToFile('33_OUT.bmp');
TempBitMap.Free;
READLN;
end.


А вот нерабочий
Код: Выделить всё
program Project3;
{$APPTYPE CONSOLE}
uses
  Classes,
  Graphics;

const
W=1392;
H=1032;
Var
  X,Y,I:Integer;
  Color:Tcolor;
type
   RGB=Record
   b,g,r: Byte;
   End;
type
  TPixels=Array[0..0] of RGB;
   PPixels= ^TPixels;
var
  Row: PPixels;
  Palette: Array[0..255] of RGB;

Type
TGradients=Record
brightness: Byte;
Color: RGB;
end;

var
Gradients: Array[0..8] of TGradients;
TempBitMap:TBitMap;
xMin, yMin, xMax, yMax:integer;
Interval:Integer;
k:double;
I1,I2:Byte;
C1,C2:RGB;

CONST
   ICP : ARRAY [0..15] OF INTEGER =(0,3,2,6,1,5,4,8,7,12,10,14,9,13,11,15);
VAR
   ICBMP,INWBMP,BRIS11,
  ICXEKR,ICYEKR,
  NWCW:INTEGER;
   RGB1,RGB2,RGB3 : ARRAY [0..255] OF BYTE;

  AXY:ARRAY[0..W,0..H] OF BYTE;
  AXYRGB:ARRAY[0..W,0..H,1..3] OF BYTE;
  F1:TEXT;

   PROCEDURE BMP_BEG(VAR NF:TEXT;VAR NTG,NTW,NBG,NBP,NBGG:LONGINT);
   VAR C:CHAR;
   NBIT,NBYTE,A,I,N,SG,NCW,R:LONGINT;
   LABEL 10,100;
   BEGIN
   FOR I:=1 TO 18 DO READ(NF,C);
   A:=0;R:=1;
   FOR I:=1 TO 4 DO BEGIN READ(NF,C);A:=A+R*ORD(C);R:=R*256;END;
   NTG:=A;
   A:=0;R:=1;
   FOR I:=1 TO 4 DO BEGIN READ(NF,C);A:=A+R*ORD(C);R:=R*256;END;
   NTW:=A;
   A:=0;
   FOR I:=1 TO 2 DO BEGIN READ(NF,C);A:=A+256*ORD(C);END;
   A:=0;R:=1;
   FOR I:=1 TO 2 DO BEGIN READ(NF,C);A:=A+R*ORD(C);R:=R*256;END;
   NBP:=A;
   A:=0;R:=1;
   FOR I:=1 TO 4 DO BEGIN READ(NF,C);A:=A+R*ORD(C);R:=R*256;END;
   SG:=A;
{   SG=A 'tip svatiq}
   A:=0;R:=1;
   FOR I:=1 TO 4 DO BEGIN READ(NF,C);A:=A+R*ORD(C);R:=R*256;END;
//   NSG:=A;
{   NSG=A Ðàçìåð ñæàòèÿ}
   A:=0;R:=1;
   FOR I:=1 TO 4 DO BEGIN READ(NF,C);A:=A+R*ORD(C);R:=R*256;END;
//   AMG:=A;
   A:=0;R:=1;
   FOR I:=1 TO 4 DO BEGIN READ(NF,C);A:=A+R*ORD(C);R:=R*256;END;
//   AMW:=A;
   A:=0;R:=1;
   FOR I:=1 TO 4 DO BEGIN READ(NF,C);A:=A+R*ORD(C);R:=R*256;END;
   NCW:=A;
{   NCW=A ×èñëî öâåòîâ}
   A:=0;R:=1;
   FOR I:=1 TO 4 DO BEGIN READ(NF,C);A:=A+R*ORD(C);R:=R*256;END;
//   NWCW:=A;
{   NWCW=A ×èñëî âàæíûõ öâåòîâ}
   N:=NCW;
   IF N>0 THEN GOTO 10;
   IF NBP=1 THEN N:=2;
   IF NBP=4 THEN N:=16;
   IF NBP=8 THEN N:=256;
{Êàðòà öâåòîâ RGB}
10:   FOR I:=1 TO N DO BEGIN
   READ(NF,C);RGB1[I-1]:=ORD(C);
   READ(NF,C);RGB2[I-1]:=ORD(C);
   READ(NF,C);RGB3[I-1]:=ORD(C);
   READ(NF,C);
   END;
   N:=4*N;
   IF SG<>0 THEN GOTO 100;
   NBG:=ROUND(NTG/8*NBP);
   NBGG:=TRUNC((NBG-1)/4)*4+4-NBG;
{   ÷èñëî áèò â ñòðîêå}
   NBIT:=NTG*NBP;
   NBYTE:=NBIT DIV 8;
   IF NBIT MOD 8>0 THEN INC(NBYTE);
   NBG:=NBYTE;
   I:=NBYTE MOD 4;
   IF I>0 THEN NBYTE:=NBYTE+4-I;
   NBGG:=NBYTE-NBG;
100:   END;{BMP_BEG}

   PROCEDURE BMP_RISBMP(VAR NFBMP:TEXT;X0BMP,Y0BMP,DDBMP:SINGLE;INWBMP:INTEGER);
   VAR II,J:INTEGER;
   NBGG,ITG,A,L,R,ITX,I,NX,NY,IX,IY,NBG,NBP:LONGINT;C,CR,CG,CB:CHAR;
   LABEL 98,99;
{   --}
   PROCEDURE PUT(IX,IY,IC:INTEGER);
   BEGIN
  AXY[IX,IY]:=IC;
   END;
{   --}
   PROCEDURE PUTRGB(IX,IY,IR,IG,IB:INTEGER);
   BEGIN
  AXYRGB[IX,IY,1]:=IR;
  AXYRGB[IX,IY,2]:=IG;
  AXYRGB[IX,IY,3]:=IB;
   END;
{   -------------}
   BEGIN
   ICBMP:=10;
   BMP_BEG(NFBMP,NX,NY,NBG,NBP,NBGG);
   FOR IY:=1 TO NY DO BEGIN
   IX:=0;ITG:=0;J:=0;
//   PUT(IX,IY,10);
   FOR ITX:=1 TO NBG DO BEGIN
IF NBP=1 THEN BEGIN
   READ(NFBMP,C);A:=ORD(C);L:=128;
   FOR I:=1 TO 8 DO BEGIN
   R:=TRUNC(A/L);A:=A-R*L;L:=ROUND(L/2);ITG:=ITG+1;
   IF ITG<=NX THEN BEGIN
   INC(IX);
   IF (INWBMP=0) AND (R=0) OR
      (INWBMP<>0) AND (R<>0) THEN PUT(IX,IY,ICBMP);
   END;
   END;
END ELSE
IF NBP=4 THEN BEGIN
   READ(NFBMP,C);A:=ORD(C);L:=TRUNC(A/16);R:=A-16*L;
   IF (INWBMP=0) THEN BEGIN
   L:=ICP[L];R:=ICP[R];
   END ELSE BEGIN
   L:=16-ICP[L];R:=16-ICP[R];
   END;
   PUT(IX,IY,L);INC(IX);
   PUT(IX,IY,R);INC(IX);
END ELSE
IF NBP=8 THEN BEGIN
   READ(NFBMP,C);
   J:=ORD(C);
   IF (INWBMP=0) THEN BEGIN
   PUTRGB(IX,IY,RGB1[J],RGB2[J],RGB3[J]);
   END ELSE BEGIN
   PUTRGB(IX,IY,256-RGB1[J],256-RGB2[J],256-RGB3[J]);
   END;
   INC(IX);
END ELSE
IF NBP=24 THEN BEGIN
   READ(NFBMP,C);
   INC(J);
   IF J=1 THEN CR:=C;
   IF J=2 THEN CG:=C;
   IF J=3 THEN CB:=C;
   IF J=3 THEN BEGIN
   J:=0;
   IF (INWBMP=0) THEN BEGIN
   PUTRGB(IX,IY,ORD(CR),ORD(CG),ORD(CB));
   END ELSE BEGIN
   PUTRGB(IX,IY,256-ORD(CR),256-ORD(CG),256-ORD(CB));
   END;
   INC(IX);
   END;
END;

   END;{ITX}
   FOR ITX:=1 TO NBGG DO READ(NFBMP,C);
   END;{ITY}
98:
//   CLOSE(NFBMP);
99:   END;{BMP_RIS}

Begin

ASSIGNFILE(F1,'33.BMP');
RESET(F1);
BMP_RISBMP(F1,1,1,1,0);
closeFile(F1);

Gradients[8].Color.r:=255;
Gradients[8].Color.g:=255;
Gradients[8].Color.b:=255;
Gradients[8].brightness:=255;

Gradients[7].Color.r:=255;
Gradients[7].Color.g:=16;
Gradients[7].Color.b:=0;
Gradients[7].brightness:=254;

Gradients[6].Color.r:=255;
Gradients[6].Color.g:=255;
Gradients[6].Color.b:=0;
Gradients[6].brightness:=196;

Gradients[5].Color.r:=0;
Gradients[5].Color.g:=255;
Gradients[5].Color.b:=0;
Gradients[5].brightness:=164;

Gradients[4].Color.r:=0;
Gradients[4].Color.g:=255;
Gradients[4].Color.b:=255;
Gradients[4].brightness:=134;

Gradients[3].Color.r:=0;
Gradients[3].Color.g:=0;
Gradients[3].Color.b:=255;
Gradients[3].brightness:=71;

Gradients[2].Color.r:=255;
Gradients[2].Color.g:=0;
Gradients[2].Color.b:=255;
Gradients[2].brightness:=40;

Gradients[1].Color.r:=0;
Gradients[1].Color.g:=0;
Gradients[1].Color.b:=0;
Gradients[1].brightness:=0;

Gradients[0].Color.r:=0;
Gradients[0].Color.g:=0;
Gradients[0].Color.b:=0;
Gradients[0].brightness:=8;

TempBitMap:=TBitmap.Create;
TempBitMap.PixelFormat:=pf24bit;
TempBitMap.Width:=W;
TempBitMap.Height:=H;

For Interval:=0 to High(Gradients)-1 do
begin
  I1:=Gradients[Interval].brightness;
  I2:=Gradients[Interval+1].Brightness;
  C1:=Gradients[Interval].Color;
  C2:=Gradients[Interval+1].Color;
   For i:=i1 to i2 do
    Begin
     k:=(i-i1)/(i2-i1);
     Palette[i].r:=Round(c1.r*(1-k)+c2.r*k);
     Palette[i].g:=Round(c1.g*(1-k)+c2.g*k);
     Palette[i].b:=Round(c1.b*(1-k)+c2.b*k);
    End;
end;

  For Y:=0 To H-1 Do
    Begin
      Row:=TempBitMap.Scanline[Y];
      For X:=0 To W-1 Do
       begin
       COLOR:=AXY[x,y];
       Row^[X]:=Palette[Color];
       end;
    End;
TempBitMap.SaveToFile('44_OUT.bmp');
TempBitMap.Free;
READLN;
end.
Mavlyudov
новенький
 
Сообщения: 50
Зарегистрирован: 24.01.2010 20:35:23

Re: Загрузка bmp

Сообщение Alex2013 » 23.07.2022 23:45:08

1 "TempBitMap.Canvas.Pixels[x,y];" Это очень медленно .
2 Тестовый файл для чения бинарных данных не годится, а если файл записан как текст лучше читать по строкам и парсить их например через SScanf https://www.freepascal.org/docs-html/rt ... scanf.html .
https://delphisources.ru/pages/faq/base ... elphi.html
Код: Выделить всё
//----Sscanf-------------------------------------

function Sscanf(const s: string; const fmt : string;

const Pointers : array of Pointer) : Integer;
var

i,j,n,m : integer;
s1      : string;
L       : LongInt;
X       : Extended;


function GetInt : Integer;
begin
s1 := '';
while (s[n] = ' ')  and (Length(s) > n) do inc(n);
while (s[n] in ['0'..'9', '+', '-'])
and (Length(s) >= n) do begin
s1 := s1+s[n];
inc(n);
end;
Result := Length(s1);
end;


function GetFloat : Integer;
begin
s1 := '';
while (s[n] = ' ')  and (Length(s) > n) do inc(n);
while (s[n] in ['0'..'9', '+', '-', '.', 'e', 'E'])
and (Length(s) >= n) do begin
s1 := s1+s[n];
inc(n);
end;
Result := Length(s1);
end;


function GetString : Integer;
begin
s1 := '';
while (s[n] = ' ')  and (Length(s) > n) do inc(n);
while (s[n] <> ' ') and (Length(s) >= n) do
begin
s1 := s1+s[n];
inc(n);
end;
Result := Length(s1);
end;


function ScanStr(c : Char) : Boolean;

begin
while (s[n] <> c) and (Length(s) > n) do inc(n);
inc(n);


If (n <= Length(s)) then Result := True
else Result := False;
end;


function GetFmt : Integer;
begin
Result := -1;


while (TRUE) do begin
while (fmt[m] = ' ') and (Length(fmt) > m) do inc(m);
if (m >= Length(fmt)) then break;


if (fmt[m] = '%') then begin
inc(m);
case fmt[m] of
'd': Result := vtInteger;
'f': Result := vtExtended;
's': Result := vtString;
end;
inc(m);
break;
end;


if (ScanStr(fmt[m]) = False) then break;
inc(m);
end;
end;
var e :Integer;

begin

n := 1;
m := 1;
Result := 0;


for i := 0 to High(Pointers) do begin
j := GetFmt;


case j of
vtInteger : begin
if GetInt > 0 then begin
L := StrToInt(s1);
Move(L, Pointers[i]^, SizeOf(LongInt));
inc(Result);
end
else break;
end;


vtExtended : begin
if GetFloat > 0 then begin
X:=0;
val (s1,x,e);
//if E<>0 THEN WRITELN (s1,' ',x);
//X := StrToFloat(s1);
Move(X, Pointers[i]^, SizeOf(Extended));
inc(Result);
end
else break;
end;


vtString : begin
if GetString > 0 then begin
Move(s1, Pointers[i]^, Length(s1)+1);
inc(Result);
end
else break;
end;


else break;
end;
end;
end;
//*****************************************************************

Последний раз редактировалось Alex2013 24.07.2022 15:44:30, всего редактировалось 1 раз.
Alex2013
долгожитель
 
Сообщения: 2923
Зарегистрирован: 03.04.2013 11:59:44

Re: Загрузка bmp

Сообщение Mavlyudov » 24.07.2022 11:02:19

Alex2013
Спасибо.
Меня пока что устроит медленный вариант. Хотелось бы все же понять, какие ошибки во второй программе
Mavlyudov
новенький
 
Сообщения: 50
Зарегистрирован: 24.01.2010 20:35:23

Re: Загрузка bmp

Сообщение Alex2013 » 24.07.2022 15:47:14

Mavlyudov писал(а):Хотелось бы все же понять, какие ошибки во второй программе

А что именно происходит при ее запуске ?
Alex2013
долгожитель
 
Сообщения: 2923
Зарегистрирован: 03.04.2013 11:59:44

Re: Загрузка bmp

Сообщение Mavlyudov » 24.07.2022 20:24:52

Alex2013
Пишет залитый черными пикселами файл
Mavlyudov
новенький
 
Сообщения: 50
Зарегистрирован: 24.01.2010 20:35:23

Re: Загрузка bmp

Сообщение Vadim » 01.08.2022 17:56:25

Mavlyudov
Для начала проверьте, правильно ли Ваш нерабочий код читает заголовки файла. Если нет, то чтоб Вы ни делали, ничего путного не увидите.
Код: Выделить всё
{$mode objfpc}{$h+}
Program p2;
Uses Classes;

const
{BMP-magic 'BM'}
  BMmagic=19778;

{ Коэффициенты давилки }
  BI_RGB = 0;
  BI_RLE8 = 1;
  BI_RLE4 = 2;
  BI_BITFIELDS = 3;
  BI_JPEG = 4;
  BI_PNG = 5;

type

   // Главный заголовок
   TBitMapFileHeader = packed record
      bfType: word;      // Тип файла ('BM')
      bfSize: longint;      // Размер файла в байтах
      bfReserved: longint;   // Не обращаем внимания ;-)
   // Смещение от начала файла, где начинаются байты картинки
   // Размеры: главный заголовок + дополнительный заголовок + палитра
      bfOffset: longint;
   end;
   PBitMapFileHeader = ^TBitMapFileHeader;

   // Дополнительный заголовок
   TBitMapInfoHeader = packed record
      Size: longint;   // Размер этого заголовка : должен быть 40=$28
      Width: longint;   // Ширина непосредственно картинки в пикселях
      Height: longint;   // Высота непосредственно картинки в пикселях
      Planes: word;   // Тут всегда 1
      BitCount: word;   // Информация о цветности, бит на пиксель (1,4,8,16,24,32)
      Compression: longint;   // Коэффициент давилки :-)
      SizeImage: longint;   // Ещё один размер картинки. 0 если файл не задавлен
      XPelsPerMeter: Longint;   // Горизонтальное разрешение пиксель на метр
      YPelsPerMeter: Longint;   // Вертикальное разрешение пиксель на метр
      ClrUsed: longint;      // Число используемых цветов. 0 если по максимуму
      ClrImportant: longint;   // Число важных цветов. ???
   end;
   PBitMapInfoHeader = ^TBitMapInfoHeader;

Var
  MyFile: TFileStream;
  FH1: TBitMapFileHeader;
  FH2: TBitMapInfoHeader;

Begin
  MyFile:=TFileStream.Create('33.bmp', fmOpenRead);
  MyFile.Read(FH1, SizeOf(TBitMapFileHeader));
  MyFile.Read(FH2, SizeOf(TBitMapInfoHeader));
 
  WriteLn('Тип файла: ', FH1.bfType);
  WriteLn('Размер файла в байтах: ', FH1.bfSize);
  WriteLn('Ширина картинки в пикселах: ', FH2.Width);
  WriteLn('Высота картинки в пикселах: ', FH2.Height);
  WriteLn('Бит на пиксель: ', FH2.BitCount);
  WriteLn('Смещение до картинки: ', FH1.bfOffset);
  WriteLn('Коэф. сжатия: ', FH2.Compression);

  MyFile.Free;
end.
Vadim
долгожитель
 
Сообщения: 4112
Зарегистрирован: 05.10.2006 08:52:59
Откуда: Красноярск

Re: Загрузка bmp

Сообщение Mavlyudov » 02.08.2022 12:48:12

Vadim
Мой код читает правильно. Им я выводил картинку на форму и он же используется в нерабочем коде
Mavlyudov
новенький
 
Сообщения: 50
Зарегистрирован: 24.01.2010 20:35:23

Re: Загрузка bmp

Сообщение Cheb » 12.08.2022 14:25:46

Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 994
Зарегистрирован: 06.06.2005 15:54:34

Re: Загрузка bmp

Сообщение Mavlyudov » 05.09.2022 18:55:05

Vadim
Создал картинку, состоящую только из одного красного пикселя (255,0,0). Сохранил через Paint как 16 цветную картинку.
Прочитал твоим кодом.
Пишет, что смещение 118.
А разве оно не должно быть всегда 54? (14 байт на первый заголовок и 40 на второй?)

Ниже эта картинка открыта в hex.
Также пробовал читать по 4 байта с того места, где массив цветов начинается. Результат ниже.
У вас нет необходимых прав для просмотра вложений в этом сообщении.
Mavlyudov
новенький
 
Сообщения: 50
Зарегистрирован: 24.01.2010 20:35:23

Re: Загрузка bmp

Сообщение delphius » 15.05.2023 20:15:04

Mavlyudov писал(а):Чем их можно заменить, не прибегая к Lazarus?

Решение, пусть поздно, но всё же...
delphius
постоялец
 
Сообщения: 122
Зарегистрирован: 18.03.2020 13:40:11

Пред.

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

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

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 22

Рейтинг@Mail.ru