Browse Source

lcl: fixed drawing image on windows

mattias 9 months ago
parent
commit
1a15ddc6e9
3 changed files with 47 additions and 12 deletions
  1. 0 3
      demo/democomps/fresnel.democheckbox.pas
  2. 35 1
      src/base/fresnel.images.pas
  3. 12 8
      src/lcl/fresnel.lcl.pas

+ 0 - 3
demo/democomps/fresnel.democheckbox.pas

@@ -6,9 +6,6 @@ interface
 
 uses
   Classes, SysUtils,
-  {$IFDEF Windows}
-  Windows,
-  {$ENDIF}
   FPReadPNG, Fresnel.DOM, Fresnel.Controls, Fresnel.Classes,
   FCL.Events, Fresnel.Events, fpCSSTree;
 

+ 35 - 1
src/base/fresnel.images.pas

@@ -1379,6 +1379,37 @@ begin
 end;
 
 procedure TImageData.LoadFromStream(const aStream: TStream; Handler:TFPCustomImageReader);
+
+  {$IFDEF DebugFresnelImgData}
+  procedure WriteAlpha;
+  var
+    sl: TStringList;
+    y, x: Integer;
+    Line: String;
+    c: TFPColor;
+  begin
+    sl:=TStringList.Create;
+    try
+      for y:=0 to Img.Height-1 do begin
+        Line:=HexStr(y,4)+' ';
+        for x:=0 to Img.Width-1 do begin
+          c:=Img.Colors[x,y];
+          if c.Alpha=alphaOpaque then
+            Line+='O'
+          else if c.Alpha=alphaTransparent then
+            Line+='T'
+          else
+            Line+=HexStr(c.Alpha shr 12,1);
+        end;
+        sl.Add(Line);
+      end;
+      sl.SaveToFile('TImageDataLoadFromStream.txt');
+    finally
+      sl.Free;
+    end;
+  end;
+  {$ENDIF}
+
 var
   Img: TFPCustomImage;
 begin
@@ -1387,7 +1418,10 @@ begin
     if Assigned(Handler) then
       Img.LoadFromStream(aStream,Handler)
     else
-      Img.LoadFromStream(aStream)
+      Img.LoadFromStream(aStream);
+    {$IFDEF DebugFresnelImgData}
+    WriteAlpha;
+    {$ENDIF}
   except
     Img.Free;
     Raise;

+ 12 - 8
src/lcl/fresnel.lcl.pas

@@ -92,7 +92,8 @@ type
     procedure TextOut(const aLeft, aTop: TFresnelLength;
       const aFont: IFresnelFont; const aColor: TFPColor;
       const aText: string); override;
-    procedure DrawImage(const aLeft, aTop, aWidth, aHeight: TFresnelLength; const aImage: TFPCustomImage); override;
+    procedure DrawImage(const aLeft, aTop, aWidth, aHeight: TFresnelLength;
+      const aImage: TFPCustomImage); override;
 
     property Canvas: TCanvas read FCanvas write FCanvas;
   end;
@@ -355,22 +356,25 @@ begin
   Canvas.TextOut(round(Origin.X+aLeft),round(Origin.Y+aTop),aText);
 end;
 
-procedure TFresnelLCLRenderer.DrawImage(const aLeft, aTop, aWidth, aHeight: TFresnelLength; const aImage: TFPCustomImage);
-
+procedure TFresnelLCLRenderer.DrawImage(const aLeft, aTop, aWidth, aHeight: TFresnelLength;
+  const aImage: TFPCustomImage);
 var
-  Img : TRasterImage;
+  Img : TBitmap;
   R : TRect;
-
 begin
   R.Left:=Round(Origin.X+aLeft);
   R.Top:=Round(Origin.Y+aTop);
-  R.Width:=Round(aWidth);
-  R.Height:=Round(aHeight);
+  R.Right:=Round(Origin.X+aLeft+aWidth);
+  R.Bottom:=Round(Origin.Y+aTop+aHeight);
   if R.IsEmpty then exit;
 
   Img:=TBitmap.Create;
   try
-    Img.Assign(aImage);
+    Img.PixelFormat:=pf32bit;
+    if aImage is TLazIntfImage then
+      Img.LoadFromIntfImage(TLazIntfImage(aImage))
+    else
+      Img.Assign(aImage);
     Canvas.StretchDraw(R,Img);
   finally
     Img.Free;