Improves bitmapped button and adds an alpha blending routine to TLazIntfImage

git-svn-id: trunk@26760 -

components/customdrawn/customdrawncontrols.pas

@@ -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,
+  // commented items are not yet supported
-    bboUseImageForMouseOver);
+  TBitmappedButtonOption = (bboUseAlphaBlending, bboUseImageForSelection
+    {bboUseImageForMouseOver, bboDrawFocusRectangle,}
+    (*bboCheckable,*));
 
   TBitmappedButtonOptions = set of TBitmappedButtonOption;
 
-  TBitmappedButtonState = (bbsNormal, bbsDown, bbsMouseOver,
+  // commented items are not yet supported
-    bbsSelected, bbsChecked, bbsCheckedSelected, bbsCheckedDown { is going to be unchecked });
+  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;
+    FImageBtn: TPicture;
-    FImageBtnDown: TBitmap;
+    FImageBtnDown: TPicture;
-    FImageBtnMouseOver: TBitmap;
+    FImageBtnMouseOver: TPicture;
-    FImageBtnSelected: TBitmap;
+    FImageBtnFocused: TPicture;
-    FImageBtnChecked: TBitmap;
+    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 ImageBtn;
-    property ImageBtnDown: TBitmap;
+    property ImageBtnDown;
-{    FImageBtnMouseOver: TBitmap;
+    property ImageBtnFocused;
-    FImageBtnSelected: TBitmap;
+    property ImageBtnAlpha;
-    FImageBtnChecked: TBitmap;
+    property Options;
-    FOptions: TBitmappedButtonOptions;}
+    // Events
+    property OnChange;
   end;
 
 procedure Register;
@@ -110,8 +129,8 @@ var
   NewState: TBitmappedButtonState;
 begin
   case FState of
-  bbsNormal, bbsSelected: NewState := bbsDown;
+  bbsNormal, bbsFocused: NewState := bbsDown;
-  bbsChecked, bbsCheckedSelected: NewState := bbsCheckedDown;
+//  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
+{  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;
+  bbsNormal:    Result := FImageBtn.Bitmap;
-  bbsDown:      Result := FImageBtnDown;
+  bbsDown:      Result := FImageBtnDown.Bitmap;
-  bbsMouseOver: Result := FImageBtnMouseOver;
+//  bbsMouseOver: Result := FImageBtnMouseOver;
-  bbsSelected:  Result := FImageBtnSelected;
+  bbsFocused:  Result := FImageBtnFocused.Bitmap;
-  bbsChecked:   Result := FImageBtnChecked;
+//  bbsChecked:   Result := FImageBtnChecked;
   end;
 end;
 

lcl/intfgraphics.pas

@@ -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