Changeset 494 for GraphicTest/Packages/bgrabitmap/bgrareadbmp.pas

Timestamp:

Dec 22, 2016, 8:49:19 PM (8 years ago)

Author:

chronos

Message:

• Modified: Updated BGRABitmap package.

File:

• GraphicTest/Packages/bgrabitmap/bgrareadbmp.pas (modified) (13 diffs)

GraphicTest/Packages/bgrabitmap/bgrareadbmp.pas

@@ -36 +36 @@
 
 type
+  TBMPTransparencyOption = (toAuto, toTransparent, toOpaque);
 
   { TBGRAReaderBMP }
@@ -56 +57 @@
       FOutputHeight: integer;
       FOriginalHeight: Integer;
+      FTransparencyOption: TBMPTransparencyOption;
       FBuffer: packed array of byte;
       FBufferPos, FBufferSize: integer;
       FBufferStream: TStream;
+      FHasAlphaValues: boolean;
       // SetupRead will allocate the needed buffers, and read the colormap if needed.
       procedure SetupRead(nPalette, nRowBits: Integer; Stream : TStream); virtual;
@@ -77 +80 @@
       procedure CloseReadBuffer;
       function GetNextBufferByte: byte;
+      procedure MakeOpaque(Img: TFPCustomImage);
     public
       MinifyHeight,WantedHeight: integer;
@@ -83 +87 @@
       property OriginalHeight: integer read FOriginalHeight;
       property OutputHeight: integer read FOutputHeight;
+      property TransparencyOption: TBMPTransparencyOption read FTransparencyOption write FTransparencyOption;
   end;
 
 implementation
-
-uses dialogs;
 
 type
@@ -117 +120 @@
 end;
 
-Constructor TBGRAReaderBMP.create;
+constructor TBGRAReaderBMP.Create;
 
 begin
   inherited create;
-end;
-
-Destructor TBGRAReaderBMP.Destroy;
+  FTransparencyOption := toTransparent;
+end;
+
+destructor TBGRAReaderBMP.Destroy;
 
 begin
@@ -130 +134 @@
 end;
 
-Procedure TBGRAReaderBMP.FreeBufs;
+procedure TBGRAReaderBMP.FreeBufs;
 
 begin
@@ -405 +409 @@
     PrevSourceRow := SourceRow-SourceRowDelta;
     if (BFI.Compression=BI_RLE8) or(BFI.Compression=BI_RLE4) then InitReadBuffer(Stream,2048);
+    FHasAlphaValues:= false;
     while SourceRow <> SourceLastRow+SourceRowDelta do
     begin
@@ -434 +439 @@
       if percent<>prevPercent then Progress(psRunning,percent,false,Rect,'',continue);
     end;
+    if not FHasAlphaValues and (TransparencyOption = toAuto) and (BFI.BitCount = 32) then
+      MakeOpaque(Img);
     Progress(psEnding,100,false,Rect,'',continue);
-  except
-    on ex:exception do
-      ShowMessage(ex.Message);
+  finally
+    if (BFI.Compression=BI_RLE8) or(BFI.Compression=BI_RLE4) then CloseReadBuffer;
+    FreeBufs;
   end;
-  if (BFI.Compression=BI_RLE8) or(BFI.Compression=BI_RLE4) then CloseReadBuffer;
-  FreeBufs;
 end;
 
@@ -602 +607 @@
 Var
   Column : Integer;
-
+  c: TFPColor;
 begin
   Case BFI.BitCount of
@@ -628 +633 @@
           img.colors[Column,Row]:=ExpandColor(PLongWord(LineBuf)[Column])
         else
-          img.colors[Column,Row]:=RGBAToFPColor(PColorRGBA(LineBuf)[Column]);
+        begin
+          if FTransparencyOption = toOpaque then
+            img.colors[Column,Row]:=RGBToFPColor(PColorRGB(PColorRGBA(LineBuf)+Column)^)
+          else
+          begin
+            c := RGBAToFPColor(PColorRGBA(LineBuf)[Column]);
+            if c.alpha <> 0 then FHasAlphaValues:= true;
+            img.colors[Column,Row]:= c;
+          end;
+        end;
     end;
 end;
@@ -672 +686 @@
       for Column:=0 to img.Width-1 do
       begin
-        {$IFDEF ENDIAN_BIG}
-        PDWord(PDest)^ := (PWord(PSrc)^ shl 16) or ((Psrc+2)^ shl 8) or $000000ff;
-        {$ELSE}
-        PDWord(PDest)^ := PWord(PSrc)^ or ((Psrc+2)^ shl 16) or $ff000000;
-        {$ENDIF}
+        PDest^ := BGRA((Psrc+2)^,(Psrc+1)^,(Psrc)^);
         inc(PDest);
         inc(PSrc,3);
@@ -689 +699 @@
         inc(PDest);
       end;
-     end else Move(LineBuf^, PDest^, img.Width*SizeOf(TBGRAPixel));
+     end else
+     if FTransparencyOption = toOpaque then
+     begin
+       if TBGRAPixel_RGBAOrder then
+       begin
+        PSrc := LineBuf;
+        for Column:=0 to img.Width-1 do
+        begin
+          PDest^:= BGRA((PSrc)^,(PSrc+1)^,(PSrc+2)^);
+          inc(PDest);
+          Inc(PSrc,4);
+        end;
+       end
+       else
+       begin
+        PSrc := LineBuf;
+        for Column:=0 to img.Width-1 do
+        begin
+          PDest^:= BGRA((PSrc+2)^,(PSrc+1)^,(PSrc+1)^);
+          inc(PDest);
+          Inc(PSrc,4);
+        end;
+       end;
+     end else
+     begin
+       if TBGRAPixel_RGBAOrder then
+       begin
+        PSrc := LineBuf;
+        for Column:=0 to img.Width-1 do
+        begin
+          PDest^:= BGRA((PSrc)^,(PSrc+1)^,(PSrc+2)^,(PSrc+3)^);
+          if PDest^.alpha <> 0 then FHasAlphaValues:= true;
+          inc(PDest);
+          Inc(PSrc,4);
+        end;
+       end
+       else
+       begin
+         PSrc := LineBuf;
+         for Column:=0 to img.Width-1 do
+         begin
+           PDest^ := PBGRAPixel(PSrc)^;
+           if PDest^.alpha <> 0 then FHasAlphaValues:= true;
+           inc(PDest);
+           Inc(PSrc,4);
+         end;
+       end;
+     end;
     end;
 end;
@@ -741 +798 @@
 end;
 
+procedure TBGRAReaderBMP.MakeOpaque(Img: TFPCustomImage);
+var c: TFPColor;
+  x,y: NativeInt;
+begin
+  if Img is TBGRACustomBitmap then
+    TBGRACustomBitmap(Img).AlphaFill(255)
+  else
+    for y := 0 to Img.Height-1 do
+      for x := 0 to Img.Width-1 do
+      begin
+        c := Img.Colors[x,y];
+        c.alpha := alphaOpaque;
+        Img.Colors[x,y] := c;
+      end;
+end;
+
 
 initialization