瀏覽代碼

Remove duplicate code.

Martijn Laan 1 月之前
父節點
當前提交
d137080205
共有 2 個文件被更改,包括 230 次插入274 次删除
  1. 31 167
      Components/BitmapButton.pas
  2. 199 107
      Components/BitmapImage.pas

+ 31 - 167
Components/BitmapButton.pas

@@ -18,25 +18,18 @@ unit BitmapButton;
 interface
 
 uses
-  Windows, Messages, Controls, Graphics, Classes;
+  Windows, Messages, Controls, Graphics, Classes,
+  BitmapImage;
 
 type
   TPaintEvent = procedure(Sender: TObject; Canvas: TCanvas; var ARect: TRect) of object;
 
   TBitmapButton = class(TCustomControl)
   private
-    FAutoSize: Boolean;
-    FBackColor: TColor;
-    FBitmap: TBitmap;
-    FCenter: Boolean;
+    FImpl: TBitmapImageImplementation;
     FOnClick: TNotifyEvent;
     FOnDblClick: TNotifyEvent;
     FOnPaint: TPaintEvent;
-    FReplaceColor: TColor;
-    FReplaceWithColor: TColor;
-    FStretch: Boolean;
-    FStretchedBitmap: TBitmap;
-    FStretchedBitmapValid: Boolean;
     procedure BitmapChanged(Sender: TObject);
     procedure SetBackColor(Value: TColor);
     procedure SetBitmap(Value: TBitmap);
@@ -59,18 +52,18 @@ type
   published
     property Align;
     property Anchors;
-    property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
-    property BackColor: TColor read FBackColor write SetBackColor default clNone;
+    property AutoSize: Boolean read FImpl.AutoSize write SetAutoSize default False;
+    property BackColor: TColor read FImpl.BackColor write SetBackColor default clNone;
     property Caption;
-    property Center: Boolean read FCenter write SetCenter default False;
+    property Center: Boolean read FImpl.Center write SetCenter default False;
     property Enabled;
     property ParentShowHint;
-    property Bitmap: TBitmap read FBitmap write SetBitmap;
+    property Bitmap: TBitmap read FImpl.Bitmap write SetBitmap;
     property PopupMenu;
     property ShowHint;
-    property Stretch: Boolean read FStretch write SetStretch default False;
-    property ReplaceColor: TColor read FReplaceColor write SetReplaceColor default clNone;
-    property ReplaceWithColor: TColor read FReplaceWithColor write SetReplaceWithColor default clNone;
+    property Stretch: Boolean read FImpl.Stretch write SetStretch default False;
+    property ReplaceColor: TColor read FImpl.ReplaceColor write SetReplaceColor default clNone;
+    property ReplaceWithColor: TColor read FImpl.ReplaceWithColor write SetReplaceWithColor default clNone;
     property TabOrder;
     property TabStop default True;
     property Visible;
@@ -93,57 +86,20 @@ end;
 
 function TBitmapButton.InitializeFromIcon(const Instance: HINST; const Name: PChar; const BkColor: TColor; const AscendingTrySizes: array of Integer): Boolean;
 begin
-  { Find the largest regular icon size smaller than the scaled image }
-  var Size := 0;
-  for var I := Length(AscendingTrySizes)-1 downto 0 do begin
-    if (Width >= AscendingTrySizes[I]) and (Height >= AscendingTrySizes[I]) then begin
-      Size := AscendingTrySizes[I];
-      Break;
-    end;
-  end;
-  if Size = 0 then
-    Size := Min(Width, Height);
-
-  { Load the desired icon }
-  var Flags := LR_DEFAULTCOLOR;
-  if Instance = 0 then
-    Flags := Flags or LR_LOADFROMFILE;
-  var Handle := LoadImage(Instance, Name, IMAGE_ICON, Size, Size, Flags);
-  if Handle = 0 then
-    Handle := LoadImage(Instance, Name, IMAGE_ICON, 0, 0, Flags);
-  if Handle <> 0 then begin
-    const Icon = TIcon.Create;
-    try
-      Icon.Handle := Handle;
-
-      { Set sizes (overrides any scaling) }
-      Width := Icon.Width;
-      Height := Icon.Height;
-
-      { Draw icon into bitmap }
-      Bitmap.Canvas.Brush.Color := BkColor;
-      Bitmap.Width := Width;
-      Bitmap.Height := Height;
-      Bitmap.Canvas.Draw(0, 0, Icon);
-
-      Result := True;
-    finally
-      Icon.Free;
-    end;
-  end else
-    Result := False;
+  Result := FImpl.InitializeFromIcon(HInstance, Name, BkColor, AscendingTrySizes);
+end;
+
+procedure TBitmapButton.BitmapChanged(Sender: TObject);
+begin
+  FImpl.BitmapChanged(Sender)
 end;
 
 constructor TBitmapButton.Create(AOwner: TComponent);
 begin
   inherited;
   ControlStyle := ControlStyle + [csReplicatable];
