Changeset 522 for GraphicTest/Packages/Graphics32/GR32_OrdinalMaps.pas

Timestamp:

Apr 17, 2019, 10:42:18 AM (5 years ago)

Author:

chronos

Message:

• Modified: Updated Graphics32 library.

Location:

GraphicTest/Packages/Graphics32

Files:

• . (modified) (1 prop)
• GR32_OrdinalMaps.pas (modified) (18 diffs)

GraphicTest/Packages/Graphics32/GR32_OrdinalMaps.pas

@@ -54 +54 @@
     ctWeightedRGB);
 
+{$IFDEF FPC}
+  PInteger = ^Integer;
+{$ENDIF}
+
   TBooleanMap = class(TCustomMap)
   private
-    FBits: TArrayOfByte;
     function GetValue(X, Y: Integer): Boolean;
     procedure SetValue(X, Y: Integer; const Value: Boolean);
-    function GetBits: PByteArray;
   protected
+    FBits: PByteArray;
     procedure ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer); override;
   public
+    constructor Create; overload; override;
     destructor Destroy; override;
+
     function Empty: Boolean; override;
     procedure Clear(FillValue: Byte);
     procedure ToggleBit(X, Y: Integer);
+
     property Value[X, Y: Integer]: Boolean read GetValue write SetValue; default;
-    property Bits: PByteArray read GetBits;
+    property Bits: PByteArray read FBits;
   end;
 
   TByteMap = class(TCustomMap)
   private
-    FBits: TArrayOfByte;
     function GetValue(X, Y: Integer): Byte; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
     function GetValPtr(X, Y: Integer): PByte; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
     procedure SetValue(X, Y: Integer; Value: Byte); {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
-    function GetBits: PByteArray;
+    function GetScanline(Y: Integer): PByteArray;
   protected
+    FBits: PByteArray;
     procedure AssignTo(Dst: TPersistent); override;
     procedure ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer); override;
   public
+    constructor Create; overload; override;
     destructor Destroy; override;
+
     procedure Assign(Source: TPersistent); override;
-    function  Empty: Boolean; override;
+    function Empty: Boolean; override;
     procedure Clear(FillValue: Byte);
+
+    procedure Multiply(Value: Byte);
+    procedure Add(Value: Byte);
+    procedure Sub(Value: Byte);
+
     procedure ReadFrom(Source: TCustomBitmap32; Conversion: TConversionType);
     procedure WriteTo(Dest: TCustomBitmap32; Conversion: TConversionType); overload;
     procedure WriteTo(Dest: TCustomBitmap32; const Palette: TPalette32); overload;
-    property Bits: PByteArray read GetBits;
+
+    procedure DrawTo(Dest: TCustomBitmap32; X, Y: Integer; Color: TColor32); overload;
+    procedure DrawTo(Dest: TCustomBitmap32; Rect: TRect; Color: TColor32); overload;
+
+    procedure Downsample(Factor: Byte); overload;
+    procedure Downsample(Dest: TByteMap; Factor: Byte); overload;
+
+    procedure FlipHorz(Dst: TByteMap = nil);
+    procedure FlipVert(Dst: TByteMap = nil);
+    procedure Rotate90(Dst: TByteMap = nil);
+    procedure Rotate180(Dst: TByteMap = nil);
+    procedure Rotate270(Dst: TByteMap = nil);
+
+    property Bits: PByteArray read FBits;
+    property Scanline[Y: Integer]: PByteArray read GetScanline;
     property ValPtr[X, Y: Integer]: PByte read GetValPtr;
     property Value[X, Y: Integer]: Byte read GetValue write SetValue; default;
   end;
 
+  { TWordMap }
+
   TWordMap = class(TCustomMap)
   private
-    FBits: TArrayOfWord;
     function GetValPtr(X, Y: Integer): PWord; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
     function GetValue(X, Y: Integer): Word; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
     procedure SetValue(X, Y: Integer; const Value: Word); {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
-    function GetBits: PWordArray;
+    function GetScanline(Y: Integer): PWordArray;
   protected
+    FBits: PWordArray;
     procedure ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer); override;
   public
+    constructor Create; overload; override;
     destructor Destroy; override;
+
+    procedure Assign(Source: TPersistent); override;
     function Empty: Boolean; override;
     procedure Clear(FillValue: Word);
+
     property ValPtr[X, Y: Integer]: PWord read GetValPtr;
     property Value[X, Y: Integer]: Word read GetValue write SetValue; default;
-    property Bits: PWordArray read GetBits;
-  end;
+    property Bits: PWordArray read FBits;
+    property Scanline[Y: Integer]: PWordArray read GetScanline;
+  end;
+
+  { TIntegerMap }
 
   TIntegerMap = class(TCustomMap)
   private
-    FBits: TArrayOfInteger;
     function GetValPtr(X, Y: Integer): PInteger; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
     function GetValue(X, Y: Integer): Integer; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
     procedure SetValue(X, Y: Integer; const Value: Integer); {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
-    function GetBits: PIntegerArray;
+    function GetScanline(Y: Integer): PIntegerArray;
   protected
+    FBits: PIntegerArray;
     procedure ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer); override;
   public
