Changeset 333 for tools/Image resize/UPixelPointer.pas

Timestamp:

Mar 31, 2021, 7:21:45 PM (4 years ago)

Author:

chronos

Message:

• Modified: Image resize tool scale up using xbrzscale tool.
• Modified: Various improvements of generation of scaled up tiles.

File:

• tools/Image resize/UPixelPointer.pas (modified) (4 diffs)

tools/Image resize/UPixelPointer.pas

@@ -9 +9 @@
   TColor32 = type Cardinal;
   TColor32Component = (ccBlue, ccGreen, ccRed, ccAlpha);
+
+  { TPixel32 }
+
   TPixel32 = packed record
+  private
+    procedure SetRGB(AValue: Cardinal);
+  public
+    function GetRGB: Cardinal;
+    property RGB: Cardinal read GetRGB write SetRGB;
     case Integer of
       0: (B, G, R, A: Byte);
@@ -37 +45 @@
 
   function PixelPointer(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; inline;
-
+  function SwapRedBlue(Color: TColor32): TColor32;
+  procedure BitmapCopyRect(DstBitmap: TRasterImage; DstRect: TRect; SrcBitmap: TRasterImage; SrcPos: TPoint);
+  procedure BitmapStretchRect(DstBitmap: TRasterImage; DstRect: TRect;
+    SrcBitmap: TRasterImage; SrcRect: TRect);
+  procedure BitmapFill(Bitmap:TRasterImage; Color: TColor32);
+  procedure BitmapFillRect(Bitmap:TRasterImage; Color: TColor32; Rect: TRect);
+  procedure BitmapSwapRedBlue(Bitmap:TRasterImage);
 
 implementation
+
+{ TPixel32 }
+
+function TPixel32.GetRGB: Cardinal;
+begin
+  Result := ARGB and $ffffff;
+end;
+
+procedure TPixel32.SetRGB(AValue: Cardinal);
+begin
+  R := (AValue shr 16) and $ff;
+  G := (AValue shr 8) and $ff;
+  B := (AValue shr 0) and $ff;
+end;
 
 { TPixelPointer }
@@ -74 +102 @@
 begin
   Pixel := Pointer(Line) + X * BytesPerPixel;
+end;
+
+procedure BitmapCopyRect(DstBitmap: TRasterImage; DstRect: TRect;
+  SrcBitmap: TRasterImage; SrcPos: TPoint);
+var
+  SrcPtr, DstPtr: TPixelPointer;
+  X, Y: Integer;
+begin
+  SrcBitmap.BeginUpdate(True);
+  DstBitmap.BeginUpdate(True);
+  SrcPtr := PixelPointer(SrcBitmap, SrcPos.X, SrcPos.Y);
+  DstPtr := PixelPointer(DstBitmap, DstRect.Left, DstRect.Top);
+  for Y := 0 to DstRect.Height - 1 do begin
+    for X := 0 to DstRect.Width - 1 do begin
+      DstPtr.Pixel^.ARGB := SrcPtr.Pixel^.ARGB;
+      SrcPtr.NextPixel;
+      DstPtr.NextPixel;
+    end;
+    SrcPtr.NextLine;
+    DstPtr.NextLine;
+  end;
+  SrcBitmap.EndUpdate;
+  DstBitmap.EndUpdate;
+end;
+
+procedure BitmapStretchRect(DstBitmap: TRasterImage; DstRect: TRect;
+  SrcBitmap: TRasterImage; SrcRect: TRect);
+var
+  SrcPtr, DstPtr: TPixelPointer;
+  SubPtr: TPixelPointer;
+  X, Y: Integer;
+  XX, YY: Integer;
+  R: TRect;
+  C: TColor32;
+begin
+  if (DstRect.Width = SrcRect.Width) and (DstRect.Height = SrcRect.Height) then begin
+    BitmapCopyRect(DstBitmap, DstRect, SrcBitmap, Point(SrcRect.Left, SrcRect.Top));
+    Exit;
+  end;
+  SrcBitmap.BeginUpdate(True);
+  DstBitmap.BeginUpdate(True);
+  SrcPtr := PixelPointer(SrcBitmap, SrcRect.Left, SrcRect.Top);
+  DstPtr := PixelPointer(DstBitmap, DstRect.Left, DstRect.Top);
+  for Y := 0 to DstRect.Height - 1 do begin
+    for X := 0 to DstRect.Width - 1 do begin
+      R := Rect(Trunc(X * SrcRect.Width / DstRect.Width),
+        Trunc(Y * SrcRect.Height / DstRect.Height),
+        Trunc((X + 1) * SrcRect.Width / DstRect.Width),
+        Trunc((Y + 1) * SrcRect.Height / DstRect.Height));
+      DstPtr.SetXY(X, Y);
+      SrcPtr.SetXY(R.Left, R.Top);
+      C := SrcPtr.Pixel^.ARGB;
+      DstPtr.Pixel^.ARGB := C;
+      for YY := 0 to R.Height - 1 do begin
+        for XX := 0 to R.Width - 1 do begin
+          DstPtr.Pixel^.ARGB := C;
+          DstPtr.NextPixel;
+        end;
+        DstPtr.NextLine;
+      end;
+    end;
+  end;
+  SrcBitmap.EndUpdate;
+  DstBitmap.EndUpdate;
+end;
+
+procedure BitmapFill(Bitmap: TRasterImage; Color: TColor32);
+var
+  X, Y: Integer;
+  Ptr: TPixelPointer;
+begin
+  Bitmap.BeginUpdate(True);
+  Ptr := PixelPointer(Bitmap);
+  for Y := 0 to Bitmap.Height - 1 do begin
+    for X := 0 to Bitmap.Width - 1 do begin
+      Ptr.Pixel^.ARGB := Color;
+      Ptr.NextPixel;
+    end;
+    Ptr.NextLine;
+  end;
+  Bitmap.EndUpdate;
+end;
+
+procedure BitmapFillRect(Bitmap: TRasterImage; Color: TColor32; Rect: TRect);
+var
+  X, Y: Integer;
+  Ptr: TPixelPointer;
+begin
+  Bitmap.BeginUpdate(True);
+  Ptr := PixelPointer(Bitmap, Rect.Left, Rect.Top);
+  for Y := 0 to Rect.Height - 1 do begin
+    for X := 0 to Rect.Width - 1 do begin
+      Ptr.Pixel^.ARGB := Color;
+      Ptr.NextPixel;
+    end;
+    Ptr.NextLine;
+  end;
+  Bitmap.EndUpdate;
+end;
+
+procedure BitmapSwapRedBlue(Bitmap: TRasterImage);
+var
+  X, Y: Integer;
+  Ptr: TPixelPointer;
+begin
+  Bitmap.BeginUpdate(True);
+  Ptr := PixelPointer(Bitmap);
+  for Y := 0 to Bitmap.Height - 1 do begin
+    for X := 0 to Bitmap.Width - 1 do begin
+      Ptr.Pixel^.ARGB := SwapRedBlue(Ptr.Pixel^.ARGB);
+      Ptr.NextPixel;
+    end;
+    Ptr.NextLine;
+  end;
+  Bitmap.EndUpdate;
 end;
 
@@ -86 +229 @@
 end;
 
+function SwapRedBlue(Color: TColor32): TColor32;
+begin
+  Result := (Color and $ff00ff00) or ((Color and $ff) shl 16) or ((Color shr 16) and $ff);
+end;
+
 
 end.