-  FBackColor := clNone;
-  FBitmap := TBitmap.Create;
-  FBitmap.OnChange := BitmapChanged;
-  FReplaceColor := clNone;
-  FReplaceWithColor := clNone;
-  FStretchedBitmap := TBitmap.Create;
+  FImpl := Default(TBitmapImageImplementation);
+  FImpl.Init(Self, BitmapChanged);
   TabStop := True;
   Height := 105;
   Width := 105;
@@ -151,91 +107,61 @@ end;
 
 procedure TBitmapButton.CreateParams(var Params: TCreateParams);
 begin
-  inherited CreateParams(Params);
+  inherited;
   CreateSubClass(Params, 'BUTTON');
 end;
 
 destructor TBitmapButton.Destroy;
 begin
-  FStretchedBitmap.Free;
-  FBitmap.Free;
-  inherited Destroy;
-end;
-
-procedure TBitmapButton.BitmapChanged(Sender: TObject);
-begin
-  FStretchedBitmapValid := False;
-  if FAutoSize and (FBitmap.Width > 0) and (FBitmap.Height > 0) then
-    SetBounds(Left, Top, FBitmap.Width, FBitmap.Height);
-  if (FBitmap.Width >= Width) and (FBitmap.Height >= Height) then
-    ControlStyle := ControlStyle + [csOpaque] - [csParentBackground]
-  else
-    ControlStyle := ControlStyle - [csOpaque] + [csParentBackground];
-  Invalidate;
+  FImpl.DeInit;
+  inherited;
 end;
 
 procedure TBitmapButton.SetAutoSize(Value: Boolean);
 begin
-  FAutoSize := Value;
-  BitmapChanged(Self);
+  FImpl.SetAutoSize(Self, Value);
 end;
 
 procedure TBitmapButton.SetBackColor(Value: TColor);
 begin
-  if FBackColor <> Value then begin
-    FBackColor := Value;
-    BitmapChanged(Self);
-  end;
+  FImpl.SetBackColor(Self, Value);
 end;
 
 procedure TBitmapButton.SetBitmap(Value: TBitmap);
 begin
-  FBitmap.Assign(Value);
+  FImpl.SetBitmap(Value);
 end;
 
 procedure TBitmapButton.SetCenter(Value: Boolean);
 begin
-  if FCenter <> Value then begin
-    FCenter := Value;
-    BitmapChanged(Self);
-  end;
+  FImpl.SetCenter(Self, Value);
 end;
 
 procedure TBitmapButton.SetReplaceColor(Value: TColor);
 begin
-  if FReplaceColor <> Value then begin
-    FReplaceColor := Value;
-    BitmapChanged(Self);
-  end;
+  FImpl.SetReplaceColor(Self, Value);
 end;
 
 procedure TBitmapButton.SetReplaceWithColor(Value: TColor);
 begin
-  if FReplaceWithColor <> Value then begin
-    FReplaceWithColor := Value;
-    BitmapChanged(Self);
-  end;
+  FImpl.SetReplaceWithColor(Self, Value);
 end;
 
 procedure TBitmapButton.SetStretch(Value: Boolean);
 begin
-  if FStretch <> Value then begin
-    FStretch := Value;
-    FStretchedBitmap.Assign(nil);
-    BitmapChanged(Self);
-  end;
+  FImpl.SetStretch(Self, Value);
 end;
 
 function TBitmapButton.GetPalette: HPALETTE;
 begin
