Как сделать Bitmap в виде скругленного прямоугольника и прозрачным фоном за пределами этого прямоуголника

unit MenuButton2;
 
interface
 
uses
  SysUtils, Classes, Controls, StdCtrls,math, Graphics, Windows, messages, GdiPlus, ActiveX,Types,
   pngimage, ExtCtrls, vcl.dialogs;
type
   TMenuButton2 = class(TCustomControl)
  private
    FOnPaint: TNotifyEvent;
    FRadius:Integer;
    FColor:TColor;
    FCaption:TCaption;
    FSelected:Boolean;
    FCornerCaption : String;
    FFontSize:word;
    FPriceFontSize:word;
    FDown:boolean;
    FUsed:boolean;
    FCornerInverse : Boolean;
    FTitleColor:TColor;
    FBorderWidth:byte;
    FImage:Graphics.TBitmap;
    FImageType:string;
 
    procedure SetCaption(value: TCaption);
    procedure SetImage(value: Graphics.TBitmap);
    procedure SetRadius(value: integer);
    procedure SetColor(value: TColor);
    procedure SetSelected(value: Boolean);
    procedure SetFCornerText(Value: string);
    procedure SetFontSize(value: word);
    procedure SetPriceFontSize(value: word);
    procedure SetUsed(value: Boolean);
    procedure SetTitleColor(value: TColor);
    procedure SetBorderWidth(value:byte);
    procedure SetImageType(value:String);
    { Private declarations }
  protected
    { Protected declarations }
    procedure Paint;override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:  Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    { Public declarations }
    constructor Create(AOWner: TComponent);override;
    destructor Destroy;override;
    property Canvas;
    procedure Click; override;
    procedure DblClick; override;
  published
    property Caption: TCaption read FCaption Write SetCaption;
    property Image: Graphics.TBitmap read FImage Write SetImage;
    property Radius:integer read FRadius Write SetRadius;
    property Color:TColor read FColor Write SetColor;
    property Selected:Boolean read FSelected Write SetSelected;
    property CornerCaption : String read FCornerCaption write SetFCornerText;
    property FontSize:word read FFontSize write SetFontSize;
    property PriceFontSize:word read FPriceFontSize write SetPriceFontSize;
    property Used:Boolean read FUsed write SetUsed;
    property ShowHint;
    property Visible;
    property Enabled;
    property Cursor;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
    property OnClick;
    property CornerInverse : Boolean read FCornerInverse write FCornerInverse default false;
    property TitleColor:TColor read FTitleColor Write SetTitleColor;
    property BorderWidth:Byte read FBorderWidth Write SetBorderWidth;
    property ImageType:String read FImageType Write SetImageType;
end;
 
 
 
procedure Register;
 
implementation
 
.......................................................
function GetScaledCenteredBitmap(bmp:Graphics.TBitmap; maxWidth, maxHeight: integer):  Graphics.TBitmap;
var
    sbmp: Graphics.TBitmap;
  scaledWidth, scaledHeight: integer;
begin
  scaledWidth := 0;
  scaledHeight := 0;
 
  sbmp := Graphics.TBitmap.Create;
 
  if bmp.Width > bmp.Height then
  begin
    scaledHeight := trunc(maxWidth * bmp.Height / bmp.Width);
    scaledWidth := maxWidth;
  end
  else if bmp.Height >= bmp.Width then
  begin
    scaledWidth := trunc(maxHeight * bmp.Width / bmp.Height);
    scaledHeight := maxHeight;
  end;
 
  sbmp.Width := maxWidth;
  sbmp.Height := maxHeight;
  //sbmp.Canvas.Brush.Color := clBlack;
  //sbmp.Canvas.FillRect(Bounds(0, 0, maxWidth, maxHeight));
  sbmp.Canvas.StretchDraw(Bounds(maxWidth div 2 - scaledWidth div 2, maxHeight div 2 -
    scaledHeight div 2, scaledWidth, scaledHeight), bmp);
  result := sbmp;
  bmp.Free;
end;
 
