Use graphics32 to draw rounded rectange with gradient + border

[DelphiRio 4]

I would like to draw something like this:

 

 

Thank you very much

Edited March 29, 2019 by DelphiRio

[Anders Melander 1782]

And have you looked at the Polygon and Gradient examples?

[jbWishmaster 2]

function Build_RoundRect(Radius : TFloat; Rec: TFloatRect; BorderWidth : TFloat ): TArrayOfFloatPoint;
var
  FRec : TFloatRect;
begin
  FRec.Left:=   Rec.Left + 0.5 * BorderWidth;
  FRec.Top:=    Rec.Top + 0.5 * BorderWidth;
  FRec.Right:=  Rec.Right - 0.5 * BorderWidth;
  FRec.Bottom:= Rec.Bottom - 0.5 * BorderWidth;
  Result:= RoundRect(FRec, Radius);
end;


procedure Draw_GradientLinear(Dst : TBitmap32; StartPoint, EndPoint: TFloatPoint;   
 Outline : TArrayOfFloatPoint; Colors : TGradColors);
var
 FFilter : TLinearGradientPolygonFiller;
 FPolys : TArrayOfArrayOfFloatPoint;
begin

   FFilter := TLinearGradientPolygonFiller.Create();
  try
    Setlength(FPolys, 0);
    FPolys:= PolyPolygon(Outline);

    FFilter.StartPoint:= StartPoint;
    FFilter.EndPoint:=  EndPoint;
    FFilter.WrapMode:= wmClamp;// TWrapMode(1);
    FFilter.Gradient.ClearColorStops;
    FFilter.Gradient.StartColor:= Color32(Colors[1]);
    FFilter.Gradient.EndColor:=   Color32(Colors[2]);

    PolyPolygonFS(Dst, FPolys, FFilter, pfWinding);
  finally
   FFilter.Free;
   Setlength(FPolys, 0);
  end;
end;

//----------------------------------------------------------
 TGradColors    = Array of TColor;
 TGradPosition  = Array [1..2] of TFloat;
 TGradientStyle = (gsLinearV, gsLinearH, .......)



procedure TjbGradient.PaintTo(Dst: TBitmap32; R: TRect);
var
  Buffer : TBitmap32;

  Colors : TGradColors;
  Position : TGradPosition;
  Center : TFloatPoint;
  Radius : TFloat;
  Angle  : TFloat;
  CenterPoint : TFloatPoint;
 FOutline : TArrayOfFloatPoint;
  StartPoint, EndPoint: TFloatPoint;
  FRect : TFloatRect;
begin
 if IsRectEmpty(R)  then
  exit;

  FRect:= FloatRect(R);

  Buffer := TBitmap32.Create;
  Buffer.SetSize(R.Width, R.Height);

  Buffer.ResetAlpha;
  Buffer.MasterAlpha := FAlpha;
  Buffer.DrawMode := dmBlend;
  Buffer.Clear(0);
 
  FOutline:= Build_RoundRect(RoundRadius, FRect, 1);

  if Length(FOutline) = 0 then
   exit;


  case FGradStyle of
    gsLinearV:
     begin
       SetLength(Colors, 3);
       Colors[1]:= ColorFrom;
       Colors[2]:= ColorTo;

       StartPoint.X:= 0;
       StartPoint.Y:= FRect.Top;
       EndPoint.X:= 0;
       EndPoint.Y:= FRect.Bottom;

       Draw_GradientLinear(Buffer, StartPoint, EndPoint, FOutline, Colors);

       Buffer.DrawTo(Dst, 0, 0);
     end;
    gsLinearH:
     begin
       SetLength(Colors, 3);
       Colors[1]:= ColorFrom;
       Colors[2]:= ColorTo;

       StartPoint.X:= FRect.Left;
       StartPoint.Y:= 0;
       EndPoint.X:= FRect.Right;
       EndPoint.Y:= 0;

       Draw_GradientLinear(Buffer, StartPoint, EndPoint, FOutline, Colors);

       Buffer.DrawTo(Dst, 0, 0);
     end;

   end





...

 

 

it's just a small snippet  I hope it helps.

 

 

 

 

 

 

 

 

 

 

Edited March 30, 2019 by jbWishmaster

[DelphiRio 4]

@jbWishmaster Thank you very much.

@Anders Melander I opened GradSampler, changed the code to:

 

// ...
FOutline := RoundRect(FloatRect(20, 20, 200, 200), 3);
// ...


procedure TFrmGradientSampler.PaintBox32PaintBuffer(Sender: TObject);
begin
  //...
    Renderer.Filler := nil;
    Renderer.Color := clRed32;
    Renderer.PolyPolygonFS(BuildPolyPolyline(PolyPolygon(FOutline), True, 1, jsRound, esRound));
  //...
end;

The border is not RED and larger than 1px (see the screenshot - zoom in version). How to get it draw same to  (I mean the border quality) : https://jsfiddle.net/zjLsuavy/

 

Thank you very much

[jbWishmaster 2]

try the following code, it works for me.

 

procedure Draw_PannelFrame_Flat_Rounded(Dst : TBitmap32; R: TRect; Sides : TSides;
  Color : TColor32; PenStyle: TPenStyle; StrokeWidth : Single = 1; Radius : Integer = 6) ;
 var
  Points : TArrayOfFloatPoint;
  Dashes : TArrayOfFloat;
  FRect : TFloatRect;
begin
   FRect:= FloatRect(R);

   case PenStyle of
     psSolid:
      begin
       Points:= Build_RoundRect(Radius, FRect, StrokeWidth * 1);
       PolyPolylineFS(Dst, PolyPolygon(Points), Color, True, StrokeWidth * 1, jsMiter, esSquare);
      end;
     psDash:
      begin
      // Dashes := MakeArrayOfFloat([10, 3, 3, 3, 3, 3]);
       Dashes := MakeArrayOfFloat([6, 2, 6, 2]);
       Points:= Build_RoundRect(Radius, FRect, StrokeWidth * 1);
       DashLineFS(Dst, Points, Dashes, Color, True, StrokeWidth * 1);
      end;
     psDot:
      begin
       Dashes := MakeArrayOfFloat([2, 2, 2, 2]);
       Points:= Build_RoundRect(Radius, FRect, StrokeWidth * 1);
       DashLineFS(Dst, Points, Dashes, Color, True, StrokeWidth * 1);
      end;
     psDashDot:
      begin
       Dashes := MakeArrayOfFloat([6, 2, 2, 2]);
       Points:= Build_RoundRect(Radius, FRect, StrokeWidth * 1);
       DashLineFS(Dst, Points, Dashes, Color, True, StrokeWidth * 1);
      end;
     psDashDotDot:
      begin
       Dashes := MakeArrayOfFloat([10, 2, 2, 2, 2, 2]);
       Points:= Build_RoundRect(Radius, FRect, StrokeWidth * 1);
       DashLineFS(Dst, Points, Dashes, Color, True, StrokeWidth * 1);
      end;
     psClear: ;
     psInsideFrame:
      begin
       Points:= Build_RoundRect(Radius, FRect, StrokeWidth * 1);
       PolyPolylineFS(Dst, PolyPolygon(Points), Color, True, StrokeWidth * 1);
      end;
     psUserStyle: ;
     psAlternate: ;
   end;

end;

 

Edited March 30, 2019 by jbWishmaster