Browse Source

+ Patches from Giulio Berna to fix endian issues, some targa issues

git-svn-id: trunk@915 -
michael 20 years ago
parent
commit
8086f61075

+ 34 - 0
fcl/image/bmpcomn.pp

@@ -76,6 +76,40 @@ type
 {54+?? : Color map : Lenght of color map is 4 bytes + the rest until the beginning of image data fixed in BFH.bfOffset}
     TColorMap=TColorRGBA;
 
+procedure SwapBMPFileHeader(var BFH : TBitMapFileHeader);
+procedure SwapBMPInfoHeader(var BFI : TBitMapInfoHeader);
+
 implementation
 
+uses FPImgCmn;
+
+procedure SwapBMPFileHeader(var BFH : TBitMapFileHeader);
+begin
+  with BFH do
+  begin
+    bfType:=swap(bfType);
+    bfSize:=swap(bfSize);
+    bfReserved:=swap(bfReserved);
+    bfOffset:=swap(bfOffset);
+  end;
+end;
+
+procedure SwapBMPInfoHeader(var BFI : TBitMapInfoHeader);
+begin
+  with BFI do
+  begin
+    Size:=swap(Size);
+    Width:=swap(Width);
+    Height:=swap(Height);
+    Planes:=swap(Planes);
+    BitCount:=swap(BitCount);
+    Compression:=swap(Compression);
+    SizeImage:=swap(SizeImage);
+    XPelsPerMeter:=swap(XPelsPerMeter);
+    YPelsPerMeter:=swap(YPelsPerMeter);
+    ClrUsed:=swap(ClrUsed);
+    ClrImportant:=swap(ClrImportant);
+  end;
+end;
+
 end.

+ 13 - 4
fcl/image/fpimage.inc

@@ -98,7 +98,11 @@ begin
           if assigned (h) then
             begin
             Writer := h.Create;
-            SaveTofile (filename, Writer);
+            try
+              SaveTofile (filename, Writer);
+            finally
+              Writer.Free;
+            end;
             break;
             end;
         except
@@ -186,7 +190,11 @@ begin
             if assigned (h) then
               begin
               reader := h.Create;
-              loadfromfile (filename, reader);
+              try
+                loadfromfile (filename, reader);
+              finally
+                Reader.Free;
+              end;
               break;
               end;
           except
@@ -394,11 +402,12 @@ begin
     // Copy extra info
     FExtra.Assign(Src.Fextra);
     // Copy palette if needed.
+    SetSize(0,0); { avoid side-effects in descendant classes }
     UsePalette:=Src.UsePalette;
     If UsePalette then
       begin
       Palette.Count:=0;
-      Palette.Build(Src);
+      Palette.Merge(Src.Palette);
       end;
     // Copy image.
     SetSize(Src.Width,Src.height);
@@ -499,8 +508,8 @@ begin
         for r := 0 to h-1 do
           move (FData^[r*Width], NewData^[r*AWidth], w);
         end;
-      FreeMem (FData);
       end;
+    if Assigned(FData) then FreeMem(FData);
     FData := NewData;
     inherited;
     end;

+ 24 - 0
fcl/image/fpimgcmn.pp

@@ -17,6 +17,8 @@ unit FPImgCmn;
 
 interface
 
+function Swap(This : qword): qword;
+function Swap(This : int64): int64;
 function Swap(This : Longword): longword;
 function Swap(This : integer): integer;
 function Swap(This : Word): Word;
@@ -67,6 +69,28 @@ begin
   result := (AnInt SHL 16) + (TmpW1 SHL 8) + TmpB2;
 end;
 
+function Swap(This : qword): qword;
+var l1, l2 : longword;
+    res : qword;
+begin
+  l1:=This and $00000000FFFFFFFF;
+  l2:=(This and $FFFFFFFF00000000) shr 32;
+  l1:=swap(l1);
+  l2:=swap(l2);
+  res:=l1;
+  Result:=(res shl 32) + l2;
+end;
+
+function Swap(This : int64): int64;
+var r,p : ^qword;
+  res : int64;
+begin
+  p := @This;
+  r := @res;
+  r^ := Swap (p^);
+  result := res;
+end;
+
 var CRCtable : array[0..255] of longword;
 
 procedure MakeCRCtable;

