paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-21 22:39:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

Improves bitmapped button and adds an alpha blending routine to TLazIntfImage

Browse Source 
git-svn-id: trunk@26760 -
This commit is contained in:
sekelsenmat 2010-07-21 07:35:04 +00:00
parent add468dac9
commit fc9813f9cf
2 changed files with 158 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

127
components/customdrawn/customdrawncontrols.pas
View File

@ -14,17 +14,20 @@ unit customdrawncontrols;
interface
uses
Classes, SysUtils, Graphics, Controls, LCLType, LCLIntf;
Classes, SysUtils, Graphics, Controls, LCLType, LCLIntf, IntfGraphics;
type
TBitmappedButtonOption = (bboCheckable, bboUseImageForSelection,
bboUseImageForMouseOver);
// commented items are not yet supported
TBitmappedButtonOption = (bboUseAlphaBlending, bboUseImageForSelection
{bboUseImageForMouseOver, bboDrawFocusRectangle,}
(*bboCheckable,*));
TBitmappedButtonOptions = set of TBitmappedButtonOption;
TBitmappedButtonState = (bbsNormal, bbsDown, bbsMouseOver,
bbsSelected, bbsChecked, bbsCheckedSelected, bbsCheckedDown { is going to be unchecked });
// commented items are not yet supported
TBitmappedButtonState = (bbsNormal, bbsDown, bbsMouseOver, bbsFocused
(* bbsChecked, bbsCheckedSelected, bbsCheckedDown { is going to be unchecked }*));
{ TCustomBitmappedButton }
@ -32,11 +35,12 @@ type
private
FOnChange: TNotifyEvent;
protected
FImageBtn: TBitmap;
FImageBtnDown: TBitmap;
FImageBtnMouseOver: TBitmap;
FImageBtnSelected: TBitmap;
FImageBtnChecked: TBitmap;
FImageBtn: TPicture;
FImageBtnDown: TPicture;
FImageBtnMouseOver: TPicture;
FImageBtnFocused: TPicture;
FImageBtnChecked: TPicture;
FImageBtnAlpha: TPicture;
FOptions: TBitmappedButtonOptions;
FState: TBitmappedButtonState;
// keyboard
@ -51,26 +55,41 @@ type
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
procedure MouseEnter; override;
procedure MouseLeave; override;
protected
// Properties
property ImageBtn: TPicture read FImageBtn;
property ImageBtnDown: TPicture read FImageBtnDown;
property ImageBtnFocused: TPicture read FImageBtnFocused;
property ImageBtnAlpha: TPicture read FImageBtnAlpha;
property Options: TBitmappedButtonOptions read FOptions write FOptions;
// Events
property OnChange: TNotifyEvent read FOnChange write FOnChange;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure EraseBackground(DC: HDC); override;
procedure Paint; override;
function GetStateBitmap(): TBitmap;
// Properties
property ImageBtn: TBitmap read FImageBtn;
property ImageBtnDown: TBitmap read FImageBtnDown;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
{@@
TBitmappedButton is a simple custom drawn button which bases it's drawing
on provided raster images. Currently the following states are supported:
normal, down and focused. The button may be drawn flat or alpha blended
using a separate image for the Alpha channel. While pixels in the alpha
channel will result in the button pixel being fully drawn, while black
pixels represent pixels which aren't drawn. grey pixels are alpha blended.
}
TBitmappedButton = class(TCustomBitmappedButton)
published
property ImageBtn: TBitmap;
property ImageBtnDown: TBitmap;
{ FImageBtnMouseOver: TBitmap;
FImageBtnSelected: TBitmap;
FImageBtnChecked: TBitmap;
FOptions: TBitmappedButtonOptions;}
property ImageBtn;
property ImageBtnDown;
property ImageBtnFocused;
property ImageBtnAlpha;
property Options;
// Events
property OnChange;
end;
procedure Register;
@ -110,8 +129,8 @@ var
NewState: TBitmappedButtonState;
begin
case FState of
bbsNormal, bbsSelected: NewState := bbsDown;
bbsChecked, bbsCheckedSelected: NewState := bbsCheckedDown;
bbsNormal, bbsFocused: NewState := bbsDown;
// bbsChecked, bbsCheckedSelected: NewState := bbsCheckedDown;
end;
if NewState <> FState then
@ -125,7 +144,28 @@ end;
procedure TCustomBitmappedButton.MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
NewState: TBitmappedButtonState;
begin
case FState of
bbsDown:
begin
if Focused then NewState := bbsFocused
else NewState := bbsNormal;
end;
{ bbsCheckedDown:
begin
if Focused then NewState := bbsCheckedSelected
else NewState := bbsChecked;
end;}
end;
if NewState <> FState then
begin
FState := NewState;
Invalidate;
end;
inherited MouseUp(Button, Shift, X, Y);
end;
@ -142,6 +182,15 @@ end;
constructor TCustomBitmappedButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FOptions := [{bboDrawSelectionRectangle}];
FImageBtn := TPicture.Create;
FImageBtnDown := TPicture.Create;
FImageBtnMouseOver := TPicture.Create;
FImageBtnFocused := TPicture.Create;
FImageBtnChecked := TPicture.Create;
FImageBtnAlpha := TPicture.Create;
end;
destructor TCustomBitmappedButton.Destroy;
@ -149,8 +198,9 @@ begin
if Assigned(FImageBtn) then FImageBtn.Free;
if Assigned(FImageBtnDown) then FImageBtnDown.Free;
if Assigned(FImageBtnMouseOver) then FImageBtnMouseOver.Free;
if Assigned(FImageBtnSelected) then FImageBtnSelected.Free;
if Assigned(FImageBtnFocused) then FImageBtnFocused.Free;
if Assigned(FImageBtnChecked) then FImageBtnChecked.Free;
if Assigned(FImageBtnAlpha) then FImageBtnAlpha.Free;
inherited Destroy;
end;
@ -161,18 +211,37 @@ begin
end;
procedure TCustomBitmappedButton.Paint;
{var
lBitmap: TBitmap;
lImageIntf, lAlphaIntf: TLazIntfImage;}
begin
Canvas.Draw(0, 0, GetStateBitmap());
{ if [bboUseAlphaBlending] in FOptions then
begin
lBitmap := TBitmap.Create;
lImageIntf := TLazIntfImage.Create(0, 0);
lAlphaIntf := TLazIntfImage.Create(0, 0);
try
lImageIntf.LoadFromBitmap(lBitmap.Handle, lBitmap.MaskHandle);
lImageIntf
Canvas.Draw(0, 0, lBitmap);
finally
lBitmap.Free;
lImageIntf.Free;
lAlphaIntf.Free;
end;
end
else}
Canvas.Draw(0, 0, GetStateBitmap());
end;
function TCustomBitmappedButton.GetStateBitmap(): TBitmap;
begin
case FState of
bbsNormal: Result := FImageBtn;
bbsDown: Result := FImageBtnDown;
bbsMouseOver: Result := FImageBtnMouseOver;
bbsSelected: Result := FImageBtnSelected;
bbsChecked: Result := FImageBtnChecked;
bbsNormal: Result := FImageBtn.Bitmap;
bbsDown: Result := FImageBtnDown.Bitmap;
// bbsMouseOver: Result := FImageBtnMouseOver;
bbsFocused: Result := FImageBtnFocused.Bitmap;
// bbsChecked: Result := FImageBtnChecked;
end;
end;