+    constructor Create; overload; override;
     destructor Destroy; override;
+
+    procedure Assign(Source: TPersistent); override;
     function Empty: Boolean; override;
-    procedure Clear(FillValue: Integer);
+    procedure Clear(FillValue: Integer = 0);
+
     property ValPtr[X, Y: Integer]: PInteger read GetValPtr;
     property Value[X, Y: Integer]: Integer read GetValue write SetValue; default;
-    property Bits: PIntegerArray read GetBits;
-  end;
+    property Bits: PIntegerArray read FBits;
+    property Scanline[Y: Integer]: PIntegerArray read GetScanline;
+  end;
+
+  { TCardinalMap }
+
+  TCardinalMap = class(TCustomMap)
+  private
+    function GetValPtr(X, Y: Cardinal): PCardinal; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
+    function GetValue(X, Y: Cardinal): Cardinal; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
+    procedure SetValue(X, Y: Cardinal; const Value: Cardinal); {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
+    function GetScanline(Y: Integer): PCardinalArray;
+  protected
+    FBits: PCardinalArray;
+    procedure ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer); override;
+  public
+    constructor Create; overload; override;
+    destructor Destroy; override;
+
+    procedure Assign(Source: TPersistent); override;
+    function Empty: Boolean; override;
+    procedure Clear(FillValue: Cardinal = 0);
+
+    property ValPtr[X, Y: Cardinal]: PCardinal read GetValPtr;
+    property Value[X, Y: Cardinal]: Cardinal read GetValue write SetValue; default;
+    property Bits: PCardinalArray read FBits;
+    property Scanline[Y: Integer]: PCardinalArray read GetScanline;
+  end;
+
+  { TFloatMap }
 
   TFloatMap = class(TCustomMap)
   private
-    FBits: TArrayOfFloat;
-    function GetValPtr(X, Y: Integer): PFloat; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
+    function GetValPtr(X, Y: Integer): GR32.PFloat; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
     function GetValue(X, Y: Integer): TFloat; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
     procedure SetValue(X, Y: Integer; const Value: TFloat); {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
-    function GetBits: PFloatArray;
+    function GetScanline(Y: Integer): PFloatArray;
   protected
+    FBits: PFloatArray;
     procedure ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer); override;
   public
+    constructor Create; overload; override;
     destructor Destroy; override;
+
+    procedure Assign(Source: TPersistent); override;
     function Empty: Boolean; override;
     procedure Clear; overload;
     procedure Clear(FillValue: TFloat); overload;
+
     property ValPtr[X, Y: Integer]: PFloat read GetValPtr;
     property Value[X, Y: Integer]: TFloat read GetValue write SetValue; default;
-    property Bits: PFloatArray read GetBits;
-  end;
+    property Bits: PFloatArray read FBits;
+    property Scanline[Y: Integer]: PFloatArray read GetScanline;
+  end;
+
+{$IFDEF COMPILER2010}
+
+  { TGenericMap<T> }
+
+  TGenericMap<T> = class(TCustomMap)
+  private
+    function GetValue(X, Y: Integer): T; {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
+    procedure SetValue(X, Y: Integer; const Value: T); {$IFDEF INLININGSUPPORTED} inline; {$ENDIF}
+  protected
+    FBits: Pointer;
+    procedure ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer); override;
+  public
+    constructor Create; overload; override;
+    destructor Destroy; override;
+
+    procedure Assign(Source: TPersistent); override;
+    function Empty: Boolean; override;
+    procedure Clear; overload;
+    procedure Clear(FillValue: T); overload;
+
+    property Value[X, Y: Integer]: T read GetValue write SetValue; default;
+    property Bits: Pointer read FBits;
+  end;
+
+{$ENDIF}
 
 implementation
 
 uses
-  GR32_LowLevel;
+  Math, GR32_LowLevel, GR32_Blend, GR32_Resamplers;
+
+function Bytes(Bits: Integer): Integer;
+begin
+  Result := (Bits - 1) shr 3 + 1;
+end;
 
 { TBooleanMap }
 
-function Bytes(Bits: Integer): Integer;
-begin
-  Result := (Bits - 1) shr 3 + 1;
+constructor TBooleanMap.Create;
+begin
+  FreeMem(FBits);
+  inherited Create;
 end;
 
@@ -164 +269 @@
   NewHeight: Integer);
 begin
-  SetLength(FBits, Bytes(NewWidth * NewHeight));
+  ReallocMem(FBits, Bytes(NewWidth * NewHeight));
   Width := NewWidth;
   Height := NewHeight;
@@ -171 +276 @@
 procedure TBooleanMap.Clear(FillValue: Byte);
 begin
-  FillChar(FBits[0], Bytes(Width * Height), FillValue);
+  FillChar(FBits^, Bytes(Width * Height), FillValue);
 end;
 
