В Делфи такого нету.
Сквозняк
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.