-  Result := FBitmap.Palette;
+  Result := FImpl.GetPalette;
 end;
 
 procedure TBitmapButton.Paint;
 begin
   Canvas.Font := Font;
   Canvas.Brush.Color := Color;
-  
+
   var R := ClientRect;
 
   if Focused then begin
@@ -254,69 +180,7 @@ begin
 
   InflateRect(R, -FocusBorderWidth, -FocusBorderHeight);
 
-  const Is32bit = (FBitmap.PixelFormat = pf32bit) and
-    (FBitmap.AlphaFormat in [afDefined, afPremultiplied]);
-
-  var W, H: Integer;
-  var Bmp: TBitmap;
-  if Stretch then begin
-    W := R.Width;
-    H := R.Height;
-    Bmp := FStretchedBitmap;
-    if not FStretchedBitmapValid or (FStretchedBitmap.Width <> W) or
-       (FStretchedBitmap.Height <> H) then begin
-      FStretchedBitmapValid := True;
-      if (FBitmap.Width = W) and (FBitmap.Height = H) then
-        FStretchedBitmap.Assign(FBitmap)
-      else begin
-        FStretchedBitmap.Assign(nil);
-        if not StretchBmp(FBitmap, FStretchedBitmap, W, H, Is32bit) then begin
-          if Is32bit then begin
-            FStretchedBitmapValid := False;
-            Bmp := FBitmap;
-          end else begin
-            FStretchedBitmap.Palette := CopyPalette(FBitmap.Palette);
-            FStretchedBitmap.Width := W;
-            FStretchedBitmap.Height := H;
-            FStretchedBitmap.Canvas.StretchDraw(R, FBitmap);
-          end;
-        end;
-      end;
-    end;
-  end else begin
-    Bmp := FBitmap;
-    W := Bmp.Width;
-    H := Bmp.Height;
-  end;
-
-  if (FBackColor <> clNone) and (Is32Bit or (Bmp.Width < Width) or (Bmp.Height < Height)) then begin
-    Canvas.Brush.Style := bsSolid;
-    Canvas.Brush.Color := FBackColor;
-    Canvas.FillRect(R);
-  end;
-
-  if csDesigning in ComponentState then begin
-    Canvas.Pen.Style := psDash;
-    Canvas.Brush.Style := bsClear;
-    Canvas.Rectangle(0, 0, Width, Height);
-  end;
-
-  var X := R.Left;
-  var Y := R.Top;
-  if Center then begin
-    Inc(X, (R.Width - W) div 2);
-    if X < 0 then
-      X := 0;
-    Inc(Y, (R.Height - H) div 2);
-    if Y < 0 then
-      Y := 0;
-  end;
-
-  if not Is32bit and (FReplaceColor <> clNone) and (FReplaceWithColor <> clNone) then begin
-    Canvas.Brush.Color := FReplaceWithColor;
-    Canvas.BrushCopy(Rect(X, Y, X + W, Y + H), Bmp, Rect(0, 0, Bmp.Width, Bmp.Height), FReplaceColor);
-  end else
-    Canvas.Draw(X, Y, Bmp);
+  FImpl.Paint(Canvas, R);
 
   if Assigned(FOnPaint) then
     FOnPaint(Self, Canvas, R);

+ 199 - 107
Components/BitmapImage.pas

@@ -17,17 +17,37 @@ uses
   Windows, Controls, Graphics, Classes;
 
 type
+  TBitmapImageImplementation = record
+  private
+    FControl: TControl;
+  public
+    AutoSize: Boolean;
+    BackColor: TColor;
+    Bitmap: TBitmap;
+    Center: Boolean;
+    ReplaceColor: TColor;
+    ReplaceWithColor: TColor;
+    Stretch: Boolean;
+    StretchedBitmap: TBitmap;
+    StretchedBitmapValid: Boolean;
+    procedure Init(const AControl: TControl; const AOnBitmapChanged: TNotifyEvent);
+    procedure DeInit;
+    function InitializeFromIcon(const Instance: HINST; const Name: PChar; const BkColor: TColor; const AscendingTrySizes: array of Integer): Boolean;
+    procedure BitmapChanged(Sender: TObject);
+    procedure SetAutoSize(Sender: TObject; Value: Boolean);
+    procedure SetBackColor(Sender: TObject; Value: TColor);
+    procedure SetBitmap(Value: TBitmap);
+    procedure SetCenter(Sender: TObject; Value: Boolean);
+    procedure SetReplaceColor(Sender: TObject; Value: TColor);
+    procedure SetReplaceWithColor(Sender: TObject; Value: TColor);
+    procedure SetStretch(Sender: TObject; Value: Boolean);
+    function GetPalette: HPALETTE;
+    procedure Paint(const Canvas: TCanvas; var R: TRect);
+  end;
+
   TBitmapImage = class(TGraphicControl)
   private