@@ -185 +290 @@
 end;
 
-function TBooleanMap.GetBits: PByteArray;
-begin
-  Result := @FBits[0];
-end;
-
 function TBooleanMap.GetValue(X, Y: Integer): Boolean;
 begin
   X := X + Y * Width;
-  Result := FBits[X shr 3] and (1 shl (X and 7)) <> 0; //Boolean(FBits[X shr 3] and (1 shl (X and 7)));
+  Result := FBits^[X shr 3] and (1 shl (X and 7)) <> 0; //Boolean(FBits^[X shr 3] and (1 shl (X and 7)));
 end;
 
@@ -200 +300 @@
   X := Y * Width + X;
   if Value then
-    FBits[X shr 3] := FBits[X shr 3] or (1 shl (X and 7))
+    FBits^[X shr 3] := FBits^[X shr 3] or (1 shl (X and 7))
   else
-    FBits[X shr 3] := FBits[X shr 3] and ((1 shl (X and 7)) xor $FF);
+    FBits^[X shr 3] := FBits^[X shr 3] and ((1 shl (X and 7)) xor $FF);
 end;
 
@@ -208 +308 @@
 begin
   X := Y * Width + X;
-  FBits[X shr 3] := FBits[X shr 3] xor (1 shl (X and 7));
+  FBits^[X shr 3] := FBits^[X shr 3] xor (1 shl (X and 7));
 end;
 
 { TByteMap }
+
+constructor TByteMap.Create;
+begin
+  FBits := nil;
+  inherited Create;
+end;
+
+destructor TByteMap.Destroy;
+begin
+  FreeMem(FBits);
+  inherited;
+end;
+
+procedure TByteMap.Downsample(Factor: Byte);
+begin
+  // downsample inplace
+  case Factor of
+    2:
+      DownsampleByteMap2x(Self, Self);
+    3:
+      DownsampleByteMap3x(Self, Self);
+    4:
+      DownsampleByteMap4x(Self, Self);
+    6:
+      begin
+        DownsampleByteMap3x(Self, Self);
+        DownsampleByteMap2x(Self, Self);
+      end;
+    8:
+      begin
+        DownsampleByteMap4x(Self, Self);
+        DownsampleByteMap2x(Self, Self);
+      end;
+    9:
+      begin
+        DownsampleByteMap3x(Self, Self);
+        DownsampleByteMap3x(Self, Self);
+      end;
+    12:
+      begin
+        DownsampleByteMap4x(Self, Self);
+        DownsampleByteMap3x(Self, Self);
+      end;
+    16:
+      begin
+        DownsampleByteMap4x(Self, Self);
+        DownsampleByteMap4x(Self, Self);
+      end;
+    18:
+      begin
+        DownsampleByteMap3x(Self, Self);
+        DownsampleByteMap3x(Self, Self);
+        DownsampleByteMap2x(Self, Self);
+      end;
+    24:
+      begin
+        DownsampleByteMap4x(Self, Self);
+        DownsampleByteMap3x(Self, Self);
+        DownsampleByteMap2x(Self, Self);
+      end;
+    27:
+      begin
+        DownsampleByteMap3x(Self, Self);
+        DownsampleByteMap3x(Self, Self);
+        DownsampleByteMap3x(Self, Self);
+      end;
+    32:
+      begin
+        DownsampleByteMap4x(Self, Self);
+        DownsampleByteMap4x(Self, Self);
+        DownsampleByteMap2x(Self, Self);
+      end;
+  end;
+end;
+
+procedure TByteMap.Downsample(Dest: TByteMap; Factor: Byte);
+
+  procedure DownsampleAndMove;
+  var
+    Temp: TByteMap;
+    Y: Integer;
+  begin
+    // clone destination and downsample inplace
+    Temp := TByteMap.Create;
+    Temp.Assign(Self);
+    Temp.Downsample(Factor);
+
+    // copy downsampled result
+    Dest.SetSize(Width div Factor, Height div Factor);
+    for Y := 0 to Dest.Height - 1 do
+      Move(Temp.Scanline[Y]^, Dest.Scanline[Y]^, Dest.Width);
+  end;
+
+begin
+  // downsample directly
+  if (Dest = Self) or not (Factor in [2, 3, 4]) then
+  begin
+    DownsampleAndMove;
+    Exit;
+  end;
+
+  case Factor of
+    2:
+      begin
+        Dest.SetSize(Width div 2, Height div 2);
+        DownsampleByteMap2x(Self, Dest);
+      end;
+    3:
+      begin
+        // downsample directly
+        Dest.SetSize(Width div 3, Height div 3);
+        DownsampleByteMap3x(Self, Dest);
+      end;
+    4:
+      begin
+        // downsample directly
+        Dest.SetSize(Width div 4, Height div 4);
+        DownsampleByteMap4x(Self, Dest);
+      end;
+  end;
+end;
 
 procedure TByteMap.Assign(Source: TPersistent);
