Changeset 35 for trunk/Packages

Timestamp:

May 4, 2018, 12:56:52 PM (7 years ago)

Author:

chronos

Message:

• Fixed: Do not allocate big temp image for drawing on screen of zoomed out image.

File:

• trunk/Packages/FastGraphics/UGGraphics.pas (modified) (10 diffs)

trunk/Packages/FastGraphics/UGGraphics.pas

@@ -51 +51 @@
       TGConvertFromColor = function (Color: TColor): TGColor of object;
       TGGetColor = function (Position: TPoint): TGColor of object;
+      PGColor = ^TGColor;
   protected
     FData: PByte;
     FSize: TPoint;
     FCanvas: TGCanvas<TGColor>;
+    FBytesPerLine: Integer;
+    FBytesPerPixel: Integer;
     function GetPixel(X, Y: Integer): TGColor; virtual;
     function GetSize: TPoint; virtual;
@@ -66 +69 @@
     procedure PaintToCanvas(Canvas: TCanvas; ColorConvertFunc: TGConvertColor); overload;
     procedure PaintToCanvas(Canvas: TCanvas; Rect: TRect; ColorConvertFunc: TGConvertColor); overload;
-    procedure PaintToBitmap(Bitmap: TBitmap; Rect: TRect; ColorConvertFunc: TGConvertColor);
+    procedure PaintToBitmap(Bitmap: TBitmap; Pos: TPoint; ColorConvertFunc: TGConvertColor); overload;
+    procedure PaintToBitmap(Bitmap: TBitmap; Rect: TRect; ColorConvertFunc: TGConvertColor); overload;
     procedure LoadFromCanvas(Canvas: TCanvas; ColorConvertFunc: TGConvertFromColor); overload;
     procedure LoadFromBitmap(Bitmap: TBitmap; ColorConvertFunc: TGConvertFromColor);
@@ -96 +100 @@
   end;
 
+  { TPixelPointer }
+
+  TPixelPointer = record
+    Base: Pointer;
+    Pixel: Pointer;
+    Line: Pointer;
+    BytesPerPixel: Integer;
+    BytesPerLine: Integer;
+    procedure NextLine; inline; // Move pointer to start of new base line
+    procedure NextPixel; inline; // Move pointer to next pixel
+    procedure SetXY(X, Y: Integer); inline; // Set pixel position relative to base
+    procedure SetX(X: Integer); inline; // Set horizontal pixel position relative to base
+    procedure Init(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0); inline; overload;
+    procedure Init(Base: Pointer; BytesPerLine, BytesPerPixel: Integer; BaseX: Integer = 0; BaseY: Integer = 0); inline; overload;
+ end;
+
 
 implementation
 
+{ TPixelPointer }
+
+procedure TPixelPointer.NextLine; inline;
+begin
+  Line := Pointer(Line) + BytesPerLine;
+  Pixel := Line;
+end;
+
+procedure TPixelPointer.NextPixel; inline;
+begin
+  Pixel := Pointer(Pixel) + BytesPerPixel;
+end;
+
+procedure TPixelPointer.SetXY(X, Y: integer); inline;
+begin
+  Line := Pointer(Base) + Y * BytesPerLine;
+  SetX(X);
+end;
+
+procedure TPixelPointer.SetX(X: Integer); inline;
+begin
+  Pixel := Pointer(Line) + X * BytesPerPixel;
+end;
+
+procedure TPixelPointer.Init(Bitmap: TRasterImage; BaseX: Integer = 0;
+  BaseY: Integer = 0); inline;
+begin
+  Init(Bitmap.RawImage.Data, Bitmap.RawImage.Description.BytesPerLine, Bitmap.RawImage.Description.BitsPerPixel shr 3, BaseX, BaseY);
+end;
+
+procedure TPixelPointer.Init(Base: Pointer; BytesPerLine, BytesPerPixel: Integer; BaseX: Integer = 0; BaseY: Integer = 0); inline; overload;
+begin
+  Self.BytesPerLine := BytesPerLine;
+  Self.BytesPerPixel := BytesPerPixel;
+  Self.Base := Pointer(Base + BaseX * BytesPerPixel + BaseY * BytesPerLine);
+  SetXY(0, 0);
+end;
+
 { TGPixmap }
 