-    FAutoSize: Boolean;
-    FBackColor: TColor;
-    FBitmap: TBitmap;
-    FCenter: Boolean;
-    FReplaceColor: TColor;
-    FReplaceWithColor: TColor;
-    FStretch: Boolean;
-    FStretchedBitmap: TBitmap;
-    FStretchedBitmapValid: Boolean;
+    FImpl: TBitmapImageImplementation;
     procedure BitmapChanged(Sender: TObject);
     procedure SetBackColor(Value: TColor);
     procedure SetBitmap(Value: TBitmap);
@@ -46,19 +66,19 @@ type
   published
     property Align;
     property Anchors;
-    property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
-    property BackColor: TColor read FBackColor write SetBackColor default clBtnFace;
-    property Center: Boolean read FCenter write SetCenter default False;
+    property AutoSize: Boolean read FImpl.AutoSize write SetAutoSize default False;
+    property BackColor: TColor read FImpl.BackColor write SetBackColor default clBtnFace;
+    property Center: Boolean read FImpl.Center write SetCenter default False;
     property DragCursor;
     property DragMode;
     property Enabled;
     property ParentShowHint;
-    property Bitmap: TBitmap read FBitmap write SetBitmap;
+    property Bitmap: TBitmap read FImpl.Bitmap write SetBitmap;
     property PopupMenu;
     property ShowHint;
-    property Stretch: Boolean read FStretch write SetStretch default False;
-    property ReplaceColor: TColor read FReplaceColor write SetReplaceColor default clNone;
-    property ReplaceWithColor: TColor read FReplaceWithColor write SetReplaceWithColor default clNone;
+    property Stretch: Boolean read FImpl.Stretch write SetStretch default False;
+    property ReplaceColor: TColor read FImpl.ReplaceColor write SetReplaceColor default clNone;
+    property ReplaceWithColor: TColor read FImpl.ReplaceWithColor write SetReplaceWithColor default clNone;
     property Visible;
     property OnClick;
     property OnDblClick;
@@ -76,25 +96,44 @@ procedure Register;
 implementation
 
 uses
-  Math, Resample;
+  SysUtils, Math, Resample;
 
 procedure Register;
 begin
   RegisterComponents('JR', [TBitmapImage]);
 end;
 
-function TBitmapImage.InitializeFromIcon(const Instance: HINST; const Name: PChar; const BkColor: TColor; const AscendingTrySizes: array of Integer): Boolean;
+{ TBitmapImageImplementation }
+
+procedure TBitmapImageImplementation.Init(const AControl: TControl; const AOnBitmapChanged: TNotifyEvent);
+begin
+  FControl := AControl;
+  Bitmap := TBitmap.Create;
+  Bitmap.OnChange := AOnBitmapChanged;
+  BackColor := clNone;
+  ReplaceColor := clNone;
+  ReplaceWithColor := clNone;
+  StretchedBitmap := TBitmap.Create;
+end;
+
+procedure TBitmapImageImplementation.DeInit;
+begin
+  FreeAndNil(StretchedBitmap);
+  FreeAndNil(Bitmap);
+end;
+
+function TBitmapImageImplementation.InitializeFromIcon(const Instance: HINST; const Name: PChar; const BkColor: TColor; const AscendingTrySizes: array of Integer): Boolean;
 begin
   { Find the largest regular icon size smaller than the scaled image }
   var Size := 0;
   for var I := Length(AscendingTrySizes)-1 downto 0 do begin
-    if (Width >= AscendingTrySizes[I]) and (Height >= AscendingTrySizes[I]) then begin
+    if (FControl.Width >= AscendingTrySizes[I]) and (FControl.Height >= AscendingTrySizes[I]) then begin
       Size := AscendingTrySizes[I];
       Break;
     end;
   end;
   if Size = 0 then