procedure TMenuButton2.Paint;
var
   GPPen: TGPPen;
   GPColor: TGPColor;
   GPLColor: TGPColor;
   GPFColor: TGPColor;
   GPGraphics: IGPGraphics;
 
   GPGraphicsPath: IGPGraphicsPath;
   GFont       : TGPFont;
   GFont2 : TGPFont;
   GPSolidBrush: TGPSolidBrush;
   SolidBrush    : TGPSolidBrush;
   SolidBrush2    : TGPSolidBrush;
   RectTitle : TGPRectF;
   strformat:IGPStringFormat;
   gImage : TGPImage;
   RectImg : TGPRectF;
   aptr: IStream;
   BitMapStream:TMemoryStream;
   sbmp:Graphics.TBitmap;
   scaledWidth, scaledHeight: integer;
begin
  try
   inherited;
    //Настройки выравнивания текста
    strformat:=TGPStringFormat.Create([]);
    strformat.Alignment  :=StringAlignmentCenter;
    strformat.LineAlignment:=StringAlignmentCenter;
 
    //Настройки сглаживания
    GPGraphics := TGPGraphics.Create(Canvas.Handle);
    GPGraphics.SmoothingMode := SmoothingModeAntiAlias;
 
 
 
    //рисование RoundRect
    GPGraphicsPath := TGPGraphicsPath.Create;
    GPGraphicsPath.Reset;
    GPGraphicsPath.AddArc(0, 0, Radius, Radius, 180, 90);
    GPGraphicsPath.AddArc(ClientWidth - Radius - 1, 0, Radius, Radius, 270, 90);
    GPGraphicsPath.AddArc(ClientWidth - Radius - 1, ClientHeight - Radius - 1,     Radius, Radius, 0, 90);
    GPGraphicsPath.AddArc(0, ClientHeight - Radius - 1, Radius, Radius, 90, 90);
    GPGraphicsPath.CloseFigure;
 
    case FUsed of
      false:
          case FSelected of
                true:
                      begin
                        GPColor.InitializeFromColorRef(ColorToRGB(color));
                        GPColor.Alpha := 255;
                        GPLColor.InitializeFromColorRef(ColorToRGB(clYellow)); //Цвет линий
                        GPLColor.Alpha := 255;
                        GPPen := TGPPen.Create(GPLColor,FBorderWidth); //Pen для Границ
                      end;
                false:
                      begin
                        GPColor.InitializeFromColorRef(ColorToRGB($00ffffff));
                        GPColor.Alpha := 125;
                        GPLColor.InitializeFromColorRef(ColorToRGB($00ffffff)); //Цвет линий
                        GPLColor.Alpha := 125;
                        GPPen := TGPPen.Create(GPLColor,0); //Pen для Границ
                      end;
          end;
      true:
            begin
              case FDown of
                true:
                      begin
                        GPColor.InitializeFromColorRef(ColorToRGB(Darker(color,10)));
                        GPColor.Alpha := 255;
                        GPLColor.InitializeFromColorRef(ColorToRGB(Darker(color,10))); //Цвет линий
                        GPLColor.Alpha := 255;
                        GPPen := TGPPen.Create(GPLColor,0); //Pen для Границ
                      end;
                false:
                      begin
                        GPColor.InitializeFromColorRef(ColorToRGB(color));
                        GPColor.Alpha := 255;
                        GPLColor.InitializeFromColorRef(ColorToRGB(color)); //Цвет линий
                        GPLColor.Alpha := 255;
                        GPPen := TGPPen.Create(GPLColor,0); //Pen для Границ
                      end;
              end;
           end;
    end;
 
 
 
    if FCornerInverse then GPFColor.InitializeFromColorRef(ColorToRGB(InverseColor(self.Color)))else
    GPFColor.InitializeFromColorRef(ColorToRGB(VisibleContrast(self.Color)));
 
    SolidBrush := TGPSolidBrush.Create(GPFColor);// SolidBrush для заголовка
    GPSolidBrush := TGPSolidBrush.Create(GPColor); //SolidBrush для заливки фигуры
 
    GPGraphics.FillPath(GPSolidBrush, GPGraphicsPath);    //Закрашиваем фигуру RoundRect
    GPGraphics.DrawPath(GPPen, GPGraphicsPath);           //Рисуем круглые края
    if (FImage<>nil) and (not FImage.Empty)  then
    begin
      try
        if ImageType.ToLower<>'png' then//GetScaledCenteredBitmap не масштабирует и не центрирует png формат :(
        begin
          FImage:=GetScaledCenteredBitmap(fImage,Width,Round(2*Height/3));
          Canvas.Draw(0,0,FImage);
        end else
          begin
            if fImage.Width > fImage.Height then
            begin
              scaledHeight := trunc(Width * fImage.Height / fImage.Width );
              scaledWidth := Width;
            end
            else if fImage.Height >= fImage.Width then
            begin
              scaledWidth := trunc((2*Height/3) * fImage.Width / fImage.Height);
              scaledHeight := trunc(2*Height/3);
            end;
 
            if scaledHeight>trunc(2*Height/3) then scaledHeight:=trunc(2*Height/3);
 
            Canvas.StretchDraw(Bounds(Width div 2 - scaledWidth div 2, trunc(2*Height/3) div 2 - scaledHeight div 2, scaledWidth, scaledHeight), fImage);
         end;
 
 
        //FImage.SetSize(Width,Round(2*Height/3));
        //BitMapStream := TMemoryStream.Create;
        //FImage.SaveToStream(BitMapStream);
        //aptr :=TStreamAdapter.Create(BitMapStream, soReference) as IStream;
        //gImage := TGPImage.Create(aptr,true); //создаем класс используя поток
        RectImg.X:=0;
        RectImg.Y:=0;
        RectImg.Width:=Width;
        RectImg.Height:=Round(2*Height/3);
        //FImage.SetSize(Width,Round(2*Height/3));
        //GPGraphics.DrawImage(gImage,RectImg,0,0,RectImg.Width,RectImg.Height,UnitPixel);
 
      finally
        //FreeAndNil(Gimage);
        //FImage.Free;
        //FreeAndNil(BitMapStream );
      end;
 
      RectTitle.X:=FBorderWidth;
      RectTitle.Y:=round(2*(Height/3));
      RectTitle.Width:=Width-FBorderWidth;
      RectTitle.Height:=Height-round(2*(Height/3));
    end else
      begin
        RectTitle.X:=FBorderWidth;
        RectTitle.Y:=FBorderWidth;
        RectTitle.Width:=Width-FBorderWidth;
        RectTitle.Height:=Height-FBorderWidth;
      end;
    //Настройки шрифта
    GFont:= TGPFont.Create(TGPFontFamily.Create('Arial'), FFontSize, [FontStyleBold], UnitPixel);
    GPGraphics.SetTextRenderingHint(TextRenderingHintAntiAlias);
    GPGraphics.DrawString(caption,GFont, RectTitle,strformat, solidBrush);//Вывод заголовка
    GPFColor.Alpha := 255;
    SolidBrush2 := TGPSolidBrush.Create(GPFColor);
 
    strformat.Alignment:=StringAlignmentFar;
    strformat.LineAlignment:=StringAlignmentFar;
    RectTitle.X:=FBorderWidth;
    RectTitle.Y:=FBorderWidth;
    RectTitle.Width:=Width-FBorderWidth-6;
    RectTitle.Height:=Height-FBorderWidth-6;
 
    GFont2:= TGPFont.Create(TGPFontFamily.Create('Arial'), FPriceFontSize, [FontStyleBold], UnitPixel);
    GPGraphics.DrawString(FCornerCaption,GFont2, RectTitle,strformat, solidBrush2);
 
    FreeAndNil(GPPen);
    FreeAndNil(GPSolidBrush);
    GPGraphicsPath:=nil;
    FreeAndNil(GFont);
    FreeAndNil(GFont2);
 
    FreeAndNil(SolidBrush);
    FreeAndNil(SolidBrush2);
    strformat:=nil;
    GPGraphics:=nil;
 
  except
    on E: Exception do
      raise Exception.Create('Ошибка MenuButton2: '+E.Message);
  end;
 
