SHARE
TWEET

AlphaBlendPolygon

uligerhardt Nov 8th, 2011 97 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. procedure NormalizeRect(var r: TRect);
  2. var
  3.   t: Integer;
  4. begin
  5.   if r.Left > r.Right then
  6.   begin
  7.     t := r.Right;
  8.     r.Right := r.Left;
  9.     r.Left := t;
  10.   end;
  11.   if r.Top > r.Bottom then
  12.   begin
  13.     t := r.Bottom;
  14.     r.Bottom := r.Top;
  15.     r.Top := t;
  16.   end;
  17. end;
  18.  
  19. // AlphaBlendRect: draws an alphablended rectangle:
  20. procedure AlphaBlendRect(DC: HDC; const ARect: TRect; AColor: TColor; AIntensity: Byte);
  21. var
  22.   Bitmap: TBitmap;
  23.   BlendParams: TBlendFunction;
  24.   rClip, rBlend: TRect;
  25.  
  26.   function GetBlendColor: TRGBQuad;
  27.  
  28.     function PreMult(b: Byte): Byte;
  29.     begin
  30.       Result := (b * AIntensity) div $FF;
  31.     end;
  32.  
  33.   var
  34.     cr: TColorRef;
  35.   begin
  36.     cr := ColorToRGB(AColor);
  37.     Result.rgbBlue := PreMult(GetBValue(cr));
  38.     Result.rgbGreen := PreMult(GetGValue(cr));
  39.     Result.rgbRed := PreMult(GetRValue(cr));
  40.     Result.rgbReserved := AIntensity;
  41.   end;
  42.  
  43. begin
  44.   GetClipBox(DC, rClip);
  45.   NormalizeRect(rClip);
  46.   rBlend := ARect;
  47.   NormalizeRect(rBlend);
  48.  
  49.   if not IntersectRect(rBlend, rClip, rBlend) then
  50.     Exit;
  51.  
  52.   Bitmap := TBitmap.Create;
  53.   try
  54.     Bitmap.PixelFormat := pf32bit;
  55.     Bitmap.SetSize(1, 1);
  56.     PRGBQuad(Bitmap.ScanLine[0])^ := GetBlendColor;
  57.  
  58.     BlendParams.BlendOp := AC_SRC_OVER;
  59.     BlendParams.BlendFlags := 0;
  60.     BlendParams.SourceConstantAlpha := $FF;
  61.     BlendParams.AlphaFormat := AC_SRC_ALPHA;
  62.  
  63.     Windows.AlphaBlend(
  64.       DC, rBlend.Left, rBlend.Top, rBlend.Right - rBlend.Left, rBlend.Bottom - rBlend.Top,
  65.       Bitmap.Canvas.Handle, 0, 0, 1, 1,
  66.       BlendParams);
  67.   finally
  68.     Bitmap.Free;
  69.   end;
  70. end;
  71.  
  72. // AlphaBlendPolygon: draws an alphablended polygon:
  73. procedure AlphaBlendPolygon(DC: HDC; const APoints: array of TPoint; AColor: TColor; AIntensity: Byte);
  74.  
  75.   procedure SetClip(APoints: array of TPoint); // pass APoints by value
  76.   var
  77.     rgn: HRGN;
  78.   begin
  79.     LPtoDP(DC, APoints[0], Length(APoints));
  80.     rgn := CreatePolygonRgn(APoints[0], Length(APoints), ALTERNATE);
  81.     try
  82.       ExtSelectClipRgn(DC, rgn, RGN_AND);
  83.     finally
  84.       DeleteObject(rgn);
  85.     end;
  86.   end;
  87.  
  88. var
  89.   SaveIndex: Integer;
  90.   rClip: TRect;
  91. begin
  92.   SaveIndex := SaveDC(DC);
  93.   try
  94.     SetClip(APoints);
  95.     GetClipBox(DC, rClip);
  96.     AlphaBlendRect(DC, rClip, AColor, AIntensity);
  97.   finally
  98.     RestoreDC(DC, SaveIndex);
  99.   end;
  100. end;
  101.  
  102.  
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top