@@ -104 +162 @@
 begin
   CheckLimits(X, Y);
-  Move(PByte(FData + (X + Y * FSize.X) * SizeOf(TGColor))^, Result, SizeOf(TGColor));
+  Move(PByte(FData + X * FBytesPerPixel + Y * FBytesPerLine)^, Result, SizeOf(TGColor));
 end;
 
@@ -110 +168 @@
 begin
   CheckLimits(X, Y);
-  Move(AValue, PByte(FData + (X + Y * FSize.X) * SizeOf(TGColor))^, SizeOf(TGColor));
+  Move(AValue, PByte(FData + X * FBytesPerPixel + Y * FBytesPerLine)^, SizeOf(TGColor));
 end;
 
@@ -122 +180 @@
   if (FSize.X <> AValue.X) and (FSize.Y <> AValue.Y) then begin
     FSize := AValue;
-    ReAllocMem(FData, FSize.X * FSize.Y * SizeOf(TGColor));
+    FBytesPerPixel := SizeOf(TGColor);
+    FBytesPerLine := AValue.X * FBytesPerPixel;
+    ReAllocMem(FData, FSize.X * FBytesPerLine);
   end;
 end;
@@ -128 +188 @@
 constructor TGPixmap<TGColor>.Create;
 begin
+  Size := Point(0, 0);
   FCanvas := TGCanvas<TGColor>.Create;
   FCanvas.Bitmap := Self;
@@ -195 +256 @@
 end;
 
+procedure TGPixmap<TGColor>.PaintToBitmap(Bitmap: TBitmap; Pos: TPoint;
+  ColorConvertFunc: TGConvertColor);
+var
+  X, Y: Integer;
+  DstPtr: TPixelPointer;
+  SrcPtr: TPixelPointer;
+begin
+  try
+    Bitmap.BeginUpdate(False);
+    DstPtr.Init(Bitmap);
+    SrcPtr.Init(FData, FBytesPerLine, FBytesPerPixel, Pos.X, Pos.Y);
+    for Y := 0 to Bitmap.Height - 1 do begin
+      for X := 0 to Bitmap.Width - 1 do begin
+        if ((X + Pos.X) >= 0) and ((X + Pos.X) < FSize.X) and
+        ((Y + Pos.Y) >= 0) and ((Y + Pos.Y) < FSize.Y) then begin
+          PInteger(DstPtr.Pixel)^ := ColorConvertFunc(PGColor(SrcPtr.Pixel)^);
+        end;
+        DstPtr.NextPixel;
+        SrcPtr.NextPixel;
+      end;
+      DstPtr.NextLine;
+      SrcPtr.NextLine;
+    end;
+  finally
+    Bitmap.EndUpdate(False);
+  end;
+end;
+
 procedure TGPixmap<TGColor>.PaintToBitmap(Bitmap: TBitmap; Rect: TRect;
   ColorConvertFunc: TGConvertColor);
 var
   X, Y: Integer;
-  PixelPtr: PInteger;
-  PixelPtrMax: PInteger;
-  PixelPtrMin: PInteger;
-  PixelRowPtr: PInteger;
-  RawImage: TRawImage;
-  BytePerPixel: Integer;
+  DstPtr: TPixelPointer;
+  ZoomX: Single;
+  ZoomY: Single;
+  SrcX: Integer;
+  SrcY: Integer;
 begin
   try
     Bitmap.BeginUpdate(False);
