Changeset 333 for tools/Image resize

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.

Location:

tools/Image resize

Files:

• ImageResize.lpi (modified) (1 diff)
• UFormMain.lfm (moved) (moved from tools/Image resize/uformmain.lfm ) (1 diff)
• UFormMain.pas (moved) (moved from tools/Image resize/uformmain.pas ) (9 diffs)
• UPixelPointer.pas (modified) (4 diffs)

tools/Image resize/ImageResize.lpi

@@ -37 +37 @@
       </Unit0>
       <Unit1>
-        <Filename Value="uformmain.pas"/>
+        <Filename Value="UFormMain.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="FormMain"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="UFormMain"/>
       </Unit1>
       <Unit2>

tools/Image resize/UFormMain.lfm

@@ -1 +1 @@
 object FormMain: TFormMain
   Left = 534
-  Height = 312
+  Height = 359
   Top = 388
-  Width = 417
+  Width = 480
   Caption = 'Image resize'
-  ClientHeight = 312
-  ClientWidth = 417
-  DesignTimePPI = 125
+  ClientHeight = 359
+  ClientWidth = 480
+  DesignTimePPI = 144
   OnShow = FormShow
-  LCLVersion = '2.0.10.0'
+  LCLVersion = '2.0.12.0'
   object ButtonResize: TButton
-    Left = 16
-    Height = 33
-    Top = 16
-    Width = 98
+    Left = 18
+    Height = 38
+    Top = 18
+    Width = 113
     Caption = 'Resize'
     OnClick = ButtonResizeClick
+    ParentFont = False
     TabOrder = 0
   end
   object ButtonAlpha: TButton
-    Left = 16
-    Height = 33
-    Top = 64
-    Width = 144
+    Left = 18
+    Height = 38
+    Top = 74
+    Width = 166
     Caption = 'Alpha channel'
     OnClick = ButtonAlphaClick
+    ParentFont = False
     TabOrder = 1
   end
+  object ButtonTile: TButton
+    Left = 18
+    Height = 38
+    Top = 126
+    Width = 153
+    Caption = 'Process tile'
+    OnClick = ButtonTileClick
+    TabOrder = 2
+  end
 end

tools/Image resize/UFormMain.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
-  Math, LazFileUtils, UPixelPointer;
+  Math, LazFileUtils, UPixelPointer, Process;
 
 type
@@ -14 +14 @@
 
   TFormMain = class(TForm)
+    ButtonTile: TButton;
     ButtonAlpha: TButton;
     ButtonResize: TButton;
     procedure ButtonAlphaClick(Sender: TObject);
     procedure ButtonResizeClick(Sender: TObject);
+    procedure ButtonTileClick(Sender: TObject);
     procedure FormShow(Sender: TObject);
   private
     function SwapColors(Color: Cardinal): Cardinal;