+ 6 - 0
fcl/image/fpreadbmp.pp

@@ -132,6 +132,9 @@ Var
 
 begin
   Stream.Read(BFI,SizeOf(BFI));
+  {$IFDEF ENDIAN_BIG}
+  SwapBMPInfoHeader(BFI);
+  {$ENDIF}
   { This will move past any junk after the BFI header }
   Stream.Position:=Stream.Position-SizeOf(BFI)+BFI.Size;
   with BFI do
@@ -211,6 +214,9 @@ var
   BFH:TBitMapFileHeader;
 begin
   stream.Read(BFH,SizeOf(BFH));
+  {$IFDEF ENDIAN_BIG}
+  SwapBMPFileHeader(BFH);
+  {$ENDIF}
   With BFH do
     Result:=(bfType=BMmagic); // Just check magic number
 end;

+ 17 - 0
fcl/image/fpreadpng.pp

@@ -139,7 +139,11 @@ begin
     // chunk header
     with ChunkHeader do
       begin
+      {$IFDEF ENDIAN_LITTLE}
       alength := swap(CLength);
+      {$ELSE}
+      alength := CLength;
+      {$ENDIF}
       ReadType := CType;
       end;
     aType := low(TChunkTypes);
@@ -160,7 +164,11 @@ begin
     TheStream.Read (readCRC, sizeof(ReadCRC));
     l := CalculateCRC (All1Bits, ReadType, sizeOf(ReadType));
     l := CalculateCRC (l, data^, alength);
+    {$IFDEF ENDIAN_LITTLE}
     l := swap(l xor All1Bits);
+    {$ELSE}
+    l := l xor All1Bits;
+    {$ENDIF}
     if ReadCRC <> l then
       raise PNGImageException.Create ('CRC check failed');
     end;
@@ -197,7 +205,9 @@ procedure TFPReaderPNG.HandleAlpha;
     var a : word;
     begin
       move (chunk.data^[0], a, 2);
+      {$IFDEF ENDIAN_LITTLE}
       a := swap (a);
+      {$ENDIF}
       TransparentDataValue := a;
       UseTransparent := True;
     end;
@@ -212,9 +222,11 @@ procedure TFPReaderPNG.HandleAlpha;
         move (data^[2], g, 2);
         move (data^[4], b, 2);
         end;
+      {$IFDEF ENDIAN_LITTLE}
       r := swap (r);
       g := swap (g);
       b := swap (b);
+      {$ENDIF}
       d := header.bitdepth;
       a := (TColorData(b) shl d) shl d;
       a := a + (TColorData(g) shl d) + r;
@@ -407,6 +419,9 @@ begin
         end;
       end;
     move (FCurrentLine^[DataIndex], Databytes, bytewidth);
+    {$IFDEF ENDIAN_BIG}
+    Databytes:=swap(Databytes);
+    {$ENDIF}
     inc (DataIndex,bytewidth);
     end;
   if bytewidth = 1 then
@@ -821,8 +836,10 @@ begin
     move (chunk.data^, FHeader, sizeof(Header));
     with header do
       begin
+      {$IFDEF ENDIAN_LITTLE}
       Width := swap(width);
       height := swap (height);
+      {$ENDIF}
       result := (width > 0) and (height > 0) and (compression = 0)
                 and (filter = 0) and (Interlace in [0,1]);
       end;

+ 4 - 0
fcl/image/fpwritebmp.pp

@@ -106,6 +106,10 @@ begin
     bfReserved:=0;
     bfSize:=bfOffset+BFI.SizeImage*BytesPerPixel;
     end;
+  {$IFDEF ENDIAN_BIG}
+  SwapBMPFileHeader(BFH);
+  SwapBMPInfoHeader(BFI);
+  {$ENDIF}
   Stream.seek(0,soFromBeginning);
   Stream.Write(bfh,sizeof(TBitMapFileHeader));
   Stream.Write(bfi,sizeof(TBitMapInfoHeader));

