source: trunk/Packages/bgracontrols/bcbutton.pas

Last change on this file was 2, checked in by chronos, 6 years ago
File size: 32.8 KB
Line 
1{ Customizable component which using BGRABitmap for drawing. Control mostly rendered
2 using framework.
3
4 Functionality:
5 - Gradients
6 - Double gradients
7 - Rounding
8 - Drop down list
9 - Glyph
10 - States (normal, hover, clicked)
11 - Caption with shadow
12 - Full alpha and antialias support
13
14 Copyright (C) 2012 Krzysztof Dibowski dibowski at interia.pl
15
16 This library is free software; you can redistribute it and/or modify it
17 under the terms of the GNU Library General Public License as published by
18 the Free Software Foundation; either version 2 of the License, or (at your
19 option) any later version with the following modification:
20
21 As a special exception, the copyright holders of this library give you
22 permission to link this library with independent modules to produce an
23 executable, regardless of the license terms of these independent modules,and
24 to copy and distribute the resulting executable under terms of your choice,
25 provided that you also meet, for each linked independent module, the terms
26 and conditions of the license of that module. An independent module is a
27 module which is not derived from or based on this library. If you modify
28 this library, you may extend this exception to your version of the library,
29 but you are not obligated to do so. If you do not wish to do so, delete this
30 exception statement from your version.
31
32 This program is distributed in the hope that it will be useful, but WITHOUT
33 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
34 FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
35 for more details.
36
37 You should have received a copy of the GNU Library General Public License
38 along with this library; if not, write to the Free Software Foundation,
39 Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
40}
41
42unit BCButton;
43
44{$mode objfpc}{$H+}
45
46interface
47
48uses
49 Classes, LResources, Controls, Dialogs, BGRABitmap, BGRABitmapTypes,
50 Buttons, Graphics, LCLType, types, BCTypes, Forms, BCBasectrls;
51
52{off $DEFINE DEBUG}
53
54type
55
56 TBCButtonState = class;
57 TBCButtonStyle = (bbtButton, bbtDropDown);
58 TOnAfterRenderBCButton = procedure(Sender: TObject; const ABGRA: TBGRABitmap;
59 AState: TBCButtonState; ARect: TRect) of object;
60 TBCButtonPropertyData = (pdNone, pdUpdateSize);
61
62 { TBCButtonState }
63
64 TBCButtonState = class(TBCProperty)
65 private
66 FBackground: TBCBackground;
67 FBorder: TBCBorder;
68 FFontEx: TBCFont;
69 procedure OnChangeFont(Sender: TObject; AData: PtrInt);
70 procedure OnChangeChildProperty(Sender: TObject; AData: PtrInt);
71 procedure SetBackground(AValue: TBCBackground);
72 procedure SetBorder(AValue: TBCBorder);
73 procedure SetFontEx(const AValue: TBCFont);
74 public
75 constructor Create(AControl: TControl); override;
76 destructor Destroy; override;
77
78 procedure Assign(Source: TPersistent); override;
79 published
80 property Background: TBCBackground read FBackground write SetBackground;
81 property Border: TBCBorder read FBorder write SetBorder;
82 property FontEx: TBCFont read FFontEx write SetFontEx;
83 end;
84
85 { TCustomBCButton }
86
87 TCustomBCButton = class(TBCStyleGraphicControl)
88 private
89 { Private declarations }
90 {$IFDEF DEBUG}
91 FRenderCount: Integer;
92 {$ENDIF}
93 FDropDownArrowSize: Integer;
94 FDropDownWidth: Integer;
95 FFlipArrow: boolean;
96 FActiveButt: TBCButtonStyle;
97 FBGRANormal, FBGRAHover, FBGRAClick: TBGRABitmapEx;
98 FRounding: TBCRounding;
99 FRoundingDropDown: TBCRounding;
100 FStateClicked: TBCButtonState;
101 FStateHover: TBCButtonState;
102 FStateNormal: TBCButtonState;
103 FDown: boolean;
104 FGlyph: TBitmap;
105 FGlyphMargin: integer;
106 FButtonState: TBCMouseState;
107 FDownButtonState: TBCMouseState;
108 FOnAfterRenderBCButton: TOnAfterRenderBCButton;
109 FOnButtonClick: TNotifyEvent;
110 FStaticButton: boolean;
111 FStyle: TBCButtonStyle;
112 FGlobalOpacity: byte;
113 FTextApplyGlobalOpacity: boolean;
114 AutoSizeExtraY: integer;
115 AutoSizeExtraX: integer;
116 procedure AssignDefaultStyle;
117 procedure CalculateGlyphSize(var NeededWidth, NeededHeight: integer);
118 procedure ConvertToGrayScale(ABGRA: TBGRABitmap);
119 procedure Render(ABGRA: TBGRABitmapEx; AState: TBCButtonState);
120 procedure RenderState(ABGRA: TBGRABitmapEx; AState: TBCButtonState;
121 const ARect: TRect; ARounding: TBCRounding);
122 procedure RenderAll(ANow: Boolean = False);
123 function GetButtonRect: TRect;
124 function GetDropDownWidth(AFull: boolean = True): integer;
125 function GetDropDownRect(AFull: Boolean = True): TRect;
126 procedure SeTBCButtonStateClicked(const AValue: TBCButtonState);
127 procedure SeTBCButtonStateHover(const AValue: TBCButtonState);
128 procedure SeTBCButtonStateNormal(const AValue: TBCButtonState);
129 procedure SetDown(AValue: boolean);
130 procedure SetDropDownArrowSize(AValue: Integer);
131 procedure SetDropDownWidth(AValue: Integer);
132 procedure SetFlipArrow(AValue: boolean);
133 procedure SetGlyph(const AValue: TBitmap);
134 procedure SetGlyphMargin(const AValue: integer);
135 procedure SetRounding(AValue: TBCRounding);
136 procedure SetRoundingDropDown(AValue: TBCRounding);
137 procedure SetStaticButton(const AValue: boolean);
138 procedure SetStyle(const AValue: TBCButtonStyle);
139 procedure SetGlobalOpacity(const AValue: byte);
140 procedure SetTextApplyGlobalOpacity(const AValue: boolean);
141 procedure UpdateSize;
142 procedure OnChangeGlyph(Sender: TObject);
143 procedure OnChangeState(Sender: TObject; AData: PtrInt);
144 protected
145 { Protected declarations }
146 procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
147 WithThemeSpace: boolean); override;
148 class function GetControlClassDefaultSize: TSize; override;
149 procedure Click; override;
150 procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
151 X, Y: integer); override;
152 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
153 procedure MouseEnter; override;
154 procedure MouseLeave; override;
155 procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
156 procedure SetEnabled(Value: boolean); override;
157 procedure TextChanged; override;
158 protected
159 {$IFDEF DEBUG}
160 function GetDebugText: String; override;
161 {$ENDIF}
162 function GetStyleExtension: String; override;
163 procedure DrawControl; override;
164 procedure RenderControl; override;
165 protected
166 property AutoSizeExtraVertical: integer read AutoSizeExtraY;
167 property AutoSizeExtraHorizontal: integer read AutoSizeExtraX;
168 property StateNormal: TBCButtonState read FStateNormal write SeTBCButtonStateNormal;
169 property StateHover: TBCButtonState read FStateHover write SeTBCButtonStateHover;
170 property StateClicked: TBCButtonState read FStateClicked write SeTBCButtonStateClicked;
171 property Down: boolean read FDown write SetDown default False;
172 property DropDownWidth: Integer read FDropDownWidth write SetDropDownWidth;
173 property DropDownArrowSize: Integer read FDropDownArrowSize write SetDropDownArrowSize;
174 property FlipArrow: boolean read FFlipArrow write SetFlipArrow;
175 property Glyph: TBitmap read FGlyph write SetGlyph;
176 property GlyphMargin: integer read FGlyphMargin write SetGlyphMargin default 5;
177 property Style: TBCButtonStyle read FStyle write SetStyle default bbtButton;
178 property StaticButton: boolean
179 read FStaticButton write SetStaticButton default False;
180 property GlobalOpacity: byte read FGlobalOpacity write SetGlobalOpacity;
181 property Rounding: TBCRounding read FRounding write SetRounding;
182 property RoundingDropDown: TBCRounding read FRoundingDropDown write SetRoundingDropDown;
183 property TextApplyGlobalOpacity: boolean
184 read FTextApplyGlobalOpacity write SetTextApplyGlobalOpacity;
185 property OnAfterRenderBCButton: TOnAfterRenderBCButton
186 read FOnAfterRenderBCButton write FOnAfterRenderBCButton;
187 property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
188 public
189 { Public declarations }
190 constructor Create(AOwner: TComponent); override;
191 destructor Destroy; override;
192 procedure Assign(Source: TPersistent); override;
193 procedure SetSizeVariables(newDropDownWidth, newDropDownArrowSize,
194 newAutoSizeExtraVertical, newAutoSizeExtraHorizontal: integer);
195 procedure UpdateControl; override; // Called by EndUpdate
196 end;
197
198 TBCButton = class(TCustomBCButton)
199 published
200 property Action;
201 property Align;
202 property Anchors;
203 property AssignStyle;
204 property AutoSize;
205 property StateClicked;
206 property StateHover;
207 property StateNormal;
208 property BorderSpacing;
209 property Caption;
210 property Color;
211 property Down;
212 property DropDownWidth;
213 property DropDownArrowSize;
214 property Enabled;
215 property FlipArrow;
216 property GlobalOpacity;
217 property Glyph;
218 property GlyphMargin;
219 property OnAfterRenderBCButton;
220 property OnButtonClick;
221 property OnClick;
222 property OnDblClick;
223 property OnMouseDown;
224 property OnMouseEnter;
225 property OnMouseLeave;
226 property OnMouseMove;
227 property OnMouseUp;
228 property ParentColor;
229 property PopupMenu;
230 property Rounding;
231 property RoundingDropDown;
232 property StaticButton;
233 property Style;
234 property TextApplyGlobalOpacity;
235 property Visible;
236 end;
237
238procedure Register;
239
240implementation
241
242uses LCLIntf, Math, LCLProc, BGRAPolygon, BCTools, SysUtils;
243
244procedure Register;
245begin
246 {$I bcbutton_icon.lrs}
247 RegisterComponents('BGRA Controls', [TBCButton]);
248end;
249
250{ TBCButtonState }
251
252procedure TBCButtonState.SetFontEx(const AValue: TBCFont);
253begin
254 if FFontEx = AValue then
255 exit;
256 FFontEx.Assign(AValue);
257
258 Change;
259end;
260
261procedure TBCButtonState.OnChangeFont(Sender: TObject; AData: PtrInt);
262begin
263 Change(PtrInt(pdUpdateSize));
264end;
265
266procedure TBCButtonState.OnChangeChildProperty(Sender: TObject; AData: PtrInt);
267begin
268 Change(AData);
269end;
270
271procedure TBCButtonState.SetBackground(AValue: TBCBackground);
272begin
273 if FBackground = AValue then Exit;
274 FBackground.Assign(AValue);
275
276 Change;
277end;
278
279procedure TBCButtonState.SetBorder(AValue: TBCBorder);
280begin
281 if FBorder = AValue then Exit;
282 FBorder.Assign(AValue);
283
284 Change;
285end;
286
287constructor TBCButtonState.Create(AControl: TControl);
288begin
289 FBackground := TBCBackground.Create(AControl);
290 FBorder := TBCBorder.Create(AControl);
291 FFontEx := TBCFont.Create(AControl);
292
293 FBackground.OnChange := @OnChangeChildProperty;
294 FBorder.OnChange := @OnChangeChildProperty;
295 FFontEx.OnChange := @OnChangeFont;
296
297 inherited Create(AControl);
298end;
299
300destructor TBCButtonState.Destroy;
301begin
302 FBackground.Free;
303 FBorder.Free;
304 FFontEx.Free;
305 inherited Destroy;
306end;
307
308procedure TBCButtonState.Assign(Source: TPersistent);
309begin
310 if Source is TBCButtonState then
311 begin
312 FBackground.Assign(TBCButtonState(Source).FBackground);
313 FBorder.Assign(TBCButtonState(Source).FBorder);
314 FFontEx.Assign(TBCButtonState(Source).FFontEx);
315
316 Change(PtrInt(pdUpdateSize));
317 end
318 else
319 inherited Assign(Source);
320end;
321
322{ TCustomBCButton }
323
324procedure TCustomBCButton.AssignDefaultStyle;
325begin
326 FRounding.RoundX := 12;
327 FRounding.RoundY := 12;
328 // Normal
329 with StateNormal do
330 begin
331 Border.Style := bboNone;
332 FontEx.Color := RGBToColor(230,230,255);
333 FontEx.Style := [fsBold];
334 FontEx.Shadow := True;
335 FontEx.ShadowOffsetX := 1;
336 FontEx.ShadowOffsetY := 1;
337 FontEx.ShadowRadius := 2;
338 Background.Gradient1EndPercent := 60;
339 Background.Style := bbsGradient;
340 // Gradient1
341 with Background.Gradient1 do
342 begin
343 EndColor := RGBToColor(64,64,128);
344 StartColor := RGBToColor(0,0,64);
345 end;
346 // Gradient2
347 with Background.Gradient2 do
348 begin
349 EndColor := RGBToColor(0,0,64);
350 GradientType := gtRadial;
351 Point1XPercent := 50;
352 Point1YPercent := 100;
353 Point2YPercent := 0;
354 StartColor := RGBToColor(64,64,128);
355 end;
356 end;
357 // Hover
358 with StateHover do
359 begin
360 Border.Style := bboNone;
361 FontEx.Color := RGBToColor(255,255,255);
362 FontEx.Style := [fsBold];
363 FontEx.Shadow := True;
364 FontEx.ShadowOffsetX := 1;
365 FontEx.ShadowOffsetY := 1;
366 FontEx.ShadowRadius := 2;
367 Background.Gradient1EndPercent := 100;
368 Background.Style := bbsGradient;
369 // Gradient1
370 with Background.Gradient1 do
371 begin
372 EndColor := RGBToColor(0,64,128);
373 GradientType := gtRadial;
374 Point1XPercent := 50;
375 Point1YPercent := 100;
376 Point2YPercent := 0;
377 StartColor := RGBToColor(0,128,255);
378 end;
379 end;
380 // Clicked
381 with StateClicked do
382 begin
383 Border.Style := bboNone;
384 FontEx.Color := RGBToColor(230,230,255);
385 FontEx.Style := [fsBold];
386 FontEx.Shadow := True;
387 FontEx.ShadowOffsetX := 1;
388 FontEx.ShadowOffsetY := 1;
389 FontEx.ShadowRadius := 2;
390 Background.Gradient1EndPercent := 100;
391 Background.Style := bbsGradient;
392 // Gradient1
393 with Background.Gradient1 do
394 begin
395 EndColor := RGBToColor(0,0,64);
396 GradientType := gtRadial;
397 Point1XPercent := 50;
398 Point1YPercent := 100;
399 Point2YPercent := 0;
400 StartColor := RGBToColor(0,64,128);
401 end;
402 end;
403end;
404
405procedure TCustomBCButton.CalculateGlyphSize(var NeededWidth, NeededHeight: integer);
406begin
407 if FGlyph = nil then
408 begin
409 NeededHeight := 0;
410 NeededWidth := 0;
411 Exit;
412 end;
413
414 NeededWidth := FGlyph.Width;
415 NeededHeight := FGlyph.Height;
416end;
417
418procedure TCustomBCButton.ConvertToGrayScale(ABGRA: TBGRABitmap);
419var
420 bounds: TRect;
421 px: PBGRAPixel;
422 xb, yb: integer;
423begin
424 bounds := ABGRA.GetImageBounds;
425 if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then
426 exit;
427
428 for yb := bounds.Top to bounds.bottom - 1 do
429 begin
430 px := ABGRA.scanline[yb] + bounds.left;
431 for xb := bounds.left to bounds.right - 1 do
432 begin
433 px^ := BGRAToGrayscale(px^);
434 Inc(px);
435 end;
436 end;
437 ABGRA.InvalidateBitmap;
438end;
439
440procedure TCustomBCButton.RenderAll(ANow: Boolean);
441begin
442 if (csCreating in FControlState) or IsUpdating or (FBGRANormal=nil) then
443 Exit;
444
445 if ANow then
446 begin
447 Render(FBGRANormal, FStateNormal);
448 Render(FBGRAHover, FStateHover);
449 Render(FBGRAClick, FStateClicked);
450 end else
451 begin
452 FBGRANormal.NeedRender := True;
453 FBGRAHover.NeedRender := True;
454 FBGRAClick.NeedRender := True;
455 end;
456end;
457
458function TCustomBCButton.GetButtonRect: TRect;
459begin
460 Result := GetClientRect;
461 if FStyle=bbtDropDown then
462 Dec(Result.Right,GetDropDownWidth(False));
463end;
464
465function TCustomBCButton.GetDropDownWidth(AFull: boolean): integer;
466begin
467 Result := FDropDownWidth + (ifthen(AFull, 2, 1) * FStateNormal.FBorder.Width);
468end;
469
470function TCustomBCButton.GetDropDownRect(AFull: Boolean): TRect;
471begin
472 Result := GetClientRect;
473 Result.Left := Result.Right - GetDropDownWidth(AFull);
474end;
475
476procedure TCustomBCButton.Render(ABGRA: TBGRABitmapEx;
477 AState: TBCButtonState);
478var
479 r,r_a: TRect;
480
481 { TODO: Create customizable glyph position by creating TBCGlyph type
482 and method in BCTools which render it }
483 procedure _RenderGlyph;
484 var
485 w, h, t, l: Integer;
486 g: TBGRABitmap;
487 begin
488 if (FGlyph<>nil) and (not FGlyph.Empty) then
489 begin
490 CalculateTextSize(Caption,AState.FontEx,w,h);
491 l := r.Right - Round(((r.Right-r.Left) + w + FGlyph.Width)/2);
492 t := r.Bottom - Round(((r.Bottom-r.Top) + FGlyph.Height) / 2);
493 g := TBGRABitmap.Create(Glyph);
494 ABGRA.PutImage(l,t,g,dmDrawWithTransparency);
495 g.Free;
496 Inc(r.Left,l+FGlyph.Width+FGlyphMargin);
497 end;
498 end;
499
500begin
501 if (csCreating in FControlState) or IsUpdating then
502 Exit;
503
504 ABGRA.NeedRender := False;
505
506 { Refreshing size }
507 ABGRA.SetSize(Width, Height);
508
509 { Calculating rect }
510 r := GetButtonRect;
511 CalculateBorderRect(AState.Border,r);
512
513 if FStyle = bbtDropDown then
514 begin
515 r_a := GetDropDownRect;
516 CalculateBorderRect(AState.Border,r_a);
517 end;
518
519 { Clearing previous paint }
520 ABGRA.Fill(BGRAPixelTransparent);
521 { Basic body }
522 RenderState(ABGRA, AState, r, FRounding);
523 if FStyle = bbtDropDown then
524 begin
525 RenderState(ABGRA, AState, r_a, FRoundingDropDown);
526 // Click offset for arrow
527 if AState=FStateClicked then
528 begin
529 Inc(r_a.Left,2);
530 Inc(r_a.Top,2);
531 end;
532
533 if FFlipArrow then
534 RenderArrow(TBGRABitmap(ABGRA),r_a,FDropDownArrowSize,badUp,AState.FontEx.Color)
535 else
536 RenderArrow(TBGRABitmap(ABGRA),r_a,FDropDownArrowSize,badDown,AState.FontEx.Color);
537 end;
538
539 // Click offset for text and glyph
540 if AState=FStateClicked then
541 begin
542 Inc(r.Left,2);
543 Inc(r.Top,2);
544 end;
545
546 if FTextApplyGlobalOpacity then
547 begin
548 { Drawing text }
549 _RenderGlyph;
550 RenderText(r,AState.FontEx,Self.Caption,TBGRABitmap(ABGRA));
551
552 { Set global opacity }
553 ABGRA.ApplyGlobalOpacity(FGlobalOpacity);
554 end
555 else
556 begin
557 { Set global opacity }
558 ABGRA.ApplyGlobalOpacity(FGlobalOpacity);
559 { Drawing text }
560 _RenderGlyph;
561 RenderText(r,AState.FontEx,Self.Caption,TBGRABitmap(ABGRA));
562 end;
563
564 { Convert to gray if not enabled }
565 if not Enabled then
566 ConvertToGrayScale(ABGRA);
567
568 if Assigned(FOnAfterRenderBCButton) then
569 FOnAfterRenderBCButton(Self, ABGRA, AState, r);
570
571 {$IFDEF DEBUG}
572 FRenderCount += 1;
573 {$ENDIF}
574end;
575
576procedure TCustomBCButton.RenderState(ABGRA: TBGRABitmapEx;
577 AState: TBCButtonState; const ARect: TRect; ARounding: TBCRounding);
578begin
579 RenderBackground(ARect, AState.FBackground, TBGRABitmap(ABGRA), ARounding);
580 RenderBorder(ARect, AState.FBorder, TBGRABitmap(ABGRA), ARounding);
581end;
582
583procedure TCustomBCButton.OnChangeGlyph(Sender: TObject);
584begin
585 RenderControl;
586 UpdateSize;
587 Invalidate;
588end;
589
590procedure TCustomBCButton.OnChangeState(Sender: TObject; AData: PtrInt);
591begin
592 RenderControl;
593 if TBCButtonPropertyData(AData)=pdUpdateSize then
594 UpdateSize;
595 Invalidate;
596end;
597
598procedure TCustomBCButton.SeTBCButtonStateClicked(const AValue: TBCButtonState);
599begin
600 if FStateClicked = AValue then
601 exit;
602 FStateClicked.Assign(AValue);
603
604 RenderControl;
605 Invalidate;
606end;
607
608procedure TCustomBCButton.SeTBCButtonStateHover(const AValue: TBCButtonState);
609begin
610 if FStateHover = AValue then
611 exit;
612 FStateHover.Assign(AValue);
613
614 RenderControl;
615 Invalidate;
616end;
617
618procedure TCustomBCButton.SeTBCButtonStateNormal(const AValue: TBCButtonState);
619begin
620 if FStateNormal = AValue then
621 exit;
622 FStateNormal.Assign(AValue);
623
624 RenderControl;
625 Invalidate;
626end;
627
628procedure TCustomBCButton.SetDown(AValue: boolean);
629begin
630 if FDown = AValue then
631 exit;
632 FDown := AValue;
633 if FDown
634 then FButtonState := msClicked
635 else FButtonState := msNone;
636 RenderControl;
637 Invalidate;
638end;
639
640procedure TCustomBCButton.SetDropDownArrowSize(AValue: Integer);
641begin
642 if FDropDownArrowSize = AValue then Exit;
643 FDropDownArrowSize := AValue;
644
645 RenderControl;
646 Invalidate;
647end;
648
649procedure TCustomBCButton.SetDropDownWidth(AValue: Integer);
650begin
651 if FDropDownWidth = AValue then Exit;
652 FDropDownWidth := AValue;
653
654 RenderControl;
655 UpdateSize;
656 Invalidate;
657end;
658
659procedure TCustomBCButton.SetFlipArrow(AValue: boolean);
660begin
661 if FFlipArrow = AValue then
662 Exit;
663 FFlipArrow := AValue;
664
665 RenderControl;
666 Invalidate;
667end;
668
669procedure TCustomBCButton.SetGlyph(const AValue: TBitmap);
670begin
671 if (FGlyph <> nil) and (FGlyph = AValue) then
672 exit;
673
674 FGlyph.Assign(AValue);
675
676 RenderControl;
677 UpdateSize;
678 Invalidate;
679end;
680
681procedure TCustomBCButton.SetGlyphMargin(const AValue: integer);
682begin
683 if FGlyphMargin = AValue then
684 exit;
685 FGlyphMargin := AValue;
686
687 RenderControl;
688 UpdateSize;
689 Invalidate;
690end;
691
692procedure TCustomBCButton.SetRounding(AValue: TBCRounding);
693begin
694 if FRounding = AValue then Exit;
695 FRounding.Assign(AValue);
696
697 RenderControl;
698 Invalidate;
699end;
700
701procedure TCustomBCButton.SetRoundingDropDown(AValue: TBCRounding);
702begin
703 if FRoundingDropDown = AValue then Exit;
704 FRoundingDropDown.Assign(AValue);
705
706 RenderControl;
707 Invalidate;
708end;
709
710procedure TCustomBCButton.SetStaticButton(const AValue: boolean);
711begin
712 if FStaticButton = AValue then
713 exit;
714 FStaticButton := AValue;
715
716 RenderControl;
717 Invalidate;
718end;
719
720procedure TCustomBCButton.SetStyle(const AValue: TBCButtonStyle);
721begin
722 if FStyle = AValue then
723 exit;
724 FStyle := AValue;
725
726 RenderControl;
727 UpdateSize;
728 Invalidate;
729end;
730
731procedure TCustomBCButton.UpdateSize;
732begin
733 InvalidatePreferredSize;
734 AdjustSize;
735end;
736
737procedure TCustomBCButton.CalculatePreferredSize(
738 var PreferredWidth, PreferredHeight: integer; WithThemeSpace: boolean);
739var
740 AWidth: integer;
741 gh: integer = 0;
742 gw: integer = 0;
743begin
744 if (Parent = nil) or (not Parent.HandleAllocated) then
745 Exit;
746 if WidthIsAnchored then
747 AWidth := Width
748 else
749 AWidth := 10000;
750
751 CalculateTextSize(Caption, FStateNormal.FontEx, PreferredWidth, PreferredHeight);
752
753 // Extra pixels for DropDown
754 if Style = bbtDropDown then
755 Inc(PreferredWidth, GetDropDownWidth);
756
757 CalculateGlyphSize(gw, gh);
758
759 if (FGlyph <> nil) and (not FGlyph.Empty) then
760 begin
761 if Caption = '' then
762 begin
763 Inc(PreferredWidth, gw{ - AutoSizeExtraY * 2});
764 Inc(PreferredHeight, gh);
765 end
766 else
767 begin
768 Inc(PreferredWidth, gw + FGlyphMargin);
769 if gh > PreferredHeight then
770 PreferredHeight := gh;
771 end;
772 end;
773
774 // Extra pixels for AutoSize
775 Inc(PreferredWidth, AutoSizeExtraX);
776 Inc(PreferredHeight, AutoSizeExtraY);
777end;
778
779class function TCustomBCButton.GetControlClassDefaultSize: TSize;
780begin
781 Result.CX := 123;
782 Result.CY := 33;
783end;
784
785procedure TCustomBCButton.Click;
786begin
787 if (FActiveButt = bbtDropDown) and Assigned(FOnButtonClick) then
788 begin
789 FOnButtonClick(Self);
790 Exit;
791 end;
792 inherited Click;
793end;
794
795procedure TCustomBCButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
796 X, Y: integer);
797begin
798 inherited MouseDown(Button, Shift, X, Y);
799 if csDesigning in ComponentState then
800 exit;
801
802 if (Button = mbLeft) and Enabled {and (not (FButtonState = msClicked)) }then
803 begin
804 case FActiveButt of
805 bbtButton:
806 if not (FButtonState=msClicked) then
807 begin
808 FButtonState := msClicked;
809 FDownButtonState := msNone;
810 Invalidate;
811 end;
812 bbtDropDown:
813 if not (FDownButtonState=msClicked) then
814 begin
815 FButtonState := msNone;
816 FDownButtonState := msClicked;
817 Invalidate;
818 end;
819 end;
820 // Old
821 {FButtonState := msClicked;
822 Invalidate;}
823 end;
824end;
825
826procedure TCustomBCButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
827 X, Y: integer);
828var
829 p: TPoint;
830begin
831 inherited MouseUp(Button, Shift, X, Y);
832 if csDesigning in ComponentState then
833 exit;
834
835 if (Button = mbLeft) and Enabled {and (FButtonState = msClicked)} then
836 begin
837 case FActiveButt of
838 bbtButton:
839 if FButtonState=msClicked then
840 begin
841 FButtonState := msHover;
842 FDownButtonState := msNone;
843 Invalidate;
844 end;
845 bbtDropDown:
846 if FDownButtonState = msClicked then
847 begin
848 FDownButtonState := msHover;
849 FButtonState := msNone;
850 Invalidate;
851 end;
852 end;
853 // Old
854 {FButtonState := msHover;
855 Invalidate;}
856 end;
857
858 if (FActiveButt = bbtDropDown) and (PopupMenu <> nil) and Enabled then
859 begin
860 if FFlipArrow then
861 p := ClientToScreen(Point(Width - FDropDownWidth - (FStateNormal.FBorder.Width * 2),
862 {PopupMenu.Height} -1))
863 else
864 p := ClientToScreen(Point(Width - FDropDownWidth - (FStateNormal.FBorder.Width * 2), Height + 1));
865
866 PopupMenu.PopUp(p.x, p.y);
867 //p := ClientToScreen(Point(X, Y));
868 //PopupMenu.PopUp(p.x, p.y);
869 end;
870end;
871
872procedure TCustomBCButton.MouseEnter;
873begin
874 if csDesigning in ComponentState then
875 exit;
876 case FActiveButt of
877 bbtButton:
878 begin
879 if FDown
880 then FButtonState := msClicked
881 else FButtonState := msHover;
882 FDownButtonState := msNone;
883 end;
884 bbtDropDown:
885 begin
886 if FDown
887 then FButtonState := msClicked
888 else FButtonState := msNone;
889 FDownButtonState := msHover;
890 end;
891 end;
892 Invalidate;
893 // Old
894 {FButtonState := msHover;
895 Invalidate;}
896 inherited MouseEnter;
897end;
898
899procedure TCustomBCButton.MouseLeave;
900begin
901 if csDesigning in ComponentState then
902 exit;
903 if FDown then
904 begin
905 FButtonState := msClicked;
906 FActiveButt := bbtButton;
907 end
908 else
909 FButtonState := msNone;
910 FDownButtonState := msNone;
911 Invalidate;
912 inherited MouseLeave;
913end;
914
915procedure TCustomBCButton.MouseMove(Shift: TShiftState; X, Y: integer);
916begin
917 inherited MouseMove(Shift, X, Y);
918
919 if FStyle=bbtButton then
920 FActiveButt := bbtButton
921 else
922 begin
923 // Calling invalidate only when active button changed. Otherwise, we leave
924 // this for LCL. This reduce paint call
925 if (FActiveButt=bbtButton) and (x>GetButtonRect.Right) then
926 begin
927 FActiveButt := bbtDropDown;
928 FDownButtonState := msHover;
929 if FDown
930 then FButtonState := msClicked
931 else FButtonState := msNone;
932 Invalidate;
933 end else
934 if (FActiveButt=bbtDropDown) and (x<=GetButtonRect.Right) then
935 begin
936 FActiveButt := bbtButton;
937 if FDown
938 then FButtonState := msClicked
939 else FButtonState := msHover;
940 FDownButtonState := msNone;
941 Invalidate;
942 end;
943 end;
944end;
945
946procedure TCustomBCButton.SetEnabled(Value: boolean);
947begin
948 inherited SetEnabled(Value);
949
950 RenderControl;
951 Invalidate;
952end;
953
954procedure TCustomBCButton.TextChanged;
955begin
956 inherited TextChanged;
957 RenderControl;
958 UpdateSize;
959 Invalidate;
960end;
961
962procedure TCustomBCButton.UpdateControl;
963begin
964 RenderControl;
965 inherited UpdateControl; // indalidate
966end;
967
968{$IFDEF DEBUG}
969function TCustomBCButton.GetDebugText: String;
970begin
971 Result := 'R: '+IntToStr(FRenderCount);
972end;
973{$ENDIF}
974
975procedure TCustomBCButton.DrawControl;
976var
977 bgra: TBGRABitmapEx;
978begin
979
980 // If style is without dropdown button or state of each button
981 // is the same (possible only for msNone) or static button then
982 // we can draw whole BGRABitmap
983 if (FStyle=bbtButton) or (FButtonState=FDownButtonState) or FStaticButton
984 then
985 begin
986 // Main button
987 if FStaticButton then
988 bgra := FBGRANormal
989 else
990 if FDown then
991 bgra := FBGRAClick
992 else
993 case FButtonState of
994 msNone: bgra := FBGRANormal;
995 msHover: bgra := FBGRAHover;
996 msClicked: bgra := FBGRAClick;
997 end;
998 if bgra.NeedRender then
999 Render(bgra,TBCButtonState(bgra.CustomData));
1000 bgra.Draw(Self.Canvas, 0, 0, False);
1001 end
1002 // Otherwise we must draw part of state for each button
1003 else
1004 begin
1005 // The active button must be draw as last because right edge of button and
1006 // left edge of dropdown are overlapping each other, so we must draw edge
1007 // for current state of active button
1008 case FActiveButt of
1009 bbtButton:
1010 begin
1011 // Drop down button
1012 case FDownButtonState of
1013 msNone: bgra := FBGRANormal;
1014 msHover: bgra := FBGRAHover;
1015 msClicked: bgra := FBGRAClick;
1016 end;
1017 if bgra.NeedRender then
1018 Render(bgra,TBCButtonState(bgra.CustomData));
1019 bgra.DrawPart(GetDropDownRect,Self.Canvas,GetDropDownRect.Left,0,False);
1020 // Main button
1021 if FDown then
1022 bgra := FBGRAClick
1023 else
1024 case FButtonState of
1025 msNone: bgra := FBGRANormal;
1026 msHover: bgra := FBGRAHover;
1027 msClicked: bgra := FBGRAClick;
1028 end;
1029 if bgra.NeedRender then
1030 Render(bgra,TBCButtonState(bgra.CustomData));
1031 bgra.DrawPart(GetButtonRect, Self.Canvas, 0, 0, False);
1032 end;
1033 bbtDropDown:
1034 begin
1035 // Main button
1036 if FDown then
1037 bgra := FBGRAClick
1038 else
1039 case FButtonState of
1040 msNone: bgra := FBGRANormal;
1041 msHover: bgra := FBGRAHover;
1042 msClicked: bgra := FBGRAClick;
1043 end;
1044 if bgra.NeedRender then
1045 Render(bgra,TBCButtonState(bgra.CustomData));
1046 bgra.DrawPart(GetButtonRect, Self.Canvas, 0, 0, False);
1047 // Drop down button
1048 case FDownButtonState of
1049 msNone: bgra := FBGRANormal;
1050 msHover: bgra := FBGRAHover;
1051 msClicked: bgra := FBGRAClick;
1052 end;
1053 if bgra.NeedRender then
1054 Render(bgra,TBCButtonState(bgra.CustomData));
1055 bgra.DrawPart(GetDropDownRect,Self.Canvas,GetDropDownRect.Left,0,False);
1056 end;
1057 end;
1058 end;
1059end;
1060
1061procedure TCustomBCButton.RenderControl;
1062begin
1063 inherited RenderControl;
1064 RenderAll;
1065end;
1066
1067procedure TCustomBCButton.SetGlobalOpacity(const AValue: byte);
1068begin
1069 if FGlobalOpacity = AValue then
1070 exit;
1071 FGlobalOpacity := AValue;
1072
1073 RenderControl;
1074 Invalidate;
1075end;
1076
1077procedure TCustomBCButton.SetTextApplyGlobalOpacity(const AValue: boolean);
1078begin
1079 if FTextApplyGlobalOpacity = AValue then
1080 exit;
1081 FTextApplyGlobalOpacity := AValue;
1082
1083 RenderControl;
1084 Invalidate;
1085end;
1086
1087constructor TCustomBCButton.Create(AOwner: TComponent);
1088begin
1089 inherited Create(AOwner);
1090 {$IFDEF DEBUG}
1091 FRenderCount := 0;
1092 {$ENDIF}
1093 DisableAutoSizing;
1094 Include(FControlState, csCreating);
1095 //{$IFDEF WINDOWS}
1096 // default sizes under different dpi settings
1097 //SetSizeVariables(ScaleX(8,96), ScaleX(16,96), ScaleY(8,96), ScaleX(24,96));
1098 //{$ELSE}
1099 // default sizes
1100 SetSizeVariables(16, 8, 8, 24);
1101 //{$ENDIF}
1102 BeginUpdate;
1103 try
1104 with GetControlClassDefaultSize do
1105 SetInitialBounds(0, 0, CX, CY);
1106 ControlStyle := ControlStyle + [csAcceptsControls];
1107 FBGRANormal := TBGRABitmapEx.Create(Width, Height, BGRAPixelTransparent);
1108 FBGRAHover := TBGRABitmapEx.Create(Width, Height, BGRAPixelTransparent);
1109 FBGRAClick := TBGRABitmapEx.Create(Width, Height, BGRAPixelTransparent);
1110
1111 ParentColor := False;
1112 Color := clNone;
1113
1114 FStateNormal := TBCButtonState.Create(Self);
1115 FStateHover := TBCButtonState.Create(Self);
1116 FStateClicked := TBCButtonState.Create(Self);
1117 FStateNormal.OnChange := @OnChangeState;
1118 FStateHover.OnChange := @OnChangeState;
1119 FStateClicked.OnChange := @OnChangeState;
1120
1121 FRounding := TBCRounding.Create(Self);
1122 FRounding.OnChange := @OnChangeState;
1123
1124 FRoundingDropDown := TBCRounding.Create(Self);
1125 FRoundingDropDown.OnChange := @OnChangeState;
1126
1127 { Connecting bitmaps with states property to easy call and access }
1128 FBGRANormal.CustomData := PtrInt(FStateNormal);
1129 FBGRAHover.CustomData := PtrInt(FStateHover);
1130 FBGRAClick.CustomData := PtrInt(FStateClicked);
1131
1132 FButtonState := msNone;
1133 FDownButtonState := msNone;
1134 FFlipArrow := False;
1135 FGlyph := TBitmap.Create;
1136 FGlyph.OnChange := @OnChangeGlyph;
1137 FGlyphMargin := 5;
1138 FStyle := bbtButton;
1139 FStaticButton := False;
1140 FActiveButt := bbtButton;
1141 FGlobalOpacity := 255;
1142 FTextApplyGlobalOpacity := False;
1143 //FStates := [];
1144 FDown := False;
1145
1146 { Default style }
1147 AssignDefaultStyle;
1148 finally
1149 Exclude(FControlState, csCreating);
1150 EnableAutoSizing;
1151 EndUpdate;
1152 end;
1153end;
1154
1155destructor TCustomBCButton.Destroy;
1156begin
1157 FStateNormal.Free;
1158 FStateHover.Free;
1159 FStateClicked.Free;
1160 FBGRANormal.Free;
1161 FBGRAHover.Free;
1162 FBGRAClick.Free;
1163 FreeThenNil(FGlyph);
1164 FRounding.Free;
1165 FRoundingDropDown.Free;
1166 inherited Destroy;
1167end;
1168
1169procedure TCustomBCButton.Assign(Source: TPersistent);
1170begin
1171 if Source is TCustomBCButton then
1172 begin
1173 Glyph := TCustomBCButton(Source).Glyph;
1174 FGlyphMargin := TCustomBCButton(Source).FGlyphMargin;
1175 FStyle := TCustomBCButton(Source).FStyle;
1176 FFlipArrow := TCustomBCButton(Source).FFlipArrow;
1177 FStaticButton := TCustomBCButton(Source).FStaticButton;
1178 FGlobalOpacity := TCustomBCButton(Source).FGlobalOpacity;
1179 FTextApplyGlobalOpacity := TCustomBCButton(Source).FTextApplyGlobalOpacity;
1180 FStateNormal.Assign(TCustomBCButton(Source).FStateNormal);
1181 FStateHover.Assign(TCustomBCButton(Source).FStateHover);
1182 FStateClicked.Assign(TCustomBCButton(Source).FStateClicked);
1183 FDropDownArrowSize := TCustomBCButton(Source).FDropDownArrowSize;
1184 FDropDownWidth := TCustomBCButton(Source).FDropDownWidth;
1185 AutoSizeExtraX := TCustomBCButton(Source).AutoSizeExtraX;
1186 AutoSizeExtraY := TCustomBCButton(Source).AutoSizeExtraY;
1187 FDown := TCustomBCButton(Source).FDown;
1188 FRounding.Assign(TCustomBCButton(Source).FRounding);
1189 FRoundingDropDown.Assign(TCustomBCButton(Source).FRoundingDropDown);
1190
1191 RenderControl;
1192 Invalidate;
1193 UpdateSize;
1194 end
1195 else
1196 inherited Assign(Source);
1197end;
1198
1199procedure TCustomBCButton.SetSizeVariables(newDropDownWidth, newDropDownArrowSize,
1200 newAutoSizeExtraVertical, newAutoSizeExtraHorizontal: integer);
1201begin
1202 FDropDownArrowSize := newDropDownArrowSize;
1203 FDropDownWidth := newDropDownWidth;
1204 AutoSizeExtraY := newAutoSizeExtraVertical;
1205 AutoSizeExtraX := newAutoSizeExtraHorizontal;
1206
1207 if csCreating in ControlState then
1208 Exit;
1209
1210 RenderControl;
1211 UpdateSize;
1212 Invalidate;
1213end;
1214
1215function TCustomBCButton.GetStyleExtension: String;
1216begin
1217 Result := 'bcbtn';
1218end;
1219
1220end.
Note: See TracBrowser for help on using the repository browser.