Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement