mORMot Open Source

array81

Member

From: Italy

Registered: 2010-07-23

Posts: 411

Draw semitransparent polygons

Hi,

I have a TBitmap or a TCanvas with a picture. Now I need add some semitransparent polygons with different color over picture.
I think this is possible with GDI+ but I cannot get information about it.

Is it possible get a piace of code about it?

Thanks

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,570

Website

Re: Draw semitransparent polygons

You need to use the AlphaBlend function, but it is not available in SynGDI+

uligerhardt

Member

Registered: 2011-03-08

Posts: 52

Re: Draw semitransparent polygons

These articles helped me with a similar task: http://itinerantdeveloper.blogspot.de/s … ansparency. I came up with this:

procedure NormalizeRect(var r: TRect);
var
  t: Integer;
begin
  if r.Left > r.Right then
  begin
    t := r.Right;
    r.Right := r.Left;
    r.Left := t;
  end;
  if r.Top > r.Bottom then
  begin
    t := r.Bottom;
    r.Bottom := r.Top;
    r.Top := t;
  end;
end;

// AlphaBlendRect: draws an alphablended rectangle:
procedure AlphaBlendRect(DC: HDC; const ARect: TRect; AColor: TColor; AIntensity: Byte);
var
  Bitmap: TBitmap;
  BlendParams: TBlendFunction;
  rClip, rBlend: TRect;

  function GetBlendColor: TRGBQuad;

    function PreMult(b: Byte): Byte;
    begin
      Result := (b * AIntensity) div $FF;
    end;

  var
    cr: TColorRef;
  begin
    cr := ColorToRGB(AColor);
    Result.rgbBlue := PreMult(GetBValue(cr));
    Result.rgbGreen := PreMult(GetGValue(cr));
    Result.rgbRed := PreMult(GetRValue(cr));
    Result.rgbReserved := AIntensity;
  end;

begin
  GetClipBox(DC, rClip);
  NormalizeRect(rClip);
  rBlend := ARect;
  NormalizeRect(rBlend);

  if not IntersectRect(rBlend, rClip, rBlend) then
    Exit;

  Bitmap := TBitmap.Create;
  try
    Bitmap.PixelFormat := pf32bit;
    Bitmap.SetSize(1, 1);
    PRGBQuad(Bitmap.ScanLine[0])^ := GetBlendColor;

    BlendParams.BlendOp := AC_SRC_OVER;
    BlendParams.BlendFlags := 0;
    BlendParams.SourceConstantAlpha := $FF;
    BlendParams.AlphaFormat := AC_SRC_ALPHA;

    Windows.AlphaBlend(
      DC, rBlend.Left, rBlend.Top, rBlend.Right - rBlend.Left, rBlend.Bottom - rBlend.Top,
      Bitmap.Canvas.Handle, 0, 0, 1, 1,
      BlendParams);
  finally
    Bitmap.Free;
  end;
end;

// AlphaBlendPolygon: draws an alphablended polygon:
procedure AlphaBlendPolygon(DC: HDC; const APoints: array of TPoint; AColor: TColor; AIntensity: Byte);

  procedure SetClip(APoints: array of TPoint); // pass APoints by value
  var
    rgn: HRGN;
  begin
    LPtoDP(DC, APoints[0], Length(APoints));
    rgn := CreatePolygonRgn(APoints[0], Length(APoints), ALTERNATE);
    try
      ExtSelectClipRgn(DC, rgn, RGN_AND);
    finally
      DeleteObject(rgn);
    end;
  end;

var
  SaveIndex: Integer;
  rClip: TRect;
begin
  SaveIndex := SaveDC(DC);
  try
    SetClip(APoints);
    GetClipBox(DC, rClip);
    AlphaBlendRect(DC, rClip, AColor, AIntensity);
  finally
    RestoreDC(DC, SaveIndex);
  end;
end;

which works quite well for me.