paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-23 08:19:41 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: add TLazIntfImage.Mask(color,keepmask), move a piece of code from rasterimage.mask to TLazIntfImage.Mask

Browse Source 
git-svn-id: trunk@34012 -
This commit is contained in:
paul 2011-12-07 02:06:39 +00:00
parent c87fc2a9cf
commit 91b8188bd0
2 changed files with 21 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
lcl/include/rasterimage.inc
View File

@ -756,9 +756,9 @@ end;
procedure TRasterImage.CreateMask(AColor: TColor);
var
IntfImage: TLazIntfImage;
x, y, stopx, stopy: Integer;
x, y: Integer;
ImgHandle, MskHandle: HBitmap;
TransColor: TColorRef;
TransColor: TFPColor;
begin
//DebugLn(['TRasterImage.CreateMask ',Width,'x',Height,' ',Transparent,' ',dbgs(ord(TransparentMode)),' ',dbgs(TransparentColor)]);
if (Width = 0)
@ -787,21 +787,16 @@ begin
if not MaskHandleAllocated
then DeleteObject(MskHandle);
ImgHandle := 0;
stopx := IntfImage.Width - 1;
stopy := IntfImage.Height - 1;
if AColor = clDefault
then begin
if (FTransparentMode = tmFixed) and (FTransparentColor <> clDefault)
then TransColor := ColorToRGB(FTransparentColor)
else TransColor := FPColorToTColorRef(IntfImage.Colors[0, stopy]);
then TransColor := TColorToFPColor(ColorToRGB(FTransparentColor))
else TransColor := IntfImage.Colors[0, IntfImage.Height - 1];
end
else TransColor := ColorToRGB(AColor);
else TransColor := TColorToFPColor(ColorToRGB(AColor));
for y := 0 to stopy do
for x := 0 to stopx do
IntfImage.Masked[x,y] := FPColorToTColorRef(IntfImage.Colors[x,y]) = TransColor;
IntfImage.Mask(TransColor);
IntfImage.CreateBitmaps(ImgHandle, MskHandle);
MaskHandle := MskHandle;

15
lcl/intfgraphics.pas
View File

@ -252,6 +252,7 @@ type
AlphaMask: Boolean = False; AlphaTreshold: Word = 0); virtual;
procedure AlphaBlend(ASource, ASourceAlpha: TLazIntfImage; const ADestX, ADestY: Integer);
procedure AlphaFromMask(AKeepAlpha: Boolean = True);
procedure Mask(const AColor: TFPColor; AKeepOldMask: Boolean = False);
procedure GetXYDataPosition(x, y: integer; out Position: TRawImagePosition);
procedure GetXYMaskPosition(x, y: integer; out Position: TRawImagePosition);
function GetDataLineStart(y: integer): Pointer;// similar to Delphi TBitmap.ScanLine. Only works with lines aligned to whole bytes.
@ -3272,6 +3273,20 @@ begin
end;
end;
procedure TLazIntfImage.Mask(const AColor: TFPColor; AKeepOldMask: Boolean = False);
var
x, y: Integer;
begin
if AKeepOldMask then
for y := 0 to Height - 1 do
for x := 0 to Width - 1 do
Masked[x,y] := Masked[x,y] or (Colors[x,y] = AColor)
else
for y := 0 to Height - 1 do
for x := 0 to Width - 1 do
Masked[x,y] := Colors[x,y] = AColor;
end;
procedure TLazIntfImage.BeginUpdate;
begin
Inc(FUpdateCount);