@@ -240 +461 @@
 procedure TByteMap.ChangeSize(var Width, Height: Integer; NewWidth, NewHeight: Integer);
 begin
-  SetLength(FBits, NewWidth * NewHeight);
+  ReallocMem(FBits, NewWidth * NewHeight);
   Width := NewWidth;
   Height := NewHeight;
@@ -247 +468 @@
 procedure TByteMap.Clear(FillValue: Byte);
 begin
-  FillChar(Bits[0], Width * Height, FillValue);
+  FillChar(Bits^, Width * Height, FillValue);
   Changed;
-end;
-
-destructor TByteMap.Destroy;
-begin
-  FBits := nil;
-  inherited;
 end;
 
@@ -263 +478 @@
 end;
 
-function TByteMap.GetBits: PByteArray;
-begin
-  Result := @FBits[0];
+procedure TByteMap.FlipHorz(Dst: TByteMap);
+var
+  i, j: Integer;
+  P1, P2: PByte;
+  tmp: Byte;
+  W, W2: Integer;
+begin
+  W := Width;
+  if (Dst = nil) or (Dst = Self) then
+  begin
+    { In-place flipping }
+    P1 := PByte(Bits);
+    P2 := P1;
+    Inc(P2, Width - 1);
+    W2 := Width shr 1;
+    for J := 0 to Height - 1 do
+    begin
+      for I := 0 to W2 - 1 do
+      begin
+        tmp := P1^;
+        P1^ := P2^;
+        P2^ := tmp;
+        Inc(P1);
+        Dec(P2);
+      end;
+      Inc(P1, W - W2);
+      Inc(P2, W + W2);
+    end;
+    Changed;
+  end
+  else
+  begin
+    { Flip to Dst }
+    Dst.BeginUpdate;
+    Dst.SetSize(W, Height);
+    P1 := PByte(Bits);
+    P2 := PByte(Dst.Bits);
+    Inc(P2, W - 1);
+    for J := 0 to Height - 1 do
+    begin
+      for I := 0 to W - 1 do
+      begin
+        P2^ := P1^;
+        Inc(P1);
+        Dec(P2);
+      end;
+      Inc(P2, W shl 1);
+    end;
+    Dst.EndUpdate;
+    Dst.Changed;
+  end;
+end;
+
+procedure TByteMap.FlipVert(Dst: TByteMap);
+var
+  J, J2: Integer;
+  Buffer: PByteArray;
+  P1, P2: PByte;
+begin
+  if (Dst = nil) or (Dst = Self) then
+  begin
+    { in-place }
+    J2 := Height - 1;
+    GetMem(Buffer, Width);
+    for J := 0 to Height div 2 - 1 do
+    begin
+      P1 := PByte(ScanLine[J]);
+      P2 := PByte(ScanLine[J2]);
+      Move(P1^, Buffer^, Width);
+      Move(P2^, P1^, Width);
+      Move(Buffer^, P2^, Width);
+      Dec(J2);
+    end;
+    FreeMem(Buffer);
+    Changed;
+  end
+  else
+  begin
+    Dst.SetSize(Width, Height);
+    J2 := Height - 1;
+    for J := 0 to Height - 1 do
+    begin
+      Move(ScanLine[J]^, Dst.ScanLine[J2]^, Width);
+      Dec(J2);
+    end;
+    Dst.Changed;
+  end;
+end;
+
+function TByteMap.GetScanline(Y: Integer): PByteArray;
+begin
+  Result := @FBits^[Y * Width];
 end;
 
 function TByteMap.GetValPtr(X, Y: Integer): PByte;
 begin
-  Result := @FBits[X + Y * Width];
+  Result := @FBits^[X + Y * Width];
 end;
 
 function TByteMap.GetValue(X, Y: Integer): Byte;
 begin
-  Result := FBits[X + Y * Width];
+  Result := FBits^[X + Y * Width];
+end;
+
+procedure TByteMap.Multiply(Value: Byte);
+var
+  Index: Integer;
+begin
+  for Index := 0 to FWidth * FHeight - 1 do
+    FBits^[Index] := ((FBits^[Index] * Value + $80) shr 8);
+end;
+
+procedure TByteMap.Add(Value: Byte);
+var
+  Index: Integer;
+begin
+  for Index := 0 to FWidth * FHeight - 1 do
+    FBits^[Index] := Min(FBits^[Index] + Value, 255);
+end;
+
+procedure TByteMap.Sub(Value: Byte);
+var
+  Index: Integer;
+begin
+  for Index := 0 to FWidth * FHeight - 1 do
+    FBits^[Index] := Max(FBits^[Index] + Value, 0);
 end;
 
@@ -295 +623 @@
     SrcC := Source.PixelPtr[0, 0];
     SrcB := Pointer(SrcC);
-    DstB := @FBits[0];
+    DstB := @FBits^;
     case Conversion of
 
@@ -371 +699 @@
 end;
 
