Add dropshadow to a TBitmap

Question

I have a routine that takes screenshots (TBitmap), I need to add drop-shadow to the final TBitmap/image, I have this code (which used to work but...) something isn't right, the drop-shadow simply isn't drawn:

// --------------------------------------------------------------------- //
procedure TakeScreenshot();
var
   lCapRect : TRect;
   DestBitmap : TBitmap;
begin
     // Take the screenshot & assign it to DestBitmap
     // ...

     // Add the drop shadow to DestBitmap
     DestBitmap.Width  := DestBitmap.Width + 6;
     DestBitmap.Height := DestBitmap.Height + 6;

     PaintShadow(DestBitmap.Canvas, lCapRect);
end;
// --------------------------------------------------------------------- //
procedure PaintShadow(ACanvas : TCanvas; ARect : TRect);
var
   AColor         : TColor;
   i, iMax        : Integer;
   h1, h2, v1, v2 : Integer;
begin
     AColor := ACanvas.Brush.Color;
     iMax   := 6;
     h1     := ARect.Left;
     h2     := ARect.Right;
     v1     := ARect.Top;
     v2     := ARect.Bottom;

     with ACanvas do
     begin
      for i := iMax downto 0 do
      begin
           ACanvas.Pen.Mode := pmMask;
           Pen.Color        := DarkenColorBy(AColor, ((iMax - i) * 4 + 10));

           MoveTo(h1 + 4{i}, v2 + i);
           LineTo(h2 + i + 1, v2 + i);
      end;    // for

      for i := iMax downto 0 do
      begin
           ACanvas.Pen.Mode := pmMask;
           Pen.Color        := DarkenColorBy(AColor, ((iMax - i) * 4 + 10));

           MoveTo(h2 + i, v1 + 4{i});
           LineTo(h2 + i, v2 + i);
      end;    // for
     end;    // with
end;
// --------------------------------------------------------------------- //
function Max(const A, B: Integer): Integer;
begin
     if (A > B) then
    Result  := A
     else
     Result := B;
end;
// --------------------------------------------------------------------- //
function DarkenColorBy(BaseColor : TColor; Amount : Integer) : TColor;
begin
     Result := RGB(Max(GetRValue(ColorToRGB(BaseColor)) - Amount, 0),
           Max(GetGValue(ColorToRGB(BaseColor)) - Amount, 0),
           Max(GetBValue(ColorToRGB(BaseColor)) - Amount, 0));
end;

My question is: How can I fix this (OR anyone know a simple way to add dropshadow to a TBitmap)?

The final image is meant to be saved as bmp/jpg, not shown in a TImage, so I really need to add drop shadow to the image itself.

PS. I'm using Delphi 7 Pro, my app is restricted to Windows XP or later

EDIT

lCapRect depends on the settings (whether I'm capturing the active monitor, window or all the desktop monitors), but let's say it's calculated this way:

lCapRect.Right  := Screen.DesktopLeft + Screen.DesktopWidth;
lCapRect.Bottom := Screen.DesktopTop + Screen.DesktopHeight;
lCapRect.Left   := Screen.DesktopLeft;
lCapRect.Top    := Screen.DesktopTop;

The bitmap does contain the screenshot (+ 6 pixels added to the bottom & right sides to make room for the dropshadow), it's just that the drop shadow drawing doesn't happen

I would recommend GDI+ (bilsen.com/gdiplus/index.shtml) which has the capabilty of creating brushes with an alpha value, but unfortunately it's D2009 and up only — Alan Clark

Sertac Akyuz Sertac Akyuz · Accepted Answer · 2012-06-06T17:46:40

You haven't shown how you are calculating lCapRect. For not drawing off the bitmap regarding your PaintShadow procedure, it has to be smaller than the bitmap, example:

lCapRect := DestBitmap.Canvas.ClipRect;

// Add the drop shadow to DestBitmap
DestBitmap.Width  := DestBitmap.Width + 6;
DestBitmap.Height := DestBitmap.Height + 6;

PaintShadow(DestBitmap.Canvas, lCapRect);

Add dropshadow to a TBitmap

1 Answers