• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2497
  • Last Modified:

Rounded corner, beveled and drop shadow

Hi,

I need help with this:

2 file inputs:
- background.jpg
- photo.jpg

Draw the photo.jpg on top of the background.jpg with this image processing:

- the photo.jpg corners are rounded
- the photo.jpg is beveled
- it also has drop shadow

if possible with configurable parameters like amount of shadow/bevel/rounded corners.

I prefer to use freeware component like GR32 (and all its plugins / extension).

See jpg examples to ilustrate what I need.

Thanks.
background.jpg
photo.jpg
Result.jpg
0
db2trade
Asked:
db2trade
  • 4
  • 3
  • 2
1 Solution
 
HypoCommented:
Hi,
I have put together some code to do that... Just create a new application, add a button to it, and then insert the full code below and connect the events.

The rounded corners is generated by setting clipping region to a round rect, and then painting the image with that clipping region active.

The drop shadow is created by identifying the area of the object we paint (which is defined by the same region we use as clipping region), and then offset this area a bit to give the illusion of a dropping shadow. The shadow itself is generated by using a shadow-map that we create as a copy of the region, and then we blur this map to give the diffuse edges of the shadow. Then we darken or lighten the target canvas using the shadow map (note, by changing the AShade parameter in DropShadowRegion from -0.5 to a positive value 0.5, we can make the object cast a white shadow instead of a dark one).

The Bevel is created by identifying the edges of the object (which is defined by the region), and then for each edge pixel we calculate a vector that identifies what angle the edge has. The angle is then used to determine if the edge should be darken or lighten.

You can play around with the parameters in the calls to DropShadowRegion and BevelRegion in Procedure TForm1.PaintImage to generate different results. - Enjoy!

regards
Hypo
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Math, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    FBackground : TBitmap;
    FPhoto : TBitmap;
    Procedure PaintImage(aBmp : TBitmap; ATargetCanvas: TCanvas; X, Y : Integer);
  end;
 
var
  Form1: TForm1;
 
implementation
 
uses Types;
 
{$R *.dfm}
 
type
  TImageBevelData = record
    Vector : TPoint;
    Generation : Integer;
  end;
 
Function ShadeColor(ACol : TColor; AValue : Double) : TColor;
var R, G, B : Byte;
Begin
  if AValue = 0 then begin
    Result := ACol;
  end else begin
    R := GetRValue(ACol);
    G := GetGValue(ACol);
    B := GetBValue(ACol);
    if AValue > 0 then begin
      Result := RGB(R + Trunc((255-R)*AValue),
                    G + Trunc((255-G)*AValue),
                    B + Trunc((255-B)*AValue));
    end else begin
      Result := RGB(R + Trunc(R*AValue),
                    G + Trunc(G*AValue),
                    B + Trunc(B*AValue));
    end;
  end;
End;
 
Procedure BevelRegion(ACanvas : TCanvas; ARegion : HRGN; ABevelWidth : Integer = 4);
var xl, yl, i, bx, by, index : Integer;
    width, height : Integer;
    aBevel : Array of TImageBevelData;
    aRgnRect : TRect;
