paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-03 23:40:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Improve PNG image support in TImage. Issue #20361, patch from José Mejuto

Browse Source 
git-svn-id: trunk@41020 -
This commit is contained in:
juha 2013-05-04 09:28:17 +00:00
parent e84f86582d
commit de9cb3d016
1 changed files with 80 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

113
lcl/intfgraphics.pas
View File

@ -1199,28 +1199,33 @@ end;
// Position is the position in bytes to the start of the pixel in TheData // Position is the position in bytes to the start of the pixel in TheData
// Prec is the precision of the channel, usually 16 for this format // Prec is the precision of the channel, usually 16 for this format
// Bits is the value of the channel, which is the output // Bits is the value of the channel, which is the output
procedure ReadRawImageBits_48(TheData: PByte; procedure ReadRawImageBits_48(TheData: PByte;
const Position: TRawImagePosition; const Position: TRawImagePosition;
Prec, Shift: cardinal; Prec, Shift: cardinal;
var Bits: word); var Bits: word);
var var
P: PByte; P: PByte;
W1, W2, W3: Word;
B1, B2, B3, B4, B5, B6: Byte;
PixelData: QWord;
begin begin
P:=@(TheData[Position.Byte]); if Prec=16 then begin
B1 := P^; P:=@(TheData[Position.Byte]);
B2 := (P+1)^; inc(P,Shift shr 3);
B3 := (P+2)^; Bits:=PWORD(P)^;
B4 := (P+3)^; end;
B5 := (P+4)^; end;
B6 := (P+5)^;
W1 := B2 + B1 shl 8; procedure ReadRawImageBits_64(TheData: PByte;
W2 := B4 + B3 shl 8; const Position: TRawImagePosition;
W3 := B6 + B5 shl 8; Prec, Shift: cardinal;
PixelData := W3 + W2 shl 16 + W1 shl 32; var Bits: word);
Bits := (PixelData shr Shift); var
P: PByte;
begin
if Prec=16 then begin
P:=@(TheData[Position.Byte]);
inc(P,Shift shr 3);
Bits:=PWORD(P)^;
end;
end; end;
procedure WriteRawImageBits_1_2_4_BIO(TheData: PByte; procedure WriteRawImageBits_1_2_4_BIO(TheData: PByte;
@ -1394,15 +1399,21 @@ var
PrecMask: Cardinal; PrecMask: Cardinal;
FourBytes: Cardinal; FourBytes: Cardinal;
begin begin
P:=@(TheData[Position.Byte]); if Prec=8 then begin
PrecMask:=(Cardinal(1) shl Prec)-1; P:=@(TheData[Position.Byte]);
Bits:=Bits shr (16-Prec); PrecMask:=(Cardinal(1) shl Prec)-1;
Bits:=Bits shr (16-Prec);
FourBytes:=PDWord(P)^; FourBytes:=PDWord(P)^;
PrecMask:=not (PrecMask shl Shift); PrecMask:=not (PrecMask shl Shift);
FourBytes:=FourBytes and PrecMask; // clear old FourBytes:=FourBytes and PrecMask; // clear old
FourBytes:=FourBytes or cardinal(Bits shl Shift); // set new FourBytes:=FourBytes or cardinal(Bits shl Shift); // set new
PDWord(P)^:=FourBytes; PDWord(P)^:=FourBytes;
end else if Prec=16 then begin
P:=@(TheData[Position.Byte]);
inc(P,2-Shift shr 3);
PWORD(P)^:=Bits;
end;
end; end;
procedure WriteRawImageBits_ReversedBytes_32(TheData: PByte; procedure WriteRawImageBits_ReversedBytes_32(TheData: PByte;
@ -1433,6 +1444,34 @@ begin
PDWord(P)^:=FourBytes; PDWord(P)^:=FourBytes;
end; end;
procedure WriteRawImageBits_48(TheData: PByte;
const Position: TRawImagePosition;
Prec, Shift: cardinal; Bits: word);
var
P: PByte;
PrecMask: Cardinal;
FourBytes: Cardinal;
begin
P:=@(TheData[Position.Byte]);
inc(P,Shift shr 3);
PWORD(P)^:=Bits;
end;
procedure WriteRawImageBits_64(TheData: PByte;
const Position: TRawImagePosition;
Prec, Shift: cardinal; Bits: word);
var
P: PByte;
PrecMask: Cardinal;
FourBytes: Cardinal;
begin
if Prec=16 then begin
P:=@(TheData[Position.Byte]);
inc(P,Shift shr 3);
PWORD(P)^:=Bits;
end;
end;
procedure ReadRawImageBits_NULL(TheData: PByte; procedure ReadRawImageBits_NULL(TheData: PByte;
const Position: TRawImagePosition; const Position: TRawImagePosition;
Prec, Shift: cardinal; Prec, Shift: cardinal;
@ -1534,7 +1573,13 @@ begin
48: 48:
begin begin
ProcReadRawImageBits := @ReadRawImageBits_48; ProcReadRawImageBits := @ReadRawImageBits_48;
ProcWriteRawImageBits := @WriteRawImageBits_NULL; ProcWriteRawImageBits := @WriteRawImageBits_48;
end;
64:
begin
ProcReadRawImageBits := @ReadRawImageBits_64;
ProcWriteRawImageBits := @WriteRawImageBits_64;
end; end;
else else
@ -5884,15 +5929,17 @@ begin
// no change // no change
end; end;
16: begin 16: begin
Desc.BitsPerPixel := Desc.Depth; if not IsGray then begin
Desc.RedPrec := 16; Desc.BitsPerPixel := Desc.Depth;
Desc.RedShift := Desc.RedShift * 2; Desc.RedPrec := 16;
Desc.GreenPrec := 16; Desc.RedShift := Desc.RedShift * 2;
Desc.GreenShift := Desc.GreenShift * 2; Desc.GreenPrec := 16;
Desc.BluePrec := 16; Desc.GreenShift := Desc.GreenShift * 2;
Desc.BlueShift := Desc.BlueShift * 2; Desc.BluePrec := 16;
Desc.AlphaPrec := Desc.AlphaPrec * 2; // might be zero Desc.BlueShift := Desc.BlueShift * 2;
Desc.AlphaShift := Desc.AlphaShift * 2; Desc.AlphaPrec := Desc.AlphaPrec * 2; // might be zero
Desc.AlphaShift := Desc.AlphaShift * 2;
end;
end; end;
end; end;
end; end;