-    RawImage := Bitmap.RawImage;
-    PixelRowPtr := PInteger(RawImage.Data);
-    BytePerPixel := RawImage.Description.BitsPerPixel div 8;
-    PixelPtrMin := PixelRowPtr;
-    PixelPtrMax := PixelRowPtr + RawImage.Description.Width * RawImage.Description.Height * BytePerPixel;
+    DstPtr.Init(Bitmap);
+    ZoomX := Bitmap.Width / (Rect.Right - Rect.Left);
+    ZoomY := Bitmap.Height / (Rect.Bottom - Rect.Top);
     for Y := 0 to Bitmap.Height - 1 do begin
-      PixelPtr := PixelRowPtr;
+      SrcY := Trunc(Y / ZoomY + Rect.Top);
       for X := 0 to Bitmap.Width - 1 do begin
-        if ((X + Rect.Left) >= 0) and ((X + Rect.Left) < FSize.X) and
-        ((Y + Rect.Top) >= 0) and ((Y + Rect.Top) < FSize.Y) and
-        (PixelPtr < PixelPtrMax) and (PixelPtr >= PixelPtrMin) then begin
-          PixelPtr^ := ColorConvertFunc(Pixels[X + Rect.Left, Y + Rect.Top]);
+        SrcX := Trunc(X / ZoomX + Rect.Left);
+        if (SrcX >= 0) and (SrcX < FSize.X) and
+        (SrcY >= 0) and (SrcY < FSize.Y) then begin
+          PInteger(DstPtr.Pixel)^ := ColorConvertFunc(Pixels[SrcX, SrcY]);
         end;
-        Inc(PByte(PixelPtr), BytePerPixel);
+        DstPtr.NextPixel;
       end;
-      Inc(PByte(PixelRowPtr), RawImage.Description.BytesPerLine);
+      DstPtr.NextLine;
     end;
   finally
@@ -248 +334 @@
 var
   X, Y: Integer;
-  PixelPtr: PInteger;
-  PixelPtrMax: PInteger;
-  PixelRowPtr: PInteger;
-  P: TPixelFormat;
-  RawImage: TRawImage;
-  BytePerPixel: Integer;
+  SrcPtr: TPixelPointer;
+  DstPtr: TPixelPointer;
 begin
   try
     Bitmap.BeginUpdate(False);
-    RawImage := Bitmap.RawImage;
-    PixelRowPtr := PInteger(RawImage.Data);
-    BytePerPixel := RawImage.Description.BitsPerPixel div 8;
-    PixelPtrMax := PixelRowPtr + RawImage.Description.Width * RawImage.Description.Height * BytePerPixel;
+    SrcPtr.Init(Bitmap);
+    DstPtr.Init(FData, FBytesPerLine, FBytesPerPixel);
     for Y := 0 to FSize.Y - 1 do begin
-      PixelPtr := PixelRowPtr;
       for X := 0 to FSize.X - 1 do begin
-        if (X >= 0) and (X < FSize.X) and (Y >= 0) and (Y < FSize.Y) and (PixelPtr < PixelPtrMax) then
-          Pixels[X, Y] := ColorConvertFunc(PixelPtr^);
-        Inc(PByte(PixelPtr), BytePerPixel);
+        if (X >= 0) and (X < FSize.X) and (Y >= 0) and (Y < FSize.Y) then
+          PInteger(DstPtr.Pixel)^ := ColorConvertFunc(PInteger(SrcPtr.Pixel)^);
+        SrcPtr.NextPixel;
+        DstPtr.NextPixel;
       end;
-      Inc(PByte(PixelRowPtr), RawImage.Description.BytesPerLine);
+      SrcPtr.NextLine;
+      DstPtr.NextLine;
     end;
   finally
@@ -277 +358 @@
 function TGPixmap<TGColor>.GetDataSize: Int64;
 begin
-  Result := FSize.X * FSize.Y * SizeOf(TGColor);
+  Result := FSize.Y * FBytesPerLine;
 end;