Begin
  GetRgnBox(ARegion, aRgnRect);
  width := aRgnRect.Right-aRgnRect.Left;
  height := aRgnRect.Bottom-aRgnRect.Top;
  SetLength(aBevel, width*height);
  try
 
    FillMemory(Addr(aBevel[0]), Width*Height*SizeOf(aBevel[0]), 0);
    for yl := 0 to height-1 do
      for xl := 0 to width-1 do
        if not PtInRegion(ARegion, xl+aRgnRect.Left, yl+aRgnRect.Top)
          then aBevel[yl*width+xl].Generation := -1
          else begin
            for by := -1 to 1 do
              for bx := -1 to 1 do
                if (yl+by < 0) or (yl+by >= height) or
                   (xl+bx < 0) or (xl+bx >= width) or
                   (not PtInRegion(ARegion, aRgnRect.Left+xl, aRgnRect.Top+yl)) then
                begin
                  // Borderpixel...
                  index := xl*width+yl;
                  aBevel[index].Vector.X := aBevel[index].Vector.X + bx;
                  aBevel[index].Vector.Y := aBevel[index].Vector.Y + by;
                  aBevel[index].Generation := 1;
                end;
          end;
 
    // Calculate what pixels should be shaded...
    for i := 1 to ABevelWidth-1 do begin
      for yl := 0 to Height-1 do
        for xl := 0 to Width-1 do begin
          if aBevel[yl*Width+xl].Generation = i then begin
            for by := -1 to 1 do
              for bx := -1 to 1 do begin
                index := (yl+by)*Width+xl+bx;
                if (yl+by >= 0) and (yl+by < Height) and
                   (xl+bx >= 0) and (xl+bx < Width) and
                   ((aBevel[index].Generation > i) or (aBevel[index].Generation = 0)) then
                begin
                  aBevel[index].Vector.X := aBevel[index].Vector.X + aBevel[yl*Width+xl].Vector.X;
                  aBevel[index].Vector.Y := aBevel[index].Vector.Y + aBevel[yl*Width+xl].Vector.Y;
                  aBevel[index].Generation := i+1;
                end;
              end;
          end;
        end;
    end;
 
    // Add Shade to border-pixels...
    for yl := 0 to Height-1 do
      for xl := 0 to Width-1 do begin
        index := xl*Width+yl;
        if aBevel[index].Generation >= 1 then begin
          if aBevel[index].Vector.X = 0 then aBevel[index].Vector.X := 1;
          ACanvas.Pixels[aRgnRect.Left+xl, aRgnRect.Top+yl] :=
            ShadeColor(ACanvas.Pixels[aRgnRect.Left+xl, aRgnRect.Top+yl],
                       Sin(ArcTan2(aBevel[index].Vector.X, aBevel[index].Vector.Y)-(3*Pi/4)) / Power(aBevel[index].Generation, 0.5));
        end;
      end;
  finally
    SetLength(aBevel, 0);
  end;
End;
 
 
procedure DropShadowRegion(ACanvas : TCanvas; ARgn : HRGN; AAngle, ADistance, AShade : Double; ADiffuse : Integer);
var xl, yl, bx, by, xp, yp : Integer;
    i, width, height : Integer;
    drop : TPoint;
    aRgnRect : TRect;
    aFactors : Array of Double;
Begin
  drop.X := Trunc(ADistance*Cos(AAngle));
  drop.Y := Trunc(-ADistance*Sin(AAngle));
  GetRgnBox(ARgn, aRgnRect);
 
  if ADiffuse > 0 then
    InflateRect(aRgnRect, ADiffuse, ADiffuse);
 
  width := aRgnRect.Right-aRgnRect.Left;
  height := aRgnRect.Bottom-aRgnRect.Top;
  SetLength(aFactors, width * height);
 
  for yl := aRgnRect.Top to aRgnRect.Bottom do
    for xl := aRgnRect.Left to aRgnRect.Right do begin
      if PtInRegion(ARgn, xl, yl)
        then aFactors[(yl-aRgnRect.Top)*width + (xl-aRgnRect.Left)] := AShade
        else aFactors[(yl-aRgnRect.Top)*width + (xl-aRgnRect.Left)] := 0;
    end;
 
  for i := 0 to ADiffuse-1 do
    for yl := 0 to height-1 do
      for xl := 0 to width-1 do
        if aFactors[yl * width + xl] = 0 then begin
          for by := -1 to 1 do
            for bx := -1 to 1 do
              if (yl+by >= 0) and (yl+by < height) and (xl+bx >= 0) and (xl+bx < width) then begin
                aFactors[yl * width + xl] := aFactors[yl * width + xl] + aFactors[(yl+by) * width + (xl+bx)];
              end;
            aFactors[yl * width + xl] := aFactors[yl * width + xl] / 10;
        end;
 
  for yl := 0 to width-1 do
    for xl := 0 to height-1 do
      if aFactors[yl*width + xl] <> 0 then begin
        xp := aRgnRect.Left+xl+drop.x;
        yp := aRgnRect.Top+yl+drop.y;
        ACanvas.Pixels[xp, yp] := ShadeColor(ACanvas.Pixels[xp, yp], aFactors[yl*width + xl]);
      end;