-    Size := Min(Width, Height);
+    Size := Min(FControl.Width, FControl.Height);
 
   { Load the desired icon }
   var Flags := LR_DEFAULTCOLOR;
@@ -109,13 +148,13 @@ begin
       Icon.Handle := Handle;
 
       { Set sizes (overrides any scaling) }
-      Width := Icon.Width;
-      Height := Icon.Height;
+      FControl.Width := Icon.Width;
+      FControl.Height := Icon.Height;
 
       { Draw icon into bitmap }
       Bitmap.Canvas.Brush.Color := BkColor;
-      Bitmap.Width := Width;
-      Bitmap.Height := Height;
+      Bitmap.Width := FControl.Width;
+      Bitmap.Height := FControl.Height;
       Bitmap.Canvas.Draw(0, 0, Icon);
 
       Result := True;
@@ -126,144 +165,122 @@ begin
     Result := False;
 end;
 
-constructor TBitmapImage.Create(AOwner: TComponent);
-begin
-  inherited;
-  ControlStyle := ControlStyle + [csReplicatable];
-  FBackColor := clBtnFace;
-  FBitmap := TBitmap.Create;
-  FBitmap.OnChange := BitmapChanged;
-  FReplaceColor := clNone;
-  FReplaceWithColor := clNone;
-  FStretchedBitmap := TBitmap.Create;
-  Height := 105;
-  Width := 105;
-end;
-
-destructor TBitmapImage.Destroy;
+procedure TBitmapImageImplementation.BitmapChanged(Sender: TObject);
 begin
-  FStretchedBitmap.Free;
-  FBitmap.Free;
-  inherited Destroy;
-end;
-
-procedure TBitmapImage.BitmapChanged(Sender: TObject);
-begin
-  FStretchedBitmapValid := False;
-  if FAutoSize and (FBitmap.Width > 0) and (FBitmap.Height > 0) then
-    SetBounds(Left, Top, FBitmap.Width, FBitmap.Height);
-  if (FBitmap.Width >= Width) and (FBitmap.Height >= Height) then
-    ControlStyle := ControlStyle + [csOpaque] - [csParentBackground]
+  StretchedBitmapValid := False;
+  if AutoSize and (Bitmap.Width > 0) and (Bitmap.Height > 0) then
+    FControl.SetBounds(FControl.Left, FControl.Top, Bitmap.Width, Bitmap.Height);
+  if (Bitmap.Width >= FControl.Width) and (Bitmap.Height >= FControl.Height) then
+    FControl.ControlStyle := FControl.ControlStyle + [csOpaque] - [csParentBackground]
   else
-    ControlStyle := ControlStyle - [csOpaque] + [csParentBackground];
-  Invalidate;
+    FControl.ControlStyle := FControl.ControlStyle - [csOpaque] + [csParentBackground];
+  FControl.Invalidate;
 end;
 
-procedure TBitmapImage.SetAutoSize(Value: Boolean);
+procedure TBitmapImageImplementation.SetAutoSize(Sender: TObject; Value: Boolean);
 begin
-  FAutoSize := Value;
-  BitmapChanged(Self);
+  AutoSize := Value;
+  BitmapChanged(Sender);
 end;
 
-procedure TBitmapImage.SetBackColor(Value: TColor);
+procedure TBitmapImageImplementation.SetBackColor(Sender: TObject; Value: TColor);
 begin
-  if FBackColor <> Value then begin
-    FBackColor := Value;
-    BitmapChanged(Self);
+  if BackColor <> Value then begin
+    BackColor := Value;
+    BitmapChanged(Sender);
   end;
 end;
 
-procedure TBitmapImage.SetBitmap(Value: TBitmap);
+procedure TBitmapImageImplementation.SetBitmap(Value: TBitmap);
 begin
-  FBitmap.Assign(Value);
+  Bitmap.Assign(Value);
 end;
 
-procedure TBitmapImage.SetCenter(Value: Boolean);
+procedure TBitmapImageImplementation.SetCenter(Sender: TObject; Value: Boolean);
 begin