-    procedure UseAlpha(SourceName: string; BBC: Boolean);
+    procedure UseAlphaFile(SourceName: string; BBC: Boolean);
+    procedure UseAlphaBitmap(SrcBitmap, DstBitmap: TBitmap; BBC: Boolean = False);
+    procedure RestoreAlphaBitmap(SrcBitmap, DstBitmap: TBitmap; BBC: Boolean = False);
+    procedure ResizeRect(SrcBitmap, DstBitmap: TBitmap; SrcRect, DstRect: TRect);
+    procedure ResizeRectXbrz(SrcBitmap, DstBitmap: TBitmap);
+    procedure ProcessBitmapRect(SrcBitmap, DstBitmap: TBitmap; SrcRect, DstRect: TRect);
+    procedure ResizeAuxPos(SrcBitmap, DstBitmap: TBitmap; SrcRect, DstRect: TRect);
   public
     procedure ResizeImage(SourceName: string; SourceSize: TPoint; Count: TPoint;
@@ -52 +60 @@
 var
   NewSize: TPoint;
-begin
+  OldSize: TPoint;
+  OldFileName: string;
+  NewFileName: string;
+  I: Integer;
+const
+  //Files: array[0..0] of string = ('Cities66x32.png');
+  Files: array[0..0] of string = ('Cities96x48.png');
+  //Files: array[0..0] of string = ('Terrain96x48.png');
+  //Files: array[0..1] of string = ('Cities66x32.png', 'Terrain66x32.png');
+  //Files: array[0..1] of string = ('Cities96x48.png', 'Terrain96x48.png');
+  TileCount: array[0..1] of TPoint = ((X: 8; Y: 2), (X: 9; Y: 21));
+  //TileCount: array[0..0] of TPoint = ((X: 9; Y: 21));
+begin
+  //OldSize := Point(66, 48);
+  OldSize := Point(96, 72);
+  //NewSize := Point(96, 72);
+  //NewSize := Point(66, 48);
   NewSize := Point(144, 108);
-  //ResizeImage('../../trunk/Graphics/Cities66x32.png', Point(66, 48), Point(8, 2),
-  //  'Cities144x72.png', NewSize);
-  //ResizeImage('../../trunk/Graphics/Terrain66x32.png', Point(66, 48), Point(9, 21),
-  //  'Terrain144x72.png', NewSize);
-{
-  ResizeImage('../../trunk/Graphics/Cities96x48.png', Point(96, 72), Point(8, 2),
-    'Cities144x72.png', NewSize);
-  ResizeImage('../../trunk/Graphics/Terrain96x48.png', Point(96, 72), Point(9, 21),
-    'Terrain144x72.png', NewSize);
-}  ResizeImage('../../branches/AlphaChannel/Graphics/Cities96x48.png', Point(96, 72), Point(8, 2),
-    'Cities144x72.png', NewSize);
-  ResizeImage('../../branches/AlphaChannel/Graphics/Terrain96x48.png', Point(96, 72), Point(9, 21),
-    'Terrain144x72.png', NewSize);
+  //NewSize := Point(192, 144);
+
+  for I := 0 to Length(Files) - 1 do begin
+    OldFileName := Files[I];
+    NewFileName := '_' + OldFileName;
+    ResizeImage(OldFileName, OldSize, TileCount[I], NewFileName, NewSize);
+  end;
+end;
+
+procedure TFormMain.ButtonTileClick(Sender: TObject);
+var
+  Ptr: TPixelPointer;
+  X, Y: Integer;
+  Bitmap: TBitmap;
+begin
+  Bitmap := TBitmap.Create;
+  Bitmap.LoadFromFile('tile.bmp');
+
+  Bitmap.BeginUpdate;
+  Ptr := PixelPointer(Bitmap);
+  for Y := 0 to Bitmap.Height - 1 do begin
+    for X := 0 to Bitmap.Width - 1 do begin
+      if Ptr.Pixel^.ARGB <> 0 then begin
+        if ((X + Y) mod 2) = 0 then
+          Ptr.Pixel^.ARGB := $ff7f007f
+          else Ptr.Pixel^.ARGB := $ff000000;
+      end else Ptr.Pixel^.ARGB := $ff7f007f;
+      Ptr.NextPixel;
+    end;
+    Ptr.NextLine;
+  end;
+  Bitmap.EndUpdate;
+
+  Bitmap.SaveToFile('tile_.bmp');
+  Bitmap.Free;
 end;
 
@@ -81 +127 @@
   I := 0;
   for I := 0 to Length(Files) - 1 do
-    UseAlpha('../../trunk/Graphics/' + Files[I], False);
-  UseAlpha('../../trunk/Help/AdvTree.png', False);
-  //UseAlpha('../../trunk/Graphics/Templates.png', True);
+    UseAlphaFile('../../trunk/Graphics/' + Files[I], False);
+  UseAlphaFile('../../trunk/Help/AdvTree.png', False);
+  //UseAlphaFile('../../trunk/Graphics/Templates.png', True);
 end;
 
@@ -103 +149 @@
 end;
 
-procedure TFormMain.UseAlpha(SourceName: string; BBC: Boolean);
+procedure TFormMain.UseAlphaFile(SourceName: string; BBC: Boolean);
 var
   ImageSrc: TImage;
@@ -124 +170 @@
   ImageSrc := TImage.Create(nil);
   ImageSrc.Picture.LoadFromFile(SourceName);
-  Size := Point(ImageSrc.Picture.Bitmap.Width,
-    ImageSrc.Picture.Bitmap.Height);
-  ImageSrc.Picture.Bitmap.BeginUpdate(True);
   ImageDest := TImage.Create(nil);
   ImageDest.Picture.Bitmap.PixelFormat := pf32bit;
-  ImageDest.Picture.Bitmap.SetSize(Size.X, Size.Y);
-  ImageDest.Picture.Bitmap.BeginUpdate(True);
+
+  UseAlphaBitmap(ImageSrc.Picture.Bitmap, ImageDest.Picture.Bitmap, BBC);
+
+  ImageDest.Picture.SaveToFile(ExtractFileName(SourceName));
+  ImageSrc.Free;
+  ImageDest.Free;
+  BitmapSet.Free;
+end;
+
+procedure TFormMain.UseAlphaBitmap(SrcBitmap, DstBitmap: TBitmap; BBC: Boolean);
+var
+  X, Y: Integer;
+  PtrSrc: PPixel32;
+  PtrDest: PPixel32;
+  C: TPixel32;
+  Size: TPoint;
+  Trans, Amp1, Amp2, Value: Integer;
+  Color1, Color2: TPixel32;
+  BitmapSet: TBitmapSet;
+  BitmapDesc: TBitmapDesc;
+  I: Integer;
+begin
+  Size := Point(SrcBitmap.Width, SrcBitmap.Height);
+  SrcBitmap.BeginUpdate(True);
+  DstBitmap.SetSize(Size.X, Size.Y);
+  DstBitmap.BeginUpdate(True);
   for Y := 0 to Size.Y - 1 do
     for X := 0 to Size.X - 1 do begin
-      PtrSrc := ImageSrc.Picture.Bitmap.ScanLine[Y] + X * 4;
-      PtrDest := ImageDest.Picture.Bitmap.ScanLine[Y] + X * 4;
+      PtrSrc := SrcBitmap.ScanLine[Y] + X * 4;
+      PtrDest := DstBitmap.ScanLine[Y] + X * 4;
       C.ARGB := PtrSrc^.ARGB and $ffffff;
       //C.ARGB := SwapColors(C.ARGB);
@@ -177 +244 @@
   end;
     }
