source: trunk/Packages/bgracontrols/bgrabutton.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 50.5 KB
Line 
1{ !! THIS CONTROL IS DEPRECATED! USE BCBUTTON INSTEAD !!
2 Customizable component which using BGRABitmap for drawing. Functionality:
3 - Gradients
4 - Double gradients
5 - Rounding
6 - Drop down list
7 - Glyph
8 - States (normal, hover, clicked)
9 - Caption with shadow
10 - Full alpha and antialias support
11
12 Copyright (C) 2011 Krzysztof Dibowski dibowski at interia.pl
13
14 This library is free software; you can redistribute it and/or modify it
15 under the terms of the GNU Library General Public License as published by
16 the Free Software Foundation; either version 2 of the License, or (at your
17 option) any later version with the following modification:
18
19 As a special exception, the copyright holders of this library give you
20 permission to link this library with independent modules to produce an
21 executable, regardless of the license terms of these independent modules,and
22 to copy and distribute the resulting executable under terms of your choice,
23 provided that you also meet, for each linked independent module, the terms
24 and conditions of the license of that module. An independent module is a
25 module which is not derived from or based on this library. If you modify
26 this library, you may extend this exception to your version of the library,
27 but you are not obligated to do so. If you do not wish to do so, delete this
28 exception statement from your version.
29
30 This program is distributed in the hope that it will be useful, but WITHOUT
31 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
32 FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
33 for more details.
34
35 You should have received a copy of the GNU Library General Public License
36 along with this library; if not, write to the Free Software Foundation,
37 Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
38}
39unit BGRAButton;
40
41{$mode objfpc}{$H+}
42
43interface
44
45uses
46 Classes, LResources, Controls, Dialogs, BGRABitmap, BGRABitmapTypes,
47 Buttons, Graphics, BGRAGradientScanner, LCLType, types, BCTypes,
48 LMessages, Forms;
49
50{off $DEFINE DEBUG}
51
52type
53
54 TBGRABorderStyle = (bsRound, bsBevel, bsSquare);
55 TBGRAButtBodyStyle = (bbsClear, bbsColor, bbsGradient);
56 TBGRAButtBorderStyle = (bboNone, bboSolid);
57 TBGRAButtStyle = (bbtButton, bbtDropDown);
58 TCustomBGRAButtonState = (
59 bstPrepareNormal,
60 bstPrepareHover,
61 bstPrepareClick,
62 // Drop down button
63 bstPrepareNormalA,
64 bstPrepareHoverA,
65 bstPrepareClickA
66 );
67 TCustomBGRAButtonStates = set of TCustomBGRAButtonState;
68 TOnAfterPrepareBGRAButton = procedure(Sender: TObject; const ABGRA: TBGRABitmap;
69 ARect: TRect; AState: TCustomBGRAButtonState) of object;
70
71 { TBody }
72
73 TBody = class(TPersistent)
74 private
75 FBorderColor: TColor;
76 FBorderColorOpacity: byte;
77 FBorderStyle: TBGRAButtBorderStyle;
78 FColor: TColor;
79 FColorOpacity: byte;
80 FFont: TFont;
81 FGradient1: TBCGradient;
82 FGradient1EndPercent: single;
83 FGradient2: TBCGradient;
84 FOwner: TControl;
85 FStyle: TBGRAButtBodyStyle;
86 FLightWidth: integer;
87 FLightOpacity: byte;
88 FLightColor: TColor;
89 procedure OnChangeFont(Sender: TObject);
90 procedure SetBorderColor(const AValue: TColor);
91 procedure SetBorderColorOpacity(const AValue: byte);
92 procedure SetBorderStyle(const AValue: TBGRAButtBorderStyle);
93 procedure SetColor(const AValue: TColor);
94 procedure SetColorOpacity(const AValue: byte);
95 procedure SetFLightColor(AValue: TColor);
96 procedure SetFont(const AValue: TFont);
97 procedure SetGradient1(const AValue: TBCGradient);
98 procedure SetGradient1EndPercent(const AValue: single);
99 procedure SetGradient2(const AValue: TBCGradient);
100 procedure SetLightOpacity(const AValue: byte);
101 procedure SetLightWidth(const AValue: integer);
102 procedure SetStyle(const AValue: TBGRAButtBodyStyle);
103 public
104 constructor Create(AOwner: TControl);
105 destructor Destroy; override;
106
107 procedure Assign(Source: TPersistent); override;
108 published
109 property BorderColor: TColor read FBorderColor write SetBorderColor default clBlack;
110 property BorderColorOpacity: byte read FBorderColorOpacity
111 write SetBorderColorOpacity default 255;
112 property BorderStyle: TBGRAButtBorderStyle
113 read FBorderStyle write SetBorderStyle default bboSolid;
114 property Color: TColor read FColor write SetColor default clDefault;
115 property ColorOpacity: byte read FColorOpacity write SetColorOpacity default 255;
116 property Font: TFont read FFont write SetFont;
117 property Gradient1: TBCGradient read FGradient1 write SetGradient1;
118 property Gradient2: TBCGradient read FGradient2 write SetGradient2;
119 property Gradient1EndPercent: single read FGradient1EndPercent
120 write SetGradient1EndPercent default 35;
121 property Style: TBGRAButtBodyStyle read FStyle write SetStyle default bbsGradient;
122 property LightWidth: integer read FLightWidth write SetLightWidth;
123 property LightOpacity: byte read FLightOpacity write SetLightOpacity;
124 property LightColor: TColor read FLightColor write SetFLightColor default clWhite;
125 end;
126
127 { TBGRABorderStyleOptions }
128
129 TBGRABorderStyleOptions = class(TPersistent)
130 private
131 FOwner: TControl;
132 FTopLeft: TBGRABorderStyle;
133 FTopRight: TBGRABorderStyle;
134 FBottomRight: TBGRABorderStyle;
135 FBottomLeft: TBGRABorderStyle;
136 procedure SetFBottomLeft(AValue: TBGRABorderStyle);
137 procedure SetFBottomRight(AValue: TBGRABorderStyle);
138 procedure SetFTopLeft(AValue: TBGRABorderStyle);
139 procedure SetFTopRight(AValue: TBGRABorderStyle);
140 function UpdateOptions: TRoundRectangleOptions;
141 public
142 constructor Create(AOwner: TControl);
143 destructor Destroy; override;
144 procedure Assign(Source: TPersistent); override;
145 property Options: TRoundRectangleOptions read UpdateOptions;
146 published
147 property TopLeft: TBGRABorderStyle read FTopLeft write SetFTopLeft;
148 property TopRight: TBGRABorderStyle read FTopRight write SetFTopRight;
149 property BottomRight: TBGRABorderStyle read FBottomRight write SetFBottomRight;
150 property BottomLeft: TBGRABorderStyle read FBottomLeft write SetFBottomLeft;
151 end;
152
153 { TCustomBGRAButton }
154
155 TCustomBGRAButton = class(TGraphicControl)
156 private
157 { Private declarations }
158 FBaseRect: TRect;
159 FFlipArrow: boolean;
160 FActiveButt: TBGRAButtStyle;
161 FBGRANormal, FBGRAHover, FBGRAClick, FBGRANormalA, FBGRAHoverA,
162 FBGRAClickA: TBGRABitmap;
163 FBodyClicked: TBody;
164 FBodyHover: TBody;
165 FBodyNormal: TBody;
166 FBorderStyle: TBGRABorderStyleOptions;
167 FBorderStyleDropDown: TBGRABorderStyleOptions;
168 FBorderWidth: integer;
169 FDown: boolean;
170 FGlyph: TBitmap;
171 FGlyphMargin: integer;
172 FMouseStage: TBCMouseState;
173 FOnAfterPrepareBGRAButton: TOnAfterPrepareBGRAButton;
174 FOnButtonClick: TNotifyEvent;
175 FRoundX: integer;
176 FRoundY: integer;
177 FStaticButton: boolean;
178 FTextAlign: TBGRATextAlign;
179 FTextCanvas: boolean;
180 FTextShadow: boolean;
181 FTextShadowColor: TColor;
182 FTextShadowColorOpacity: byte;
183 FTextShadowOffsetX: integer;
184 FTextShadowOffsetY: integer;
185 FTextShadowRadius: integer;
186 FStyle: TBGRAButtStyle;
187 FTextVAlign: TBGRATextVAlign;
188 FGlobalOpacity: byte;
189 FTextApplyGlobalOpacity: boolean;
190 FStates: TCustomBGRAButtonStates;
191 FUpdateCount: integer;
192 ARR_SIZE: integer;
193 ARR_SPACE: integer;
194 AutoSizeExtraY: integer;
195 AutoSizeExtraX: integer;
196 {$IFDEF DEBUG}
197 FInvalidateCount: integer;
198 {$ENDIF}
199 procedure CalculateBaseRect;
200 procedure CalculateTextSize(MaxWidth: integer;
201 var NeededWidth, NeededHeight: integer);
202 procedure CalculateGlyphSize(var NeededWidth, NeededHeight: integer);
203 procedure ConvertToGrayScale(ABGRA: TBGRABitmap);
204 procedure DrawArrow(ABGRA: TBGRABitmap; ABody: TBody; ARect: TRect);
205 procedure DrawBasicBody(ABGRA: TBGRABitmap; ABody: TBody; ARect: TRect;
206 boroptions: TRoundRectangleOptions);
207 procedure DrawText(ABGRA: TBGRABitmap; AFontColor: TColor;
208 AFontStyle: TFontStyles = []; AFontName: string = 'Default');
209 function GetDropDownWidth(AFull: boolean = True): integer;
210 procedure Prepare;
211 procedure PrepareBGRA(ABGRA: TBGRABitmap; ABody: TBody;
212 AState: TCustomBGRAButtonState);
213 procedure PrepareBGRADropDown(ABGRA: TBGRABitmap; ABody: TBody;
214 AState: TCustomBGRAButtonState);
215 procedure OnChangeGlyph(Sender: TObject);
216 procedure SetBodyClicked(const AValue: TBody);
217 procedure SetBodyHover(const AValue: TBody);
218 procedure SetBodyNormal(const AValue: TBody);
219 procedure SetBorderWidth(const AValue: integer);
220 procedure SetDown(AValue: boolean);
221 procedure SetFBorderStyle(AValue: TBGRABorderStyleOptions);
222 procedure SetFBorderStyleDropDown(AValue: TBGRABorderStyleOptions);
223 procedure SetFFlipArrow(AValue: boolean);
224 procedure SetFTextCanvas(AValue: boolean);
225 procedure SetGlyph(const AValue: TBitmap);
226 procedure SetGlyphMargin(const AValue: integer);
227 procedure SetRoundX(const AValue: integer);
228 procedure SetRoundY(const AValue: integer);
229 procedure SetStaticButton(const AValue: boolean);
230 procedure SeTBGRATextAlign(const AValue: TBGRATextAlign);
231 procedure SetTextShadow(const AValue: boolean);
232 procedure SetTextShadowColor(const AValue: TColor);
233 procedure SetTextShadowColorOpacity(const AValue: byte);
234 procedure SetTextShadowOffsetX(const AValue: integer);
235 procedure SetTextShadowOffsetY(const AValue: integer);
236 procedure SetTextShadowRadius(const AValue: integer);
237 procedure SetStyle(const AValue: TBGRAButtStyle);
238 procedure SeTBGRATextVAlign(const AValue: TBGRATextVAlign);
239 procedure SetGlobalOpacity(const AValue: byte);
240 procedure SetTextApplyGlobalOpacity(const AValue: boolean);
241 procedure UpdateSize;
242 protected
243 procedure CMChanged(var Message: TLMessage); message CM_CHANGED;
244 protected
245 { Protected declarations }
246 procedure BoundsChanged; override;
247 procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
248 WithThemeSpace: boolean); override;
249 class function GetControlClassDefaultSize: TSize; override;
250 procedure Click; override;
251 procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
252 X, Y: integer); override;
253 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
254 procedure MouseEnter; override;
255 procedure MouseLeave; override;
256 procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
257 procedure Paint; override;
258 procedure SetEnabled(Value: boolean); override;
259 procedure TextChanged; override;
260 public
261 { Public declarations }
262 constructor Create(AOwner: TComponent); override;
263 destructor Destroy; override;
264 procedure Assign(Source: TPersistent); override;
265 procedure BeginUpdate; virtual;
266 procedure EndUpdate; virtual;
267 procedure SetSizeVariables(newArrowSize, newArrowSpace,
268 newAutoSizeExtraVertical, newAutoSizeExtraHorizontal: integer);
269 property ArrowSize: integer read ARR_SIZE;
270 property ArrowSpace: integer read ARR_SPACE;
271 property AutoSizeExtraVertical: integer read AutoSizeExtraY;
272 property AutoSizeExtraHorizontal: integer read AutoSizeExtraX;
273 property BodyNormal: TBody read FBodyNormal write SetBodyNormal;
274 property BodyHover: TBody read FBodyHover write SetBodyHover;
275 property BodyClicked: TBody read FBodyClicked write SetBodyClicked;
276 property BorderWidth: integer read FBorderWidth write SetBorderWidth default 1;
277 property BorderStyle: TBGRABorderStyleOptions
278 read FBorderStyle write SetFBorderStyle;
279 property BorderStyleDropDown: TBGRABorderStyleOptions
280 read FBorderStyleDropDown write SetFBorderStyleDropDown;
281 property Down: boolean read FDown write SetDown default False;
282 property FlipArrow: boolean read FFlipArrow write SetFFlipArrow;
283 property Glyph: TBitmap read FGlyph write SetGlyph;
284 property GlyphMargin: integer read FGlyphMargin write SetGlyphMargin default 5;
285 property RoundX: integer read FRoundX write SetRoundX default 1;
286 property RoundY: integer read FRoundY write SetRoundY default 1;
287 property TextAlign: TBGRATextAlign
288 read FTextAlign write SeTBGRATextAlign default btaCenter;
289 property TextCanvas: boolean read FTextCanvas write SetFTextCanvas default False;
290 property TextVAlign: TBGRATextVAlign
291 read FTextVAlign write SeTBGRATextVAlign default btvaCenter;
292 property TextShadow: boolean read FTextShadow write SetTextShadow default True;
293 property TextShadowColor: TColor read FTextShadowColor
294 write SetTextShadowColor default clBlack;
295 property TextShadowColorOpacity: byte read FTextShadowColorOpacity
296 write SetTextShadowColorOpacity;
297 property TextShadowOffsetX: integer read FTextShadowOffsetX
298 write SetTextShadowOffsetX default 5;
299 property TextShadowOffsetY: integer read FTextShadowOffsetY
300 write SetTextShadowOffsetY default 5;
301 property TextShadowRadius: integer read FTextShadowRadius
302 write SetTextShadowRadius default 5;
303 property Style: TBGRAButtStyle read FStyle write SetStyle default bbtButton;
304 property StaticButton: boolean
305 read FStaticButton write SetStaticButton default False;
306 property GlobalOpacity: byte read FGlobalOpacity write SetGlobalOpacity;
307 property TextApplyGlobalOpacity: boolean
308 read FTextApplyGlobalOpacity write SetTextApplyGlobalOpacity;
309 property OnAfterPrepareBGRAButton: TOnAfterPrepareBGRAButton
310 read FOnAfterPrepareBGRAButton write FOnAfterPrepareBGRAButton;
311 property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
312 end;
313
314 TBGRAButton = class(TCustomBGRAButton)
315 published
316 property Action;
317 property Align;
318 property Anchors;
319 property AutoSize;
320 property BodyClicked;
321 property BodyHover;
322 property BodyNormal;
323 property BorderSpacing;
324 property BorderStyle;
325 property BorderStyleDropDown;
326 property BorderWidth;
327 property Caption;
328 property Color;
329 property Down;
330 property Enabled;
331 property FlipArrow;
332 property GlobalOpacity;
333 property Glyph;
334 property GlyphMargin;
335 property OnAfterPrepareBGRAButton;
336 property OnButtonClick;
337 property OnClick;
338 property OnDblClick;
339 property OnMouseDown;
340 property OnMouseEnter;
341 property OnMouseLeave;
342 property OnMouseMove;
343 property OnMouseUp;
344 property ParentColor;
345 property PopupMenu;
346 property RoundX;
347 property RoundY;
348 property StaticButton;
349 property Style;
350 property TextAlign;
351 property TextApplyGlobalOpacity;
352 property TextCanvas;
353 property TextShadow;
354 property TextShadowColor;
355 property TextShadowColorOpacity;
356 property TextShadowOffsetX;
357 property TextShadowOffsetY;
358 property TextShadowRadius;
359 property TextVAlign;
360 property Visible;
361 end;
362
363procedure Register;
364
365implementation
366
367uses LCLIntf, Math, LCLProc, BGRAPolygon, BGRAFillInfo, SysUtils, BCTools;
368
369procedure Register;
370begin
371 {$I bgrabutton_icon.lrs}
372 RegisterComponents('BGRA Controls', [TBGRAButton]);
373end;
374
375{ TBGRABorderStyleOptions }
376
377procedure TBGRABorderStyleOptions.SetFBottomLeft(AValue: TBGRABorderStyle);
378begin
379 if FBottomLeft = AValue then
380 Exit;
381 FBottomLeft := AValue;
382
383 FOwner.Perform(CM_CHANGED, 0, 0);
384 FOwner.Invalidate;
385end;
386
387procedure TBGRABorderStyleOptions.SetFBottomRight(AValue: TBGRABorderStyle);
388begin
389 if FBottomRight = AValue then
390 Exit;
391 FBottomRight := AValue;
392
393 FOwner.Perform(CM_CHANGED, 0, 0);
394 FOwner.Invalidate;
395end;
396
397procedure TBGRABorderStyleOptions.SetFTopLeft(AValue: TBGRABorderStyle);
398begin
399 if FTopLeft = AValue then
400 Exit;
401 FTopLeft := AValue;
402
403 FOwner.Perform(CM_CHANGED, 0, 0);
404 FOwner.Invalidate;
405end;
406
407procedure TBGRABorderStyleOptions.SetFTopRight(AValue: TBGRABorderStyle);
408begin
409 if FTopRight = AValue then
410 Exit;
411 FTopRight := AValue;
412
413 FOwner.Perform(CM_CHANGED, 0, 0);
414 FOwner.Invalidate;
415end;
416
417function TBGRABorderStyleOptions.UpdateOptions: TRoundRectangleOptions;
418var
419 tl, tr, br, bl: TRoundRectangleOptions;
420begin
421 case TopLeft of
422 bsBevel: tl := [rrTopLeftBevel];
423 bsSquare: tl := [rrTopLeftSquare];
424 bsRound: tl := [];
425 end;
426
427 case TopRight of
428 bsBevel: tr := [rrTopRightBevel];
429 bsSquare: tr := [rrTopRightSquare];
430 bsRound: tr := [];
431 end;
432
433 case BottomRight of
434 bsBevel: br := [rrBottomRightBevel];
435 bsSquare: br := [rrBottomRightSquare];
436 bsRound: br := [];
437 end;
438
439 case BottomLeft of
440 bsBevel: bl := [rrBottomLeftBevel];
441 bsSquare: bl := [rrBottomLeftSquare];
442 bsRound: bl := [];
443 end;
444
445 Result := tl + tr + br + bl;
446end;
447
448constructor TBGRABorderStyleOptions.Create(AOwner: TControl);
449begin
450 FOwner := AOwner;
451 FTopLeft := bsRound;
452 FTopRight := bsRound;
453 FBottomRight := bsRound;
454 FBottomLeft := bsRound;
455 inherited Create;
456end;
457
458destructor TBGRABorderStyleOptions.Destroy;
459begin
460 inherited Destroy;
461end;
462
463procedure TBGRABorderStyleOptions.Assign(Source: TPersistent);
464begin
465 if Source is TBGRABorderStyleOptions then
466 begin
467 FTopLeft := TBGRABorderStyleOptions(Source).FTopLeft;
468 FTopRight := TBGRABorderStyleOptions(Source).FTopRight;
469 FBottomRight := TBGRABorderStyleOptions(Source).FBottomRight;
470 FBottomLeft := TBGRABorderStyleOptions(Source).FBottomLeft;
471
472 FOwner.Invalidate;
473 end
474 else
475 inherited Assign(Source);
476end;
477
478{ TBody }
479
480procedure TBody.SetColor(const AValue: TColor);
481begin
482 if FColor = AValue then
483 exit;
484 FColor := AValue;
485
486 FOwner.Perform(CM_CHANGED, 0, 0);
487 FOwner.Invalidate;
488end;
489
490procedure TBody.SetColorOpacity(const AValue: byte);
491begin
492 if FColorOpacity = AValue then
493 exit;
494 FColorOpacity := AValue;
495
496 FOwner.Perform(CM_CHANGED, 0, 0);
497 FOwner.Invalidate;
498end;
499
500procedure TBody.SetFLightColor(AValue: TColor);
501begin
502 if FLightColor = AValue then
503 Exit;
504 FLightColor := AValue;
505
506 FOwner.Perform(CM_CHANGED, 0, 0);
507 FOwner.Invalidate;
508end;
509
510procedure TBody.SetFont(const AValue: TFont);
511begin
512 if FFont = AValue then
513 exit;
514 FFont.Assign(AValue);
515
516 FOwner.Perform(CM_CHANGED, 0, 0);
517 FOwner.Invalidate;
518end;
519
520procedure TBody.SetGradient1(const AValue: TBCGradient);
521begin
522 if FGradient1 = AValue then
523 exit;
524 FGradient1.Assign(AValue);
525
526 FOwner.Perform(CM_CHANGED, 0, 0);
527 FOwner.Invalidate;
528end;
529
530procedure TBody.SetGradient1EndPercent(const AValue: single);
531begin
532 if FGradient1EndPercent = AValue then
533 exit;
534 FGradient1EndPercent := AValue;
535
536 FOwner.Perform(CM_CHANGED, 0, 0);
537 FOwner.Invalidate;
538end;
539
540procedure TBody.SetGradient2(const AValue: TBCGradient);
541begin
542 if FGradient2 = AValue then
543 exit;
544 FGradient2.Assign(AValue);
545
546 FOwner.Perform(CM_CHANGED, 0, 0);
547 FOwner.Invalidate;
548end;
549
550procedure TBody.SetLightOpacity(const AValue: byte);
551begin
552 if FLightOpacity = AValue then
553 exit;
554 FLightOpacity := AValue;
555
556 FOwner.Perform(CM_CHANGED, 0, 0);
557 FOwner.Invalidate;
558end;
559
560procedure TBody.SetLightWidth(const AValue: integer);
561begin
562 if FLightWidth = AValue then
563 exit;
564 FLightWidth := AValue;
565
566 FOwner.Perform(CM_CHANGED, 0, 0);
567 FOwner.Invalidate;
568end;
569
570procedure TBody.OnChangeFont(Sender: TObject);
571begin
572 FOwner.Perform(CM_CHANGED, 0, 0);
573 FOwner.Invalidate;
574 TCustomBGRAButton(FOwner).UpdateSize;
575end;
576
577procedure TBody.SetBorderColor(const AValue: TColor);
578begin
579 if FBorderColor = AValue then
580 exit;
581 FBorderColor := AValue;
582
583 FOwner.Perform(CM_CHANGED, 0, 0);
584 FOwner.Invalidate;
585end;
586
587procedure TBody.SetBorderColorOpacity(const AValue: byte);
588begin
589 if FBorderColorOpacity = AValue then
590 exit;
591 FBorderColorOpacity := AValue;
592
593 FOwner.Perform(CM_CHANGED, 0, 0);
594 FOwner.Invalidate;
595end;
596
597procedure TBody.SetBorderStyle(const AValue: TBGRAButtBorderStyle);
598begin
599 if FBorderStyle = AValue then
600 exit;
601 FBorderStyle := AValue;
602
603 FOwner.Perform(CM_CHANGED, 0, 0);
604 FOwner.Invalidate;
605end;
606
607procedure TBody.SetStyle(const AValue: TBGRAButtBodyStyle);
608begin
609 if FStyle = AValue then
610 exit;
611 FStyle := AValue;
612
613 FOwner.Perform(CM_CHANGED, 0, 0);
614 FOwner.Invalidate;
615end;
616
617constructor TBody.Create(AOwner: TControl);
618begin
619 FOwner := AOwner;
620 FBorderColor := clBlack;
621 FBorderColorOpacity := 255;
622 FBorderStyle := bboSolid;
623 FColor := clBtnFace;
624 FColorOpacity := 255;
625 FFont := TFont.Create;
626 FGradient1 := TBCGradient.Create(FOwner);
627 FGradient2 := TBCGradient.Create(FOwner);
628 FGradient1EndPercent := 35;
629 FStyle := bbsGradient;
630 FLightOpacity := 64;
631 FLightWidth := 0;
632 FLightColor := clWhite;
633
634 FFont.Assign(FOwner.Font);
635 FFont.OnChange := @OnChangeFont;
636 inherited Create;
637end;
638
639destructor TBody.Destroy;
640begin
641 FGradient1.Free;
642 FGradient2.Free;
643 FFont.Free;
644 inherited Destroy;
645end;
646
647procedure TBody.Assign(Source: TPersistent);
648begin
649 if Source is TBody then
650 begin
651 FBorderColor := TBody(Source).FBorderColor;
652 FBorderStyle := TBody(Source).FBorderStyle;
653 FColor := TBody(Source).FColor;
654 FStyle := TBody(Source).FStyle;
655 FGradient1EndPercent := TBody(Source).FGradient1EndPercent;
656 FLightOpacity := TBody(Source).FLightOpacity;
657 FLightWidth := TBody(Source).FLightWidth;
658 FLightColor := TBody(Source).FLightColor;
659 FFont.Assign(TBody(Source).FFont);
660 FGradient1.Assign(TBody(Source).FGradient1);
661 FGradient2.Assign(TBody(Source).FGradient2);
662
663 FOwner.Invalidate;
664 FOwner.InvalidatePreferredSize;
665 FOwner.AdjustSize;
666 end
667 else
668 inherited Assign(Source);
669end;
670
671{ TCustomBGRAButton }
672
673procedure TCustomBGRAButton.CalculateBaseRect;
674begin
675 { As far as border width is bigger, BGRA drawing rectangle with offset (half border width) }
676 FBaseRect := ClientRect;
677 Inc(FBaseRect.Left, Round(FBorderWidth / 2));
678 Inc(FBaseRect.Top, Round(FBorderWidth / 2));
679 Dec(FBaseRect.Right, Round(FBorderWidth / 2) + 1);
680 Dec(FBaseRect.Bottom, Round(FBorderWidth / 2) + 1);
681end;
682
683procedure TCustomBGRAButton.CalculateTextSize(MaxWidth: integer;
684 var NeededWidth, NeededHeight: integer);
685var
686 s: TSize;
687 ax, ay: integer;
688begin
689 if (Caption = '') or (FBGRANormal = nil) then
690 begin
691 NeededWidth := 0;
692 NeededHeight := 0;
693 Exit;
694 end;
695
696 Canvas.Font := FBodyNormal.FFont;
697 FBGRANormal.FontStyle := FBodyNormal.FFont.Style;
698
699 if FTextCanvas then
700 begin
701 FBGRANormal.FontHeight := FBodyNormal.FFont.Height;
702 FBGRANormal.FontQuality := fqSystemClearType;
703 end
704 else
705 begin
706 FBGRANormal.FontHeight := Canvas.TextHeight(Caption);
707 FBGRANormal.FontQuality := fqFineAntialiasing;
708 end;
709
710 if FBodyNormal.FFont.Name = '' then
711 FBGRANormal.FontName := 'default'
712 else
713 FBGRANormal.FontName := FBodyNormal.FFont.Name;
714
715 s := FBGRANormal.TextSize(Caption);
716
717 { shadow offset }
718 if FTextShadow then
719 begin
720 if FTextShadowOffsetX < 0 then
721 ax := (FTextShadowOffsetX) - (FTextShadowOffsetX * 2)
722 else
723 ax := FTextShadowOffsetX;
724
725 if FTextShadowOffsetY < 0 then
726 ay := (FTextShadowOffsetY) - (FTextShadowOffsetY * 2)
727 else
728 ay := FTextShadowOffsetY;
729
730 Inc(s.cx, 2 * ax + 2 * FTextShadowRadius);
731 Inc(s.cy, 2 * ay + 2 * FTextShadowRadius);
732 end;
733
734 NeededWidth := s.cx;
735 NeededHeight := s.cy;
736
737 // old shadow offset
738 //NeededWidth := s.cx + Round(1.2 * FTextShadowRadius) + FTextShadowOffsetX;
739 //NeededHeight := s.cy + Round(1.2 * FTextShadowRadius) + FTextShadowOffsetY;
740end;
741
742procedure TCustomBGRAButton.CalculateGlyphSize(var NeededWidth, NeededHeight: integer);
743begin
744 if FGlyph = nil then
745 begin
746 NeededHeight := 0;
747 NeededWidth := 0;
748 Exit;
749 end;
750
751 NeededWidth := FGlyph.Width;
752 NeededHeight := FGlyph.Height;
753end;
754
755procedure TCustomBGRAButton.ConvertToGrayScale(ABGRA: TBGRABitmap);
756var
757 bounds: TRect;
758 px: PBGRAPixel;
759 xb, yb: integer;
760begin
761 bounds := ABGRA.GetImageBounds;
762 if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then
763 exit;
764
765 for yb := bounds.Top to bounds.bottom - 1 do
766 begin
767 px := ABGRA.scanline[yb] + bounds.left;
768 for xb := bounds.left to bounds.right - 1 do
769 begin
770 px^ := BGRAToGrayscale(px^);
771 Inc(px);
772 end;
773 end;
774 ABGRA.InvalidateBitmap;
775end;
776
777procedure TCustomBGRAButton.DrawText(ABGRA: TBGRABitmap; AFontColor: TColor;
778 AFontStyle: TFontStyles; AFontName: string);
779var
780 s: TSize;
781 x, y, gx, gy: integer;
782 gly, shd: TBGRABitmap;
783begin
784 ABGRA.FontAntialias := True;
785 shd := TBGRABitmap.Create(ClientWidth, ClientHeight, BGRAPixelTransparent);
786 shd.FontAntialias := True;
787 Canvas.Font := FBodyNormal.FFont;
788 ABGRA.FontStyle := AFontStyle;
789 ABGRA.FontName := AFontName;
790
791 if FTextCanvas then
792 begin
793 ABGRA.FontHeight := FBodyNormal.FFont.Height;
794 ABGRA.FontQuality := fqSystemClearType;
795 end
796 else
797 begin
798 ABGRA.FontHeight := Canvas.TextHeight(Caption);
799 ABGRA.FontQuality := fqFineAntialiasing;
800 end;
801
802 x := 0;
803 y := 0;
804 gx := 0;
805 gy := 0;
806
807 s := ABGRA.TextSize(Caption);
808
809 { X Position }
810 case FTextAlign of
811 btaLeft:
812 begin
813 if (FGlyph <> nil) and (not FGlyph.Empty) then
814 gx := 5;
815 if gx > 0 then
816 x := gx + FGlyph.Width + FGlyphMargin
817 else
818 x := 5;
819 end;
820 btaCenter:
821 begin
822 if (FGlyph <> nil) and (not FGlyph.Empty) then
823 begin
824 gx := Round((ClientWidth - ifthen(FStyle = bbtDropDown, ARR_SPACE)) / 2) -
825 Round((FGlyph.Width + s.cx + FGlyphMargin) / 2);
826 x := gx + FGlyph.Width + FGlyphMargin;
827 end
828 else
829 x := Round((ClientWidth - ifthen(FStyle = bbtDropDown, ARR_SPACE)) / 2) -
830 Round((s.cx) / 2);
831 end;
832 btaRight:
833 begin
834 if (FGlyph <> nil) and (not FGlyph.Empty) then
835 begin
836 gx := ClientWidth - 5 - ifthen(FStyle = bbtDropDown, ARR_SPACE) -
837 FGlyph.Width - FGlyphMargin - s.cx;
838 x := gx + FGlyph.Width + FGlyphMargin;
839 end
840 else
841 x := ClientWidth - 5 - ifthen(FStyle = bbtDropDown, ARR_SPACE) - s.cx;
842 end;
843 end;
844
845 { Y position }
846 case FTextVAlign of
847 btvaTop:
848 begin
849 if (FGlyph <> nil) and (not FGlyph.Empty) then
850 begin
851 if FGlyph.Height > s.cy then
852 begin
853 gy := 2 + FBorderWidth;
854 y := gy + Round(FGlyph.Height / 2);
855 end
856 else
857 begin
858 y := 2 + FBorderWidth;
859 gy := y + Round((s.cy / 2) - (FGlyph.Height / 2));
860 end;
861 end
862 else
863 y := 2 + FBorderWidth;
864 end;
865 btvaCenter:
866 begin
867 if (FGlyph <> nil) and (not FGlyph.Empty) then
868 gy := Round(ClientHeight / 2) - Round(FGlyph.Height / 2);
869 y := Round(ClientHeight / 2) - Round(s.cy / 2);
870 end;
871 btvaBottom:
872 begin
873 if (FGlyph <> nil) and (not FGlyph.Empty) then
874 begin
875 if FGlyph.Height > s.cy then
876 begin
877 gy := ClientHeight - FBorderWidth - FGlyph.Height - 2;
878 y := gy + Round(FGlyph.Height / 2);
879 end
880 else
881 begin
882 y := ClientHeight - FBorderWidth - 2 - s.cy;
883 gy := y + Round((s.cy / 2) - (FGlyph.Height / 2));
884 end;
885 end
886 else
887 y := ClientHeight - FBorderWidth - 2 - s.cy;
888 end;
889 end;
890
891 if (FMouseStage = msClicked) and (FActiveButt = bbtButton) and (not FStaticButton) then
892 begin
893 Inc(gx);
894 Inc(gy);
895 Inc(x);
896 Inc(y);
897 end;
898
899 if FTextShadow then
900 begin
901 shd.SetSize(s.cx + 2 * FTextShadowRadius, s.cy + 2 * FTextShadowRadius);
902 shd.Fill(BGRAPixelTransparent);
903 shd.FontAntialias := True;
904 shd.FontStyle := AFontStyle;
905 shd.FontName := AFontName;
906
907 if FTextCanvas then
908 begin
909 shd.FontHeight := FBodyNormal.FFont.Height;
910 shd.FontQuality := fqSystemClearType;
911 end
912 else
913 begin
914 shd.FontHeight := Canvas.TextHeight(Caption);
915 shd.FontQuality := fqFineAntialiasing;
916 end;
917
918 shd.TextOut(FTextShadowRadius, FTextShadowRadius,
919 Caption, ColorToBGRA(ColorToRGB(FTextShadowColor), FTextShadowColorOpacity));
920 BGRAReplace(shd, shd.FilterBlurRadial(FTextShadowRadius, rbFast));
921 ABGRA.PutImage(x + FTextShadowOffsetX - FTextShadowRadius, y +
922 FTextShadowOffsetY - FTextShadowRadius, shd,
923 dmDrawWithTransparency);
924 end;
925
926 if (FGlyph <> nil) and (not FGlyph.Empty) then
927 begin
928 gly := TBGRABitmap.Create(FGlyph);
929 if Caption <> '' then
930 ABGRA.PutImage(gx, gy, gly, dmDrawWithTransparency)
931 else
932 ABGRA.PutImage(Round((ClientWidth - gly.Width) div 2), gy, gly,
933 dmDrawWithTransparency);
934 gly.Free;
935 end;
936
937 ABGRA.Bitmap;
938 ABGRA.TextOut(x, y, Caption, ColorToBGRA(ColorToRGB(AFontColor)));
939
940 shd.Free;
941end;
942
943function TCustomBGRAButton.GetDropDownWidth(AFull: boolean): integer;
944begin
945 Result := ARR_SPACE + (ifthen(AFull, 2, 1) * FBorderWidth);
946end;
947
948procedure TCustomBGRAButton.Prepare;
949begin
950 FStates := FStates + [bstPrepareNormal, bstPrepareHover, bstPrepareClick,
951 bstPrepareNormalA, bstPrepareHoverA, bstPrepareClickA];
952end;
953
954procedure TCustomBGRAButton.PrepareBGRA(ABGRA: TBGRABitmap; ABody: TBody;
955 AState: TCustomBGRAButtonState);
956var
957 r: TRect;
958begin
959 if (csCreating in FControlState) or (FUpdateCount > 0) then
960 Exit;
961 { Calculating rect }
962 r := FBaseRect;
963
964 if FStyle = bbtDropDown then
965 Dec(r.Right, GetDropDownWidth(False));
966
967 { Refreshing size }
968 ABGRA.SetSize(Width - ifthen(FStyle = bbtDropDown, GetDropDownWidth(False)), Height);
969 { Clearing previous paint }
970 ABGRA.Fill(BGRAPixelTransparent);
971 { Basic body }
972 DrawBasicBody(ABGRA, ABody, r, BorderStyle.Options);
973
974 if FTextApplyGlobalOpacity then
975 begin
976 { Drawing text }
977 DrawText(ABGRA, ABody.FFont.Color, ABody.FFont.Style, ABody.FFont.Name);
978 { Set global opacity }
979 ABGRA.ApplyGlobalOpacity(FGlobalOpacity);
980 end
981 else
982 begin
983 { Set global opacity }
984 ABGRA.ApplyGlobalOpacity(FGlobalOpacity);
985 { Drawing text }
986 DrawText(ABGRA, ABody.FFont.Color, ABody.FFont.Style, ABody.FFont.Name);
987 end;
988
989 { Convert to gray if not enabled }
990 if not Enabled then
991 ConvertToGrayScale(ABGRA);
992
993 if Assigned(FOnAfterPrepareBGRAButton) then
994 FOnAfterPrepareBGRAButton(Self, ABGRA, r, AState);
995end;
996
997procedure TCustomBGRAButton.PrepareBGRADropDown(ABGRA: TBGRABitmap;
998 ABody: TBody; AState: TCustomBGRAButtonState);
999var
1000 r: TRect;
1001begin
1002 if (ABGRA = nil) or (FUpdateCount > 0) then
1003 Exit;
1004
1005 ABGRA.SetSize(GetDropDownWidth, ClientHeight);
1006 ABGRA.Fill(BGRAPixelTransparent);
1007 r := ABGRA.ClipRect;
1008 Inc(r.Left, Round(FBorderWidth / 2));
1009 Inc(r.Top, Round(FBorderWidth / 2));
1010 Dec(r.Right, Round(FBorderWidth / 2) + 1);
1011 Dec(r.Bottom, Round(FBorderWidth / 2) + 1);
1012 DrawBasicBody(ABGRA, ABody, r, BorderStyleDropDown.Options);
1013 { Drawing arrow }
1014 DrawArrow(ABGRA, ABody, r);
1015
1016 { Convert to gray if not enabled }
1017 if not Enabled then
1018 ConvertToGrayScale(ABGRA);
1019
1020 if Assigned(FOnAfterPrepareBGRAButton) then
1021 FOnAfterPrepareBGRAButton(Self, ABGRA, ABGRA.ClipRect, AState);
1022end;
1023
1024procedure TCustomBGRAButton.DrawArrow(ABGRA: TBGRABitmap; ABody: TBody; ARect: TRect);
1025var
1026 p: ArrayOfTPointF;
1027 o: byte = 0;
1028 alpha: byte;
1029 n: byte;
1030 temp: TBGRABitmap;
1031begin
1032 { Clicked offset}
1033 if (FMouseStage = msClicked) and (FActiveButt = bbtDropDown) and
1034 (not FStaticButton) then
1035 o := 1;
1036
1037 { Poly }
1038 SetLength(p, 3);
1039
1040 p[0].x := ARect.Right - Round(ARR_SPACE / 2) + o;
1041 p[0].y := ARect.Bottom - Round((ARect.Bottom - ARect.Top) / 2) +
1042 Round(ARR_SIZE / 4) + o;
1043
1044 p[1].x := ARect.Right - Round(ARR_SPACE / 2) + Round(ARR_SIZE / 2) + o;
1045 p[1].y := ARect.Bottom - Round((ARect.Bottom - ARect.Top) / 2) -
1046 Round(ARR_SIZE / 4) + o;
1047
1048 p[2].x := ARect.Right - Round(ARR_SPACE / 2) - Round(ARR_SIZE / 2) + o;
1049 p[2].y := p[1].y;
1050
1051 if TextApplyGlobalOpacity then
1052 alpha := GlobalOpacity
1053 else
1054 alpha := 255;
1055
1056 temp := TBGRABitmap.Create(ABGRA.Width, ABGRA.Height);
1057
1058 // Fill n times to get best quality
1059 for n := 1 to 6 do
1060 temp.FillPolyAntialias(p, ColorToBGRA(ColorToRGB(FBodyNormal.Font.Color),
1061 alpha));
1062
1063 if FlipArrow then
1064 temp.VerticalFlip;
1065
1066 ABGRA.PutImage(0, 0, temp, dmDrawWithTransparency);
1067 temp.Free;
1068end;
1069
1070procedure TCustomBGRAButton.DrawBasicBody(ABGRA: TBGRABitmap; ABody: TBody;
1071 ARect: TRect; boroptions: TRoundRectangleOptions);
1072var
1073 borcolor, backcolor: TBGRAPixel;
1074 gra: TBGRAGradientScanner;
1075 back: TBGRABitmap;
1076 grect1, grect2: TRect;
1077 multi: TBGRAMultishapeFiller;
1078 fiLight: TFillBorderRoundRectInfo;
1079begin
1080 { Calculating border width and color }
1081 case ABody.FBorderStyle of
1082 bboNone: borcolor := BGRAPixelTransparent;
1083 bboSolid: borcolor := ColorToBGRA(ColorToRGB(ABody.FBorderColor),
1084 ABody.FBorderColorOpacity);
1085 end;
1086
1087 { Background color }
1088 case ABody.FStyle of
1089 bbsClear: backcolor := BGRAPixelTransparent;
1090 bbsColor: backcolor := ColorToBGRA(ColorToRGB(ABody.FColor), ABody.FColorOpacity);
1091 end;
1092
1093 case ABody.FStyle of
1094 bbsClear, bbsColor:
1095 { Solid background color }
1096 ABGRA.RoundRectAntialias(ARect.Left, ARect.Top, ARect.Right,
1097 ARect.Bottom, FRoundX, FRoundY,
1098 borcolor, FBorderWidth, backcolor, boroptions);
1099 bbsGradient:
1100 begin
1101 { Using multishape filler to merge background gradient and border }
1102 multi := TBGRAMultishapeFiller.Create;
1103 multi.PolygonOrder := poFirstOnTop; { Border will replace background }
1104
1105 if borcolor.alpha <> 0 then
1106 { Let the background be wider with transparent border }
1107 multi.AddRoundRectangleBorder(ARect.Left, ARect.Top, ARect.Right,
1108 ARect.Bottom, FRoundX, FRoundY,
1109 FBorderWidth, borcolor, boroptions);
1110
1111 { Gradients }
1112 back := TBGRABitmap.Create(ClientWidth, ClientHeight, BGRAPixelTransparent);
1113 grect1 := ARect;
1114 grect2 := ARect;
1115 { Gradient 1 }
1116 if ABody.FGradient1EndPercent > 0 then
1117 begin
1118 grect1.Bottom := Round((grect1.Bottom / 100) * ABody.FGradient1EndPercent);
1119 gra := CreateGradient(ABody.FGradient1, grect1);
1120 back.FillRect(grect1.Left, grect1.Top, grect1.Right, grect1.Bottom,
1121 gra, dmSet
1122 );
1123 gra.Free;
1124 end;
1125 { Gradient 2 }
1126 if ABody.FGradient1EndPercent < 100 then
1127 begin
1128 if grect1.Bottom < ARect.Bottom then
1129 grect2.Top := grect1.Bottom - 1;
1130 gra := CreateGradient(ABody.FGradient2, grect2);
1131 back.FillRect(grect2.Left, grect2.Top, grect2.Right, grect2.Bottom,
1132 gra, dmSet
1133 );
1134 gra.Free;
1135 end;
1136
1137 multi.AddRoundRectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom,
1138 FRoundX, FRoundY, back, boroptions);
1139
1140 multi.Draw(ABGRA);
1141 multi.Free;
1142 back.Free;
1143
1144 if ABody.LightWidth > 0 then
1145 begin
1146 //compute light position
1147 fiLight := TFillBorderRoundRectInfo.Create(
1148 ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, FRoundX,
1149 FRoundY, FBorderWidth + ABody.LightWidth, boroptions);
1150 //check if there is an inner position
1151 if fiLight.InnerBorder <> nil then
1152 with fiLight.InnerBorder do //fill with light
1153 ABGRA.RoundRectAntialias(topleft.x, topleft.y, bottomright.x,
1154 bottomright.y, radiusx, radiusY,
1155 ColorToBGRA(ColorToRGB(ABody.LightColor), ABody.LightOpacity),
1156 ABody.LightWidth, boroptions);
1157 fiLight.Free;
1158 end;
1159 end;
1160 end;
1161end;
1162
1163procedure TCustomBGRAButton.OnChangeGlyph(Sender: TObject);
1164begin
1165 Invalidate;
1166 UpdateSize;
1167end;
1168
1169procedure TCustomBGRAButton.SetBodyClicked(const AValue: TBody);
1170begin
1171 if FBodyClicked = AValue then
1172 exit;
1173 FBodyClicked.Assign(AValue);
1174
1175 Changed;
1176 Invalidate;
1177end;
1178
1179procedure TCustomBGRAButton.SetBodyHover(const AValue: TBody);
1180begin
1181 if FBodyHover = AValue then
1182 exit;
1183 FBodyHover.Assign(AValue);
1184
1185 Changed;
1186 Invalidate;
1187end;
1188
1189procedure TCustomBGRAButton.SetBodyNormal(const AValue: TBody);
1190begin
1191 if FBodyNormal = AValue then
1192 exit;
1193 FBodyNormal.Assign(AValue);
1194
1195 Changed;
1196 Invalidate;
1197end;
1198
1199procedure TCustomBGRAButton.SetBorderWidth(const AValue: integer);
1200begin
1201 if FBorderWidth = AValue then
1202 exit;
1203 FBorderWidth := AValue;
1204
1205 Changed;
1206 Invalidate;
1207 UpdateSize;
1208end;
1209
1210procedure TCustomBGRAButton.SetDown(AValue: boolean);
1211begin
1212 if FDown = AValue then
1213 exit;
1214 FDown := AValue;
1215
1216 Update;
1217end;
1218
1219procedure TCustomBGRAButton.SetFBorderStyle(AValue: TBGRABorderStyleOptions);
1220begin
1221 if FBorderStyle = AValue then
1222 Exit;
1223 FBorderStyle := AValue;
1224
1225 Changed;
1226 Invalidate;
1227end;
1228
1229procedure TCustomBGRAButton.SetFBorderStyleDropDown(AValue: TBGRABorderStyleOptions);
1230begin
1231 if FBorderStyleDropDown = AValue then
1232 Exit;
1233 FBorderStyleDropDown := AValue;
1234
1235 Changed;
1236 Invalidate;
1237end;
1238
1239procedure TCustomBGRAButton.SetFFlipArrow(AValue: boolean);
1240begin
1241 if FFlipArrow = AValue then
1242 Exit;
1243 FFlipArrow := AValue;
1244
1245 Changed;
1246 Invalidate;
1247end;
1248
1249procedure TCustomBGRAButton.SetFTextCanvas(AValue: boolean);
1250begin
1251 if FTextCanvas = AValue then
1252 exit;
1253 FTextCanvas := AValue;
1254
1255 Changed;
1256 Invalidate;
1257 UpdateSize;
1258end;
1259
1260procedure TCustomBGRAButton.SetGlyph(const AValue: TBitmap);
1261begin
1262 if (FGlyph <> nil) and (FGlyph = AValue) then
1263 exit;
1264
1265 FGlyph.Assign(AValue);
1266
1267 Changed;
1268 Invalidate;
1269 UpdateSize;
1270end;
1271
1272procedure TCustomBGRAButton.SetGlyphMargin(const AValue: integer);
1273begin
1274 if FGlyphMargin = AValue then
1275 exit;
1276 FGlyphMargin := AValue;
1277
1278 Changed;
1279 Invalidate;
1280 UpdateSize;
1281end;
1282
1283procedure TCustomBGRAButton.SetRoundX(const AValue: integer);
1284begin
1285 if FRoundX = AValue then
1286 exit;
1287 FRoundX := AValue;
1288
1289 Changed;
1290 Invalidate;
1291end;
1292
1293procedure TCustomBGRAButton.SetRoundY(const AValue: integer);
1294begin
1295 if FRoundY = AValue then
1296 exit;
1297 FRoundY := AValue;
1298
1299 Changed;
1300 Invalidate;
1301end;
1302
1303procedure TCustomBGRAButton.SetStaticButton(const AValue: boolean);
1304begin
1305 if FStaticButton = AValue then
1306 exit;
1307 FStaticButton := AValue;
1308
1309 Changed;
1310 Invalidate;
1311end;
1312
1313procedure TCustomBGRAButton.SeTBGRATextAlign(const AValue: TBGRATextAlign);
1314begin
1315 if FTextAlign = AValue then
1316 exit;
1317 FTextAlign := AValue;
1318
1319 Changed;
1320 Invalidate;
1321end;
1322
1323procedure TCustomBGRAButton.SetTextShadow(const AValue: boolean);
1324begin
1325 if FTextShadow = AValue then
1326 exit;
1327 FTextShadow := AValue;
1328
1329 Changed;
1330 Invalidate;
1331 UpdateSize;
1332end;
1333
1334procedure TCustomBGRAButton.SetTextShadowColor(const AValue: TColor);
1335begin
1336 if FTextShadowColor = AValue then
1337 exit;
1338 FTextShadowColor := AValue;
1339
1340 Changed;
1341 Invalidate;
1342 UpdateSize;
1343end;
1344
1345procedure TCustomBGRAButton.SetTextShadowColorOpacity(const AValue: byte);
1346begin
1347 if FTextShadowColorOpacity = AValue then
1348 exit;
1349 FTextShadowColorOpacity := AValue;
1350
1351 Changed;
1352 Invalidate;
1353 UpdateSize;
1354end;
1355
1356procedure TCustomBGRAButton.SetTextShadowOffsetX(const AValue: integer);
1357begin
1358 if FTextShadowOffsetX = AValue then
1359 exit;
1360 FTextShadowOffsetX := AValue;
1361
1362 Changed;
1363 Invalidate;
1364 UpdateSize;
1365end;
1366
1367procedure TCustomBGRAButton.SetTextShadowOffsetY(const AValue: integer);
1368begin
1369 if FTextShadowOffsetY = AValue then
1370 exit;
1371 FTextShadowOffsetY := AValue;
1372
1373 Changed;
1374 Invalidate;
1375 UpdateSize;
1376end;
1377
1378procedure TCustomBGRAButton.SetTextShadowRadius(const AValue: integer);
1379begin
1380 if FTextShadowRadius = AValue then
1381 exit;
1382 FTextShadowRadius := AValue;
1383
1384 Changed;
1385 Invalidate;
1386 UpdateSize;
1387end;
1388
1389procedure TCustomBGRAButton.SetStyle(const AValue: TBGRAButtStyle);
1390begin
1391 if FStyle = AValue then
1392 exit;
1393 FStyle := AValue;
1394
1395 if (AValue = bbtDropDown) then
1396 begin
1397 if (FBGRANormalA = nil) then
1398 begin
1399 FBGRANormalA := TBGRABitmap.Create(ARR_SPACE, ClientHeight, BGRAPixelTransparent);
1400 FBGRAHoverA := TBGRABitmap.Create(ARR_SPACE, ClientHeight, BGRAPixelTransparent);
1401 FBGRAClickA := TBGRABitmap.Create(ARR_SPACE, ClientHeight, BGRAPixelTransparent);
1402 end;
1403 end
1404 else
1405 begin
1406 FreeThenNil(FBGRANormalA);
1407 FreeThenNil(FBGRAHoverA);
1408 FreeThenNil(FBGRAClickA);
1409 end;
1410
1411 Changed;
1412 Invalidate;
1413 UpdateSize;
1414end;
1415
1416procedure TCustomBGRAButton.SeTBGRATextVAlign(const AValue: TBGRATextVAlign);
1417begin
1418 if FTextVAlign = AValue then
1419 exit;
1420 FTextVAlign := AValue;
1421
1422 Changed;
1423 Invalidate;
1424end;
1425
1426procedure TCustomBGRAButton.UpdateSize;
1427begin
1428 CalculateBaseRect;
1429 FStates := FStates + [bstPrepareNormal, bstPrepareHover, bstPrepareClick,
1430 bstPrepareNormalA, bstPrepareHoverA, bstPrepareClickA];
1431
1432 InvalidatePreferredSize;
1433 AdjustSize;
1434end;
1435
1436procedure TCustomBGRAButton.CMChanged(var Message: TLMessage);
1437begin
1438 if FUpdateCount > 0 then
1439 Exit;
1440 Prepare;
1441end;
1442
1443procedure TCustomBGRAButton.BoundsChanged;
1444begin
1445 CalculateBaseRect;
1446 Prepare;
1447 inherited BoundsChanged;
1448end;
1449
1450procedure TCustomBGRAButton.CalculatePreferredSize(
1451 var PreferredWidth, PreferredHeight: integer; WithThemeSpace: boolean);
1452var
1453 AWidth: integer;
1454 gh: integer = 0;
1455 gw: integer = 0;
1456begin
1457 if (Parent = nil) or (not Parent.HandleAllocated) then
1458 Exit;
1459 if WidthIsAnchored then
1460 AWidth := Width
1461 else
1462 AWidth := 10000;
1463
1464 CalculateTextSize(AWidth, PreferredWidth, PreferredHeight);
1465
1466 // Extra pixels for DropDown
1467 if Style = bbtDropDown then
1468 Inc(PreferredWidth, GetDropDownWidth);
1469
1470 CalculateGlyphSize(gw, gh);
1471
1472 if (FGlyph <> nil) and (not FGlyph.Empty) then
1473 begin
1474 if Caption = '' then
1475 begin
1476 Inc(PreferredWidth, gw{ - AutoSizeExtraY * 2});
1477 Inc(PreferredHeight, gh);
1478 end
1479 else
1480 begin
1481 Inc(PreferredWidth, gw + FGlyphMargin);
1482 if gh > PreferredHeight then
1483 PreferredHeight := gh;
1484 end;
1485 end;
1486
1487 // Extra pixels for AutoSize
1488 Inc(PreferredWidth, AutoSizeExtraX);
1489 Inc(PreferredHeight, AutoSizeExtraY);
1490end;
1491
1492class function TCustomBGRAButton.GetControlClassDefaultSize: TSize;
1493begin
1494 Result.CX := 123;
1495 Result.CY := 33;
1496end;
1497
1498procedure TCustomBGRAButton.Click;
1499begin
1500 if (FActiveButt = bbtDropDown) and Assigned(FOnButtonClick) then
1501 begin
1502 FOnButtonClick(Self);
1503 Exit;
1504 end;
1505 inherited Click;
1506end;
1507
1508procedure TCustomBGRAButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
1509 X, Y: integer);
1510begin
1511 inherited MouseDown(Button, Shift, X, Y);
1512 if csDesigning in ComponentState then
1513 exit;
1514
1515 if (Button = mbLeft) and Enabled and (not (FMouseStage = msClicked)) then
1516 begin
1517 FMouseStage := msClicked;
1518 Invalidate;
1519 end;
1520end;
1521
1522procedure TCustomBGRAButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
1523 X, Y: integer);
1524var
1525 p: TPoint;
1526begin
1527 inherited MouseUp(Button, Shift, X, Y);
1528 if csDesigning in ComponentState then
1529 exit;
1530
1531 if (Button = mbLeft) and Enabled and (FMouseStage = msClicked) then
1532 begin
1533 FMouseStage := msHover;
1534 Invalidate;
1535 end;
1536
1537 if (FActiveButt = bbtDropDown) and (PopupMenu <> nil) and Enabled then
1538 begin
1539 if FlipArrow then
1540 p := ClientToScreen(Point(Width - ARR_SPACE - (BorderWidth * 2),
1541 {PopupMenu.Height} -1))
1542 else
1543 p := ClientToScreen(Point(Width - ARR_SPACE - (BorderWidth * 2), Height + 1));
1544
1545 PopupMenu.PopUp(p.x, p.y);
1546 //p := ClientToScreen(Point(X, Y));
1547 //PopupMenu.PopUp(p.x, p.y);
1548 end;
1549end;
1550
1551procedure TCustomBGRAButton.MouseEnter;
1552begin
1553 if csDesigning in ComponentState then
1554 exit;
1555 FMouseStage := msHover;
1556 Invalidate;
1557 inherited MouseEnter;
1558end;
1559
1560procedure TCustomBGRAButton.MouseLeave;
1561begin
1562 if csDesigning in ComponentState then
1563 exit;
1564 FMouseStage := msNone;
1565 Invalidate;
1566 inherited MouseLeave;
1567end;
1568
1569procedure TCustomBGRAButton.MouseMove(Shift: TShiftState; X, Y: integer);
1570begin
1571 inherited MouseMove(Shift, X, Y);
1572
1573 if (FStyle = bbtDropDown) and (x >= ClientRect.Right - ARR_SPACE) then
1574 FActiveButt := bbtDropDown
1575 else
1576 FActiveButt := bbtButton;
1577
1578 Invalidate;
1579end;
1580
1581procedure TCustomBGRAButton.Paint;
1582var
1583 s1, s2: TBCMouseState;
1584begin
1585 //inherited Paint;
1586 if (csCreating in FControlState) or (FUpdateCount > 0) then
1587 Exit;
1588 { TODO -oDibo : In future, separate FMouseStage to FButtonStage and FDropDownStage }
1589 if FStaticButton then
1590 begin
1591 s1 := msNone;
1592 s2 := msNone;
1593 end
1594 else
1595 if (FActiveButt = bbtButton) and FDown then
1596 s1 := msClicked
1597 else
1598 case FActiveButt of
1599 bbtButton:
1600 begin
1601 s1 := FMouseStage;
1602 s2 := msNone;
1603 end;
1604 bbtDropDown:
1605 begin
1606 s1 := msNone;
1607 s2 := FMouseStage;
1608 end;
1609 end;
1610
1611 { Main button }
1612 case s1 of
1613 msNone:
1614 begin
1615 if bstPrepareNormal in FStates then
1616 begin
1617 PrepareBGRA(FBGRANormal, FBodyNormal, bstPrepareNormal);
1618 Exclude(FStates, bstPrepareNormal);
1619 end;
1620 FBGRANormal.Draw(Self.Canvas, 0, 0, False);
1621 end;
1622 msHover:
1623 begin
1624 if bstPrepareHover in FStates then
1625 begin
1626 PrepareBGRA(FBGRAHover, FBodyHover, bstPrepareHover);
1627 Exclude(FStates, bstPrepareHover);
1628 end;
1629 FBGRAHover.Draw(Self.Canvas, 0, 0, False);
1630 end;
1631 msClicked:
1632 begin
1633 if bstPrepareClick in FStates then
1634 begin
1635 PrepareBGRA(FBGRAClick, FBodyClicked, bstPrepareClick);
1636 Exclude(FStates, bstPrepareClick);
1637 end;
1638 FBGRAClick.Draw(Self.Canvas, 0, 0, False);
1639 end;
1640 end;
1641
1642 { Drop down button }
1643 if FStyle = bbtDropDown then
1644 case s2 of
1645 msNone:
1646 begin
1647 if bstPrepareNormalA in FStates then
1648 begin
1649 PrepareBGRADropDown(FBGRANormalA, FBodyNormal, bstPrepareNormalA);
1650 Exclude(FStates, bstPrepareNormalA);
1651 end;
1652 FBGRANormalA.Draw(Self.Canvas, FBGRANormal.Width - FBorderWidth, 0, False);
1653 end;
1654 msHover:
1655 begin
1656 if bstPrepareHoverA in FStates then
1657 begin
1658 PrepareBGRADropDown(FBGRAHoverA, FBodyHover, bstPrepareHoverA);
1659 Exclude(FStates, bstPrepareHoverA);
1660 end;
1661 FBGRAHoverA.Draw(Self.Canvas, FBGRANormal.Width - FBorderWidth, 0, False);
1662 end;
1663 msClicked:
1664 begin
1665 if bstPrepareClickA in FStates then
1666 begin
1667 PrepareBGRADropDown(FBGRAClickA, FBodyClicked, bstPrepareClickA);
1668 Exclude(FStates, bstPrepareClickA);
1669 end;
1670 FBGRAClickA.Draw(Self.Canvas, FBGRANormal.Width - FBorderWidth, 0, False);
1671 end;
1672 end;
1673 {$IFDEF DEBUG}
1674 //Debug: display in button Invalidate Count.
1675 Inc(FInvalidateCount);
1676 Canvas.TextOut(0, 0, IntToStr(FInvalidateCount));
1677 {$ENDIF}
1678end;
1679
1680procedure TCustomBGRAButton.SetEnabled(Value: boolean);
1681begin
1682 inherited SetEnabled(Value);
1683
1684 Changed;
1685 Invalidate;
1686end;
1687
1688procedure TCustomBGRAButton.TextChanged;
1689begin
1690 inherited TextChanged;
1691 Invalidate;
1692 UpdateSize;
1693end;
1694
1695procedure TCustomBGRAButton.SetGlobalOpacity(const AValue: byte);
1696begin
1697 if FGlobalOpacity = AValue then
1698 exit;
1699 FGlobalOpacity := AValue;
1700
1701 Changed;
1702 Invalidate;
1703end;
1704
1705procedure TCustomBGRAButton.SetTextApplyGlobalOpacity(const AValue: boolean);
1706begin
1707 if FTextApplyGlobalOpacity = AValue then
1708 exit;
1709 FTextApplyGlobalOpacity := AValue;
1710
1711 Changed;
1712 Invalidate;
1713end;
1714
1715{procedure TCustomBGRAButton.WMLButtonDown(var Message: TLMLButtonDown);
1716begin
1717
1718end; }
1719
1720constructor TCustomBGRAButton.Create(AOwner: TComponent);
1721begin
1722 inherited Create(AOwner);
1723 DisableAutoSizing;
1724 Include(FControlState, csCreating);
1725 //{$IFDEF WINDOWS}
1726 // default sizes under different dpi settings
1727 //SetSizeVariables(ScaleX(8,96), ScaleX(16,96), ScaleY(8,96), ScaleX(24,96));
1728 //{$ELSE}
1729 // default sizes
1730 SetSizeVariables(8, 16, 8, 24);
1731 //{$ENDIF}
1732 BeginUpdate;
1733 try
1734 with GetControlClassDefaultSize do
1735 SetInitialBounds(0, 0, CX, CY);
1736 ControlStyle := ControlStyle + [csAcceptsControls];
1737 FBGRANormal := TBGRABitmap.Create(Width, Height, BGRAPixelTransparent);
1738 FBGRANormal.FontAntialias := True;
1739 FBGRAHover := TBGRABitmap.Create(Width, Height, BGRAPixelTransparent);
1740 FBGRAHover.FontAntialias := True;
1741 FBGRAClick := TBGRABitmap.Create(Width, Height, BGRAPixelTransparent);
1742 FBGRAClick.FontAntialias := True;
1743 FBorderStyle := TBGRABorderStyleOptions.Create(Self);
1744 FBorderStyleDropDown := TBGRABorderStyleOptions.Create(Self);
1745 ParentColor := False;
1746 Color := clNone;
1747 FBodyNormal := TBody.Create(Self);
1748 FBodyHover := TBody.Create(Self);
1749 FBodyClicked := TBody.Create(Self);
1750 FMouseStage := msNone;
1751 FTextAlign := btaCenter;
1752 FTextCanvas := False;
1753 FTextVAlign := btvaCenter;
1754 FTextShadow := True;
1755 FTextShadowRadius := 5;
1756 FTextShadowColor := clBlack;
1757 FTextShadowColorOpacity := 255;
1758 FTextShadowOffsetX := 5;
1759 FTextShadowOffsetY := 5;
1760 FBorderWidth := 1;
1761 FRoundX := 1;
1762 FRoundY := 1;
1763 FFlipArrow := False;
1764 FGlyph := TBitmap.Create;
1765 FGlyph.OnChange := @OnChangeGlyph;
1766 FGlyphMargin := 5;
1767 FStyle := bbtButton;
1768 FStaticButton := False;
1769 FActiveButt := bbtButton;
1770 FGlobalOpacity := 255;
1771 FTextApplyGlobalOpacity := False;
1772 FStates := [];
1773 FUpdateCount := 0;
1774 FDown := False;
1775
1776 { Some default theme }
1777 FBodyNormal.FGradient2.StartColor := $00C87511;
1778 FBodyNormal.FGradient2.EndColor := $00EFE6D2;
1779 FBodyHover.FGradient2.StartColor := $00C87511;
1780 FBodyHover.FGradient2.EndColor := $00EFE6D2;
1781 FBodyClicked.FGradient2.StartColor := $00C87511;
1782 FBodyClicked.FGradient2.EndColor := $00EFE6D2;
1783 FBodyHover.FBorderColor := $00D7B697;
1784 finally
1785 Exclude(FControlState, csCreating);
1786 EnableAutoSizing;
1787 EndUpdate;
1788 end;
1789end;
1790
1791destructor TCustomBGRAButton.Destroy;
1792begin
1793 FBodyNormal.Free;
1794 FBodyHover.Free;
1795 FBodyClicked.Free;
1796 FBGRANormal.Free;
1797 FBGRAHover.Free;
1798 FBGRAClick.Free;
1799 FBorderStyle.Free;
1800 FBorderStyleDropDown.Free;
1801 FreeThenNil(FGlyph);
1802 FreeThenNil(FBGRANormalA);
1803 FreeThenNil(FBGRAHoverA);
1804 FreeThenNil(FBGRAClickA);
1805 inherited Destroy;
1806end;
1807
1808procedure TCustomBGRAButton.Assign(Source: TPersistent);
1809begin
1810 if Source is TCustomBGRAButton then
1811 begin
1812 FBorderWidth := TCustomBGRAButton(Source).FBorderWidth;
1813 Glyph := TCustomBGRAButton(Source).Glyph;
1814 FGlyphMargin := TCustomBGRAButton(Source).FGlyphMargin;
1815 FRoundX := TCustomBGRAButton(Source).FRoundX;
1816 FRoundY := TCustomBGRAButton(Source).FRoundY;
1817 FTextAlign := TCustomBGRAButton(Source).FTextAlign;
1818 FTextCanvas := TCustomBGRAButton(Source).FTextCanvas;
1819 FTextVAlign := TCustomBGRAButton(Source).FTextVAlign;
1820 FTextShadow := TCustomBGRAButton(Source).FTextShadow;
1821 FTextShadowColor := TCustomBGRAButton(Source).FTextShadowColor;
1822 FTextShadowColorOpacity := TCustomBGRAButton(Source).FTextShadowColorOpacity;
1823 FTextShadowOffsetX := TCustomBGRAButton(Source).FTextShadowOffsetX;
1824 FTextShadowOffsetY := TCustomBGRAButton(Source).FTextShadowOffsetY;
1825 FTextShadowRadius := TCustomBGRAButton(Source).FTextShadowRadius;
1826 FStyle := TCustomBGRAButton(Source).FStyle;
1827 FFlipArrow := TCustomBGRAButton(Source).FFlipArrow;
1828 FStaticButton := TCustomBGRAButton(Source).FStaticButton;
1829 FGlobalOpacity := TCustomBGRAButton(Source).FGlobalOpacity;
1830 FTextApplyGlobalOpacity := TCustomBGRAButton(Source).FTextApplyGlobalOpacity;
1831 FBorderStyle.Assign(TCustomBGRAButton(Source).FBorderStyle);
1832 FBorderStyleDropDown.Assign(TCustomBGRAButton(Source).FBorderStyle);
1833 FBodyNormal.Assign(TCustomBGRAButton(Source).FBodyNormal);
1834 FBodyHover.Assign(TCustomBGRAButton(Source).FBodyHover);
1835 FBodyClicked.Assign(TCustomBGRAButton(Source).FBodyClicked);
1836
1837 Invalidate;
1838 UpdateSize;
1839 end
1840 else
1841 inherited Assign(Source);
1842end;
1843
1844procedure TCustomBGRAButton.BeginUpdate;
1845begin
1846 Inc(FUpdateCount);
1847end;
1848
1849procedure TCustomBGRAButton.EndUpdate;
1850begin
1851 if FUpdateCount > 0 then
1852 Dec(FUpdateCount);
1853 if FUpdateCount = 0 then
1854 Prepare;
1855end;
1856
1857procedure TCustomBGRAButton.SetSizeVariables(newArrowSize, newArrowSpace,
1858 newAutoSizeExtraVertical, newAutoSizeExtraHorizontal: integer);
1859begin
1860 ARR_SIZE := newArrowSize;
1861 ARR_SPACE := newArrowSpace;
1862 AutoSizeExtraY := newAutoSizeExtraVertical;
1863 AutoSizeExtraX := newAutoSizeExtraHorizontal;
1864
1865 if csCreating in ControlState then
1866 Exit;
1867
1868 Invalidate;
1869 UpdateSize;
1870end;
1871
1872end.
Note: See TracBrowser for help on using the repository browser.