1455 lines
39 KiB
ObjectPascal
1455 lines
39 KiB
ObjectPascal
// SPDX-License-Identifier: LGPL-3.0-linking-exception
|
|
{
|
|
Created by BGRA Controls Team
|
|
Dibo, Circular, lainz (007) and contributors.
|
|
For detailed information see readme.txt
|
|
|
|
Site: https://sourceforge.net/p/bgra-controls/
|
|
Wiki: http://wiki.lazarus.freepascal.org/BGRAControls
|
|
Forum: http://forum.lazarus.freepascal.org/index.php/board,46.0.html
|
|
}
|
|
{******************************* CONTRIBUTOR(S) ******************************
|
|
- Edivando S. Santos Brasil | mailedivando@gmail.com
|
|
(Compatibility with delphi VCL 11/2018)
|
|
|
|
***************************** END CONTRIBUTOR(S) *****************************}
|
|
unit BCImageButton;
|
|
|
|
{$I bgracontrols.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Forms, Controls, Graphics,
|
|
{$IFDEF FPC}{$ifdef Windows}Windows,{$endif}LCLType, LResources, LMessages,{$ENDIF} ExtCtrls,
|
|
Types,
|
|
{$IFNDEF FPC}Windows, Messages, BGRAGraphics, GraphType, FPImage, {$ENDIF}
|
|
{ BGRAControls }
|
|
BCBaseCtrls, BCEffect,
|
|
{ BGRABitmap }
|
|
BGRABitmap, BGRABitmapTypes, BGRASliceScaling;
|
|
|
|
{off $DEFINE DEBUG}
|
|
|
|
function CalculateAspectRatioH(W1, H1, W2: integer): integer; //result H2
|
|
function CalculateAspectRatioW(W1, H1, H2: integer): integer; //result W2
|
|
function CalculateDestRect(ImageW, ImageH, DestW, DestH: integer;
|
|
Stretch, Proportional, Center: boolean): TRect;
|
|
procedure AssignFontToBGRA(Source: TFont; Dest: TBGRABitmap);
|
|
|
|
type
|
|
TBCGraphicButtonState = (gbsNormal, gbsHover, gbsActive, gbsDisabled);
|
|
|
|
TOnRenderControl = procedure(Sender: TObject; Bitmap: TBGRABitmap;
|
|
State: TBCGraphicButtonState) of object;
|
|
|
|
type
|
|
|
|
{ TBCGraphicButton }
|
|
|
|
TBCGraphicButton = class(TBCGraphicControl)
|
|
protected
|
|
FState: TBCGraphicButtonState;
|
|
FModalResult: TModalResult;
|
|
protected
|
|
procedure DoClick; virtual;
|
|
procedure DoMouseDown; virtual;
|
|
procedure DoMouseUp; virtual;
|
|
procedure DoMouseEnter; virtual;
|
|
procedure DoMouseLeave; virtual;
|
|
procedure DoMouseMove({%H-}x, {%H-}y: integer); virtual;
|
|
protected
|
|
procedure Click; override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
|
|
procedure MouseEnter; override;
|
|
procedure MouseLeave; override;
|
|
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
|
|
public
|
|
property ModalResult: TModalResult
|
|
read FModalResult write FModalResult default mrNone;
|
|
end;
|
|
|
|
{ TBCXButton }
|
|
TBCXButton = class(TBCGraphicButton)
|
|
protected
|
|
FOnRenderControl: TOnRenderControl;
|
|
FBGRANormal, FBGRAHover, FBGRAActive, FBGRADisabled: TBGRABitmap;
|
|
protected
|
|
class function GetControlClassDefaultSize: TSize; override;
|
|
procedure DrawControl; override;
|
|
procedure RenderControl; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
published
|
|
property OnRenderControl: TOnRenderControl
|
|
read FOnRenderControl write FOnRenderControl;
|
|
published
|
|
property Action;
|
|
property Align;
|
|
property Anchors;
|
|
property AutoSize;
|
|
property BidiMode;
|
|
property BorderSpacing;
|
|
property Caption;
|
|
property Color;
|
|
property Constraints;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property Enabled;
|
|
property Font;
|
|
property ParentBidiMode;
|
|
property ModalResult;
|
|
{$IFDEF FPC}
|
|
property OnChangeBounds;
|
|
{$ENDIF}
|
|
property OnClick;
|
|
property OnContextPopup;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDrag;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnResize;
|
|
property OnStartDrag;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property Visible;
|
|
end;
|
|
|
|
{ TBCSliceScalingOptions }
|
|
|
|
TBCCustomSliceScalingOptions = class(TPersistent)
|
|
protected
|
|
FOwner: TControl;
|
|
FBitmap: TBGRABitmap;
|
|
FAutoDetectRepeat, FRepeatTop, FRepeatLeft, FRepeatMiddleHorizontal,
|
|
FRepeatMiddleVertical, FRepeatRight, FRepeatBottom: boolean;
|
|
FMarginTop, FMarginRight, FMarginBottom, FMarginLeft, FNumberOfItems: integer;
|
|
FDirection: TSliceScalingDirection;
|
|
FDrawMode: TDrawMode;
|
|
FResampleMode: TResampleMode;
|
|
FResampleFilter: TResampleFilter;
|
|
private
|
|
procedure SetFBitmap(AValue: TBGRABitmap);
|
|
procedure SetFMarginBottom(AValue: integer);
|
|
procedure SetFMarginLeft(AValue: integer);
|
|
procedure SetFMarginRight(AValue: integer);
|
|
procedure SetFMarginTop(AValue: integer);
|
|
procedure SetFAutoDetectRepeat(AValue: boolean);
|
|
procedure SetFDirection(AValue: TSliceScalingDirection);
|
|
procedure SetFDrawMode(AValue: TDrawMode);
|
|
procedure SetFNumberOfItems(AValue: integer);
|
|
procedure SetFRepeatBottom(AValue: boolean);
|
|
procedure SetFRepeatLeft(AValue: boolean);
|
|
procedure SetFRepeatMiddleHorizontal(AValue: boolean);
|
|
procedure SetFRepeatMiddleVertical(AValue: boolean);
|
|
procedure SetFRepeatRight(AValue: boolean);
|
|
procedure SetFRepeatTop(AValue: boolean);
|
|
procedure SetFResampleFilter(AValue: TResampleFilter);
|
|
procedure SetFResampleMode(AValue: TResampleMode);
|
|
public
|
|
constructor Create(AOwner: TControl);
|
|
destructor Destroy; override;
|
|
published
|
|
property Bitmap: TBGRABitmap read FBitmap write SetFBitmap;
|
|
property AutoDetectRepeat: boolean read FAutoDetectRepeat
|
|
write SetFAutoDetectRepeat default False;
|
|
property RepeatTop: boolean read FRepeatTop write SetFRepeatTop default False;
|
|
property RepeatLeft: boolean read FRepeatLeft write SetFRepeatLeft default False;
|
|
property RepeatMiddleHorizontal: boolean
|
|
read FRepeatMiddleHorizontal write SetFRepeatMiddleHorizontal default False;
|
|
property RepeatMiddleVertical: boolean read FRepeatMiddleVertical
|
|
write SetFRepeatMiddleVertical default False;
|
|
property RepeatRight: boolean read FRepeatRight write SetFRepeatRight default False;
|
|
property RepeatBottom: boolean
|
|
read FRepeatBottom write SetFRepeatBottom default False;
|
|
property MarginTop: integer read FMarginTop write SetFMarginTop default 0;
|
|
property MarginRight: integer read FMarginRight write SetFMarginRight default 0;
|
|
property MarginBottom: integer read FMarginBottom write SetFMarginBottom default 0;
|
|
property MarginLeft: integer read FMarginLeft write SetFMarginLeft default 0;
|
|
property NumberOfItems: integer
|
|
read FNumberOfItems write SetFNumberOfItems default 1;
|
|
property Direction: TSliceScalingDirection read FDirection write SetFDirection;
|
|
property DrawMode: TDrawMode read FDrawMode write SetFDrawMode default
|
|
dmDrawWithTransparency;
|
|
property ResampleMode: TResampleMode read FResampleMode
|
|
write SetFResampleMode default rmFineResample;
|
|
property ResampleFilter: TResampleFilter read FResampleFilter
|
|
write SetFResampleFilter default rfBestQuality;
|
|
end;
|
|
|
|
{ TBCImageButtonSliceScalingOptions }
|
|
|
|
TBCImageButtonSliceScalingOptions = class(TBCCustomSliceScalingOptions)
|
|
private
|
|
procedure SetFCenter(AValue: boolean);
|
|
procedure SetFProportional(AValue: boolean);
|
|
procedure SetFStretch(AValue: boolean);
|
|
protected
|
|
FCenter, FStretch, FProportional: boolean;
|
|
published
|
|
property NumberOfItems: integer read FNumberOfItems default 4;
|
|
property Center: boolean read FCenter write SetFCenter default True;
|
|
property Stretch: boolean read FStretch write SetFStretch default True;
|
|
property Proportional: boolean
|
|
read FProportional write SetFProportional default False;
|
|
public
|
|
constructor Create(AOwner: TControl);
|
|
procedure Assign(Source: TPersistent); override;
|
|
end;
|
|
|
|
{ TBCCustomImageButton }
|
|
|
|
TBCCustomImageButton = class(TBCGraphicButton)
|
|
private
|
|
{ Private declarations }
|
|
FAlphaTest: boolean;
|
|
FAlphaTestValue: byte;
|
|
{$IFDEF INDEBUG}
|
|
FDrawCount: integer;
|
|
FRenderCount: integer;
|
|
{$ENDIF}
|
|
FBitmapOptions: TBCImageButtonSliceScalingOptions;
|
|
FBGRAMultiSliceScaling: TBGRAMultiSliceScaling;
|
|
FBGRANormal, FBGRAHover, FBGRAActive, FBGRADisabled: TBGRABitmap;
|
|
FDestRect: TRect;
|
|
FPressed: boolean;
|
|
FTimer: TTimer;
|
|
FFade: TFading;
|
|
FAnimation: boolean;
|
|
FBitmapFile: string;
|
|
FTextVisible: boolean;
|
|
FToggle: boolean;
|
|
FMouse: TPoint;
|
|
procedure SetFAlphaTest(AValue: boolean);
|
|
procedure SetFAlphaTestValue(AValue: byte);
|
|
procedure SetFAnimation(AValue: boolean);
|
|
procedure SetFBitmapFile(AValue: string);
|
|
procedure SetFBitmapOptions(AValue: TBCImageButtonSliceScalingOptions);
|
|
procedure Fade({%H-}Sender: TObject);
|
|
procedure SetFPressed(AValue: boolean);
|
|
procedure SetFTextVisible(AValue: boolean);
|
|
procedure SetFToggle(AValue: boolean);
|
|
protected
|
|
{ Protected declarations }
|
|
procedure DrawControl; override;
|
|
procedure RenderControl; override;
|
|
procedure TextChanged; override;
|
|
procedure FontChanged(Sender: TObject); override;
|
|
procedure CMChanged(var {%H-}Message: {$IFDEF FPC}TLMessage{$ELSE}TMessage{$ENDIF}); message CM_CHANGED; {$IFDEF FPC}virtual;{$ENDIF}
|
|
{$IFDEF INDEBUG}
|
|
{$IFDEF FPC}
|
|
function GetDebugText: string;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
procedure DoMouseDown; override;
|
|
procedure DoMouseUp; override;
|
|
procedure DoMouseEnter; override;
|
|
procedure DoMouseLeave; override;
|
|
procedure DoMouseMove(x, y: integer); override;
|
|
procedure Click; override;
|
|
public
|
|
{ Public declarations }
|
|
property AlphaTest: boolean read FAlphaTest write SetFAlphaTest default True;
|
|
property AlphaTestValue: byte
|
|
read FAlphaTestValue write SetFAlphaTestValue default 255;
|
|
property Toggle: boolean read FToggle write SetFToggle default False;
|
|
property Pressed: boolean read FPressed write SetFPressed default False;
|
|
//property State: TBCGraphicButtonState read FState;
|
|
property BitmapOptions: TBCImageButtonSliceScalingOptions
|
|
read FBitmapOptions write SetFBitmapOptions;
|
|
property Animation: boolean read FAnimation write SetFAnimation default True;
|
|
property BitmapFile: string read FBitmapFile write SetFBitmapFile;
|
|
property TextVisible: boolean read FTextVisible write SetFTextVisible default True;
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
{ It loads the 'BitmapFile' }
|
|
procedure LoadFromBitmapResource(const Resource: string; ResourceType: PChar); overload;
|
|
procedure LoadFromBitmapResource(const Resource: string); overload;
|
|
procedure LoadFromBitmapFile;
|
|
procedure Assign(Source: TPersistent); override;
|
|
{ Streaming }
|
|
{$IFDEF FPC}
|
|
procedure SaveToFile(AFileName: string); override;
|
|
procedure LoadFromFile(AFileName: string); override;
|
|
procedure AssignFromFile(AFileName: string); override;
|
|
{$ENDIF}
|
|
procedure OnFindClass({%H-}Reader: TReader; const AClassName: string;
|
|
var ComponentClass: TComponentClass);
|
|
published
|
|
{ Published declarations }
|
|
end;
|
|
|
|
TBCImageButton = class(TBCCustomImageButton)
|
|
published
|
|
property AlphaTest;
|
|
property AlphaTestValue;
|
|
property Action;
|
|
property Align;
|
|
property Anchors;
|
|
property Animation;
|
|
property AutoSize;
|
|
//property AutoSizeExtraHorizontal;
|
|
//property AutoSizeExtraVertical;
|
|
property BidiMode;
|
|
//property Bitmap;
|
|
property BitmapFile;
|
|
property BitmapOptions;
|
|
property BorderSpacing;
|
|
property Caption;
|
|
//property Checked;
|
|
property Color;
|
|
property Constraints;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property Enabled;
|
|
property Font;
|
|
property ModalResult;
|
|
{$IFDEF FPC}
|
|
property OnChangeBounds;
|
|
{$ENDIF}
|
|
property OnClick;
|
|
property OnContextPopup;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDrag;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
//property OnPlaySound;
|
|
//property OnRedraw;
|
|
property OnResize;
|
|
property OnStartDrag;
|
|
property ParentBidiMode;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
//property Shadow;
|
|
property ShowHint;
|
|
//property Sound;
|
|
//property SoundClick;
|
|
//property SoundEnter;
|
|
property TextVisible;
|
|
property Toggle;
|
|
property Pressed;
|
|
property Visible;
|
|
end;
|
|
|
|
{$IFDEF FPC}procedure Register;{$ENDIF}
|
|
|
|
implementation
|
|
|
|
{$IFDEF FPC}procedure Register;
|
|
begin
|
|
RegisterComponents('BGRA Button Controls', [TBCImageButton]);
|
|
RegisterComponents('BGRA Button Controls', [TBCXButton]);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function CalculateAspectRatioH(W1, H1, W2: integer): integer;
|
|
begin
|
|
Result := Round(H1 / W1 * W2);
|
|
end;
|
|
|
|
function CalculateAspectRatioW(W1, H1, H2: integer): integer;
|
|
begin
|
|
Result := Round(W1 / H1 * H2);
|
|
end;
|
|
|
|
function CalculateDestRect(ImageW, ImageH, DestW, DestH: integer;
|
|
Stretch, Proportional, Center: boolean): TRect;
|
|
var
|
|
w: integer;
|
|
h: integer;
|
|
begin
|
|
// Stretch or Proportional when Image (Width or Height) is bigger than Destination
|
|
if Stretch or (Proportional and ((ImageW > DestW) or (ImageH > DestH))) then
|
|
begin
|
|
// Proportional when Image (Width or Height) is bigger than 0
|
|
if Proportional and (ImageW > 0) and (ImageH > 0) then
|
|
begin
|
|
w := DestW;
|
|
h := CalculateAspectRatioH(ImageW, ImageH, DestW);
|
|
if h > DestH then
|
|
begin
|
|
h := DestH;
|
|
w := CalculateAspectRatioW(ImageW, ImageH, DestH);
|
|
end;
|
|
ImageW := w;
|
|
ImageH := h;
|
|
end
|
|
// Stretch not Proportional or when Image (Width or Height) is 0
|
|
else
|
|
begin
|
|
ImageW := DestW;
|
|
ImageH := DestH;
|
|
end;
|
|
end;
|
|
|
|
Result := Rect(0, 0, ImageW, ImageH);
|
|
|
|
// Center: Destination (Width or Height) - Image divided by 2
|
|
if Center then
|
|
begin
|
|
Result.Left := Round((DestW - ImageW) div 2);
|
|
Result.Top := Round((DestH - ImageH) div 2);
|
|
end;
|
|
end;
|
|
|
|
procedure AssignFontToBGRA(Source: TFont; Dest: TBGRABitmap);
|
|
begin
|
|
Dest.FontAntialias := True;
|
|
|
|
Dest.FontName := Source.Name;
|
|
Dest.FontStyle := Source.Style;
|
|
Dest.FontOrientation := Source.Orientation;
|
|
|
|
case Source.Quality of
|
|
fqNonAntialiased: Dest.FontQuality := fqSystem;
|
|
fqAntialiased: Dest.FontQuality := fqFineAntialiasing;
|
|
fqProof: Dest.FontQuality := fqFineClearTypeRGB;
|
|
fqDefault, fqDraft, fqCleartype, fqCleartypeNatural: Dest.FontQuality :=
|
|
fqSystemClearType;
|
|
end;
|
|
|
|
Dest.FontHeight := -Source.Height;
|
|
end;
|
|
|
|
{ TBCXButton }
|
|
|
|
class function TBCXButton.GetControlClassDefaultSize: TSize;
|
|
begin
|
|
Result := inherited GetControlClassDefaultSize;
|
|
end;
|
|
|
|
procedure TBCXButton.DrawControl;
|
|
begin
|
|
if Enabled then
|
|
case FState of
|
|
gbsNormal: FBGRANormal.Draw(Canvas, 0, 0, False);
|
|
gbsHover: FBGRAHover.Draw(Canvas, 0, 0, False);
|
|
gbsActive: FBGRAActive.Draw(Canvas, 0, 0, False);
|
|
end
|
|
else
|
|
FBGRADisabled.Draw(Canvas, 0, 0, False);
|
|
end;
|
|
|
|
procedure TBCXButton.RenderControl;
|
|
begin
|
|
{ Free cache bitmaps }
|
|
if FBGRANormal <> nil then
|
|
FreeAndNil(FBGRANormal);
|
|
if FBGRAHover <> nil then
|
|
FreeAndNil(FBGRAHover);
|
|
if FBGRAActive <> nil then
|
|
FreeAndNil(FBGRAActive);
|
|
if FBGRADisabled <> nil then
|
|
FreeAndNil(FBGRADisabled);
|
|
|
|
{ Create cache bitmaps }
|
|
FBGRANormal := TBGRABitmap.Create(Width, Height);
|
|
FBGRAHover := TBGRABitmap.Create(Width, Height);
|
|
FBGRAActive := TBGRABitmap.Create(Width, Height);
|
|
FBGRADisabled := TBGRABitmap.Create(Width, Height);
|
|
|
|
if Assigned(FOnRenderControl) then
|
|
begin
|
|
FOnRenderControl(Self, FBGRANormal, gbsNormal);
|
|
FOnRenderControl(Self, FBGRAHover, gbsHover);
|
|
FOnRenderControl(Self, FBGRAActive, gbsActive);
|
|
FOnRenderControl(Self, FBGRADisabled, gbsDisabled);
|
|
end;
|
|
end;
|
|
|
|
constructor TBCXButton.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
with GetControlClassDefaultSize do
|
|
SetInitialBounds(0, 0, CX, CY);
|
|
end;
|
|
|
|
destructor TBCXButton.Destroy;
|
|
begin
|
|
if FBGRANormal <> nil then
|
|
FreeAndNil(FBGRANormal);
|
|
if FBGRAHover <> nil then
|
|
FreeAndNil(FBGRAHover);
|
|
if FBGRAActive <> nil then
|
|
FreeAndNil(FBGRAActive);
|
|
if FBGRADisabled <> nil then
|
|
FreeAndNil(FBGRADisabled);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TBCImageButtonSliceScalingOptions }
|
|
|
|
procedure TBCImageButtonSliceScalingOptions.SetFCenter(AValue: boolean);
|
|
begin
|
|
if FCenter = AValue then
|
|
Exit;
|
|
FCenter := AValue;
|
|
|
|
FOwner.Perform(CM_CHANGED, 0, 0);
|
|
FOwner.Invalidate;
|
|
end;
|
|
|
|
procedure TBCImageButtonSliceScalingOptions.SetFProportional(AValue: boolean);
|
|
begin
|
|
if FProportional = AValue then
|
|
Exit;
|
|
FProportional := AValue;
|
|
|
|
FOwner.Perform(CM_CHANGED, 0, 0);
|
|
FOwner.Invalidate;
|
|
end;
|
|
|
|
procedure TBCImageButtonSliceScalingOptions.SetFStretch(AValue: boolean);
|
|
begin
|
|
if FStretch = AValue then
|
|
Exit;
|
|
FStretch := AValue;
|
|
|
|
FOwner.Perform(CM_CHANGED, 0, 0);
|
|
FOwner.Invalidate;
|
|
end;
|
|
|
|
constructor TBCImageButtonSliceScalingOptions.Create(AOwner: TControl);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FNumberOfItems := 4;
|
|
FCenter := True;
|
|
FProportional := False;
|
|
FStretch := True;
|
|
end;
|
|
|
|
procedure TBCImageButtonSliceScalingOptions.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TBCImageButtonSliceScalingOptions then
|
|
begin
|
|
FAutoDetectRepeat := TBCImageButtonSliceScalingOptions(Source).AutoDetectRepeat;
|
|
FCenter := TBCImageButtonSliceScalingOptions(Source).Center;
|
|
FRepeatTop := TBCImageButtonSliceScalingOptions(Source).RepeatTop;
|
|
FRepeatLeft := TBCImageButtonSliceScalingOptions(Source).RepeatLeft;
|
|
FRepeatMiddleHorizontal :=
|
|
TBCImageButtonSliceScalingOptions(Source).RepeatMiddleHorizontal;
|
|
FRepeatMiddleVertical := TBCImageButtonSliceScalingOptions(
|
|
Source).RepeatMiddleVertical;
|
|
FRepeatRight := TBCImageButtonSliceScalingOptions(Source).RepeatRight;
|
|
FRepeatBottom := TBCImageButtonSliceScalingOptions(Source).RepeatBottom;
|
|
FMarginTop := TBCImageButtonSliceScalingOptions(Source).MarginTop;
|
|
FMarginRight := TBCImageButtonSliceScalingOptions(Source).MarginRight;
|
|
FMarginBottom := TBCImageButtonSliceScalingOptions(Source).MarginBottom;
|
|
FMarginLeft := TBCImageButtonSliceScalingOptions(Source).MarginLeft;
|
|
FDirection := TBCImageButtonSliceScalingOptions(Source).Direction;
|
|
FDrawMode := TBCImageButtonSliceScalingOptions(Source).DrawMode;
|
|
FResampleMode := TBCImageButtonSliceScalingOptions(Source).ResampleMode;
|
|
FResampleFilter := TBCImageButtonSliceScalingOptions(Source).ResampleFilter;
|
|
FStretch := TBCImageButtonSliceScalingOptions(Source).Stretch;
|
|
FProportional := TBCImageButtonSliceScalingOptions(Source).Proportional;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
{ TBCCustomSliceScalingOptions }
|
|
|
|
procedure TBCCustomSliceScalingOptions.SetFBitmap(AValue: TBGRABitmap);
|
|
begin
|
|
if FBitmap = AValue then
|
|
Exit;
|
|
FBitmap := AValue;
|
|
|
|
FOwner.Perform(CM_CHANGED, 0, 0);
|
|
FOwner.Invalidate;
|
|
end;
|
|
|
|
procedure TBCCustomSliceScalingOptions.SetFMarginBottom(AValue: integer);
|
|
begin
|
|
if FMarginBottom = AValue then
|
|
Exit;
|
|
FMarginBottom := AValue;
|
|
|
|
FOwner.Perform(CM_CHANGED, 0, 0);
|
|
FOwner.Invalidate;
|
|
end;
|
|
|
|
procedure TBCCustomSliceScalingOptions.SetFMarginLeft(AValue: integer);
|
|
begin
|
|
if FMarginLeft = AValue then
|
|
Exit;
|
|
FMarginLeft := AValue;
|
|
|
|
FOwner.Perform(CM_CHANGED, 0, 0);
|
|
FOwner.Invalidate;
|
|
end;
|
|
|
|
procedure TBCCustomSliceScalingOptions.SetFMarginRight(AValue: integer);
|
|
begin
|
|
if FMarginRight = AValue then
|
|
Exit;
|
|
FMarginRight := AValue;
|
|
|
|
FOwner.Perform(CM_CHANGED, 0, 0);
|
|
FOwner.Invalidate;
|
|
end;
|
|
|
|
procedure TBCCustomSliceScalingOptions.SetFMarginTop(AValue: integer);
|
|
begin
|
|
if FMarginTop = AValue then
|
|
Exit;
|
|
FMarginTop := AValue;
|
|
|
|
FOwner.Perform(CM_CHANGED, 0, 0);
|
|
FOwner.Invalidate;
|
|
end;
|
|
|
|
procedure TBCCustomSliceScalingOptions.SetFAutoDetectRepeat(AValue: boolean);
|
|
begin
|
|
if FAutoDetectRepeat = AValue then
|
|
Exit;
|
|
FAutoDetectRepeat := AValue;
|
|
|
|
FOwner.Perform(CM_CHANGED, 0, 0);
|
|
FOwner.Invalidate;
|
|
end;
|
|
|
|
procedure TBCCustomSliceScalingOptions.SetFDirection(AValue: TSliceScalingDirection);
|
|
begin
|
|
if FDirection = AValue then
|
|
Exit;
|
|
FDirection := AValue;
|
|
|
|
FOwner.Perform(CM_CHANGED, 0, 0);
|
|
FOwner.Invalidate;
|
|
end;
|
|
|
|
procedure TBCCustomSliceScalingOptions.SetFDrawMode(AValue: TDrawMode);
|
|
begin
|
|
if FDrawMode = AValue then
|
|
Exit;
|
|
FDrawMode := AValue;
|
|
|
|
FOwner.Perform(CM_CHANGED, 0, 0);
|
|
FOwner.Invalidate;
|
|
end;
|
|
|
|
procedure TBCCustomSliceScalingOptions.SetFNumberOfItems(AValue: integer);
|
|
begin
|
|
if FNumberOfItems = AValue then
|
|
Exit;
|
|
FNumberOfItems := AValue;
|
|
end;
|
|
|
|
procedure TBCCustomSliceScalingOptions.SetFRepeatBottom(AValue: boolean);
|
|
begin
|
|
if FRepeatBottom = AValue then
|
|
Exit;
|
|
FRepeatBottom := AValue;
|
|
|
|
FOwner.Perform(CM_CHANGED, 0, 0);
|
|
FOwner.Invalidate;
|
|
end;
|
|
|
|
procedure TBCCustomSliceScalingOptions.SetFRepeatLeft(AValue: boolean);
|
|
begin
|
|
if FRepeatLeft = AValue then
|
|
Exit;
|
|
FRepeatLeft := AValue;
|
|
|
|
FOwner.Perform(CM_CHANGED, 0, 0);
|
|
FOwner.Invalidate;
|
|
end;
|
|
|
|
procedure TBCCustomSliceScalingOptions.SetFRepeatMiddleHorizontal(AValue: boolean);
|
|
begin
|
|
if FRepeatMiddleHorizontal = AValue then
|
|
Exit;
|
|
FRepeatMiddleHorizontal := AValue;
|
|
|
|
FOwner.Perform(CM_CHANGED, 0, 0);
|
|
FOwner.Invalidate;
|
|
end;
|
|
|
|
procedure TBCCustomSliceScalingOptions.SetFRepeatMiddleVertical(AValue: boolean);
|
|
begin
|
|
if FRepeatMiddleVertical = AValue then
|
|
Exit;
|
|
FRepeatMiddleVertical := AValue;
|
|
|
|
FOwner.Perform(CM_CHANGED, 0, 0);
|
|
FOwner.Invalidate;
|
|
end;
|
|
|
|
procedure TBCCustomSliceScalingOptions.SetFRepeatRight(AValue: boolean);
|
|
begin
|
|
if FRepeatRight = AValue then
|
|
Exit;
|
|
FRepeatRight := AValue;
|
|
|
|
FOwner.Perform(CM_CHANGED, 0, 0);
|
|
FOwner.Invalidate;
|
|
end;
|
|
|
|
procedure TBCCustomSliceScalingOptions.SetFRepeatTop(AValue: boolean);
|
|
begin
|
|
if FRepeatTop = AValue then
|
|
Exit;
|
|
FRepeatTop := AValue;
|
|
|
|
FOwner.Perform(CM_CHANGED, 0, 0);
|
|
FOwner.Invalidate;
|
|
end;
|
|
|
|
procedure TBCCustomSliceScalingOptions.SetFResampleFilter(AValue: TResampleFilter);
|
|
begin
|
|
if FResampleFilter = AValue then
|
|
Exit;
|
|
FResampleFilter := AValue;
|
|
|
|
FOwner.Perform(CM_CHANGED, 0, 0);
|
|
FOwner.Invalidate;
|
|
end;
|
|
|
|
procedure TBCCustomSliceScalingOptions.SetFResampleMode(AValue: TResampleMode);
|
|
begin
|
|
if FResampleMode = AValue then
|
|
Exit;
|
|
FResampleMode := AValue;
|
|
|
|
FOwner.Perform(CM_CHANGED, 0, 0);
|
|
FOwner.Invalidate;
|
|
end;
|
|
|
|
constructor TBCCustomSliceScalingOptions.Create(AOwner: TControl);
|
|
begin
|
|
FOwner := AOwner;
|
|
FBitmap := nil;
|
|
FAutoDetectRepeat := False;
|
|
FRepeatTop := False;
|
|
FRepeatLeft := False;
|
|
FRepeatMiddleHorizontal := False;
|
|
FRepeatMiddleVertical := False;
|
|
FRepeatRight := False;
|
|
FRepeatBottom := False;
|
|
FMarginTop := 0;
|
|
FMarginRight := 0;
|
|
FMarginBottom := 0;
|
|
FMarginLeft := 0;
|
|
FNumberOfItems := 1;
|
|
FDirection := sdVertical;
|
|
FDrawMode := dmDrawWithTransparency;
|
|
FResampleMode := rmFineResample;
|
|
FResampleFilter := rfBestQuality;
|
|
inherited Create;
|
|
end;
|
|
|
|
destructor TBCCustomSliceScalingOptions.Destroy;
|
|
begin
|
|
if FBitmap <> nil then
|
|
FreeAndNil(FBitmap);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{ TBCGraphicButton }
|
|
|
|
procedure TBCGraphicButton.DoClick;
|
|
var
|
|
Form: TCustomForm;
|
|
begin
|
|
if ModalResult <> mrNone then
|
|
begin
|
|
Form := GetParentForm(Self);
|
|
if Form <> nil then
|
|
Form.ModalResult := ModalResult;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCGraphicButton.DoMouseDown;
|
|
var
|
|
NewState: TBCGraphicButtonState;
|
|
begin
|
|
NewState := gbsActive;
|
|
|
|
if NewState <> FState then
|
|
begin
|
|
FState := NewState;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCGraphicButton.DoMouseUp;
|
|
var
|
|
NewState: TBCGraphicButtonState;
|
|
p: TPoint;
|
|
begin
|
|
p := ScreenToClient(Mouse.CursorPos);
|
|
|
|
if (p.x >= 0) and (p.x <= Width) and (p.y >= 0) and (p.y <= Height) then
|
|
NewState := gbsHover
|
|
else
|
|
NewState := gbsNormal;
|
|
|
|
if NewState <> FState then
|
|
begin
|
|
FState := NewState;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCGraphicButton.DoMouseEnter;
|
|
var
|
|
NewState: TBCGraphicButtonState;
|
|
begin
|
|
if Enabled then
|
|
NewState := gbsHover
|
|
else
|
|
begin
|
|
FState := gbsNormal;
|
|
NewState := FState;
|
|
end;
|
|
|
|
if NewState <> FState then
|
|
begin
|
|
FState := NewState;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCGraphicButton.DoMouseLeave;
|
|
var
|
|
NewState: TBCGraphicButtonState;
|
|
begin
|
|
if Enabled then
|
|
NewState := gbsNormal
|
|
else
|
|
begin
|
|
FState := gbsNormal;
|
|
NewState := FState;
|
|
end;
|
|
|
|
if NewState <> FState then
|
|
begin
|
|
FState := NewState;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCGraphicButton.DoMouseMove(x, y: integer);
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
procedure TBCGraphicButton.Click;
|
|
begin
|
|
DoClick;
|
|
inherited Click;
|
|
end;
|
|
|
|
procedure TBCGraphicButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: integer);
|
|
begin
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
if Button = mbLeft then
|
|
DoMouseDown;
|
|
end;
|
|
|
|
procedure TBCGraphicButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: integer);
|
|
begin
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
DoMouseUp;
|
|
end;
|
|
|
|
procedure TBCGraphicButton.MouseEnter;
|
|
begin
|
|
inherited MouseEnter;
|
|
DoMouseEnter;
|
|
end;
|
|
|
|
procedure TBCGraphicButton.MouseLeave;
|
|
begin
|
|
inherited MouseLeave;
|
|
DoMouseLeave;
|
|
end;
|
|
|
|
procedure TBCGraphicButton.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
inherited MouseMove(Shift, X, Y);
|
|
DoMouseMove(X, Y);
|
|
end;
|
|
|
|
{ TBCCustomImageButton }
|
|
|
|
procedure TBCCustomImageButton.Fade(Sender: TObject);
|
|
begin
|
|
if FFade.Mode <> fmSuspended then
|
|
Invalidate;
|
|
|
|
if csDesigning in ComponentState then
|
|
Exit;
|
|
FTimer.Enabled := FAnimation;
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.SetFPressed(AValue: boolean);
|
|
begin
|
|
if FPressed = AValue then
|
|
Exit;
|
|
FPressed := AValue;
|
|
|
|
RenderControl;
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.SetFTextVisible(AValue: boolean);
|
|
begin
|
|
if FTextVisible = AValue then
|
|
Exit;
|
|
FTextVisible := AValue;
|
|
|
|
RenderControl;
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.SetFToggle(AValue: boolean);
|
|
begin
|
|
if FToggle = AValue then
|
|
Exit;
|
|
FToggle := AValue;
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.SetFBitmapOptions(AValue:
|
|
TBCImageButtonSliceScalingOptions);
|
|
begin
|
|
if FBitmapOptions = AValue then
|
|
Exit;
|
|
FBitmapOptions := AValue;
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.SetFAlphaTest(AValue: boolean);
|
|
begin
|
|
if FAlphaTest = AValue then
|
|
Exit;
|
|
FAlphaTest := AValue;
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.SetFAlphaTestValue(AValue: byte);
|
|
begin
|
|
if FAlphaTestValue = AValue then
|
|
Exit;
|
|
FAlphaTestValue := AValue;
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.SetFAnimation(AValue: boolean);
|
|
begin
|
|
if FAnimation = AValue then
|
|
Exit;
|
|
FAnimation := AValue;
|
|
|
|
if csDesigning in ComponentState then Exit;
|
|
FTimer.Enabled := FAnimation;
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.SetFBitmapFile(AValue: string);
|
|
begin
|
|
if FBitmapFile = AValue then
|
|
Exit;
|
|
FBitmapFile := AValue;
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.DrawControl;
|
|
var
|
|
temp: TBGRABitmap;
|
|
begin
|
|
{$IFNDEF FPC}//# //@ IN DELPHI RenderControl NEDD. IF NO RenderControl BE BLACK AFTER INVALIDATE.
|
|
RenderControl;
|
|
{$ENDIF}
|
|
|
|
if Color <> clDefault then
|
|
begin
|
|
Canvas.Brush.Color := Color;
|
|
Canvas.FillRect(Rect(0, 0, Width, Height));
|
|
end;
|
|
|
|
if Enabled then
|
|
begin
|
|
if (Toggle) then
|
|
begin
|
|
if (Pressed) then
|
|
FBGRAActive.Draw(Canvas, FDestRect.Left, FDestRect.Top, False)
|
|
else
|
|
case FState of
|
|
gbsHover: FBGRAHover.Draw(Canvas, FDestRect.Left,
|
|
FDestRect.Top, False);
|
|
else
|
|
FBGRANormal.Draw(Canvas, FDestRect.Left,
|
|
FDestRect.Top, False);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
case FState of
|
|
gbsNormal, gbsHover: FBGRANormal.Draw(Canvas, FDestRect.Left,
|
|
FDestRect.Top, False);
|
|
gbsActive: FBGRAActive.Draw(Canvas, FDestRect.Left, FDestRect.Top, False);
|
|
end;
|
|
|
|
temp := TBGRABitmap.Create(Width, Height);
|
|
FFade.Execute;
|
|
FFade.PutImage(temp, 0, 0, FBGRAHover);
|
|
|
|
temp.Draw(Canvas, FDestRect.Left, FDestRect.Top, False);
|
|
temp.Free;
|
|
end;
|
|
end
|
|
else
|
|
FBGRADisabled.Draw(Canvas, FDestRect.Left, FDestRect.Top, False);
|
|
|
|
{$IFDEF INDEBUG}
|
|
FDrawCount := FDrawCount +1;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF INDEBUG}
|
|
Canvas.Brush.Color := clWhite;
|
|
Canvas.TextOut(0, 0, GetDebugText);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.RenderControl;
|
|
|
|
procedure DrawText(ABitmap: TBGRABitmap);
|
|
begin
|
|
AssignFontToBGRA(Font, ABitmap);
|
|
ABitmap.TextRect(Rect(0, 0, Width, Height), Caption, taCenter, tlCenter,
|
|
Font.Color);
|
|
end;
|
|
|
|
{$IFDEF INDEBUG}
|
|
const
|
|
Debug = True;
|
|
{$ELSE}
|
|
const
|
|
Debug = False;
|
|
{$ENDIF}
|
|
var
|
|
i: integer;
|
|
begin
|
|
{ Free cache bitmaps }
|
|
if FBGRANormal <> nil then
|
|
FreeAndNil(FBGRANormal);
|
|
if FBGRAHover <> nil then
|
|
FreeAndNil(FBGRAHover);
|
|
if FBGRAActive <> nil then
|
|
FreeAndNil(FBGRAActive);
|
|
if FBGRADisabled <> nil then
|
|
FreeAndNil(FBGRADisabled);
|
|
|
|
{ Create cache bitmaps }
|
|
FBGRANormal := TBGRABitmap.Create(Width, Height);
|
|
FBGRAHover := TBGRABitmap.Create(Width, Height);
|
|
FBGRAActive := TBGRABitmap.Create(Width, Height);
|
|
FBGRADisabled := TBGRABitmap.Create(Width, Height);
|
|
|
|
{ Free FBGRAMultiSliceScaling }
|
|
if FBGRAMultiSliceScaling <> nil then
|
|
FreeAndNil(FBGRAMultiSliceScaling);
|
|
|
|
if (FBitmapOptions.Bitmap <> nil) then
|
|
begin
|
|
{ Create FBGRAMultiSliceScaling }
|
|
FBGRAMultiSliceScaling := TBGRAMultiSliceScaling.Create(FBitmapOptions.Bitmap,
|
|
FBitmapOptions.MarginTop, FBitmapOptions.MarginRight,
|
|
FBitmapOptions.MarginBottom, FBitmapOptions.MarginLeft,
|
|
FBitmapOptions.NumberOfItems, FBitmapOptions.Direction);
|
|
|
|
{ Set FBGRAMultiSliceScaling properties }
|
|
for i := 0 to High(FBGRAMultiSliceScaling.SliceScalingArray) do
|
|
begin
|
|
FBGRAMultiSliceScaling.SliceScalingArray[i].ResampleFilter :=
|
|
FBitmapOptions.ResampleFilter;
|
|
FBGRAMultiSliceScaling.SliceScalingArray[i].ResampleMode :=
|
|
FBitmapOptions.ResampleMode;
|
|
FBGRAMultiSliceScaling.SliceScalingArray[i].DrawMode := FBitmapOptions.DrawMode;
|
|
FBGRAMultiSliceScaling.SliceScalingArray[i].SliceRepeat[srpTop] :=
|
|
FBitmapOptions.RepeatTop;
|
|
FBGRAMultiSliceScaling.SliceScalingArray[i].SliceRepeat[srpBottom] :=
|
|
FBitmapOptions.RepeatBottom;
|
|
FBGRAMultiSliceScaling.SliceScalingArray[i].SliceRepeat[srpLeft] :=
|
|
FBitmapOptions.RepeatLeft;
|
|
FBGRAMultiSliceScaling.SliceScalingArray[i].SliceRepeat[srpRight] :=
|
|
FBitmapOptions.RepeatRight;
|
|
FBGRAMultiSliceScaling.SliceScalingArray[i].SliceRepeat[srpMiddleHorizontal] :=
|
|
FBitmapOptions.RepeatMiddleHorizontal;
|
|
FBGRAMultiSliceScaling.SliceScalingArray[i].SliceRepeat[srpMiddleVertical] :=
|
|
FBitmapOptions.RepeatMiddleVertical;
|
|
if FBitmapOptions.AutoDetectRepeat then
|
|
FBGRAMultiSliceScaling.SliceScalingArray[i].AutodetectRepeat;
|
|
end;
|
|
|
|
{ Calculate FDestRect }
|
|
FDestRect := CalculateDestRect(
|
|
FBGRAMultiSliceScaling.SliceScalingArray[0].BitmapWidth,
|
|
FBGRAMultiSliceScaling.SliceScalingArray[0].BitmapHeight, Width,
|
|
Height, FBitmapOptions.Stretch, FBitmapOptions.Proportional,
|
|
FBitmapOptions.Center);
|
|
|
|
{ Draw in cache bitmaps }
|
|
FBGRAMultiSliceScaling.Draw(0, FBGRANormal, 0, 0, FDestRect.Right,
|
|
FDestRect.Bottom, Debug);
|
|
FBGRAMultiSliceScaling.Draw(1, FBGRAHover, 0, 0, FDestRect.Right,
|
|
FDestRect.Bottom, Debug);
|
|
FBGRAMultiSliceScaling.Draw(2, FBGRAActive, 0, 0, FDestRect.Right,
|
|
FDestRect.Bottom, Debug);
|
|
FBGRAMultiSliceScaling.Draw(3, FBGRADisabled, 0, 0, FDestRect.Right,
|
|
FDestRect.Bottom, Debug);
|
|
|
|
if TextVisible then
|
|
begin
|
|
{ Draw Text }
|
|
DrawText(FBGRANormal);
|
|
DrawText(FBGRAHover);
|
|
DrawText(FBGRAActive);
|
|
DrawText(FBGRADisabled);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ Calculate FDestRect }
|
|
FDestRect := Rect(0, 0, Width, Height);
|
|
|
|
{ Draw default style in cache bitmaps }
|
|
FBGRANormal.Rectangle(0, 0, Width, Height, BGRA(173, 173, 173), BGRA(225, 225, 225),
|
|
dmSet);
|
|
FBGRAHover.Rectangle(0, 0, Width, Height, BGRA(0, 120, 215), BGRA(229, 241, 251),
|
|
dmSet);
|
|
FBGRAActive.Rectangle(0, 0, Width, Height, BGRA(0, 84, 153), BGRA(204, 228, 247),
|
|
dmSet);
|
|
FBGRADisabled.Rectangle(0, 0, Width, Height, BGRA(191, 191, 191), BGRA(204, 204, 204),
|
|
dmSet);
|
|
|
|
if TextVisible then
|
|
begin
|
|
{ Draw Text }
|
|
DrawText(FBGRANormal);
|
|
DrawText(FBGRAHover);
|
|
DrawText(FBGRAActive);
|
|
DrawText(FBGRADisabled);
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF INDEBUG}
|
|
FRenderCount := FRenderCount +1;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.TextChanged;
|
|
begin
|
|
InvalidatePreferredSize;
|
|
{$IFDEF FPC}//#
|
|
if Assigned(Parent) and Parent.AutoSize then
|
|
Parent.AdjustSize;
|
|
{$ENDIF}
|
|
AdjustSize;
|
|
RenderControl;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.FontChanged(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
RenderControl;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.CMChanged(var Message: {$IFDEF FPC}TLMessage{$ELSE}TMessage{$ENDIF});
|
|
begin
|
|
if csReadingState in ControlState then
|
|
Exit;
|
|
RenderControl;
|
|
end;
|
|
|
|
{$IFDEF INDEBUG}
|
|
{$IFDEF FPC}
|
|
function TBCCustomImageButton.GetDebugText: string;
|
|
begin
|
|
Result := 'Render: ' + IntToStr(FRenderCount) + ' Draw: ' + IntToStr(FDrawCount);
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
procedure TBCCustomImageButton.DoMouseDown;
|
|
begin
|
|
if FAlphaTest and (FBGRANormal.GetPixel(FMouse.X, FMouse.Y).alpha < FAlphaTestValue) then
|
|
Exit;
|
|
|
|
FFade.Mode := fmFadeOut;
|
|
|
|
if Animation then
|
|
FFade.Step := 60
|
|
else
|
|
FFade.Step := 255;
|
|
|
|
inherited DoMouseDown;
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.DoMouseUp;
|
|
var
|
|
Ctrl: TControl;
|
|
begin
|
|
if FAlphaTest and (FBGRANormal.GetPixel(FMouse.X, FMouse.Y).alpha < FAlphaTestValue) then
|
|
Exit;
|
|
|
|
FFade.Mode := fmFadeIn;
|
|
|
|
if Animation then
|
|
FFade.Step := 20
|
|
else
|
|
FFade.Step := 255;
|
|
{$IFDEF FPC} //#
|
|
Ctrl := Application.GetControlAtMouse;
|
|
{$ENDIF}
|
|
if Ctrl = Self then
|
|
DoMouseEnter
|
|
else
|
|
DoMouseLeave;
|
|
|
|
inherited DoMouseUp;
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.DoMouseEnter;
|
|
begin
|
|
FFade.Mode := fmFadeIn;
|
|
|
|
if Animation then
|
|
FFade.Step := 15
|
|
else
|
|
FFade.Step := 255;
|
|
|
|
inherited DoMouseEnter;
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.DoMouseLeave;
|
|
begin
|
|
FFade.Mode := fmFadeOut;
|
|
|
|
if Animation then
|
|
FFade.Step := 8
|
|
else
|
|
FFade.Step := 255;
|
|
|
|
inherited DoMouseLeave;
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.DoMouseMove(x, y: integer);
|
|
begin
|
|
FMouse := Point(X, Y);
|
|
if FAlphaTest then
|
|
if FBGRANormal.GetPixel(X, Y).alpha >= FAlphaTestValue then
|
|
DoMouseEnter
|
|
else
|
|
DoMouseLeave;
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.Click;
|
|
begin
|
|
if FAlphaTest and (FBGRANormal.GetPixel(FMouse.X, FMouse.Y).alpha < FAlphaTestValue) then
|
|
Exit;
|
|
inherited Click;
|
|
if (Toggle) then
|
|
begin
|
|
Pressed := not Pressed;
|
|
end;
|
|
end;
|
|
|
|
constructor TBCCustomImageButton.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
{$IFDEF INDEBUG}
|
|
FDrawCount := 0;
|
|
FRenderCount := 0;
|
|
{$ENDIF}
|
|
{$IFDEF FPC}
|
|
DisableAutoSizing;
|
|
Include(FControlState, csCreating);
|
|
{$ELSE} //#
|
|
|
|
{$ENDIF}
|
|
BeginUpdate;
|
|
try
|
|
FBitmapOptions := TBCImageButtonSliceScalingOptions.Create(Self);
|
|
|
|
with GetControlClassDefaultSize do
|
|
SetInitialBounds(0, 0, CX, CY);
|
|
ControlStyle := ControlStyle + [csAcceptsControls];
|
|
|
|
// FBitmapOptions := TBCImageButtonSliceScalingOptions.Create(Self);
|
|
{FBitmapOptions.Bitmap := TBGRABitmap.Create(1,4,BGRAWhite);
|
|
FBitmapOptions.Bitmap.SetPixel(0,0,BGRA(255,0,0,255));
|
|
FBitmapOptions.Bitmap.SetPixel(0,1,BGRA(0,255,0,255));
|
|
FBitmapOptions.Bitmap.SetPixel(0,2,BGRA(0,0,255,255));
|
|
FBitmapOptions.Bitmap.SetPixel(0,3,BGRA(100,100,100,255));}
|
|
|
|
FAlphaTest := True;
|
|
FAlphaTestValue := 255;
|
|
FFade.Step := 15;
|
|
FFade.Mode := fmFadeOut;
|
|
FTimer := TTimer.Create(Self);
|
|
FTimer.Interval := 15;
|
|
FTimer.OnTimer := Fade;
|
|
if csDesigning in ComponentState then
|
|
FTimer.Enabled := False;
|
|
FAnimation := True;
|
|
FTextVisible := True;
|
|
|
|
finally
|
|
{$IFDEF FPC}
|
|
Exclude(FControlState, csCreating);
|
|
EnableAutoSizing;
|
|
{$ELSE} //#
|
|
{$ENDIF}
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
destructor TBCCustomImageButton.Destroy;
|
|
begin
|
|
FTimer.Enabled := False;
|
|
FTimer.OnTimer := nil;
|
|
FTimer.Free;
|
|
if FBGRAMultiSliceScaling <> nil then
|
|
FreeAndNil(FBGRAMultiSliceScaling);
|
|
if FBGRANormal <> nil then
|
|
FreeAndNil(FBGRANormal);
|
|
if FBGRAHover <> nil then
|
|
FreeAndNil(FBGRAHover);
|
|
if FBGRAActive <> nil then
|
|
FreeAndNil(FBGRAActive);
|
|
if FBGRADisabled <> nil then
|
|
FreeAndNil(FBGRADisabled);
|
|
FreeAndNil(FBitmapOptions);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.LoadFromBitmapResource(const Resource: string;
|
|
ResourceType: PChar);
|
|
var
|
|
res: TResourceStream;
|
|
begin
|
|
res := TResourceStream.Create(HInstance, Resource, ResourceType);
|
|
|
|
if BitmapOptions.Bitmap <> nil then
|
|
BitmapOptions.Bitmap.Free;
|
|
|
|
BitmapOptions.Bitmap := TBGRABitmap.Create(res);
|
|
res.Free;
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.LoadFromBitmapResource(const Resource: string);
|
|
begin
|
|
LoadFromBitmapResource(Resource, {$ifdef Windows}Windows.{$endif}RT_RCDATA);
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.LoadFromBitmapFile;
|
|
begin
|
|
if BitmapFile <> '' then
|
|
if BitmapOptions.Bitmap <> nil then
|
|
BitmapOptions.Bitmap.LoadFromFile(BitmapFile)
|
|
else
|
|
BitmapOptions.Bitmap := TBGRABitmap.Create(BitmapFile);
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TBCCustomImageButton then
|
|
begin
|
|
FBitmapOptions.Assign(TBCCustomImageButton(Source).BitmapOptions);
|
|
FAnimation := TBCCustomImageButton(Source).Animation;
|
|
FBitmapFile := TBCCustomImageButton(Source).BitmapFile;
|
|
FTextVisible := TBCCustomImageButton(Source).TextVisible;
|
|
|
|
if TBCCustomImageButton(Source).BitmapOptions.Bitmap <> nil then
|
|
begin
|
|
if FBitmapOptions.Bitmap <> nil then
|
|
FBitmapOptions.Bitmap.Free;
|
|
|
|
FBitmapOptions.Bitmap :=
|
|
TBGRABitmap.Create(TBCCustomImageButton(Source).BitmapOptions.Bitmap.Bitmap);
|
|
end
|
|
else
|
|
LoadFromBitmapFile;
|
|
|
|
RenderControl;
|
|
Invalidate;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
{$IFDEF FPC}
|
|
procedure TBCCustomImageButton.SaveToFile(AFileName: string);
|
|
var
|
|
AStream: TMemoryStream;
|
|
begin
|
|
AStream := TMemoryStream.Create;
|
|
try
|
|
WriteComponentAsTextToStream(AStream, Self);
|
|
AStream.SaveToFile(AFileName);
|
|
finally
|
|
AStream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.LoadFromFile(AFileName: string);
|
|
var
|
|
AStream: TMemoryStream;
|
|
begin
|
|
AStream := TMemoryStream.Create;
|
|
try
|
|
AStream.LoadFromFile(AFileName);
|
|
ReadComponentFromTextStream(AStream, TComponent(Self), OnFindClass);
|
|
finally
|
|
AStream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TBCCustomImageButton.AssignFromFile(AFileName: string);
|
|
var
|
|
AStream: TMemoryStream;
|
|
AButton: TBCImageButton;
|
|
begin
|
|
AButton := TBCImageButton.Create(nil);
|
|
AStream := TMemoryStream.Create;
|
|
try
|
|
AStream.LoadFromFile(AFileName);
|
|
ReadComponentFromTextStream(AStream, TComponent(AButton), OnFindClass);
|
|
Assign(AButton);
|
|
finally
|
|
AStream.Free;
|
|
AButton.Free;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TBCCustomImageButton.OnFindClass(Reader: TReader;
|
|
const AClassName: string; var ComponentClass: TComponentClass);
|
|
begin
|
|
if CompareText(AClassName, 'TBCImageButton') = 0 then
|
|
ComponentClass := TBCImageButton;
|
|
end;
|
|
|
|
end.
|