+ 21 - 1
fcl/image/fpwritepng.pp

@@ -124,8 +124,12 @@ var chead : TChunkHeader;
 begin
   with FChunk do
     begin
+    {$IFDEF ENDIAN_LITTLE}
     chead.CLength := swap (alength);
-    if (ReadType = '') then
+    {$ELSE}
+    chead.CLength := alength;
+    {$ENDIF}
+	if (ReadType = '') then
       if atype <> ctUnknown then
         chead.CType := ChunkTypes[aType]
       else
@@ -134,7 +138,11 @@ begin
       chead.CType := ReadType;
     c := CalculateCRC (All1Bits, ReadType, sizeOf(ReadType));
     c := CalculateCRC (c, data^, alength);
+    {$IFDEF ENDIAN_LITTLE}
     crc := swap(c xor All1Bits);
+    {$ELSE}
+    crc := c xor All1Bits;
+    {$ENDIF}
     with TheStream do
       begin
       Write (chead, sizeof(chead));
@@ -381,10 +389,15 @@ var c : integer;
 begin
   with AHeader do
     begin
+    {$IFDEF ENDIAN_LITTLE}
     // problem: TheImage has integer width, PNG header longword width.
     //          Integer Swap can give negative value
     Width := swap (longword(TheImage.Width));
     height := swap (longword(TheImage.Height));
+    {$ELSE}
+    Width := TheImage.Width;
+    height := TheImage.Height;
+    {$ENDIF}
     if FUseAlpha then
       c := CountAlphas
     else
@@ -578,6 +591,9 @@ begin
   for x := 0 to pred(TheImage.Width) do
     begin
     cd := FGetPixel (x,y);
+    {$IFDEF ENDIAN_BIG}
+    cd:=swap(cd);
+    {$ENDIF}
     move (cd, ScanLine^[index], FBytewidth);
     if WordSized then
       begin
@@ -663,7 +679,9 @@ procedure TFPWriterPNG.WritetRNS;
       g := CalculateGray (SingleTransparentColor)
     else
       g := hi (CalculateGray(SingleTransparentColor));
+    {$IFDEF ENDIAN_LITTLE}
     g := swap (g);
+    {$ENDIF}
     move (g,ChunkDataBuffer^[0],2);
     WriteChunk;
   end;
@@ -675,9 +693,11 @@ procedure TFPWriterPNG.WritetRNS;
     with g do
       if WordSized then
         begin
+        {$IFDEF ENDIAN_LITTLE}
         red := swap (red);
         green := swap (green);
         blue := swap (blue);
+        {$ENDIF}
         move (g, ChunkDatabuffer^[0], 6);
         end
       else

+ 1 - 1
fcl/image/fpwritetga.pp

@@ -97,5 +97,5 @@ begin
 end;
 
 initialization
-  ImageHandlers.RegisterImageWriter ('TARGA Format', 'tgha', TFPWriterTarga);
+  ImageHandlers.RegisterImageWriter ('TARGA Format', 'tga', TFPWriterTarga);
 end.

+ 4 - 2
fcl/image/imgconv.pp

@@ -83,6 +83,7 @@ begin
     Halt(1);
     end;
   img := TFPMemoryImage.Create(0,0);
+  img.UsePalette:=false;
 end;
 
 procedure ReadImage;
@@ -146,7 +147,8 @@ begin
   if (paramcount <> 4) and (paramcount <> 3) then
     begin
     writeln ('Give filename to read and to write, preceded by filetype:');
-    writeln ('X for XPM, P for PNG, B for BMP (write only), J for JPEG');
+    writeln ('X for XPM, P for PNG, B for BMP, J for JPEG, T for TGA,');
+    writeln ('N for PNM (read only)');
     writeln ('example: imgconv X hello.xpm P hello.png');
     writeln ('example: imgconv hello.xpm P hello.png');
     writeln ('Options for');
@@ -163,7 +165,7 @@ begin
       Init;
       writeln ('Reading image');
       ReadImage;
-      writeln ('Writeing image');
+      writeln ('Writing image');
       WriteImage;
       writeln ('Clean up');
       Clean;