61
lcl/intfgraphics.pas
View File

@ -32,7 +32,7 @@ interface
uses
Classes, SysUtils, fpImage, FPReadBMP, FPWriteBMP, BMPComn, FPCAdds,
AvgLvlTree, LCLType, LCLversion,
AvgLvlTree, LCLType, LCLversion, Math,
LCLProc, GraphType, LCLIntf, FPReadPNG, FPWritePNG, FPReadTiff, FPWriteTiff,
IcnsTypes;
@ -250,6 +250,7 @@ type
procedure FillPixels(const Color: TFPColor); virtual;
procedure CopyPixels(ASource: TFPCustomImage; XDst: Integer = 0; YDst: Integer = 0;
AlphaMask: Boolean = False; AlphaTreshold: Word = 0); virtual;
procedure AlphaBlend(ASource, ASourceAlpha: TLazIntfImage; const ADestX, ADestY: Integer);
procedure AlphaFromMask(AKeepAlpha: Boolean = True);
procedure GetXYDataPosition(x, y: integer; out Position: TRawImagePosition);
procedure GetXYMaskPosition(x, y: integer; out Position: TRawImagePosition);
@ -3417,6 +3418,64 @@ begin
// ToDo: mask
end;
{
Merges an image to a canvas using alpha blend acording to a separate image
containing the alpha channel. White pixels in the alpha channel will correspond
to the source image pixel being fully drawn, grey ones are merged and
black ones ignored.
}
procedure TLazIntfImage.AlphaBlend(ASource, ASourceAlpha: TLazIntfImage;
const ADestX, ADestY: Integer);
var
x, y, CurX, CurY: Integer;
MaskValue, InvMaskValue: Word;
CurColor: TFPColor;
lDrawWidth, lDrawHeight: Integer;
begin
// Take care not to draw outside the destination area
lDrawWidth := Min(Self.Width - ADestX, ASource.Width);
lDrawHeight := Min(Self.Height - ADestY, ASource.Height);
for y := 0 to lDrawHeight - 1 do
begin
for x := 0 to lDrawWidth - 1 do
begin
CurX := ADestX + x;
CurY := ADestY + y;
// Never draw outside the destination
if (CurX < 0) or (CurY < 0) then Continue;
// All channels in the Alpha should have the same value
// So getting any of them should be enough
MaskValue := ASourceAlpha.Colors[x, y].red;
InvMaskValue := $FFFF - MaskValue;
if MaskValue = $FFFF then
begin
Self.Colors[CurX, CurY] := ASource.Colors[x, y];
end
else if MaskValue > $00 then
begin
CurColor := Self.Colors[CurX, CurY];
CurColor.Red := Round(
CurColor.Red * InvMaskValue / $FFFF +
ASource.Colors[x, y].Red * MaskValue / $FFFF);
CurColor.Green := Round(
CurColor.Green * InvMaskValue / $FFFF +
ASource.Colors[x, y].Green * MaskValue / $FFFF);
CurColor.Blue := Round(
CurColor.Blue * InvMaskValue / $FFFF +
ASource.Colors[x, y].Blue * MaskValue / $FFFF);
Self.Colors[CurX, CurY] := CurColor;
end;
end;
end;
end;
procedure TLazIntfImage.CopyPixels(ASource: TFPCustomImage; XDst, YDst: Integer;
AlphaMask: Boolean; AlphaTreshold: Word);
var