-  ImageSrc.Picture.Bitmap.EndUpdate;
-  ImageDest.Picture.Bitmap.EndUpdate;
-  ImageDest.Picture.SaveToFile(ExtractFileName(SourceName));
-  ImageSrc.Free;
-  ImageDest.Free;
-  BitmapSet.Free;
+  SrcBitmap.EndUpdate;
+  DstBitmap.EndUpdate;
+end;
+
+procedure TFormMain.RestoreAlphaBitmap(SrcBitmap, DstBitmap: TBitmap;
+  BBC: Boolean);
+var
+  X, Y: Integer;
+  Size: TPoint;
+  PtrSrc: PPixel32;
+  PtrDest: PPixel32;
+  C: TPixel32;
+  A: Cardinal;
+  Alpha: Byte;
+const
+  AlphaThreshold = $80;
+begin
+  Size := Point(SrcBitmap.Width, SrcBitmap.Height);
+  SrcBitmap.BeginUpdate(True);
+  SrcBitmap.PixelFormat := pf32bit;
+  DstBitmap.SetSize(Size.X, Size.Y);
+  DstBitmap.BeginUpdate(True);
+  for Y := 0 to Size.Y - 1 do
+    for X := 0 to Size.X - 1 do begin
+      PtrSrc := SrcBitmap.ScanLine[Y] + X * 4;
+      PtrDest := DstBitmap.ScanLine[Y] + X * 4;
+      C.ARGB := PtrSrc^.ARGB;
+      //C.ARGB := SwapColors(C.ARGB);
+      if BBC then begin
+        PtrDest^.R := C.R;
+        PtrDest^.G := C.G;
+        PtrDest^.B := 0; //C.B;
+        PtrDest^.A := 255 - C.B; // blue channel = transparency
+      end else begin
+        Alpha := C.A;
+        if Alpha < AlphaThreshold then begin
+          PtrDest^.RGB := $7f007f
+        end
+        else begin
+          A := C.ARGB and $ffffff;
+          PtrDest^.RGB := SwapRedBlue(A);
+        end;
+      end;
+    end;
+  SrcBitmap.EndUpdate;
+  DstBitmap.EndUpdate;
+end;
+
+procedure TFormMain.ResizeRect(SrcBitmap, DstBitmap: TBitmap; SrcRect, DstRect: TRect);
+var
+  X, Y: Integer;
+  SrcPtr: PCardinal;
+  DestPtr: PCardinal;
+begin
+  SrcBitmap.BeginUpdate(True);
+  DstBitmap.BeginUpdate(True);
+  for Y := 0 to DstRect.Height - 1 do begin
+    for X := 0 to DstRect.Width - 1 do begin
+      SrcPtr := SrcBitmap.ScanLine[SrcRect.Top + Trunc(Y / DstRect.Height * SrcRect.Height)];
+      DestPtr := DstBitmap.ScanLine[DstRect.Top + Y];
+      SrcPtr := SrcPtr + SrcRect.Left + Trunc(X / DstRect.Width * SrcRect.Width);
+      DestPtr := DestPtr + DstRect.Left + X;
+      DestPtr^ := SrcPtr^;
+      //ImageDest.Picture.Bitmap.Canvas.Pixels[XX * (DestSize.X + 1) + 1 + X,
+      //  YY * (DestSize.Y + 1) + 1 + Y] :=
+      //ImageSrc.Picture.Bitmap.Canvas.Pixels[XX * (SourceSize.X + 1) + 1 + Trunc(X / DestSize.X * SourceSize.X),
+      //  YY * (SourceSize.Y + 1) + 1 + Trunc(Y / DestSize.Y * SourceSize.Y)];
+    end;
+  end;
+  SrcBitmap.EndUpdate;
+  DstBitmap.EndUpdate;
+end;
+
+procedure ExecuteProgram(Executable: string; Parameters: array of string);
+var
+  Process: TProcess;
+  I: Integer;
+begin
+  try
+    Process := TProcess.Create(nil);
+    Process.Executable := Executable;
+    for I := 0 to Length(Parameters) - 1 do
+      Process.Parameters.Add(Parameters[I]);
+    Process.Options := [poNoConsole, poWaitOnExit];
+    Process.Execute;
+  finally
+    Process.Free;
+  end;
+end;
+
+procedure TFormMain.ResizeRectXbrz(SrcBitmap, DstBitmap: TBitmap);
+var
+  Png: TPortableNetworkGraphic;
+const
+  XbrzScaleExe = 'xbrzscale'; // https://github.com/atheros/xbrzscale
+begin
+  SrcBitmap.SaveToFile('Input.bmp');
+  ExecuteProgram(XbrzScaleExe, ['3', 'Input.bmp', 'Output.png']);
+  Png := TPortableNetworkGraphic.Create;
+  Png.PixelFormat := pf32bit;
+  Png.LoadFromFile('Output.png');
+  Png.PixelFormat := pf32bit;
+  Png.SaveToFile('Output2.png');
+  DstBitmap.SaveToFile('xxx1.bmp');
+  BitmapStretchRect(DstBitmap, Bounds(0, 0, DstBitmap.Width, DstBitmap.Height),
+    Png, Rect(0, 0, Png.Width, Png.Height));
+  BitmapSwapRedBlue(DstBitmap);
+  DstBitmap.SaveToFile('xxx.bmp');
+  Png.Free;
+end;
+
+procedure TFormMain.ProcessBitmapRect(SrcBitmap, DstBitmap: TBitmap; SrcRect,
+  DstRect: TRect);
+var
+  Src, Dst: TBitmap;
+  Alpha: TBitmap;
+  Alpha2: TBitmap;
+begin
+  Src := TBitmap.Create;
+  Src.SetSize(SrcRect.Width, SrcRect.Height);
+  Src.Canvas.CopyRect(Bounds(0, 0, SrcRect.Width, SrcRect.Height), SrcBitmap.Canvas,
+    SrcRect);
+  Dst := TBitmap.Create;
+  Dst.SetSize(DstRect.Width, DstRect.Height);
+  Dst.PixelFormat := Src.PixelFormat;
+  //Dst.Canvas.Brush.Style := bsSolid;
+  //Dst.Canvas.Brush.Color := $757575;
+  //Dst.Canvas.FillRect(0, 0, Dst.Width, Dst.Height);
+  FillRectBitmap(Dst, $ff000000);
+
+  Alpha := TBitmap.Create;
+  Alpha.PixelFormat := pf32bit;
+  Alpha.SetSize(Src.Width, Src.Height);
+  UseAlphaBitmap(Src, Alpha);
+
+  Alpha2 := TBitmap.Create;
+  Alpha2.PixelFormat := pf32bit;
+  Alpha2.SetSize(Dst.Width, Dst.Height);
+  FillRectBitmap(Alpha2, $00000000);
+  //Alpha2.Canvas.Brush.Style := bsSolid;
+  //Alpha2.Canvas.Brush.Color := $000000;
+  //Alpha2.Canvas.FillRect(0, 0, 0, 0);
+
+  ResizeRectXbrz(Alpha, Alpha2);
+
+  RestoreAlphaBitmap(Alpha2, Dst);
+
+  Dst.SaveToFile('Dst.bmp');
+  DstBitmap.Canvas.CopyRect(DstRect, Dst.Canvas, Bounds(0, 0, DstRect.Width, DstRect.Height));
+  DstBitmap.SaveToFile('DstBitmap.bmp');
+  Src.Free;
+  Dst.Free;
+  Alpha.Free;
+  Alpha2.Free;
+end;
+
+function FindPosition(Bitmap: TBitmap; x, y, xmax, ymax: Integer; Mark: TColor): TPoint;
+var
+  xp, yp: Integer;
+begin
+  xp := 0;
+  while (xp < xmax) and (Bitmap.Canvas.Pixels[x + 1 + xp, y] <> Mark) do
+    Inc(xp);
+  yp := 0;
+  while (yp < ymax) and (Bitmap.Canvas.Pixels[x, y + 1 + yp] <> Mark) do
+    Inc(yp);
+  Result := Point(xp, yp);
+end;
+
+procedure TFormMain.ResizeAuxPos(SrcBitmap, DstBitmap: TBitmap; SrcRect,
+  DstRect: TRect);
+var
+  P: TPoint;
+const
+  MarkColor: TColor = $00ffff;
+begin
+  P := FindPosition(SrcBitmap, SrcRect.Left, SrcRect.Top, SrcRect.Width, SrcRect.Height, MarkColor);
+  P := Point(Round(P.X * DstRect.Width / SrcRect.Width),
+    Round(P.Y * DstRect.Height / SrcRect.Height));
+  DstBitmap.Canvas.Pixels[DstRect.Left + P.X, DstRect.Top] := MarkColor;
+  DstBitmap.Canvas.Pixels[DstRect.Left, DstRect.Top + P.Y] := MarkColor;
 end;
 