+procedure TByteMap.Rotate180(Dst: TByteMap);
+var
+  Src: PByteArray;
+  S, D: PByte;
+  X, Y: Integer;
+  T: Byte;
+begin
+  if (Dst = nil) or (Dst = Self) then
+  begin
+    for Y := 0 to FHeight - 1 do
+    begin
+      Src := Scanline[Y];
+      for X := 0 to (FWidth div 2) - 1 do
+      begin
+        T := Src^[X];
+        Src^[X] := Src^[Width - 1 - X];
+        Src^[Width - 1 - X] := T;
+      end;
+    end;
+  end
+  else
+  begin
+    S := PByte(FBits);
+    D := PByte(@Dst.Bits[FHeight * FWidth - 1]);
+    for X := 0 to FHeight * FWidth - 1 do
+    begin
+      D^ := S^;
+      Dec(D);
+      Inc(S);
+    end;
+  end;
+end;
+
+procedure TByteMap.Rotate270(Dst: TByteMap);
+var
+  Src: PByteArray;
+  Current: PByte;
+  X, Y, W, H: Integer;
+begin
+  if (Dst = nil) or (Dst = Self) then
+  begin
+    W := FWidth;
+    H := FHeight;
+
+     // inplace replace
+    GetMem(Src, W * H);
+
+    // copy bits
+    Move(Bits^, Src^, W * H);
+
+    SetSize(H, W);
+
+    Current := PByte(Src);
+    for Y := 0 to H - 1 do
+      for X := 0 to W - 1 do
+      begin
+        Bits^[(W - 1 - X) * H + Y] := Current^;
+        Inc(Current);
+      end;
+
+    // dispose old data pointer
+    FreeMem(Src);
+  end
+  else
+  begin
+    // exchange dimensions
+    Dst.SetSize(Height, Width);
+
+    for Y := 0 to FHeight - 1 do
+    begin
+      Src := Scanline[Y];
+      for X := 0 to FWidth - 1 do
+        Dst.Bits^[X * FHeight + FHeight - 1 - Y] := Src^[X];
+    end;
+  end;
+end;
+
+procedure TByteMap.Rotate90(Dst: TByteMap);
+var
+  Src: PByteArray;
+  Current: PByte;
+  X, Y, W, H: Integer;
+begin
+  if (Dst = nil) or (Dst = Self) then
+  begin
+    W := FWidth;
+    H := FHeight;
+
+     // inplace replace
+    GetMem(Src, W * H);
+
+    // copy bits
+    Move(Bits^, Src^, W * H);
+
+    SetSize(H, W);
+
+    Current := PByte(Src);
+    for Y := 0 to H - 1 do
+      for X := 0 to W - 1 do
+      begin
+        Bits^[X * H + (H - 1 - Y)] := Current^;
+        Inc(Current);
+      end;
+
+    // dispose old data pointer
+    FreeMem(Src);
+  end
+  else
+  begin
+    // exchange dimensions
+    Dst.SetSize(Height, Width);
+
+    for Y := 0 to FHeight - 1 do
+    begin
+      Src := Scanline[Y];
+      for X := 0 to FWidth - 1 do
+        Dst.Bits^[(FWidth - 1 - X) * FHeight + Y] := Src^[X];
+    end;
+  end;
+end;
+
 procedure TByteMap.SetValue(X, Y: Integer; Value: Byte);
 begin
-  FBits[X + Y * Width] := Value;
+  FBits^[X + Y * Width] := Value;
 end;
 
@@ -394 +843 @@
     DstC := Dest.PixelPtr[0, 0];
     DstB := Pointer(DstC);
-    SrcB := @FBits[0];
+    SrcB := @FBits^;
     case Conversion of
 
@@ -472 +921 @@
     N := W * H - 1;
     DstC := Dest.PixelPtr[0, 0];
-    SrcB := @FBits[0];
+    SrcB := @FBits^;
 
     for I := 0 to N do
@@ -485 +934 @@
   end;
 end;