end;

    GPGraphics.FillPath(GPSolidBrush, GPGraphicsPath);    //Закрашиваем фигуру RoundRect
    GPGraphics.DrawPath(GPPen, GPGraphicsPath);           //Рисуем круглые края

GPGraphics.SetClip(GPGraphicsPath);
GPGraphics.DrawImage(GPImage, ... );

procedure PremultiplieAlpha(bmSrc, bmMask: TBitmap);
var
  x, y, x4, mx: integer;
  pbS, pbM: PByteArray;
begin
  // Функция GdiAlphaBlend принимает на вход предварительно умноженные на значение Alpha значения пикселей
  // Предварительная подготовка источника для использования в GdiAlphaBlend
  bmSrc.PixelFormat := pf32bit; // Обязательно 32 бит для нашей рамки
  bmMask.PixelFormat := pf32bit; // Обязательно 32 бит для нашей рамки
  bmMask.Width  := bmSrc.Width ;
  bmMask.Height := bmSrc.Height;
 
  mx := bmSrc.Width*bmSrc.Height*4;
  pbS := bmSrc.ScanLine[bmSrc.Height-1];
  pbM := bmMask.ScanLine[bmSrc.Height-1];
  x4 := 0;
  while x4 < mx do begin
    x := pbM^[x4]; // Берём значение маски из видимой части пикселя
    pbS^[x4  ] := (pbS^[x4  ] * x) div 255; // Предварительное умножение на alpha
    pbS^[x4+1] := (pbS^[x4+1] * x) div 255;
    pbS^[x4+2] := (pbS^[x4+2] * x) div 255;
    pbS^[x4+3] := x; // Установка значения alpha для пикселя
    x4 := x4 + 4;
  end;{}
