From 83249c4946aa7fead167572b34e0361adc03ff72 Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Tue, 31 Aug 2010 15:47:38 +0000 Subject: [PATCH] Adds support for alpha while drawing rectangles in the icon editor git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1307 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/rgbgraphics/rgbgraphics.pas | 35 ++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/components/rgbgraphics/rgbgraphics.pas b/components/rgbgraphics/rgbgraphics.pas index 0134dc9e5..f545b2a37 100644 --- a/components/rgbgraphics/rgbgraphics.pas +++ b/components/rgbgraphics/rgbgraphics.pas @@ -152,6 +152,8 @@ type procedure Ellipse(X1, Y1, X2, Y2: Integer); procedure FloodFill(X, Y: Integer); procedure MaskFloodFill(X, Y: Integer); + // Alpha drawing methods + procedure AlphaRectangle(X1, Y1, X2, Y2, AAlpha: Integer); public procedure DrawTo(ACanvas: TCanvas; X, Y: Integer); procedure StretchDrawTo(ACanvas: TCanvas; DstX, DstY, DstWidth, DstHeight: Integer); @@ -770,6 +772,39 @@ begin @SamePixelUnmasked, (FOwner as TRGB32Bitmap).Mask.GetFillProcedure);; end; +// AAlpha is the alpha of the rectangle, ranging from +// 0 - fully transparent to 100 - fully opaque +procedure TRGB32Canvas.AlphaRectangle(X1, Y1, X2, Y2, AAlpha: Integer); +var + OldColor, NewColor: Integer; + X, Y: LongInt; + OldR, OldG, OldB, NewR, NewG, NewB: Byte; +begin + // If the rectangle is fully opaque this is the same as a normal rectangle + if AAlpha = 100 then + begin + Rectangle(X1, Y1, X2, Y2); + Exit; + end; + + // if it is fully transparent there is nothing to draw + if AAlpha = 0 then Exit; + + // A partially transparent rectangle + for Y := Y1 to Y2 do + for X := X1 to X2 do + begin + OldColor := GetColor(X, Y); + RedGreenBlue(OldColor, OldR, OldG, OldB); + + NewR := ((100 - AAlpha) * OldR + AAlpha * Red(FillColor)) div 100; + NewG := ((100 - AAlpha) * OldG + AAlpha * Green(FillColor)) div 100; + NewB := ((100 - AAlpha) * OldB + AAlpha * Blue(FillColor)) div 100; + + SetColor(X, Y, RGBToColor(NewR, NewG, NewB)); + end; +end; + procedure TRGB32Canvas.DrawTo(ACanvas: TCanvas; X, Y: Integer); begin if ACanvas <> nil then