-  
+
+procedure TByteMap.DrawTo(Dest: TCustomBitmap32; X, Y: Integer; Color: TColor32);
+var
+  ClipRect: TRect;
+  IX, IY: Integer;
+  RGB: Cardinal;
+  NewColor: TColor32;
+  ScnLn: PColor32Array;
+  ByteLine: PByteArray;
+  Alpha: Byte;
+begin
+  with ClipRect do
+  begin
+    Left := X;
+    if Left < 0 then
+      Left := 0;
+    Top := Y;
+    if Top < 0 then
+      Top := 0;
+    Right := X + Self.Width;
+    if Right > Self.Width then
+      Right := Self.Width;
+    Bottom := Y + Self.Height;
+    if Bottom > Self.Height then
+      Bottom := Self.Height;
+
+    // split RGB and alpha
+    RGB := Color and $FFFFFF;
+    Alpha := Color shr 24;
+
+    // blend scanlines
+    for IY := Top to Bottom - 1 do
+    begin
+      ScnLn := Dest.ScanLine[IY];
+      ByteLine := Self.ScanLine[IY - Y];
+      for IX := Left to Right - 1 do
+      begin
+        NewColor := (((ByteLine^[IX - X] * Alpha) shl 16) and $FF000000) or RGB;
+        MergeMem(NewColor, ScnLn^[IX]);
+      end;
+    end;
+    EMMS;
+  end;
+end;
+
+procedure TByteMap.DrawTo(Dest: TCustomBitmap32; Rect: TRect; Color: TColor32);
+var
+  ClipRect: TRect;
+  IX, IY: Integer;
+  RGB: Cardinal;
+  NewColor: TColor32;
+  ScnLn: PColor32Array;
+  ByteLine: PByteArray;
+  Alpha: Byte;
+begin
+  with ClipRect do
+  begin
+    Left := Rect.Left;
+    if Left < 0 then
+      Left := 0;
+    Top := Rect.Top;
+    if Top < 0 then
+      Top := 0;
+    Right := Math.Min(Rect.Left + Self.Width, Rect.Right);
+    Bottom := Math.Min(Rect.Top + Self.Height, Rect.Bottom);
+
+    // split RGB and alpha
+    RGB := Color and $FFFFFF;
+    Alpha := Color shr 24;
+
+    // blend scanlines
+    for IY := Top to Bottom - 1 do
+    begin
+      ScnLn := Dest.ScanLine[IY];
+      ByteLine := Self.ScanLine[IY - Rect.Top];
+      for IX := Left to Right - 1 do
+      begin
+        NewColor := (((ByteLine^[IX - Rect.Left] * Alpha) shl 16) and $FF000000) or RGB;
+        MergeMem(NewColor, ScnLn^[IX]);
+      end;
+    end;
+    EMMS;
+  end;
+end;
+
+
 { TWordMap }
+
+constructor TWordMap.Create;
+begin
+  FBits := nil;
+  inherited Create;
+end;
+
+destructor TWordMap.Destroy;
+begin
+  FreeMem(FBits);
+  inherited;
+end;
 
 procedure TWordMap.ChangeSize(var Width, Height: Integer; NewWidth,
   NewHeight: Integer);
 begin
-  SetLength(FBits, NewWidth * NewHeight);
+  ReallocMem(FBits, NewWidth * NewHeight * SizeOf(Word));
   Width := NewWidth;
   Height := NewHeight;
@@ -498 +1044 @@
 procedure TWordMap.Clear(FillValue: Word);
 begin
-  FillWord(FBits[0], Width * Height, FillValue);
+  FillWord(FBits^, Width * Height, FillValue);
   Changed;
 end;
 
-destructor TWordMap.Destroy;
+procedure TWordMap.Assign(Source: TPersistent);
+begin
+  BeginUpdate;
+    try
+      if Source is TWordMap then
+      begin
+        inherited SetSize(TWordMap(Source).Width, TWordMap(Source).Height);
+        Move(TWordMap(Source).Bits[0], Bits[0], Width * Height * SizeOf(Word));
+      end
+      //else if Source is TBitmap32 then
+      //  ReadFrom(TBitmap32(Source), ctWeightedRGB)
+      else
+        inherited;
+    finally
+      EndUpdate;
+      Changed;
+    end;
+end;
+
+function TWordMap.Empty: Boolean;
+begin
+  Result := not Assigned(FBits);
+end;
+
+function TWordMap.GetScanline(Y: Integer): PWordArray;
+begin
+  Result := @FBits^[Y * Width];
+end;
+
+function TWordMap.GetValPtr(X, Y: Integer): PWord;
+begin
+  Result := @FBits^[X + Y * Width];
+end;
+
+function TWordMap.GetValue(X, Y: Integer): Word;
+begin
+  Result := FBits^[X + Y * Width];
+end;
+
+procedure TWordMap.SetValue(X, Y: Integer; const Value: Word);
+begin
+  FBits^[X + Y * Width] := Value;
+end;
+
+
+{ TIntegerMap }
+
+constructor TIntegerMap.Create;
 begin
   FBits := nil;
+  inherited Create;
+end;
+
+destructor TIntegerMap.Destroy;
+begin
+  FreeMem(FBits);
   inherited;
 end;
-
-function TWordMap.Empty: Boolean;
-begin
-  Result := not Assigned(FBits);
-end;
-
-function TWordMap.GetBits: PWordArray;
-begin
-  Result := @FBits[0];
-end;
-
-function TWordMap.GetValPtr(X, Y: Integer): PWord;
-begin
-  Result := @FBits[X + Y * Width];
-end;
-
-function TWordMap.GetValue(X, Y: Integer): Word;
-begin
-  Result := FBits[X + Y * Width];
-end;
-
-procedure TWordMap.SetValue(X, Y: Integer; const Value: Word);
-begin
-  FBits[X + Y * Width] := Value;
-end;
-
-{ TIntegerMap }
 
 procedure TIntegerMap.ChangeSize(var Width, Height: Integer; NewWidth,
   NewHeight: Integer);
 begin
