Clone monocromático de bitmap

Function CreateDisabledBitmap(FOriginal: TBitmap; OutlineColor: TColor): TBitmap;
// Use-a assim:
// image2.picture.Bitmap := CreateDisabledBitmap(Image1.Picture.Bitmap, clBtnFace);
const
ROP_DSPDxax = $00E20746;
var
MonoBmp: TBitmap;
IRect: TRect;
begin
IRect := Rect(0, 0, FOriginal.Width, FOriginal.Height);
Result := TBitmap.Create;
try
Result.Width := FOriginal.Width;
Result.Height := FOriginal.Height;
MonoBmp := TBitmap.Create;
try
with MonoBmp do
begin
Assign(FOriginal);
{$IFDEF S_D3}
HandleType := bmDDB;
{$ENDIF}
Canvas.Brush.Color := clBlack;
if Monochrome then
begin
Canvas.Font.Color := clWhite;
Monochrome := False;
Canvas.Brush.Color := clWhite;
end;
Monochrome := True;
end;
with Result.Canvas do
begin
Brush.Color := OutlineColor;
FillRect(IRect);
Brush.Color := clBtnHighlight;
SetTextColor(Handle, clBlack);
SetBkColor(Handle, clWhite);
BitBlt(Handle, 1, 1, IRect.Right - IRect.Left, IRect.Bottom - IRect.Top,
MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
Brush.Color := clBtnShadow;
SetTextColor(Handle, clBlack);
SetBkColor(Handle, clWhite);
BitBlt(Handle, 0, 0, IRect.Right - IRect.Left, IRect.Bottom - IRect.Top,
MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
End;
finally
MonoBmp.Free;
end;
except
Result.Free;
raise;
end;
end;