Changeset 331 for trunk/Packages/CevoComponents/ScreenTools.pas

Timestamp:

Mar 26, 2021, 3:24:15 PM (3 years ago)

Author:

chronos

Message:

• Modified: Player border tile preparation code for bitmap color replacement moved to ScreenTools.

File:

• trunk/Packages/CevoComponents/ScreenTools.pas (modified) (2 diffs)

trunk/Packages/CevoComponents/ScreenTools.pas

@@ -42 +42 @@
 function LoadGraphicSet2(const Name: string): TGraphicSet;
 procedure Dump(dst: TBitmap; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);
+procedure BitmapReplaceColor(Dst: TBitmap; X, Y, Width, Height: Integer; OldColor, NewColor: TColor);
 procedure Sprite(Canvas: TCanvas; HGr: TGraphicSet; xDst, yDst, Width, Height, xGr, yGr: integer);
   overload;
@@ -567 +568 @@
 end;
 
+procedure BitmapReplaceColor(Dst: TBitmap; X, Y, Width, Height: Integer; OldColor, NewColor: TColor);
+var
+  XX, YY: Integer;
+  PixelPtr: TPixelPointer;
+begin
+  Dst.BeginUpdate;
+  PixelPtr := PixelPointer(Dst, ScaleToNative(X), ScaleToNative(Y));
+  for YY := 0 to ScaleToNative(Height) - 1 do begin
+    for XX := 0 to ScaleToNative(Width) - 1 do begin
+      if PixelPtr.Pixel^.RGB = SwapRedBlue(OldColor) then begin
+        PixelPtr.Pixel^.RGB := SwapRedBlue(NewColor);
+      end;
+      PixelPtr.NextPixel;
+    end;
+    PixelPtr.NextLine;
+  end;
+  Dst.EndUpdate;
+end;
+
 procedure MakeBlue(Dst: TBitmap; X, Y, Width, Height: Integer);
 var