-  SetLength(FBits, NewWidth * NewHeight);
+  ReallocMem(FBits, NewWidth * NewHeight * SizeOf(Integer));
   Width := NewWidth;
   Height := NewHeight;
@@ -545 +1117 @@
 procedure TIntegerMap.Clear(FillValue: Integer);
 begin
-  FillLongword(FBits[0], Width * Height, FillValue);
+  FillLongword(FBits^, Width * Height, FillValue);
   Changed;
 end;
 
-destructor TIntegerMap.Destroy;
+procedure TIntegerMap.Assign(Source: TPersistent);
+begin
+  BeginUpdate;
+  try
+    if Source is TIntegerMap then
+    begin
+      inherited SetSize(TIntegerMap(Source).Width, TIntegerMap(Source).Height);
+      Move(TIntegerMap(Source).Bits[0], Bits[0], Width * Height * SizeOf(Integer));
+    end
+    //else if Source is TBitmap32 then
+    //  ReadFrom(TBitmap32(Source), ctWeightedRGB)
+    else
+      inherited;
+  finally
+    EndUpdate;
+    Changed;
+  end;
+end;
+
+function TIntegerMap.Empty: Boolean;
+begin
+  Result := not Assigned(FBits);
+end;
+
+function TIntegerMap.GetScanline(Y: Integer): PIntegerArray;
+begin
+  Result := @FBits^[Y * Width];
+end;
+
+function TIntegerMap.GetValPtr(X, Y: Integer): PInteger;
+begin
+  Result := @FBits^[X + Y * Width];
+end;
+
+function TIntegerMap.GetValue(X, Y: Integer): Integer;
+begin
+  Result := FBits^[X + Y * Width];
+end;
+
+procedure TIntegerMap.SetValue(X, Y: Integer; const Value: Integer);
+begin
+  FBits^[X + Y * Width] := Value;
+end;
+
+
+{ TCardinalMap }
+
+constructor TCardinalMap.Create;
 begin
   FBits := nil;
+  inherited Create;
+end;
+
+destructor TCardinalMap.Destroy;
+begin
+  FreeMem(FBits);
   inherited;
 end;
 
-function TIntegerMap.Empty: Boolean;
+procedure TCardinalMap.Assign(Source: TPersistent);
+begin
+  BeginUpdate;
+  try
+    if Source is TCardinalMap then
+    begin
+      inherited SetSize(TCardinalMap(Source).Width, TCardinalMap(Source).Height);
+      Move(TCardinalMap(Source).Bits[0], Bits[0], Width * Height * SizeOf(Cardinal));
+    end
+    //else if Source is TBitmap32 then
+    //  ReadFrom(TBitmap32(Source), ctWeightedRGB)
+    else
+      inherited;
+  finally
+    EndUpdate;
+    Changed;
+  end;
+end;
+
+procedure TCardinalMap.ChangeSize(var Width, Height: Integer; NewWidth,
+  NewHeight: Integer);
+begin
+  ReallocMem(FBits, NewWidth * NewHeight * SizeOf(Cardinal));
+  Width := NewWidth;
+  Height := NewHeight;
+end;
+
+procedure TCardinalMap.Clear(FillValue: Cardinal);
+begin
+  FillLongword(FBits^, Width * Height, FillValue);
+  Changed;
+end;
+
+function TCardinalMap.Empty: Boolean;
 begin
   Result := not Assigned(FBits);
 end;
 
-function TIntegerMap.GetBits: PIntegerArray;
-begin
-  Result := @FBits[0];
-end;
-
-function TIntegerMap.GetValPtr(X, Y: Integer): PInteger;
-begin
-  Result := @FBits[X + Y * Width];
-end;
-
-function TIntegerMap.GetValue(X, Y: Integer): Integer;
-begin
-  Result := FBits[X + Y * Width];
-end;
-
-procedure TIntegerMap.SetValue(X, Y: Integer; const Value: Integer);
-begin
-  FBits[X + Y * Width] := Value;
-end;
+function TCardinalMap.GetScanline(Y: Integer): PCardinalArray;
+begin
+  Result := @FBits^[Y * Width];
+end;
+
+function TCardinalMap.GetValPtr(X, Y: Cardinal): PCardinal;
+begin
+  Result := @FBits^[X + Y * Cardinal(Width)];
+end;
+
+function TCardinalMap.GetValue(X, Y: Cardinal): Cardinal;
+begin
+  Result := FBits^[X + Y * Cardinal(Width)];
+end;
+
+procedure TCardinalMap.SetValue(X, Y: Cardinal; const Value: Cardinal);
+begin
+  FBits^[X + Y * Cardinal(Width)] := Value;
+end;
+
 
 { TFloatMap }
