Changeset 77 for trunk/Packages/Common/UPixelPointer.pas

Timestamp:

May 19, 2021, 11:30:41 AM (3 years ago)

Author:

chronos

Message:

• Added: Control icons for Pause, Play and Fast forward.
• Modified: Image buttons changed to custom TImage control with Enabled property supported.

File:

• trunk/Packages/Common/UPixelPointer.pas (modified) (2 diffs)

trunk/Packages/Common/UPixelPointer.pas

@@ -53 +53 @@
   procedure BitmapSwapRedBlue(Bitmap:TRasterImage);
   procedure BitmapInvert(Bitmap: TRasterImage);
+  procedure BitmapBlendColor(Bitmap: TRasterImage; Color: TColor32);
+  function Color32(A, R, G, B: Byte): TColor32;
+  function Color32ToPixel32(Color: TColor32): TPixel32;
+  function Pixel32ToColor32(Color: TPixel32): TColor32;
 
 implementation
@@ -237 +241 @@
 end;
 
+procedure BitmapBlendColor(Bitmap: TRasterImage; Color: TColor32);
+var
+  X, Y: Integer;
+  Ptr: TPixelPointer;
+  A, R, G, B: Word;
+  Pixel: TPixel32;
+begin
+  Pixel := Color32ToPixel32(Color);
+  Bitmap.BeginUpdate(True);
+  Ptr := PixelPointer(Bitmap);
+  for Y := 0 to Bitmap.Height - 1 do begin
+    for X := 0 to Bitmap.Width - 1 do begin
+      A := Ptr.Pixel^.A; //(Ptr.Pixel^.A + Pixel.A) shr 1;
+      R := (Ptr.Pixel^.R + Pixel.R) shr 1;
+      G := (Ptr.Pixel^.G + Pixel.G) shr 1;
+      B := (Ptr.Pixel^.B + Pixel.B) shr 1;
+      Ptr.Pixel^.ARGB := Color32(A, R, G, B);
+      Ptr.NextPixel;
+    end;
+    Ptr.NextLine;
+  end;
+  Bitmap.EndUpdate;
+end;
+
+function Color32(A, R, G, B: Byte): TColor32;
+begin
+  Result := ((A and $ff) shl 24) or ((R and $ff) shl 16) or
+    ((G and $ff) shl 8) or ((B and $ff) shl 0);
+end;
+
+function Color32ToPixel32(Color: TColor32): TPixel32;
+begin
+  Result.ARGB := Color;
+end;
+
+function Pixel32ToColor32(Color: TPixel32): TColor32;
+begin
+  Result := Color.ARGB;
+end;
+
 function PixelPointer(Bitmap: TRasterImage; BaseX: Integer;
   BaseY: Integer): TPixelPointer;