@@ -190 +432 @@
   ImageSrc: TImage;
   ImageDest: TImage;
-  XX, YY: Integer;
-  X, Y: Integer;
-  SrcPtr: PCardinal;
-  DestPtr: PCardinal;
+  X, Y: Integer;
 begin
   ImageSrc := TImage.Create(nil);
@@ -205 +444 @@
 
   ImageSrc.Picture.Bitmap.BeginUpdate(True);
-  ImageDest.Picture.Bitmap.BeginUpdate(True);
+  //ImageDest.Picture.Bitmap.BeginUpdate(True);
   //ImageDest.Picture.Bitmap.Canvas.Brush.Style := bsSolid;
   //ImageDest.Picture.Bitmap.Canvas.Brush.Color := $757575;
   //ImageDest.Picture.Bitmap.Canvas.FillRect(0, 0, ImageDest.Picture.Bitmap.Width, ImageDest.Picture.Bitmap.Height);
-  XX := 0;
-  YY := 0;
-  for YY := 0 to Count.Y - 1 do
-    for XX := 0 to Count.X - 1 do begin
-      for Y := 0 to DestSize.Y - 1 do
-        for X := 0 to DestSize.X - 1 do begin
-          SrcPtr := ImageSrc.Picture.Bitmap.ScanLine[YY * (SourceSize.Y + 1) + 1 + Trunc(Y / DestSize.Y * SourceSize.Y)];
-          DestPtr := ImageDest.Picture.Bitmap.ScanLine[YY * (DestSize.Y + 1) + 1 + Y];
-          SrcPtr := SrcPtr + XX * (SourceSize.X + 1) + 1 + Trunc(X / DestSize.X * SourceSize.X);
-          DestPtr := DestPtr + XX * (DestSize.X + 1) + 1 + X;
-          DestPtr^ := SrcPtr^;
-          //ImageDest.Picture.Bitmap.Canvas.Pixels[XX * (DestSize.X + 1) + 1 + X,
-          //  YY * (DestSize.Y + 1) + 1 + Y] :=
-          //ImageSrc.Picture.Bitmap.Canvas.Pixels[XX * (SourceSize.X + 1) + 1 + Trunc(X / DestSize.X * SourceSize.X),
-          //  YY * (SourceSize.Y + 1) + 1 + Trunc(Y / DestSize.Y * SourceSize.Y)];
-        end;
+  for Y := 0 to Count.Y - 1 do
+    for X := 0 to Count.X - 1 do begin
+      ProcessBitmapRect(ImageSrc.Picture.Bitmap, ImageDest.Picture.Bitmap,
+        Bounds(X * (SourceSize.X + 1) + 1, Y * (SourceSize.Y + 1) + 1, SourceSize.X, SourceSize.Y),
+        Bounds(X * (DestSize.X + 1) + 1, Y * (DestSize.Y + 1) + 1, DestSize.X, DestSize.Y));
+      ResizeAuxPos(ImageSrc.Picture.Bitmap, ImageDest.Picture.Bitmap,
+        Bounds(X * (SourceSize.X + 1), Y * (SourceSize.Y + 1), SourceSize.X, SourceSize.Y),
+        Bounds(X * (DestSize.X + 1), Y * (DestSize.Y + 1), DestSize.X, DestSize.Y));
     end;
   ImageSrc.Picture.Bitmap.EndUpdate;
-  ImageDest.Picture.Bitmap.EndUpdate;
+  //ImageDest.Picture.Bitmap.EndUpdate;
   ImageDest.Picture.SaveToFile(DestName);
   ImageSrc.Free;

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.