+
+constructor TFloatMap.Create;
+begin
+  FBits := nil;
+  inherited Create;
+end;
+
+destructor TFloatMap.Destroy;
+begin
+  FreeMem(FBits);
+  inherited;
+end;
+
+procedure TFloatMap.Assign(Source: TPersistent);
+begin
+  BeginUpdate;
+  try
+    if Source is TFloatMap then
+    begin
+      inherited SetSize(TFloatMap(Source).Width, TFloatMap(Source).Height);
+      Move(TFloatMap(Source).Bits[0], Bits[0], Width * Height * SizeOf(TFloat));
+    end
+    //else if Source is TBitmap32 then
+    //  ReadFrom(TBitmap32(Source), ctWeightedRGB)
+    else
+      inherited;
+  finally
+    EndUpdate;
+    Changed;
+  end;
+end;
 
 procedure TFloatMap.ChangeSize(var Width, Height: Integer; NewWidth,
   NewHeight: Integer);
 begin
-  SetLength(FBits, NewWidth * NewHeight);
+  ReallocMem(FBits, NewWidth * NewHeight * SizeOf(TFloat));
   Width := NewWidth;
   Height := NewHeight;
@@ -592 +1282 @@
 procedure TFloatMap.Clear;
 begin
-  FillChar(FBits[0], Width * Height * SizeOf(TFloat), 0);
+  FillChar(FBits^, Width * Height * SizeOf(TFloat), 0);
   Changed;
 end;
@@ -601 +1291 @@
 begin
   for Index := 0 to Width * Height - 1 do
-    FBits[Index] := FillValue;
+    FBits^[Index] := FillValue;
   Changed;
 end;
 
-destructor TFloatMap.Destroy;
+function TFloatMap.Empty: Boolean;
+begin
+  Result := not Assigned(FBits);
+end;
+
+function TFloatMap.GetScanline(Y: Integer): PFloatArray;
+begin
+  Result := @FBits^[Y * Width];
+end;
+
+function TFloatMap.GetValPtr(X, Y: Integer): GR32.PFloat;
+begin
+  Result := @FBits^[X + Y * Width];
+end;
+
+function TFloatMap.GetValue(X, Y: Integer): TFloat;
+begin
+  Result := FBits^[X + Y * Width];
+end;
+
+procedure TFloatMap.SetValue(X, Y: Integer; const Value: TFloat);
+begin
+  FBits^[X + Y * Width] := Value;
+end;
+
+
+{$IFDEF COMPILER2010}
+
+{ TGenericMap<T> }
+
+constructor TGenericMap<T>.Create;
 begin
   FBits := nil;
+  inherited Create;
+end;
+
+destructor TGenericMap<T>.Destroy;
+begin
+  FreeMem(FBits);
   inherited;
 end;
 
-function TFloatMap.Empty: Boolean;
+procedure TGenericMap<T>.Assign(Source: TPersistent);
+begin
+  BeginUpdate;
+  try
+(*
+    if Source is TFloatMap then
+    begin
+      inherited SetSize(TFloatMap(Source).Width, TFloatMap(Source).Height);
+      Move(TFloatMap(Source).Bits[0], Bits[0], Width * Height * SizeOf(TFloat));
+    end
+    //else if Source is TBitmap32 then
+    //  ReadFrom(TBitmap32(Source), ctWeightedRGB)
+    else
+      inherited;
+*)
+  finally
+    EndUpdate;
+    Changed;
+  end;
+end;
+
+procedure TGenericMap<T>.ChangeSize(var Width, Height: Integer; NewWidth,
+  NewHeight: Integer);
+begin
+  ReallocMem(FBits, NewWidth * NewHeight * SizeOf(T));
+  Width := NewWidth;
+  Height := NewHeight;
+end;
+
+procedure TGenericMap<T>.Clear(FillValue: T);
+var
+  Index: Integer;
+begin
+  for Index := 0 to Width * Height - 1 do
+    Move(FillValue, PByte(FBits)[Index], SizeOf(T));
+  Changed;
+end;
+
+procedure TGenericMap<T>.Clear;
+begin
+  FillChar(FBits^, Width * Height * SizeOf(T), 0);
+  Changed;
+end;
+
+function TGenericMap<T>.Empty: Boolean;
 begin
   Result := not Assigned(FBits);
 end;
 
-function TFloatMap.GetBits: PFloatArray;
-begin
-  Result := @FBits[0];
-end;
-
-function TFloatMap.GetValPtr(X, Y: Integer): PFloat;
-begin
-  Result := @FBits[X + Y * Width];
-end;
-
-function TFloatMap.GetValue(X, Y: Integer): TFloat;
-begin
-  Result := FBits[X + Y * Width];
-end;
-
-procedure TFloatMap.SetValue(X, Y: Integer; const Value: TFloat);
-begin
-  FBits[X + Y * Width] := Value;
-end;
+function TGenericMap<T>.GetValue(X, Y: Integer): T;
+begin
+  Move(PByte(FBits)[(X + Y * Width) * SizeOf(T)], Result, SizeOf(T));
+end;
+
+procedure TGenericMap<T>.SetValue(X, Y: Integer; const Value: T);
+begin
+  Move(Value, PByte(FBits)[(X + Y * Width) * SizeOf(T)], SizeOf(T));
+end;
+
+{$ENDIF}
 
 end.