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