-  if FCenter <> Value then begin
-    FCenter := Value;
-    BitmapChanged(Self);
+  if Center <> Value then begin
+    Center := Value;
+    BitmapChanged(Sender);
   end;
 end;
 
-procedure TBitmapImage.SetReplaceColor(Value: TColor);
+procedure TBitmapImageImplementation.SetReplaceColor(Sender: TObject; Value: TColor);
 begin
-  if FReplaceColor <> Value then begin
-    FReplaceColor := Value;
-    BitmapChanged(Self);
+  if ReplaceColor <> Value then begin
+    ReplaceColor := Value;
+    BitmapChanged(Sender);
   end;
 end;
 
-procedure TBitmapImage.SetReplaceWithColor(Value: TColor);
+procedure TBitmapImageImplementation.SetReplaceWithColor(Sender: TObject; Value: TColor);
 begin
-  if FReplaceWithColor <> Value then begin
-    FReplaceWithColor := Value;
-    BitmapChanged(Self);
+  if ReplaceWithColor <> Value then begin
+    ReplaceWithColor := Value;
+    BitmapChanged(Sender);
   end;
 end;
 
-procedure TBitmapImage.SetStretch(Value: Boolean);
+procedure TBitmapImageImplementation.SetStretch(Sender: TObject; Value: Boolean);
 begin
-  if FStretch <> Value then begin
-    FStretch := Value;
-    FStretchedBitmap.Assign(nil);
-    BitmapChanged(Self);
+  if Stretch <> Value then begin
+    Stretch := Value;
+    StretchedBitmap.Assign(nil);
+    BitmapChanged(Sender);
   end;
 end;
 
-function TBitmapImage.GetPalette: HPALETTE;
+function TBitmapImageImplementation.GetPalette: HPALETTE;
 begin
-  Result := FBitmap.Palette;
+  Result := Bitmap.Palette;
 end;
 
-procedure TBitmapImage.Paint;
+procedure TBitmapImageImplementation.Paint(const Canvas: TCanvas; var R: TRect);
 begin
-  var R := ClientRect;
-  const Is32bit = (FBitmap.PixelFormat = pf32bit) and
-    (FBitmap.AlphaFormat in [afDefined, afPremultiplied]);
+  const Is32bit = (Bitmap.PixelFormat = pf32bit) and
+    (Bitmap.AlphaFormat in [afDefined, afPremultiplied]);
 
   var W, H: Integer;
   var Bmp: TBitmap;
   if Stretch then begin
     W := R.Width;
     H := R.Height;
-    Bmp := FStretchedBitmap;
-    if not FStretchedBitmapValid or (FStretchedBitmap.Width <> W) or
-        (FStretchedBitmap.Height <> H) then begin
-      FStretchedBitmapValid := True;
-      if (FBitmap.Width = W) and (FBitmap.Height = H) then
-        FStretchedBitmap.Assign(FBitmap)
+    Bmp := StretchedBitmap;
+    if not StretchedBitmapValid or (StretchedBitmap.Width <> W) or
+        (StretchedBitmap.Height <> H) then begin
+      StretchedBitmapValid := True;
+      if (Bitmap.Width = W) and (Bitmap.Height = H) then
+        StretchedBitmap.Assign(Bitmap)
       else begin
-        FStretchedBitmap.Assign(nil);
-        if not StretchBmp(FBitmap, FStretchedBitmap, W, H, Is32bit) then begin
+        StretchedBitmap.Assign(nil);
+        if not StretchBmp(Bitmap, StretchedBitmap, W, H, Is32bit) then begin
           if Is32bit then begin
-            FStretchedBitmapValid := False;
-            Bmp := FBitmap;
+            StretchedBitmapValid := False;
+            Bmp := Bitmap;
           end else begin
-            FStretchedBitmap.Palette := CopyPalette(FBitmap.Palette);
-            FStretchedBitmap.Width := W;
-            FStretchedBitmap.Height := H;
-            FStretchedBitmap.Canvas.StretchDraw(R, FBitmap);
+            StretchedBitmap.Palette := CopyPalette(Bitmap.Palette);
+            StretchedBitmap.Width := W;
+            StretchedBitmap.Height := H;
+            StretchedBitmap.Canvas.StretchDraw(R, Bitmap);
           end;
         end;
       end;
     end;
   end else begin