End;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  // Load your images here... 
  FBackground := TBitmap.Create;
  FBackground.LoadFromFile('C:\background.bmp');
  FPhoto := TBitmap.Create;
  FPhoto.LoadFromFile('C:\photo.bmp');
end;
 
 
Procedure TForm1.PaintImage(aBmp : TBitmap; ATargetCanvas: TCanvas; X, Y : Integer);
var aRgn : HRGN;
Begin
  aRgn := CreateRoundRectRgn(X, Y, X+aBmp.Width, Y+ABmp.Height, 15, 15);
  try
    DropShadowRegion(ATargetCanvas, aRgn, -pi/4, 10, -0.5, 10);
    SelectClipRgn(Canvas.Handle, aRgn);
    ATargetCanvas.Draw(X, Y, aBmp);
    BevelRegion(ATargetCanvas, aRgn);
  finally
    DeleteObject(aRgn);
  end;
End;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FBackground.Free;
  FPhoto.Free;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  Canvas.Draw(10, 10, FBackground);
  PaintImage(FPhoto,
             Canvas,
             10+Random(FBackground.Width - FPhoto.Width),
             10+Random(FBackground.Height - FPhoto.Height));
end;
 
end.

Open in new window

0
 
db2tradeAuthor Commented:
Hi Hypo,

I tested your solution, and here is my comment:

- The rounded corners is good, but not anti-aliased.

- The bevel is not correct, because it is not rounded (I see rectangles)

- The drop shadow is too dark and not soft (the edges)
0
 
HypoCommented:
Hi,
You can lower the darkness of the shadow by changing a parameter in the call to dropshadow.
    DropShadowRegion(ATargetCanvas, aRgn, -pi/4, 10, -0.25, 10);

Regarding the bevel:
I think it's a bit more complicated to get true rounded corners on that bevel. The bevelfunction right now is based on the shape of the region, and it will bevel any borderpixels, even holes in the middle of the region, or any other complex shapes... Anyway, If I have some other ideas of how to do a more rounded bevel, but I don't have the time to try those out for maybe after the next couple of days.

regards
Hypo
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
Eddie ShipmanAll-around developerCommented:
What application did you do that bevel in?
0
 
db2tradeAuthor Commented:
EddieShipman,

I created the examples using Photoshop.
0
 
Eddie ShipmanAll-around developerCommented:
Photoshop uses filters to create that kind of bevel. I do not think that GDI+ has the capability to create that kind of bevel. I'm working on something, however, that may be of interest.
0
 