end;
 
 
procedure PrepareRoundRectFrame(bmSrc: TBitmap; Round: integer);
var
  bmapm, bmapt: TBitmap;
begin
  // Создать промежуточный увеличенный битмап для маски
  bmapt := TBitmap.Create;
  bmapt.PixelFormat := pf32bit; // Желательно 32 бит для уменьшения переменных и вычислений
  bmapt.Canvas.Brush.Color := clBlack;  // Залить чёрным
  bmapt.Width  := bmSrc.Width *2; // Если не хватает плавности, можно увеличить в 3 раза
  bmapt.Height := bmSrc.Height*2;
  // Сделать белый прямоугольник с закруглёнными углами
  bmapt.Canvas.Brush.Color := clWhite;
  bmapt.Canvas.Pen.Color := clWhite;
//  bmapt.Canvas.Pen.Color := clGray; // Вариант для плавного перехода
  bmapt.Canvas.RoundRect(0, 0, bmapt.Width, bmapt.Height, Round, Round);
 
  // Создать битмап для маски размером с источник
  bmapm := TBitmap.Create;
  bmapm.Width  := bmSrc.Width ;
  bmapm.Height := bmSrc.Height;
  bmapm.PixelFormat := pf32bit; // Желательно 32 бит для уменьшения переменных и вычислений
 
  SetStretchBltMode(bmapm.Canvas.Handle, HALFTONE); // Установить режим со сглаживанием
  // Уменьшить маску со сглаживанием до размера источника
  StretchBlt(bmapm.Canvas.Handle, 0, 0, bmapm.Width, bmapm.Height,
             bmapt.Canvas.Handle, 0, 0, bmapt.Width, bmapt.Height, SRCCOPY);
  bmapt.Free;
 
  // Функция GdiAlphaBlend принимает на вход предварительно умноженные на значение Alpha значения пикселей
  // Подготовить источник в соответствии с маской
  PremultiplieAlpha(bmSrc, bmapm);
 
  bmapm.Free;
end;

  PrepareRoundRectFrame(bmSrc, ScrollBar1.Position); // Второй параметр задаёт диаметр (или радиус?) закруглений
  // Предварительно bmDest заполняется нужным фоном.
  GdiAlphaBlend(bmDest.Canvas.Handle, 0, 0, bmSrc.Width, bmSrc.Height, bmSrc.Canvas.Handle, 0, 0, bmSrc.Width, bmSrc.Height, (255 shl 16)+$01000000);