1 // SPDX-License-Identifier: LGPL-3.0-only (modified to allow linking)
2 {
3   Created by BGRA Controls Team
4   Dibo, Circular, lainz (007) and contributors.
5   For detailed information see readme.txt
6 
7   Site: https://sourceforge.net/p/bgra-controls/
8   Wiki: http://wiki.lazarus.freepascal.org/BGRAControls
9   Forum: http://forum.lazarus.freepascal.org/index.php/board,46.0.html
10 }
11 {******************************* CONTRIBUTOR(S) ******************************
12 - Edivando S. Santos Brasil | mailedivando@gmail.com
13   (Compatibility with delphi VCL 11/2018)
14 
15 ***************************** END CONTRIBUTOR(S) *****************************}
16 unit BCImageButton;
17 
18 {$I bgracontrols.inc}
19 
20 interface
21 
22 uses
23   Classes, SysUtils, Forms, Controls, Graphics,
24   {$IFDEF FPC}{$ifdef Windows}Windows,{$endif}LCLType, LResources, LMessages,{$ENDIF} ExtCtrls,
25   Types,
26   {$IFNDEF FPC}Windows, Messages, BGRAGraphics, GraphType, FPImage, {$ENDIF}
27   { BGRAControls }
28   BCBaseCtrls, BCEffect,
29   { BGRABitmap }
30   BGRABitmap, BGRABitmapTypes, BGRASliceScaling;
31 
32 {off $DEFINE DEBUG}
33 
CalculateAspectRatioHnull34 function CalculateAspectRatioH(W1, H1, W2: integer): integer; //result H2
CalculateAspectRatioWnull35 function CalculateAspectRatioW(W1, H1, H2: integer): integer; //result W2
CalculateDestRectnull36 function CalculateDestRect(ImageW, ImageH, DestW, DestH: integer;
37   Stretch, Proportional, Center: boolean): TRect;
38 procedure AssignFontToBGRA(Source: TFont; Dest: TBGRABitmap);
39 
40 type
41   TBCGraphicButtonState = (gbsNormal, gbsHover, gbsActive, gbsDisabled);
42 
43   TOnRenderControl = procedure(Sender: TObject; Bitmap: TBGRABitmap;
44     State: TBCGraphicButtonState) of object;
45 
46 type
47 
48   { TBCGraphicButton }
49 
50   TBCGraphicButton = class(TBCGraphicControl)
51   protected
52     FState: TBCGraphicButtonState;
53     FModalResult: TModalResult;
54   protected
55     procedure DoClick; virtual;
56     procedure DoMouseDown; virtual;
57     procedure DoMouseUp; virtual;
58     procedure DoMouseEnter; virtual;
59     procedure DoMouseLeave; virtual;
60     procedure DoMouseMove({%H-}x, {%H-}y: integer); virtual;
61   protected
62     procedure Click; override;
63     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
64       X, Y: integer); override;
65     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
66     procedure MouseEnter; override;
67     procedure MouseLeave; override;
68     procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
69   public
70     property ModalResult: TModalResult
71       read FModalResult write FModalResult default mrNone;
72   end;
73 
74   { TBCXButton }
75   TBCXButton = class(TBCGraphicButton)
76   protected
77     FOnRenderControl: TOnRenderControl;
78     FBGRANormal, FBGRAHover, FBGRAActive, FBGRADisabled: TBGRABitmap;
79   protected
GetControlClassDefaultSizenull80     class function GetControlClassDefaultSize: TSize; override;
81     procedure DrawControl; override;
82     procedure RenderControl; override;
83   public
84     constructor Create(AOwner: TComponent); override;
85     destructor Destroy; override;
86   published
87     property OnRenderControl: TOnRenderControl
88       read FOnRenderControl write FOnRenderControl;
89   published
90     property Action;
91     property Align;
92     property Anchors;
93     property AutoSize;
94     property BidiMode;
95     property BorderSpacing;
96     property Caption;
97     property Color;
98     property Constraints;
99     property DragCursor;
100     property DragKind;
101     property DragMode;
102     property Enabled;
103     property Font;
104     property ParentBidiMode;
105     property ModalResult;
106     {$IFDEF FPC}
107     property OnChangeBounds;
108     {$ENDIF}
109     property OnClick;
110     property OnContextPopup;
111     property OnDragDrop;
112     property OnDragOver;
113     property OnEndDrag;
114     property OnMouseDown;
115     property OnMouseEnter;
116     property OnMouseLeave;
117     property OnMouseMove;
118     property OnMouseUp;
119     property OnMouseWheel;
120     property OnMouseWheelDown;
121     property OnMouseWheelUp;
122     property OnResize;
123     property OnStartDrag;
124     property ParentFont;
125     property ParentShowHint;
126     property PopupMenu;
127     property ShowHint;
128     property Visible;
129   end;
130 
131   { TBCSliceScalingOptions }
132 
133   TBCCustomSliceScalingOptions = class(TPersistent)
134   protected
135     FOwner: TControl;
136     FBitmap: TBGRABitmap;
137     FAutoDetectRepeat, FRepeatTop, FRepeatLeft, FRepeatMiddleHorizontal,
138     FRepeatMiddleVertical, FRepeatRight, FRepeatBottom: boolean;
139     FMarginTop, FMarginRight, FMarginBottom, FMarginLeft, FNumberOfItems: integer;
140     FDirection: TSliceScalingDirection;
141     FDrawMode: TDrawMode;
142     FResampleMode: TResampleMode;
143     FResampleFilter: TResampleFilter;
144   private
145     procedure SetFBitmap(AValue: TBGRABitmap);
146     procedure SetFMarginBottom(AValue: integer);
147     procedure SetFMarginLeft(AValue: integer);
148     procedure SetFMarginRight(AValue: integer);
149     procedure SetFMarginTop(AValue: integer);
150     procedure SetFAutoDetectRepeat(AValue: boolean);
151     procedure SetFDirection(AValue: TSliceScalingDirection);
152     procedure SetFDrawMode(AValue: TDrawMode);
153     procedure SetFNumberOfItems(AValue: integer);
154     procedure SetFRepeatBottom(AValue: boolean);
155     procedure SetFRepeatLeft(AValue: boolean);
156     procedure SetFRepeatMiddleHorizontal(AValue: boolean);
157     procedure SetFRepeatMiddleVertical(AValue: boolean);
158     procedure SetFRepeatRight(AValue: boolean);
159     procedure SetFRepeatTop(AValue: boolean);
160     procedure SetFResampleFilter(AValue: TResampleFilter);
161     procedure SetFResampleMode(AValue: TResampleMode);
162   public
163     constructor Create(AOwner: TControl);
164     destructor Destroy; override;
165   published
166     property Bitmap: TBGRABitmap read FBitmap write SetFBitmap;
167     property AutoDetectRepeat: boolean read FAutoDetectRepeat
168       write SetFAutoDetectRepeat default False;
169     property RepeatTop: boolean read FRepeatTop write SetFRepeatTop default False;
170     property RepeatLeft: boolean read FRepeatLeft write SetFRepeatLeft default False;
171     property RepeatMiddleHorizontal: boolean
172       read FRepeatMiddleHorizontal write SetFRepeatMiddleHorizontal default False;
173     property RepeatMiddleVertical: boolean read FRepeatMiddleVertical
174       write SetFRepeatMiddleVertical default False;
175     property RepeatRight: boolean read FRepeatRight write SetFRepeatRight default False;
176     property RepeatBottom: boolean
177       read FRepeatBottom write SetFRepeatBottom default False;
178     property MarginTop: integer read FMarginTop write SetFMarginTop default 0;
179     property MarginRight: integer read FMarginRight write SetFMarginRight default 0;
180     property MarginBottom: integer read FMarginBottom write SetFMarginBottom default 0;
181     property MarginLeft: integer read FMarginLeft write SetFMarginLeft default 0;
182     property NumberOfItems: integer
183       read FNumberOfItems write SetFNumberOfItems default 1;
184     property Direction: TSliceScalingDirection read FDirection write SetFDirection;
185     property DrawMode: TDrawMode read FDrawMode write SetFDrawMode default
186       dmDrawWithTransparency;
187     property ResampleMode: TResampleMode read FResampleMode
188       write SetFResampleMode default rmFineResample;
189     property ResampleFilter: TResampleFilter read FResampleFilter
190       write SetFResampleFilter default rfBestQuality;
191   end;
192 
193   { TBCImageButtonSliceScalingOptions }
194 
195   TBCImageButtonSliceScalingOptions = class(TBCCustomSliceScalingOptions)
196   private
197     procedure SetFCenter(AValue: boolean);
198     procedure SetFProportional(AValue: boolean);
199     procedure SetFStretch(AValue: boolean);
200   protected
201     FCenter, FStretch, FProportional: boolean;
202   published
203     property NumberOfItems: integer read FNumberOfItems default 4;
204     property Center: boolean read FCenter write SetFCenter default True;
205     property Stretch: boolean read FStretch write SetFStretch default True;
206     property Proportional: boolean
207       read FProportional write SetFProportional default False;
208   public
209     constructor Create(AOwner: TControl);
210     procedure Assign(Source: TPersistent); override;
211   end;
212 
213   { TBCCustomImageButton }
214 
215   TBCCustomImageButton = class(TBCGraphicButton)
216   private
217     { Private declarations }
218     FAlphaTest: boolean;
219     FAlphaTestValue: byte;
220     {$IFDEF INDEBUG}
221     FDrawCount: integer;
222     FRenderCount: integer;
223     {$ENDIF}
224     FBitmapOptions: TBCImageButtonSliceScalingOptions;
225     FBGRAMultiSliceScaling: TBGRAMultiSliceScaling;
226     FBGRANormal, FBGRAHover, FBGRAActive, FBGRADisabled: TBGRABitmap;
227     FDestRect: TRect;
228     FPressed: boolean;
229     FTimer: TTimer;
230     FFade: TFading;
231     FAnimation: boolean;
232     FBitmapFile: string;
233     FTextVisible: boolean;
234     FToggle: boolean;
235     FMouse: TPoint;
236     procedure SetFAlphaTest(AValue: boolean);
237     procedure SetFAlphaTestValue(AValue: byte);
238     procedure SetFAnimation(AValue: boolean);
239     procedure SetFBitmapFile(AValue: string);
240     procedure SetFBitmapOptions(AValue: TBCImageButtonSliceScalingOptions);
241     procedure Fade({%H-}Sender: TObject);
242     procedure SetFPressed(AValue: boolean);
243     procedure SetFTextVisible(AValue: boolean);
244     procedure SetFToggle(AValue: boolean);
245   protected
246     { Protected declarations }
247     procedure DrawControl; override;
248     procedure RenderControl; override;
249     procedure TextChanged; override;
250     procedure FontChanged(Sender: TObject); override;
251     procedure CMChanged(var {%H-}Message: {$IFDEF FPC}TLMessage{$ELSE}TMessage{$ENDIF}); message CM_CHANGED; {$IFDEF FPC}virtual;{$ENDIF}
252     {$IFDEF INDEBUG}
253     {$IFDEF FPC}
GetDebugTextnull254     function GetDebugText: string;
255     {$ENDIF}
256     {$ENDIF}
257     procedure DoMouseDown; override;
258     procedure DoMouseUp; override;
259     procedure DoMouseEnter; override;
260     procedure DoMouseLeave; override;
261     procedure DoMouseMove(x, y: integer); override;
262     procedure Click; override;
263   public
264     { Public declarations }
265     property AlphaTest: boolean read FAlphaTest write SetFAlphaTest default True;
266     property AlphaTestValue: byte
267       read FAlphaTestValue write SetFAlphaTestValue default 255;
268     property Toggle: boolean read FToggle write SetFToggle default False;
269     property Pressed: boolean read FPressed write SetFPressed default False;
270     //property State: TBCGraphicButtonState read FState;
271     property BitmapOptions: TBCImageButtonSliceScalingOptions
272       read FBitmapOptions write SetFBitmapOptions;
273     property Animation: boolean read FAnimation write SetFAnimation default True;
274     property BitmapFile: string read FBitmapFile write SetFBitmapFile;
275     property TextVisible: boolean read FTextVisible write SetFTextVisible default True;
276     constructor Create(AOwner: TComponent); override;
277     destructor Destroy; override;
278     { It loads the 'BitmapFile' }
279     procedure LoadFromBitmapResource(const Resource: string; ResourceType: PChar); overload;
280     procedure LoadFromBitmapResource(const Resource: string); overload;
281     procedure LoadFromBitmapFile;
282     procedure Assign(Source: TPersistent); override;
283     { Streaming }
284     {$IFDEF FPC}
285     procedure SaveToFile(AFileName: string); override;
286     procedure LoadFromFile(AFileName: string); override;
287     procedure AssignFromFile(AFileName: string); override;
288     {$ENDIF}
289     procedure OnFindClass({%H-}Reader: TReader; const AClassName: string;
290       var ComponentClass: TComponentClass);
291   published
292     { Published declarations }
293   end;
294 
295   TBCImageButton = class(TBCCustomImageButton)
296   published
297     property AlphaTest;
298     property AlphaTestValue;
299     property Action;
300     property Align;
301     property Anchors;
302     property Animation;
303     property AutoSize;
304     //property AutoSizeExtraHorizontal;
305     //property AutoSizeExtraVertical;
306     property BidiMode;
307     //property Bitmap;
308     property BitmapFile;
309     property BitmapOptions;
310     property BorderSpacing;
311     property Caption;
312     //property Checked;
313     property Color;
314     property Constraints;
315     property DragCursor;
316     property DragKind;
317     property DragMode;
318     property Enabled;
319     property Font;
320     property ModalResult;
321     {$IFDEF FPC}
322     property OnChangeBounds;
323     {$ENDIF}
324     property OnClick;
325     property OnContextPopup;
326     property OnDragDrop;
327     property OnDragOver;
328     property OnEndDrag;
329     property OnMouseDown;
330     property OnMouseMove;
331     property OnMouseUp;
332     property OnMouseEnter;
333     property OnMouseLeave;
334     property OnMouseWheel;
335     property OnMouseWheelDown;
336     property OnMouseWheelUp;
337     //property OnPlaySound;
338     //property OnRedraw;
339     property OnResize;
340     property OnStartDrag;
341     property ParentBidiMode;
342     property ParentFont;
343     property ParentShowHint;
344     property PopupMenu;
345     //property Shadow;
346     property ShowHint;
347     //property Sound;
348     //property SoundClick;
349     //property SoundEnter;
350     property TextVisible;
351     property Toggle;
352     property Pressed;
353     property Visible;
354   end;
355 
356 {$IFDEF FPC}procedure Register;{$ENDIF}
357 
358 implementation
359 
360 {$IFDEF FPC}procedure Register;
361 begin
362   {$IFDEF FPC}
363   {$I icons\bcimagebutton_icon.lrs}
364   {$ENDIF}
365   RegisterComponents('BGRA Button Controls', [TBCImageButton]);
366   //{$I icons\bcxbutton_icon.lrs}
367   RegisterComponents('BGRA Button Controls', [TBCXButton]);
368 end;
369 {$ENDIF}
370 
CalculateAspectRatioHnull371 function CalculateAspectRatioH(W1, H1, W2: integer): integer;
372 begin
373   Result := Round(H1 / W1 * W2);
374 end;
375 
CalculateAspectRatioWnull376 function CalculateAspectRatioW(W1, H1, H2: integer): integer;
377 begin
378   Result := Round(W1 / H1 * H2);
379 end;
380 
CalculateDestRectnull381 function CalculateDestRect(ImageW, ImageH, DestW, DestH: integer;
382   Stretch, Proportional, Center: boolean): TRect;
383 var
384   w: integer;
385   h: integer;
386 begin
387   // Stretch or Proportional when Image (Width or Height) is bigger than Destination
388   if Stretch or (Proportional and ((ImageW > DestW) or (ImageH > DestH))) then
389   begin
390     // Proportional when Image (Width or Height) is bigger than 0
391     if Proportional and (ImageW > 0) and (ImageH > 0) then
392     begin
393       w := DestW;
394       h := CalculateAspectRatioH(ImageW, ImageH, DestW);
395       if h > DestH then
396       begin
397         h := DestH;
398         w := CalculateAspectRatioW(ImageW, ImageH, DestH);
399       end;
400       ImageW := w;
401       ImageH := h;
402     end
403     // Stretch not Proportional or when Image (Width or Height) is 0
404     else
405     begin
406       ImageW := DestW;
407       ImageH := DestH;
408     end;
409   end;
410 
411   Result := Rect(0, 0, ImageW, ImageH);
412 
413   // Center: Destination (Width or Height) - Image divided by 2
414   if Center then
415   begin
416     Result.Left := Round((DestW - ImageW) div 2);
417     Result.Top := Round((DestH - ImageH) div 2);
418   end;
419 end;
420 
421 procedure AssignFontToBGRA(Source: TFont; Dest: TBGRABitmap);
422 begin
423   Dest.FontAntialias := True;
424 
425   Dest.FontName := Source.Name;
426   Dest.FontStyle := Source.Style;
427   Dest.FontOrientation := Source.Orientation;
428 
429   case Source.Quality of
430     fqNonAntialiased: Dest.FontQuality := fqSystem;
431     fqAntialiased: Dest.FontQuality := fqFineAntialiasing;
432     fqProof: Dest.FontQuality := fqFineClearTypeRGB;
433     fqDefault, fqDraft, fqCleartype, fqCleartypeNatural: Dest.FontQuality :=
434         fqSystemClearType;
435   end;
436 
437   Dest.FontHeight := -Source.Height;
438 end;
439 
440 { TBCXButton }
441 
TBCXButton.GetControlClassDefaultSizenull442 class function TBCXButton.GetControlClassDefaultSize: TSize;
443 begin
444   Result := inherited GetControlClassDefaultSize;
445 end;
446 
447 procedure TBCXButton.DrawControl;
448 begin
449   if Enabled then
450     case FState of
451       gbsNormal: FBGRANormal.Draw(Canvas, 0, 0, False);
452       gbsHover: FBGRAHover.Draw(Canvas, 0, 0, False);
453       gbsActive: FBGRAActive.Draw(Canvas, 0, 0, False);
454     end
455   else
456     FBGRADisabled.Draw(Canvas, 0, 0, False);
457 end;
458 
459 procedure TBCXButton.RenderControl;
460 begin
461   { Free cache bitmaps }
462   if FBGRANormal <> nil then
463     FreeAndNil(FBGRANormal);
464   if FBGRAHover <> nil then
465     FreeAndNil(FBGRAHover);
466   if FBGRAActive <> nil then
467     FreeAndNil(FBGRAActive);
468   if FBGRADisabled <> nil then
469     FreeAndNil(FBGRADisabled);
470 
471   { Create cache bitmaps }
472   FBGRANormal := TBGRABitmap.Create(Width, Height);
473   FBGRAHover := TBGRABitmap.Create(Width, Height);
474   FBGRAActive := TBGRABitmap.Create(Width, Height);
475   FBGRADisabled := TBGRABitmap.Create(Width, Height);
476 
477   if Assigned(FOnRenderControl) then
478   begin
479     FOnRenderControl(Self, FBGRANormal, gbsNormal);
480     FOnRenderControl(Self, FBGRAHover, gbsHover);
481     FOnRenderControl(Self, FBGRAActive, gbsActive);
482     FOnRenderControl(Self, FBGRADisabled, gbsDisabled);
483   end;
484 end;
485 
486 constructor TBCXButton.Create(AOwner: TComponent);
487 begin
488   inherited Create(AOwner);
489   with GetControlClassDefaultSize do
490     SetInitialBounds(0, 0, CX, CY);
491 end;
492 
493 destructor TBCXButton.Destroy;
494 begin
495   if FBGRANormal <> nil then
496     FreeAndNil(FBGRANormal);
497   if FBGRAHover <> nil then
498     FreeAndNil(FBGRAHover);
499   if FBGRAActive <> nil then
500     FreeAndNil(FBGRAActive);
501   if FBGRADisabled <> nil then
502     FreeAndNil(FBGRADisabled);
503   inherited Destroy;
504 end;
505 
506 { TBCImageButtonSliceScalingOptions }
507 
508 procedure TBCImageButtonSliceScalingOptions.SetFCenter(AValue: boolean);
509 begin
510   if FCenter = AValue then
511     Exit;
512   FCenter := AValue;
513 
514   FOwner.Perform(CM_CHANGED, 0, 0);
515   FOwner.Invalidate;
516 end;
517 
518 procedure TBCImageButtonSliceScalingOptions.SetFProportional(AValue: boolean);
519 begin
520   if FProportional = AValue then
521     Exit;
522   FProportional := AValue;
523 
524   FOwner.Perform(CM_CHANGED, 0, 0);
525   FOwner.Invalidate;
526 end;
527 
528 procedure TBCImageButtonSliceScalingOptions.SetFStretch(AValue: boolean);
529 begin
530   if FStretch = AValue then
531     Exit;
532   FStretch := AValue;
533 
534   FOwner.Perform(CM_CHANGED, 0, 0);
535   FOwner.Invalidate;
536 end;
537 
538 constructor TBCImageButtonSliceScalingOptions.Create(AOwner: TControl);
539 begin
540   inherited Create(AOwner);
541   FNumberOfItems := 4;
542   FCenter := True;
543   FProportional := False;
544   FStretch := True;
545 end;
546 
547 procedure TBCImageButtonSliceScalingOptions.Assign(Source: TPersistent);
548 begin
549   if Source is TBCImageButtonSliceScalingOptions then
550   begin
551     FAutoDetectRepeat := TBCImageButtonSliceScalingOptions(Source).AutoDetectRepeat;
552     FCenter := TBCImageButtonSliceScalingOptions(Source).Center;
553     FRepeatTop := TBCImageButtonSliceScalingOptions(Source).RepeatTop;
554     FRepeatLeft := TBCImageButtonSliceScalingOptions(Source).RepeatLeft;
555     FRepeatMiddleHorizontal :=
556       TBCImageButtonSliceScalingOptions(Source).RepeatMiddleHorizontal;
557     FRepeatMiddleVertical := TBCImageButtonSliceScalingOptions(
558       Source).RepeatMiddleVertical;
559     FRepeatRight := TBCImageButtonSliceScalingOptions(Source).RepeatRight;
560     FRepeatBottom := TBCImageButtonSliceScalingOptions(Source).RepeatBottom;
561     FMarginTop := TBCImageButtonSliceScalingOptions(Source).MarginTop;
562     FMarginRight := TBCImageButtonSliceScalingOptions(Source).MarginRight;
563     FMarginBottom := TBCImageButtonSliceScalingOptions(Source).MarginBottom;
564     FMarginLeft := TBCImageButtonSliceScalingOptions(Source).MarginLeft;
565     FDirection := TBCImageButtonSliceScalingOptions(Source).Direction;
566     FDrawMode := TBCImageButtonSliceScalingOptions(Source).DrawMode;
567     FResampleMode := TBCImageButtonSliceScalingOptions(Source).ResampleMode;
568     FResampleFilter := TBCImageButtonSliceScalingOptions(Source).ResampleFilter;
569     FStretch := TBCImageButtonSliceScalingOptions(Source).Stretch;
570     FProportional := TBCImageButtonSliceScalingOptions(Source).Proportional;
571   end
572   else
573     inherited Assign(Source);
574 end;
575 
576 { TBCCustomSliceScalingOptions }
577 
578 procedure TBCCustomSliceScalingOptions.SetFBitmap(AValue: TBGRABitmap);
579 begin
580   if FBitmap = AValue then
581     Exit;
582   FBitmap := AValue;
583 
584   FOwner.Perform(CM_CHANGED, 0, 0);
585   FOwner.Invalidate;
586 end;
587 
588 procedure TBCCustomSliceScalingOptions.SetFMarginBottom(AValue: integer);
589 begin
590   if FMarginBottom = AValue then
591     Exit;
592   FMarginBottom := AValue;
593 
594   FOwner.Perform(CM_CHANGED, 0, 0);
595   FOwner.Invalidate;
596 end;
597 
598 procedure TBCCustomSliceScalingOptions.SetFMarginLeft(AValue: integer);
599 begin
600   if FMarginLeft = AValue then
601     Exit;
602   FMarginLeft := AValue;
603 
604   FOwner.Perform(CM_CHANGED, 0, 0);
605   FOwner.Invalidate;
606 end;
607 
608 procedure TBCCustomSliceScalingOptions.SetFMarginRight(AValue: integer);
609 begin
610   if FMarginRight = AValue then
611     Exit;
612   FMarginRight := AValue;
613 
614   FOwner.Perform(CM_CHANGED, 0, 0);
615   FOwner.Invalidate;
616 end;
617 
618 procedure TBCCustomSliceScalingOptions.SetFMarginTop(AValue: integer);
619 begin
620   if FMarginTop = AValue then
621     Exit;
622   FMarginTop := AValue;
623 
624   FOwner.Perform(CM_CHANGED, 0, 0);
625   FOwner.Invalidate;
626 end;
627 
628 procedure TBCCustomSliceScalingOptions.SetFAutoDetectRepeat(AValue: boolean);
629 begin
630   if FAutoDetectRepeat = AValue then
631     Exit;
632   FAutoDetectRepeat := AValue;
633 
634   FOwner.Perform(CM_CHANGED, 0, 0);
635   FOwner.Invalidate;
636 end;
637 
638 procedure TBCCustomSliceScalingOptions.SetFDirection(AValue: TSliceScalingDirection);
639 begin
640   if FDirection = AValue then
641     Exit;
642   FDirection := AValue;
643 
644   FOwner.Perform(CM_CHANGED, 0, 0);
645   FOwner.Invalidate;
646 end;
647 
648 procedure TBCCustomSliceScalingOptions.SetFDrawMode(AValue: TDrawMode);
649 begin
650   if FDrawMode = AValue then
651     Exit;
652   FDrawMode := AValue;
653 
654   FOwner.Perform(CM_CHANGED, 0, 0);
655   FOwner.Invalidate;
656 end;
657 
658 procedure TBCCustomSliceScalingOptions.SetFNumberOfItems(AValue: integer);
659 begin
660   if FNumberOfItems = AValue then
661     Exit;
662   FNumberOfItems := AValue;
663 end;
664 
665 procedure TBCCustomSliceScalingOptions.SetFRepeatBottom(AValue: boolean);
666 begin
667   if FRepeatBottom = AValue then
668     Exit;
669   FRepeatBottom := AValue;
670 
671   FOwner.Perform(CM_CHANGED, 0, 0);
672   FOwner.Invalidate;
673 end;
674 
675 procedure TBCCustomSliceScalingOptions.SetFRepeatLeft(AValue: boolean);
676 begin
677   if FRepeatLeft = AValue then
678     Exit;
679   FRepeatLeft := AValue;
680 
681   FOwner.Perform(CM_CHANGED, 0, 0);
682   FOwner.Invalidate;
683 end;
684 
685 procedure TBCCustomSliceScalingOptions.SetFRepeatMiddleHorizontal(AValue: boolean);
686 begin
687   if FRepeatMiddleHorizontal = AValue then
688     Exit;
689   FRepeatMiddleHorizontal := AValue;
690 
691   FOwner.Perform(CM_CHANGED, 0, 0);
692   FOwner.Invalidate;
693 end;
694 
695 procedure TBCCustomSliceScalingOptions.SetFRepeatMiddleVertical(AValue: boolean);
696 begin
697   if FRepeatMiddleVertical = AValue then
698     Exit;
699   FRepeatMiddleVertical := AValue;
700 
701   FOwner.Perform(CM_CHANGED, 0, 0);
702   FOwner.Invalidate;
703 end;
704 
705 procedure TBCCustomSliceScalingOptions.SetFRepeatRight(AValue: boolean);
706 begin
707   if FRepeatRight = AValue then
708     Exit;
709   FRepeatRight := AValue;
710 
711   FOwner.Perform(CM_CHANGED, 0, 0);
712   FOwner.Invalidate;
713 end;
714 
715 procedure TBCCustomSliceScalingOptions.SetFRepeatTop(AValue: boolean);
716 begin
717   if FRepeatTop = AValue then
718     Exit;
719   FRepeatTop := AValue;
720 
721   FOwner.Perform(CM_CHANGED, 0, 0);
722   FOwner.Invalidate;
723 end;
724 
725 procedure TBCCustomSliceScalingOptions.SetFResampleFilter(AValue: TResampleFilter);
726 begin
727   if FResampleFilter = AValue then
728     Exit;
729   FResampleFilter := AValue;
730 
731   FOwner.Perform(CM_CHANGED, 0, 0);
732   FOwner.Invalidate;
733 end;
734 
735 procedure TBCCustomSliceScalingOptions.SetFResampleMode(AValue: TResampleMode);
736 begin
737   if FResampleMode = AValue then
738     Exit;
739   FResampleMode := AValue;
740 
741   FOwner.Perform(CM_CHANGED, 0, 0);
742   FOwner.Invalidate;
743 end;
744 
745 constructor TBCCustomSliceScalingOptions.Create(AOwner: TControl);
746 begin
747   FOwner := AOwner;
748   FBitmap := nil;
749   FAutoDetectRepeat := False;
750   FRepeatTop := False;
751   FRepeatLeft := False;
752   FRepeatMiddleHorizontal := False;
753   FRepeatMiddleVertical := False;
754   FRepeatRight := False;
755   FRepeatBottom := False;
756   FMarginTop := 0;
757   FMarginRight := 0;
758   FMarginBottom := 0;
759   FMarginLeft := 0;
760   FNumberOfItems := 1;
761   FDirection := sdVertical;
762   FDrawMode := dmDrawWithTransparency;
763   FResampleMode := rmFineResample;
764   FResampleFilter := rfBestQuality;
765   inherited Create;
766 end;
767 
768 destructor TBCCustomSliceScalingOptions.Destroy;
769 begin
770   if FBitmap <> nil then
771     FreeAndNil(FBitmap);
772   inherited Destroy;
773 end;
774 
775 { TBCGraphicButton }
776 
777 procedure TBCGraphicButton.DoClick;
778 var
779   Form: TCustomForm;
780 begin
781   if ModalResult <> mrNone then
782   begin
783     Form := GetParentForm(Self);
784     if Form <> nil then
785       Form.ModalResult := ModalResult;
786   end;
787 end;
788 
789 procedure TBCGraphicButton.DoMouseDown;
790 var
791   NewState: TBCGraphicButtonState;
792 begin
793   NewState := gbsActive;
794 
795   if NewState <> FState then
796   begin
797     FState := NewState;
798     Invalidate;
799   end;
800 end;
801 
802 procedure TBCGraphicButton.DoMouseUp;
803 var
804   NewState: TBCGraphicButtonState;
805   p: TPoint;
806 begin
807   p := ScreenToClient(Mouse.CursorPos);
808 
809   if (p.x >= 0) and (p.x <= Width) and (p.y >= 0) and (p.y <= Height) then
810     NewState := gbsHover
811   else
812     NewState := gbsNormal;
813 
814   if NewState <> FState then
815   begin
816     FState := NewState;
817     Invalidate;
818   end;
819 end;
820 
821 procedure TBCGraphicButton.DoMouseEnter;
822 var
823   NewState: TBCGraphicButtonState;
824 begin
825   if Enabled then
826     NewState := gbsHover
827   else
828   begin
829     FState := gbsNormal;
830     NewState := FState;
831   end;
832 
833   if NewState <> FState then
834   begin
835     FState := NewState;
836     Invalidate;
837   end;
838 end;
839 
840 procedure TBCGraphicButton.DoMouseLeave;
841 var
842   NewState: TBCGraphicButtonState;
843 begin
844   if Enabled then
845     NewState := gbsNormal
846   else
847   begin
848     FState := gbsNormal;
849     NewState := FState;
850   end;
851 
852   if NewState <> FState then
853   begin
854     FState := NewState;
855     Invalidate;
856   end;
857 end;
858 
859 procedure TBCGraphicButton.DoMouseMove(x, y: integer);
860 begin
861   inherited;
862 end;
863 
864 procedure TBCGraphicButton.Click;
865 begin
866   DoClick;
867   inherited Click;
868 end;
869 
870 procedure TBCGraphicButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
871   X, Y: integer);
872 begin
873   inherited MouseDown(Button, Shift, X, Y);
874   if Button = mbLeft then
875     DoMouseDown;
876 end;
877 
878 procedure TBCGraphicButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
879   X, Y: integer);
880 begin
881   inherited MouseUp(Button, Shift, X, Y);
882   DoMouseUp;
883 end;
884 
885 procedure TBCGraphicButton.MouseEnter;
886 begin
887   inherited MouseEnter;
888   DoMouseEnter;
889 end;
890 
891 procedure TBCGraphicButton.MouseLeave;
892 begin
893   inherited MouseLeave;
894   DoMouseLeave;
895 end;
896 
897 procedure TBCGraphicButton.MouseMove(Shift: TShiftState; X, Y: Integer);
898 begin
899   inherited MouseMove(Shift, X, Y);
900   DoMouseMove(X, Y);
901 end;
902 
903 { TBCCustomImageButton }
904 
905 procedure TBCCustomImageButton.Fade(Sender: TObject);
906 begin
907   if FFade.Mode <> fmSuspended then
908     Invalidate;
909 
910   if csDesigning in ComponentState then
911     Exit;
912   FTimer.Enabled := FAnimation;
913 end;
914 
915 procedure TBCCustomImageButton.SetFPressed(AValue: boolean);
916 begin
917   if FPressed = AValue then
918     Exit;
919   FPressed := AValue;
920 
921   RenderControl;
922 end;
923 
924 procedure TBCCustomImageButton.SetFTextVisible(AValue: boolean);
925 begin
926   if FTextVisible = AValue then
927     Exit;
928   FTextVisible := AValue;
929 
930   RenderControl;
931 end;
932 
933 procedure TBCCustomImageButton.SetFToggle(AValue: boolean);
934 begin
935   if FToggle = AValue then
936     Exit;
937   FToggle := AValue;
938 end;
939 
940 procedure TBCCustomImageButton.SetFBitmapOptions(AValue:
941   TBCImageButtonSliceScalingOptions);
942 begin
943   if FBitmapOptions = AValue then
944     Exit;
945   FBitmapOptions := AValue;
946 end;
947 
948 procedure TBCCustomImageButton.SetFAlphaTest(AValue: boolean);
949 begin
950   if FAlphaTest = AValue then
951       Exit;
952     FAlphaTest := AValue;
953 end;
954 
955 procedure TBCCustomImageButton.SetFAlphaTestValue(AValue: byte);
956 begin
957   if FAlphaTestValue = AValue then
958       Exit;
959     FAlphaTestValue := AValue;
960 end;
961 
962 procedure TBCCustomImageButton.SetFAnimation(AValue: boolean);
963 begin
964   if FAnimation = AValue then
965     Exit;
966   FAnimation := AValue;
967 
968   if csDesigning in ComponentState then Exit;
969     FTimer.Enabled := FAnimation;
970 end;
971 
972 procedure TBCCustomImageButton.SetFBitmapFile(AValue: string);
973 begin
974   if FBitmapFile = AValue then
975     Exit;
976   FBitmapFile := AValue;
977 end;
978 
979 procedure TBCCustomImageButton.DrawControl;
980 var
981   temp: TBGRABitmap;
982 begin
983   {$IFNDEF FPC}//# //@  IN DELPHI RenderControl NEDD. IF NO RenderControl BE BLACK AFTER INVALIDATE.
984   RenderControl;
985   {$ENDIF}
986 
987   if Color <> clDefault then
988   begin
989     Canvas.Brush.Color := Color;
990     Canvas.FillRect(Rect(0, 0, Width, Height));
991   end;
992 
993   if Enabled then
994   begin
995     if (Toggle) then
996     begin
997       if (Pressed) then
998         FBGRAActive.Draw(Canvas, FDestRect.Left, FDestRect.Top, False)
999       else
1000         case FState of
1001           gbsHover: FBGRAHover.Draw(Canvas, FDestRect.Left,
1002               FDestRect.Top, False);
1003           else
1004             FBGRANormal.Draw(Canvas, FDestRect.Left,
1005               FDestRect.Top, False);
1006         end;
1007     end
1008     else
1009     begin
1010       case FState of
1011         gbsNormal, gbsHover: FBGRANormal.Draw(Canvas, FDestRect.Left,
1012             FDestRect.Top, False);
1013         gbsActive: FBGRAActive.Draw(Canvas, FDestRect.Left, FDestRect.Top, False);
1014       end;
1015 
1016       temp := TBGRABitmap.Create(Width, Height);
1017       FFade.Execute;
1018       FFade.PutImage(temp, 0, 0, FBGRAHover);
1019 
1020       temp.Draw(Canvas, FDestRect.Left, FDestRect.Top, False);
1021       temp.Free;
1022     end;
1023   end
1024   else
1025     FBGRADisabled.Draw(Canvas, FDestRect.Left, FDestRect.Top, False);
1026 
1027   {$IFDEF INDEBUG}
1028   FDrawCount := FDrawCount +1;
1029   {$ENDIF}
1030 
1031   {$IFDEF INDEBUG}
1032   Canvas.Brush.Color := clWhite;
1033   Canvas.TextOut(0, 0, GetDebugText);
1034   {$ENDIF}
1035 end;
1036 
1037 procedure TBCCustomImageButton.RenderControl;
1038 
1039   procedure DrawText(ABitmap: TBGRABitmap);
1040   begin
1041     AssignFontToBGRA(Font, ABitmap);
1042     ABitmap.TextRect(Rect(0, 0, Width, Height), Caption, taCenter, tlCenter,
1043       Font.Color);
1044   end;
1045 
1046 {$IFDEF INDEBUG}
1047 const
1048   Debug = True;
1049 {$ELSE}
1050 const
1051   Debug = False;
1052 {$ENDIF}
1053 var
1054   i: integer;
1055 begin
1056   { Free cache bitmaps }
1057   if FBGRANormal <> nil then
1058     FreeAndNil(FBGRANormal);
1059   if FBGRAHover <> nil then
1060     FreeAndNil(FBGRAHover);
1061   if FBGRAActive <> nil then
1062     FreeAndNil(FBGRAActive);
1063   if FBGRADisabled <> nil then
1064     FreeAndNil(FBGRADisabled);
1065 
1066   { Create cache bitmaps }
1067   FBGRANormal := TBGRABitmap.Create(Width, Height);
1068   FBGRAHover := TBGRABitmap.Create(Width, Height);
1069   FBGRAActive := TBGRABitmap.Create(Width, Height);
1070   FBGRADisabled := TBGRABitmap.Create(Width, Height);
1071 
1072   { Free FBGRAMultiSliceScaling }
1073   if FBGRAMultiSliceScaling <> nil then
1074     FreeAndNil(FBGRAMultiSliceScaling);
1075 
1076   if (FBitmapOptions.Bitmap <> nil) then
1077   begin
1078     { Create FBGRAMultiSliceScaling }
1079     FBGRAMultiSliceScaling := TBGRAMultiSliceScaling.Create(FBitmapOptions.Bitmap,
1080       FBitmapOptions.MarginTop, FBitmapOptions.MarginRight,
1081       FBitmapOptions.MarginBottom, FBitmapOptions.MarginLeft,
1082       FBitmapOptions.NumberOfItems, FBitmapOptions.Direction);
1083 
1084     { Set FBGRAMultiSliceScaling properties }
1085     for i := 0 to High(FBGRAMultiSliceScaling.SliceScalingArray) do
1086     begin
1087       FBGRAMultiSliceScaling.SliceScalingArray[i].ResampleFilter :=
1088         FBitmapOptions.ResampleFilter;
1089       FBGRAMultiSliceScaling.SliceScalingArray[i].ResampleMode :=
1090         FBitmapOptions.ResampleMode;
1091       FBGRAMultiSliceScaling.SliceScalingArray[i].DrawMode := FBitmapOptions.DrawMode;
1092       FBGRAMultiSliceScaling.SliceScalingArray[i].SliceRepeat[srpTop] :=
1093         FBitmapOptions.RepeatTop;
1094       FBGRAMultiSliceScaling.SliceScalingArray[i].SliceRepeat[srpBottom] :=
1095         FBitmapOptions.RepeatBottom;
1096       FBGRAMultiSliceScaling.SliceScalingArray[i].SliceRepeat[srpLeft] :=
1097         FBitmapOptions.RepeatLeft;
1098       FBGRAMultiSliceScaling.SliceScalingArray[i].SliceRepeat[srpRight] :=
1099         FBitmapOptions.RepeatRight;
1100       FBGRAMultiSliceScaling.SliceScalingArray[i].SliceRepeat[srpMiddleHorizontal] :=
1101         FBitmapOptions.RepeatMiddleHorizontal;
1102       FBGRAMultiSliceScaling.SliceScalingArray[i].SliceRepeat[srpMiddleVertical] :=
1103         FBitmapOptions.RepeatMiddleVertical;
1104       if FBitmapOptions.AutoDetectRepeat then
1105         FBGRAMultiSliceScaling.SliceScalingArray[i].AutodetectRepeat;
1106     end;
1107 
1108     { Calculate FDestRect }
1109     FDestRect := CalculateDestRect(
1110       FBGRAMultiSliceScaling.SliceScalingArray[0].BitmapWidth,
1111       FBGRAMultiSliceScaling.SliceScalingArray[0].BitmapHeight, Width,
1112       Height, FBitmapOptions.Stretch, FBitmapOptions.Proportional,
1113       FBitmapOptions.Center);
1114 
1115     { Draw in cache bitmaps }
1116     FBGRAMultiSliceScaling.Draw(0, FBGRANormal, 0, 0, FDestRect.Right,
1117       FDestRect.Bottom, Debug);
1118     FBGRAMultiSliceScaling.Draw(1, FBGRAHover, 0, 0, FDestRect.Right,
1119       FDestRect.Bottom, Debug);
1120     FBGRAMultiSliceScaling.Draw(2, FBGRAActive, 0, 0, FDestRect.Right,
1121       FDestRect.Bottom, Debug);
1122     FBGRAMultiSliceScaling.Draw(3, FBGRADisabled, 0, 0, FDestRect.Right,
1123       FDestRect.Bottom, Debug);
1124 
1125     if TextVisible then
1126     begin
1127       { Draw Text }
1128       DrawText(FBGRANormal);
1129       DrawText(FBGRAHover);
1130       DrawText(FBGRAActive);
1131       DrawText(FBGRADisabled);
1132     end;
1133   end
1134   else
1135   begin
1136     { Calculate FDestRect }
1137     FDestRect := Rect(0, 0, Width, Height);
1138 
1139     { Draw default style in cache bitmaps }
1140     FBGRANormal.Rectangle(0, 0, Width, Height, BGRA(173, 173, 173), BGRA(225, 225, 225),
1141       dmSet);
1142     FBGRAHover.Rectangle(0, 0, Width, Height, BGRA(0, 120, 215), BGRA(229, 241, 251),
1143       dmSet);
1144     FBGRAActive.Rectangle(0, 0, Width, Height, BGRA(0, 84, 153), BGRA(204, 228, 247),
1145       dmSet);
1146     FBGRADisabled.Rectangle(0, 0, Width, Height, BGRA(191, 191, 191), BGRA(204, 204, 204),
1147       dmSet);
1148 
1149     if TextVisible then
1150     begin
1151       { Draw Text }
1152       DrawText(FBGRANormal);
1153       DrawText(FBGRAHover);
1154       DrawText(FBGRAActive);
1155       DrawText(FBGRADisabled);
1156     end;
1157   end;
1158 
1159   {$IFDEF INDEBUG}
1160   FRenderCount := FRenderCount +1;
1161   {$ENDIF}
1162 end;
1163 
1164 procedure TBCCustomImageButton.TextChanged;
1165 begin
1166   InvalidatePreferredSize;
1167   {$IFDEF FPC}//#
1168   if Assigned(Parent) and Parent.AutoSize then
1169     Parent.AdjustSize;
1170   {$ENDIF}
1171   AdjustSize;
1172   RenderControl;
1173   Invalidate;
1174 end;
1175 
1176 procedure TBCCustomImageButton.FontChanged(Sender: TObject);
1177 begin
1178   inherited;
1179   RenderControl;
1180   Invalidate;
1181 end;
1182 
1183 procedure TBCCustomImageButton.CMChanged(var Message: {$IFDEF FPC}TLMessage{$ELSE}TMessage{$ENDIF});
1184 begin
1185   if csReadingState in ControlState then
1186     Exit;
1187   RenderControl;
1188 end;
1189 
1190 {$IFDEF INDEBUG}
1191 {$IFDEF FPC}
TBCCustomImageButton.GetDebugTextnull1192 function TBCCustomImageButton.GetDebugText: string;
1193 begin
1194   Result := 'Render: ' + IntToStr(FRenderCount) + ' Draw: ' + IntToStr(FDrawCount);
1195 end;
1196 {$ENDIF}
1197 {$ENDIF}
1198 
1199 procedure TBCCustomImageButton.DoMouseDown;
1200 begin
1201   if FAlphaTest and (FBGRANormal.GetPixel(FMouse.X, FMouse.Y).alpha < FAlphaTestValue) then
1202     Exit;
1203 
1204   FFade.Mode := fmFadeOut;
1205 
1206   if Animation then
1207     FFade.Step := 60
1208   else
1209     FFade.Step := 255;
1210 
1211   inherited DoMouseDown;
1212 end;
1213 
1214 procedure TBCCustomImageButton.DoMouseUp;
1215 var
1216   Ctrl: TControl;
1217 begin
1218   if FAlphaTest and (FBGRANormal.GetPixel(FMouse.X, FMouse.Y).alpha < FAlphaTestValue) then
1219     Exit;
1220 
1221   FFade.Mode := fmFadeIn;
1222 
1223   if Animation then
1224     FFade.Step := 20
1225   else
1226     FFade.Step := 255;
1227   {$IFDEF FPC} //#
1228   Ctrl := Application.GetControlAtMouse;
1229   {$ENDIF}
1230   if Ctrl = Self then
1231     DoMouseEnter
1232   else
1233     DoMouseLeave;
1234 
1235   inherited DoMouseUp;
1236 end;
1237 
1238 procedure TBCCustomImageButton.DoMouseEnter;
1239 begin
1240   FFade.Mode := fmFadeIn;
1241 
1242   if Animation then
1243     FFade.Step := 15
1244   else
1245     FFade.Step := 255;
1246 
1247   inherited DoMouseEnter;
1248 end;
1249 
1250 procedure TBCCustomImageButton.DoMouseLeave;
1251 begin
1252   FFade.Mode := fmFadeOut;
1253 
1254   if Animation then
1255     FFade.Step := 8
1256   else
1257     FFade.Step := 255;
1258 
1259   inherited DoMouseLeave;
1260 end;
1261 
1262 procedure TBCCustomImageButton.DoMouseMove(x, y: integer);
1263 begin
1264   FMouse := Point(X, Y);
1265   if FAlphaTest then
1266     if FBGRANormal.GetPixel(X, Y).alpha >= FAlphaTestValue then
1267       DoMouseEnter
1268     else
1269       DoMouseLeave;
1270 end;
1271 
1272 procedure TBCCustomImageButton.Click;
1273 begin
1274   if FAlphaTest and (FBGRANormal.GetPixel(FMouse.X, FMouse.Y).alpha < FAlphaTestValue) then
1275     Exit;
1276   inherited Click;
1277   if (Toggle) then
1278   begin
1279     Pressed := not Pressed;
1280   end;
1281 end;
1282 
1283 constructor TBCCustomImageButton.Create(AOwner: TComponent);
1284 begin
1285   inherited Create(AOwner);
1286   {$IFDEF INDEBUG}
1287   FDrawCount := 0;
1288   FRenderCount := 0;
1289   {$ENDIF}
1290   {$IFDEF FPC}
1291   DisableAutoSizing;
1292   Include(FControlState, csCreating);
1293   {$ELSE} //#
1294 
1295   {$ENDIF}
1296   BeginUpdate;
1297   try
1298     FBitmapOptions := TBCImageButtonSliceScalingOptions.Create(Self);
1299 
1300     with GetControlClassDefaultSize do
1301       SetInitialBounds(0, 0, CX, CY);
1302     ControlStyle := ControlStyle + [csAcceptsControls];
1303 
1304 //    FBitmapOptions := TBCImageButtonSliceScalingOptions.Create(Self);
1305     {FBitmapOptions.Bitmap := TBGRABitmap.Create(1,4,BGRAWhite);
1306     FBitmapOptions.Bitmap.SetPixel(0,0,BGRA(255,0,0,255));
1307     FBitmapOptions.Bitmap.SetPixel(0,1,BGRA(0,255,0,255));
1308     FBitmapOptions.Bitmap.SetPixel(0,2,BGRA(0,0,255,255));
1309     FBitmapOptions.Bitmap.SetPixel(0,3,BGRA(100,100,100,255));}
1310 
1311     FAlphaTest := True;
1312     FAlphaTestValue := 255;
1313     FFade.Step := 15;
1314     FFade.Mode := fmFadeOut;
1315     FTimer := TTimer.Create(Self);
1316     FTimer.Interval := 15;
1317     FTimer.OnTimer := Fade;
1318     if csDesigning in ComponentState then
1319       FTimer.Enabled := False;
1320     FAnimation := True;
1321     FTextVisible := True;
1322 
1323   finally
1324     {$IFDEF FPC}
1325     Exclude(FControlState, csCreating);
1326     EnableAutoSizing;
1327     {$ELSE} //#
1328     {$ENDIF}
1329     EndUpdate;
1330   end;
1331 end;
1332 
1333 destructor TBCCustomImageButton.Destroy;
1334 begin
1335   FTimer.Enabled := False;
1336   FTimer.OnTimer := nil;
1337   FTimer.Free;
1338   if FBGRAMultiSliceScaling <> nil then
1339     FreeAndNil(FBGRAMultiSliceScaling);
1340   if FBGRANormal <> nil then
1341     FreeAndNil(FBGRANormal);
1342   if FBGRAHover <> nil then
1343     FreeAndNil(FBGRAHover);
1344   if FBGRAActive <> nil then
1345     FreeAndNil(FBGRAActive);
1346   if FBGRADisabled <> nil then
1347     FreeAndNil(FBGRADisabled);
1348   FreeAndNil(FBitmapOptions);
1349   inherited Destroy;
1350 end;
1351 
1352 procedure TBCCustomImageButton.LoadFromBitmapResource(const Resource: string;
1353   ResourceType: PChar);
1354 var
1355   res: TResourceStream;
1356 begin
1357   res := TResourceStream.Create(HInstance, Resource, ResourceType);
1358 
1359   if BitmapOptions.Bitmap <> nil then
1360     BitmapOptions.Bitmap.Free;
1361 
1362   BitmapOptions.Bitmap := TBGRABitmap.Create(res);
1363   res.Free;
1364 end;
1365 
1366 procedure TBCCustomImageButton.LoadFromBitmapResource(const Resource: string);
1367 begin
1368   LoadFromBitmapResource(Resource, {$ifdef Windows}Windows.{$endif}RT_RCDATA);
1369 end;
1370 
1371 procedure TBCCustomImageButton.LoadFromBitmapFile;
1372 begin
1373   if BitmapFile <> '' then
1374     if BitmapOptions.Bitmap <> nil then
1375       BitmapOptions.Bitmap.LoadFromFile(BitmapFile)
1376     else
1377       BitmapOptions.Bitmap := TBGRABitmap.Create(BitmapFile);
1378 end;
1379 
1380 procedure TBCCustomImageButton.Assign(Source: TPersistent);
1381 begin
1382   if Source is TBCCustomImageButton then
1383   begin
1384     FBitmapOptions.Assign(TBCCustomImageButton(Source).BitmapOptions);
1385     FAnimation := TBCCustomImageButton(Source).Animation;
1386     FBitmapFile := TBCCustomImageButton(Source).BitmapFile;
1387     FTextVisible := TBCCustomImageButton(Source).TextVisible;
1388 
1389     if TBCCustomImageButton(Source).BitmapOptions.Bitmap <> nil then
1390     begin
1391       if FBitmapOptions.Bitmap <> nil then
1392         FBitmapOptions.Bitmap.Free;
1393 
1394       FBitmapOptions.Bitmap :=
1395         TBGRABitmap.Create(TBCCustomImageButton(Source).BitmapOptions.Bitmap.Bitmap);
1396     end
1397     else
1398       LoadFromBitmapFile;
1399 
1400     RenderControl;
1401     Invalidate;
1402   end
1403   else
1404     inherited Assign(Source);
1405 end;
1406 {$IFDEF FPC}
1407 procedure TBCCustomImageButton.SaveToFile(AFileName: string);
1408 var
1409   AStream: TMemoryStream;
1410 begin
1411   AStream := TMemoryStream.Create;
1412   try
1413     WriteComponentAsTextToStream(AStream, Self);
1414     AStream.SaveToFile(AFileName);
1415   finally
1416     AStream.Free;
1417   end;
1418 end;
1419 
1420 procedure TBCCustomImageButton.LoadFromFile(AFileName: string);
1421 var
1422   AStream: TMemoryStream;
1423 begin
1424   AStream := TMemoryStream.Create;
1425   try
1426     AStream.LoadFromFile(AFileName);
1427     ReadComponentFromTextStream(AStream, TComponent(Self), OnFindClass);
1428   finally
1429     AStream.Free;
1430   end;
1431 end;
1432 
1433 procedure TBCCustomImageButton.AssignFromFile(AFileName: string);
1434 var
1435   AStream: TMemoryStream;
1436   AButton: TBCImageButton;
1437 begin
1438   AButton := TBCImageButton.Create(nil);
1439   AStream := TMemoryStream.Create;
1440   try
1441     AStream.LoadFromFile(AFileName);
1442     ReadComponentFromTextStream(AStream, TComponent(AButton), OnFindClass);
1443     Assign(AButton);
1444   finally
1445     AStream.Free;
1446     AButton.Free;
1447   end;
1448 end;
1449 {$ENDIF}
1450 
1451 procedure TBCCustomImageButton.OnFindClass(Reader: TReader;
1452   const AClassName: string; var ComponentClass: TComponentClass);
1453 begin
1454   if CompareText(AClassName, 'TBCImageButton') = 0 then
1455     ComponentClass := TBCImageButton;
1456 end;
1457 
1458 end.
1459