-    Bmp := FBitmap;
+    Bmp := Bitmap;
     W := Bmp.Width;
     H := Bmp.Height;
   end;
 
-  if (FBackColor <> clNone) and (Is32Bit or (Bmp.Width < Width) or (Bmp.Height < Height)) then begin
+  if (BackColor <> clNone) and (Is32Bit or (Bmp.Width < FControl.Width) or (Bmp.Height < FControl.Height)) then begin
     Canvas.Brush.Style := bsSolid;
-    Canvas.Brush.Color := FBackColor;
+    Canvas.Brush.Color := BackColor;
     Canvas.FillRect(R);
   end;
 
-  if csDesigning in ComponentState then begin
+  if csDesigning in FControl.ComponentState then begin
     Canvas.Pen.Style := psDash;
     Canvas.Brush.Style := bsClear;
-    Canvas.Rectangle(0, 0, Width, Height);
+    Canvas.Rectangle(0, 0, FControl.Width, FControl.Height);
   end;
 
   var X := R.Left;
@@ -277,11 +294,86 @@ begin
       Y := 0;
   end;
 
-  if not Is32bit and (FReplaceColor <> clNone) and (FReplaceWithColor <> clNone) then begin
-    Canvas.Brush.Color := FReplaceWithColor;
-    Canvas.BrushCopy(Rect(X, Y, X + W, Y + H), Bmp, Rect(0, 0, Bmp.Width, Bmp.Height), FReplaceColor);
+  if not Is32bit and (ReplaceColor <> clNone) and (ReplaceWithColor <> clNone) then begin
+    Canvas.Brush.Color := ReplaceWithColor;
+    Canvas.BrushCopy(Rect(X, Y, X + W, Y + H), Bmp, Rect(0, 0, Bmp.Width, Bmp.Height), ReplaceColor);
   end else
     Canvas.Draw(X, Y, Bmp);
 end;
 
+{ TBitmapImage }
+
+function TBitmapImage.InitializeFromIcon(const Instance: HINST; const Name: PChar; const BkColor: TColor; const AscendingTrySizes: array of Integer): Boolean;
+begin
+  Result := FImpl.InitializeFromIcon(HInstance, Name, BkColor, AscendingTrySizes);
+end;
+
+procedure TBitmapImage.BitmapChanged(Sender: TObject);
+begin
+  FImpl.BitmapChanged(Sender);
+end;
+
+constructor TBitmapImage.Create(AOwner: TComponent);
+begin
+  inherited;
+  ControlStyle := ControlStyle + [csReplicatable];
+  FImpl := Default(TBitmapImageImplementation);
+  FImpl.Init(Self, BitmapChanged);
+  FImpl.BackColor := clBtnFace;
+  Height := 105;
+  Width := 105;
+end;
+
+destructor TBitmapImage.Destroy;
+begin
+  FImpl.DeInit;
+  inherited;
+end;
+
+procedure TBitmapImage.SetAutoSize(Value: Boolean);
+begin
+  FImpl.SetAutoSize(Self, Value);
+end;
+
+procedure TBitmapImage.SetBackColor(Value: TColor);
+begin
+  FImpl.SetBackColor(Self, Value);
+end;
+
+procedure TBitmapImage.SetBitmap(Value: TBitmap);
+begin
+  FImpl.SetBitmap(Value);
+end;
+
+procedure TBitmapImage.SetCenter(Value: Boolean);
+begin
+  FImpl.SetCenter(Self, Value);
+end;
+
+procedure TBitmapImage.SetReplaceColor(Value: TColor);
+begin
+  FImpl.SetReplaceColor(Self, Value);
+end;
+
+procedure TBitmapImage.SetReplaceWithColor(Value: TColor);
+begin
+  FImpl.SetReplaceWithColor(Self, Value);
+end;
+
+procedure TBitmapImage.SetStretch(Value: Boolean);
+begin
+  FImpl.SetStretch(Self, Value);
+end;
+
+function TBitmapImage.GetPalette: HPALETTE;
+begin
+  Result := FImpl.GetPalette;
+end;
+
+procedure TBitmapImage.Paint;
+begin
+  var R := ClientRect;
+  FImpl.Paint(Canvas, R);
+end;
+
 end.