db2tradeAuthor Commented:
Hmm .. no solution :(
0
 
Eddie ShipmanAll-around developerCommented:
I have not been able to get enough help with GDI+ to finish the example. I've run into some VB code that does something quite like it but translating to Delphi is what is causing the difficulty. If you want to give it a try, be my guest, I'd love to see the results:
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=38644&lngWId=1
0
 
Eddie ShipmanAll-around developerCommented:
This was my attempt at converting some of the code to Delphi. I used the IGDIPlus units available here:
http://www.mitov.com/html/igdi_.html

Also tried the GDI+ API units here: http://www.progdigy.com/?page_id=7

unit uGIDPlusStuff;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, JPEG, GDIPAPI, GDIPOBJ, ExtCtrls, StdCtrls, IGDIPlus;
 
const XPGoldDark   = $001882B0; //#B08218
      XPGoldLight  = $00C3F9FC; //#FCF9C3
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
uses Types;
 
{$R *.dfm}
 
(*
{VB Code}
Private Sub DrawRectangularButtons()
   '
   ' A whole lot of other buttons but I'm only
   ' interested in this one
   '
   '##### RR 3
   DrawGDIPMultiStyleRectangle hDC, _
      140, 110, 260, 150, 4, _
      BrushTypeLinearGradient, _
      3, PenTypeSolidColor, XPGoldLight, XPGoldDark, _
      XPGoldDark, XPGoldLight
 
   ' DrawShell32Icon hDC, 79, 144, 114
 
   DrawGDIPFormattedText hDC, 178, 112, 77, 36, _
      "Raised 3D Gradient Fill", _
      StringAlignmentCenter, Black
   '
   ' More buttons here
   '
End Sub
 
Public Sub DrawGDIPMultiStyleRectangle(ByVal hDC As Long, _
   ByVal x1 As Integer, _
   ByVal y1 As Integer, _
   ByVal x2 As Integer, _
   ByVal y2 As Integer, _
   ByVal radius As Integer, _
   ByVal BrushType As BrushType, _
   ByVal PenWidth As Integer, _
   ByVal PenType As PenType, _
   ByVal BorderColor As Colors, _
   Optional ByVal BorderColor3D As Colors, _
   Optional ByVal StartColor As Colors, _
   Optional ByVal EndColor As Colors, _
   Optional ByVal LGMode As LinearGradientMode = LinearGradientModeVertical, 
_
   Optional ByVal sImageFill As String = "", _
   Optional ByVal sImageBorder As String = "")
 
   Dim graphics         As Long
   Dim pen              As Long
   Dim brush            As Long
   Dim path             As Long
   Dim region           As Long
   Dim img              As Long
   Dim diameter         As Integer
   Dim pt1              As POINTL
   Dim pt2              As POINTL
   Dim p2               As Long
 
   diameter = radius + radius
   ' Initializations
   GdipCreateFromHDC hDC, graphics
   GdipSetSmoothingMode graphics, SmoothingModeAntiAlias
 
   GdipCreatePath FillModeWinding, path
 
   If radius Then
      'Top
      GdipAddPathLineI path, x1 + radius, y1, x2 - radius, y1
      'TopRight
      GdipAddPathArcI path, x2 - diameter, y1, diameter, diameter, 270, 90
      'Right
      GdipAddPathLineI path, x2, y1 + radius, x2, y2 - radius
      'BottomRight
      GdipAddPathArcI path, x2 - diameter, y2 - diameter, diameter, diameter, 0, 90
      'Bottom
      GdipAddPathLineI path, x1 + radius, y2, x2 - radius, y2
      'BottomLeft
      GdipAddPathArcI path, x1, y2 - diameter, diameter, diameter, 90, 90
      'Left
      GdipAddPathLineI path, x1, y1 + radius, x1, y2 - radius
      'TopLeft
      GdipAddPathArcI path, x1, y1, diameter, diameter, 180, 90
   Else
      'Top
      GdipAddPathLineI path, x1, y1, x2, y1
      'Right
      GdipAddPathLineI path, x2, y1, x2, y2
      'Bottom
      GdipAddPathLineI path, x2, y2, x1, y2
      'Left
      GdipAddPathLineI path, x1, y2, x1, y1
   End If
   GdipClosePathFigure path
 
   Select Case PenType
      Case PenTypeSolidColor
         GdipCreatePen1 BorderColor, PenWidth, UnitPixel, pen
      Case PenTypeTextureFill
         If bFileExists(sImageBorder) Then
            GdipLoadImageFromFile StrConv(sImageBorder, vbUnicode), img
            GdipCreateTexture img, WrapModeTile, brush
            GdipCreatePen2 brush, PenWidth, UnitPixel, pen
            GdipDeleteBrush brush
         End If
      Case PenTypeHatchFill
      Case PenTypeLinearGradient
      Case PenTypePathGradient
      Case Else
         'None
   End Select
 
   Select Case BrushType
      Case BrushTypeSolidColor
         GdipCreateSolidFill StartColor, brush
      Case BrushTypeLinearGradient
         pt1.x = x1
         pt1.y = y1
         pt2.x = x1
         pt2.y = y2
         GdipCreateLineBrushI pt1, pt2, StartColor, EndColor, WrapModeTile, brush
      Case BrushTypeHatchFill
 
      Case BrushTypePathGradient
         GdipCreatePathGradientFromPath path, brush
         GdipSetPathGradientCenterColor brush, StartColor
         GdipSetPathGradientSurroundColorsWithCount brush, EndColor, 1
      Case BrushTypeTextureFill
         If bFileExists(sImageFill) Then
            GdipLoadImageFromFile StrConv(sImageFill, vbUnicode), img
            GdipCreateTexture img, WrapModeTile, brush
            GdipDisposeImage img
         End If
      Case Else
         'None
   End Select
 
   If brush Then
      GdipFillPath graphics, brush, path
   End If
 
   GdipDrawPath graphics, pen, path
 
   If BorderColor3D Then
      'Delete old pen
      GdipDeletePen pen
      'Create new pen
      GdipCreatePen1 BorderColor3D, PenWidth, UnitPixel, pen
      If radius Then
         'TopRight(StartAngle = 315°, Sweep = 45°)
         GdipDrawArcI graphics, pen, x2 - diameter, y1, diameter, diameter, 315, 45
         'Right
         GdipDrawLineI graphics, pen, x2, y1 + radius - 1, x2, y2 - radius + 1
         'BottomRight
         GdipDrawArcI graphics, pen, x2 - diameter, y2 - diameter, diameter, diameter, 0, 90
         'Bottom
         GdipDrawLineI graphics, pen, x1 + radius - 1, y2, x2 - radius + 1, y2
         'BottomLeft(StartAngle = 90°, Sweep = 45°)
         GdipDrawArcI graphics, pen, x1, y2 - diameter, diameter, diameter, 90, 45
      Else
         p2 = PenWidth \ 2
         'TopRight(StartAngle = 315°, Sweep = 45°)
         'GdipDrawArcI graphics, pen, x2 - diameter, y1, diameter, diameter, 315, 45
         'Right
         GdipDrawLineI graphics, pen, x2, y1 + p2, x2, y2 + p2
         'Bottom
         GdipDrawLineI graphics, pen, x2 + p2, y2, x1 + p2, y2
         'BottomLeft(StartAngle = 90°, Sweep = 45°)
         'GdipDrawArcI graphics, pen, x1, y2 - diameter, diameter, diameter, 90, 45
      End If
   End If
 
   ' Cleanup
   GdipDeletePen pen
   GdipDeleteBrush brush
   GdipDeletePath path
   GdipDisposeImage img
   GdipDeleteGraphics graphics
 
End Sub
 
Public Sub DrawGDIPFormattedText(ByVal hDC As Long, _
   ByVal x1 As Single, _
   ByVal y1 As Single, _
   ByVal x2 As Single, _
   ByVal y2 As Single, _
   ByVal sText As String, _
   ByVal StringAlignment As StringAlignment, _
   ByVal PenColor As Colors)
 
   Dim graphics         As Long
   Dim brush            As Long
   Dim pen              As Long
   Dim fontFam          As Long
   Dim curFont          As Long
   Dim strFormat        As Long
   Dim rct              As RECTF   ' Designates the string drawing bounds
   Dim str              As String
 
   ' Initializations
   GdipCreateFromHDC hDC, graphics   ' Initialize the graphics class - required for all drawing
   GdipCreateSolidFill PenColor, brush     ' Create a brush to draw the text with
   ' Create a font family object to allow use to create a font
   ' We have no font collection here, so pass a NULL for that parameter
   GdipCreateFontFamilyFromName StrConv("Arial", vbUnicode), 0, fontFam
   ' Create the font from the specified font family name
   ' >> Note that we have changed the drawing Unit from pixels to points!!
   GdipCreateFont fontFam, 8, FontStyleRegular, UnitPoint, curFont
   ' Create the StringFormat object
   ' We can pass NULL for the flags and language id if we want
   GdipCreateStringFormat 0, 0, strFormat
 
   ' Set up the drawing area boundary
   rct.Left = x1
   rct.Top = y1
   rct.Right = x2
   rct.Bottom = y2
 
   ' Center-justify each line of text
   GdipSetStringFormatAlign strFormat, StringAlignment
 
   ' Center the block of text (top to bottom) in the rectangle.
   GdipSetStringFormatLineAlign strFormat, StringAlignment
 
   ' Draw the string within the boundary
   str = StrConv(sText, vbUnicode)
   GdipDrawString graphics, str, -1, curFont, rct, strFormat, brush
 
   ' Cleanup
   GdipDeleteStringFormat strFormat
   GdipDeleteFont curFont
   GdipDeleteFontFamily fontFam
   GdipDeleteBrush brush
   GdipDeleteGraphics graphics
End Sub
 
*)
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  // Load your image here...
  Image1.Picture.LoadFromFile('C:\background.bmp');
end;
 
procedure DrawGDIPMultiStyleRectangle(
  hDC:           Integer;
  x1:            Integer;
  y1:            Integer;
  x2:            Integer;
  y2:            Integer;
  radius:        Integer;
  BrushType:     BrushType;
  PenWidth:      Integer;
  PenType:       PenType;
  BorderColor:   ARGB;
  BorderColor3D: ARGB;
  StartColor:    ARGB;
  EndColor:      ARGB;
  LGMode:        LinearGradientMode;
  sImageFill:    String;
  sImageBorder:  String);
var
  graphics: GPGRAPHICS;
  pen:      GPPEN;
  brush:    GPBRUSH;
  path:     GPPATH;
  region:   GPREGION;
  img:      GPIMAGE;
  diameter: Integer;
  pt1:      TGPPOINT;
  pt2:      TGPPOINT;
  p2:       Integer;
begin
  LGMode       := LinearGradientModeVertical;
  sImageFill   := '';
  sImageborder := '';
  diameter := radius + radius;
  // Initializations
  GdipCreateFromHDC(hDC, graphics);
  GdipSetSmoothingMode(graphics, SmoothingModeAntiAlias);
 
  GdipCreatePath(FillModeWinding, path);
 
  if radius > 0 then
  begin
     //Top
     GdipAddPathLineI(path, x1 + radius, y1, x2 - radius, y1);
     //TopRight
     GdipAddPathArcI(path, x2 - diameter, y1, diameter, diameter, 270, 90);
     //Right
     GdipAddPathLineI(path, x2, y1 + radius, x2, y2 - radius);
     //BottomRight
     GdipAddPathArcI(path, x2 - diameter, y2 - diameter, diameter, diameter, 0, 90);
     //Bottom
     GdipAddPathLineI(path, x1 + radius, y2, x2 - radius, y2);
     //BottomLeft
     GdipAddPathArcI(path, x1, y2 - diameter, diameter, diameter, 90, 90);
     //Left
     GdipAddPathLineI(path, x1, y1 + radius, x1, y2 - radius);
     //TopLeft
     GdipAddPathArcI(path, x1, y1, diameter, diameter, 180, 90);
  end
  else
  begin
     //Top
     GdipAddPathLineI(path, x1, y1, x2, y1);
     //Right
     GdipAddPathLineI(path, x2, y1, x2, y2);
     //Bottom
     GdipAddPathLineI(path, x2, y2, x1, y2);
     //Left
     GdipAddPathLineI(path, x1, y2, x1, y1);
  end;
  GdipClosePathFigure(path);
 
  Case PenType of
  PenTypeSolidColor:
        GdipCreatePen1(BorderColor, PenWidth, UnitPixel, pen);
  PenTypeTextureFill:
    begin
      if FileExists(sImageBorder) then
      begin
        GdipLoadImageFromFile(PWideChar(sImageBorder), img);
        GdipCreateTexture(img, WrapModeTile, brush);
        GdipCreatePen2(brush, PenWidth, UnitPixel, pen);
        GdipDeleteBrush(brush);
      end;
    end;
  { Not used so not converted...
  PenTypeHatchFill:
  PenTypeLinearGradient:
  PenTypePathGradient:
  }
  end; // case
 
  Case BrushType of
  BrushTypeSolidColor:
     GdipCreateSolidFill(StartColor, brush);
  BrushTypeLinearGradient:
    begin
      pt1.X := x1;
      pt1.Y := y1;
      pt2.X := x1;
      pt2.Y := y2;
      GdipCreateLineBrushI(@pt1, @pt2, StartColor, EndColor, WrapModeTile, brush);
    end;
  { Not used so not converted...
  BrushTypeHatchFill:
 
  BrushTypePathGradient:
    begin
      GdipCreatePathGradientFromPath(path, brush);
      GdipSetPathGradientCenterColor(brush, StartColor);
      GdipSetPathGradientSurroundColorsWithCount(brush, EndColor, 1);
    end;
  BrushTypeTextureFill:
    begin
      if bFileExists(sImageFill) then
      begin
         GdipLoadImageFromFile(StrConv(sImageFill, vbUnicode), img);
         GdipCreateTexture(img, WrapModeTile, brush);
         GdipDisposeImage(img);
      end;
    end;
  }
  end; // Case
 
  if Assigned(brush) then
     GdipFillPath(graphics, brush, path);
 
  GdipDrawPath(graphics, pen, path);
 
  if BorderColor3D > 0 then
  begin
     //Delete old pen
     GdipDeletePen(pen);
 
     //Create new pen
     GdipCreatePen1(BorderColor3D, PenWidth, UnitPixel, pen);
     if radius > 0 then
     begin
        //TopRight(StartAngle := 315°, Sweep := 45°)
        GdipDrawArcI(graphics, pen, x2 - diameter, y1, diameter, diameter,315, 45);
 
        //Right
        GdipDrawLineI(graphics, pen, x2, y1 + radius - 1, x2, y2 - radius + 1);
 
        //BottomRight
        GdipDrawArcI(graphics, pen, x2 - diameter, y2 - diameter, diameter, diameter, 0, 90);
 
        //Bottom
        GdipDrawLineI(graphics, pen, x1 + radius - 1, y2, x2 - radius + 1,y2);
 
        //BottomLeft(StartAngle := 90°, Sweep := 45°)
        GdipDrawArcI(graphics, pen, x1, y2 - diameter, diameter, diameter, 90, 45);
     end
     else
     begin
        p2 := PenWidth div 2;
 
        //TopRight(StartAngle := 315°, Sweep := 45°)
        // GdipDrawArcI(graphics, pen, x2 - diameter, y1, diameter, diameter, 315, 45);
        //Right
        GdipDrawLineI(graphics, pen, x2, y1 + p2, x2, y2 + p2);
        //Bottom
 
        GdipDrawLineI(graphics, pen, x2 + p2, y2, x1 + p2, y2);
        //BottomLeft(StartAngle := 90°, Sweep := 45°)
        //GdipDrawArcI(graphics, pen, x1, y2 - diameter, diameter, diameter, 90, 45);
     end;
  end;
 
  // Cleanup
  GdipDeletePen(pen);
  GdipDeleteBrush(brush);
  GdipDeletePath(path);
  GdipDisposeImage(img);
  GdipDeleteGraphics(graphics);
end;
 
procedure DrawGDIPFormattedText(
  hDC: Integer;
  x1:              Single;
  y1:              Single;
  x2:              Single;
  y2:              Single;
  sText:           String;
  StringAlignment: StringAlignment;
  PenColor:        TColor);
var
  graphics:  GPGRAPHICS;
  brush:     GPBRUSH;
  pen:       GPPEN;
  fontFam:   GPFONTFAMILY;
  curFont:   GPFONT;
  strFormat: GPSTRINGFORMAT;
  rct:       TGPRectF;   // Designates the string drawing bounds
begin
   // Initializations
   // Initialize the graphics class - required for all drawing
   GdipCreateFromHDC(hDC, graphics);
 
   // Create a brush to draw the text with
   GdipCreateSolidFill(PenColor, brush);
 
   // Create a font family object to allow use to create a font
   // We have no font collection here, so pass a NULL for that parameter
   GdipCreateFontFamilyFromName('Arial', 0, fontFam);
 
   // Create the font from the specified font family name
   // >> Note that we have changed the drawing Unit from pixels to points!!
   GdipCreateFont(fontFam, 8, FontStyleRegular, 3 {UnitPoint}, curFont);
 
   // Create the StringFormat object
   // We can pass NULL for the flags and language id if we want
   GdipCreateStringFormat(0, 0, strFormat);
 
   // Set up the drawing area boundary
   rct.X   := Trunc(x1);
   rct.Y   := Trunc(y1);
   rct.Width  := Trunc(x2);
   rct.Height := Trunc(y2);
 
   // Center-justify each line of text
   GdipSetStringFormatAlign(strFormat, StringAlignment);
 
   // Center the block of text (top to bottom) in the rectangle.
   GdipSetStringFormatLineAlign(strFormat, StringAlignment);
 
   // Draw the string within the boundary
   GdipDrawString(graphics, PWideChar(sText), -1, curFont, ^rct, strFormat, brush);
 
   // Cleanup
   GdipDeleteStringFormat(strFormat);
   GdipDeleteFont(curFont);
   GdipDeleteFontFamily(fontFam);
   GdipDeleteBrush(brush);
   GdipDeleteGraphics(graphics);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
   DoStartup;
   // Gradient Fill (XP Button colors)
   DrawGDIPMultiStyleRectangle(
                 Form1.Canvas.Handle,         //hDC: Integer;
                 140,                          //x1: Integer;
                 110,                          //xy1: Integer;
                 260,                          //xx2: Integer;
                 150,                          //xy2: Integer;
                 4,                            //xradius: Integer;
                 BrushTypeLinearGradient,      //xBrushType: BrushType;
                 3,                            //xPenWidth: Integer;
                 PenTypeSolidColor,            //xPenType: PenType;
                 XPGoldLight,                  //xBorderColor: ARGB;
                 XPGoldDark,                   //xBorderColor3D: ARGB;
                 XPGoldDark,                   //xStartColor: ARGB;
                 XPGoldLight,                  //xEndColor: ARGB;
                 LinearGradientModeHorizontal, //xLGMode:
                 '',                           //xsImageFill: String;
                 '');                          //xsImageBorder: String);
 
   // DrawShell32Icon hDC, 79, 144, 114
 
   DrawGDIPFormattedText(
     Form1.Canvas.Handle,
     178,
     112,
     77,
     36,
     'Raised 3D Gradient Fill',
     StringAlignmentCenter,
     clBlack);
 
 
   DoShutDown;
end;
 
end.
 
{DFM}
object Form1: TForm1
  Left = 281
  Top = 81
  Width = 870
  Height = 640
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Image1: TImage
    Left = 424
    Top = 16
    Width = 425
    Height = 297
    AutoSize = True
  end
  object Button1: TButton
    Left = 16
    Top = 16
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
end

Open in new window

0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 4
  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now