source: trunk/Packages/bgracontrols/bgraneobutton.pas

Last change on this file was 2, checked in by chronos, 6 years ago
File size: 28.2 KB
Line 
1{
2BGRANeoButton 2011 - 2012 by Lainz
3
4This is a control that can be modified to create your own graphic button.
5By default it has very limited functionality, but you can extend the code to
6get the result you want.
7
8* TGraphicButton *
9TGraphicControl descendant. It handles mouse events and
10ModalResult. It uses TGraphicButtonState to indicate the current button stage.
11
12* TBGRANeoTextStyle *
13BGRABitmap font style and alpha.
14
15* TBGRANeoShadowStyle *
16Usefull to general shadow purposes.
17
18* TBGRANeoGradientStyle *
19Gradient with alpha.
20
21* TBGRANeoBorderStyle *
22Round rectangle options, inner and outer border.
23It uses TBGRANeoRoundRectangleOption.
24
25* TBGRANeoButtonStyle *
26A combination of TBGRANeoTextStyle, TBGRANeoShadowStyle, TBGRANeoGradientStyle
27and TBGRANeoBorderStyle. Is the style of each TBGRANeoButton states.
28
29* TCustomBGRANeoButton *
30A button that can be overriden. TSampleBGRANeoButton show how
31to do that. With 4 states, each of them read the style properties
32from TBGRANeoButtonStyle.
33
34* TBGRANeoButton *
35TSampleBGRANeoButton descendant. It show how to publish all the properties that
36are visible in the object inspector.
37}
38
39unit BGRANeoButton;
40
41{$mode objfpc}{$H+}
42{off $DEFINE DEBUG}
43
44interface
45
46uses
47 Classes, LResources, Forms, Controls, Graphics, Dialogs, types,
48 BGRABitmap, BGRABitmapTypes, BGRAPolygon, BGRAGradients;
49
50type
51 TGraphicButtonState = (gbsNormal, gbsHover, gbsActive);
52 TBGRANeoRoundRectangleOption = (rroRound, rroBevel, rroSquare);
53
54type
55
56 { TGraphicButton }
57
58 TGraphicButton = class(TGraphicControl)
59 protected
60 FState: TGraphicButtonState;
61 FModalResult: TModalResult;
62 protected
63 procedure DoClick; virtual;
64 procedure DoMouseDown; virtual;
65 procedure DoMouseUp; virtual;
66 procedure DoMouseEnter; virtual;
67 procedure DoMouseLeave; virtual;
68 protected
69 procedure Click; override;
70 procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
71 X, Y: integer); override;
72 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
73 procedure MouseEnter; override;
74 procedure MouseLeave; override;
75 public
76 property ModalResult: TModalResult
77 read FModalResult write FModalResult default mrNone;
78 end;
79
80 { TBGRANeoShadowStyle }
81
82 TBGRANeoShadowStyle = class(TPersistent)
83 protected
84 FOwner: TControl;
85 FColor: TColor;
86 FAlpha: byte;
87 FOffsetX: integer;
88 FOffsetY: integer;
89 FRadius: integer;
90 protected
91 procedure SetFAlpha(AValue: byte); virtual;
92 procedure SetFColor(AValue: TColor); virtual;
93 procedure SetFOffsetX(AValue: integer); virtual;
94 procedure SetFOffsetY(AValue: integer); virtual;
95 procedure SetFRadius(AValue: integer); virtual;
96 public
97 constructor Create(AOwner: TControl);
98 destructor Destroy; override;
99 procedure Assign(Source: TPersistent); override;
100 published
101 property Color: TColor read FColor write SetFColor default clWhite;
102 property Alpha: byte read FAlpha write SetFAlpha default 255;
103 property OffsetX: integer read FOffsetX write SetFOffsetX default 0;
104 property OffsetY: integer read FOffsetY write SetFOffsetY default 0;
105 property Radius: integer read FRadius write SetFRadius default 0;
106 end;
107
108 { TBGRANeoTextStyle }
109
110 TBGRANeoTextStyle = class(TPersistent)
111 protected
112 FOwner: TControl;
113 FFont: TFont;
114 FAlpha: byte;
115 FQuality: TBGRAFontQuality;
116 protected
117 procedure SetFAlpha(AValue: byte); virtual;
118 procedure SetFFont(AValue: TFont); virtual;
119 procedure SetFQuality(AValue: TBGRAFontQuality); virtual;
120 public
121 constructor Create(AOwner: TControl);
122 destructor Destroy; override;
123 procedure Assign(Source: TPersistent); override;
124 published
125 property Font: TFont read FFont write SetFFont;
126 property Alpha: byte read FAlpha write SetFAlpha default 255;
127 property Quality: TBGRAFontQuality read FQuality write SetFQuality default
128 fqSystemClearType;
129 end;
130
131 { TBGRANeoGradientStyle }
132
133 TBGRANeoGradientStyle = class(TPersistent)
134 protected
135 FOwner: TControl;
136 FColor1: TColor;
137 FColor1Alpha: byte;
138 FColor2: TColor;
139 FColor2Alpha: byte;
140 FStyle: TGradientType;
141 FSinus: boolean;
142 protected
143 procedure SetFColor1(AValue: TColor); virtual;
144 procedure SetFColor1Alpha(AValue: byte); virtual;
145 procedure SetFColor2(AValue: TColor); virtual;
146 procedure SetFColor2Alpha(AValue: byte); virtual;
147 procedure SetFSinus(AValue: boolean); virtual;
148 procedure SetFStyle(AValue: TGradientType); virtual;
149 public
150 constructor Create(AOwner: TControl);
151 destructor Destroy; override;
152 procedure Assign(Source: TPersistent); override;
153 published
154 property Color1: TColor read FColor1 write SetFColor1 default clWhite;
155 property Color1Alpha: byte read FColor1Alpha write SetFColor1Alpha default 255;
156 property Color2: TColor read FColor2 write SetFColor2 default clWhite;
157 property Color2Alpha: byte read FColor1Alpha write SetFColor2Alpha default 255;
158 property Style: TGradientType read FStyle write SetFStyle default gtLinear;
159 property Sinus: boolean read FSinus write SetFSinus default False;
160 end;
161
162 { TBGRANeoBorderStyle }
163
164 TBGRANeoBorderStyle = class(TPersistent)
165 protected
166 FOwner: TControl;
167 FInnerColor: TColor;
168 FInnerAlpha: byte;
169 FInnerWidth: single;
170 FOuterColor: TColor;
171 FOuterAlpha: byte;
172 FOuterWidth: single;
173 FRoundX: single;
174 FRoundY: single;
175 FTopLeft, FTopRight, FBottomLeft, FBottomRight: TBGRANeoRoundRectangleOption;
176 protected
177 procedure SetFBottomLeft(AValue: TBGRANeoRoundRectangleOption); virtual;
178 procedure SetFBottomRight(AValue: TBGRANeoRoundRectangleOption); virtual;
179 procedure SetFInnerAlpha(AValue: byte); virtual;
180 procedure SetFInnerColor(AValue: TColor); virtual;
181 procedure SetFInnerWidth(AValue: single); virtual;
182 procedure SetFOuterAlpha(AValue: byte); virtual;
183 procedure SetFOuterColor(AValue: TColor); virtual;
184 procedure SetFOuterWidth(AValue: single); virtual;
185 procedure SetFRoundX(AValue: single); virtual;
186 procedure SetFRoundY(AValue: single); virtual;
187 procedure SetFTopLeft(AValue: TBGRANeoRoundRectangleOption); virtual;
188 procedure SetFTopRight(AValue: TBGRANeoRoundRectangleOption); virtual;
189 public
190 constructor Create(AOwner: TControl);
191 destructor Destroy; override;
192 procedure Assign(Source: TPersistent); override;
193 function Options: TRoundRectangleOptions;
194 published
195 property InnerColor: TColor read FInnerColor write SetFInnerColor default clWhite;
196 property InnerColorAlpha: byte read FInnerAlpha write SetFInnerAlpha default 255;
197 property InnerWidth: single read FInnerWidth write SetFInnerWidth default 0;
198 property OuterColor: TColor read FOuterColor write SetFOuterColor default clWhite;
199 property OuterColorAlpha: byte read FOuterAlpha write SetFOuterAlpha default 255;
200 property OuterWidth: single read FOuterWidth write SetFOuterWidth default 0;
201 property RoundX: single read FRoundX write SetFRoundX default 0;
202 property RoundY: single read FRoundY write SetFRoundY default 0;
203 property TopLeft: TBGRANeoRoundRectangleOption
204 read FTopLeft write SetFTopLeft default rroRound;
205 property TopRight: TBGRANeoRoundRectangleOption
206 read FTopRight write SetFTopRight default rroRound;
207 property BottomLeft: TBGRANeoRoundRectangleOption
208 read FBottomLeft write SetFBottomLeft default rroRound;
209 property BottomRight: TBGRANeoRoundRectangleOption
210 read FBottomRight write SetFBottomRight default rroRound;
211 end;
212
213 { TBGRANeoButtonStyle }
214
215 TBGRANeoButtonStyle = class(TPersistent)
216 protected
217 FOwner: TControl;
218 FText: TBGRANeoTextStyle;
219 FShadow: TBGRANeoShadowStyle;
220 FGradient1: TBGRANeoGradientStyle;
221 FGradient2: TBGRANeoGradientStyle;
222 FGradientPosition: single;
223 FBorder: TBGRANeoBorderStyle;
224 protected
225 procedure SetFBorder(AValue: TBGRANeoBorderStyle); virtual;
226 procedure SetFGradient1(AValue: TBGRANeoGradientStyle); virtual;
227 procedure SetFGradient2(AValue: TBGRANeoGradientStyle); virtual;
228 procedure SetFGradientPosition(AValue: single); virtual;
229 procedure SetFShadow(AValue: TBGRANeoShadowStyle); virtual;
230 procedure SetFText(AValue: TBGRANeoTextStyle); virtual;
231 public
232 constructor Create(AOwner: TControl);
233 destructor Destroy; override;
234 procedure Assign(Source: TPersistent); override;
235 published
236 property Text: TBGRANeoTextStyle read FText write SetFText;
237 property Shadow: TBGRANeoShadowStyle read FShadow write SetFShadow;
238 property Gradient1: TBGRANeoGradientStyle read FGradient1 write SetFGradient1;
239 property Gradient2: TBGRANeoGradientStyle read FGradient2 write SetFGradient2;
240 property GradientPosition: single read FGradientPosition write SetFGradientPosition;
241 property Border: TBGRANeoBorderStyle read FBorder write SetFBorder;
242 end;
243
244 { TCustomBGRANeoButton }
245
246 TCustomBGRANeoButton = class(TGraphicButton)
247 protected
248 FBGRA: TBGRABitmap;
249 FStyleNormal, FStyleHover, FStyleActive, FStyleDisabled: TBGRANeoButtonStyle;
250 {$IFDEF DEBUG}
251 FPaintCount: integer;
252 {$ENDIF}
253 protected
254 procedure SetFStyleActive(AValue: TBGRANeoButtonStyle); virtual;
255 procedure SetFStyleDisabled(AValue: TBGRANeoButtonStyle); virtual;
256 procedure SetFStyleHover(AValue: TBGRANeoButtonStyle); virtual;
257 procedure SetFStyleNormal(AValue: TBGRANeoButtonStyle); virtual;
258 protected
259 procedure DrawButton; virtual;
260 procedure DrawBody(AStyle: TBGRANeoButtonStyle); virtual;
261 procedure DrawText(AStyle: TBGRANeoButtonStyle); virtual;
262 protected
263 procedure Paint; override;
264 public
265 constructor Create(AOwner: TComponent); override;
266 destructor Destroy; override;
267 procedure Assign(Source: TPersistent); override;
268 published
269 property StyleNormal: TBGRANeoButtonStyle read FStyleNormal write SetFStyleNormal;
270 property StyleHover: TBGRANeoButtonStyle read FStyleHover write SetFStyleHover;
271 property StyleActive: TBGRANeoButtonStyle read FStyleActive write SetFStyleActive;
272 property StyleDisabled: TBGRANeoButtonStyle
273 read FStyleDisabled write SetFStyleDisabled;
274 end;
275
276 { TSampleBGRANeoButton }
277
278 TSampleBGRANeoButton = class(TCustomBGRANeoButton)
279 protected
280 procedure DrawBody(AStyle: TBGRANeoButtonStyle); override;
281 procedure DrawText(AStyle: TBGRANeoButtonStyle); override;
282 end;
283
284 { TBGRANeoButton }
285
286 TBGRANeoButton = class(TSampleBGRANeoButton)
287 published
288 property StyleNormal;
289 property StyleHover;
290 property StyleActive;
291 property StyleDisabled;
292 published
293 property Action;
294 property Align;
295 property Anchors;
296 property AutoSize;
297 property BidiMode;
298 property BorderSpacing;
299 property Caption;
300 property Color;
301 property Constraints;
302 property DragCursor;
303 property DragKind;
304 property DragMode;
305 property Enabled;
306 property Font;
307 property ModalResult;
308 property OnChangeBounds;
309 property OnClick;
310 property OnContextPopup;
311 property OnDragDrop;
312 property OnDragOver;
313 property OnEndDrag;
314 property OnMouseDown;
315 property OnMouseEnter;
316 property OnMouseLeave;
317 property OnMouseMove;
318 property OnMouseUp;
319 property OnResize;
320 property OnStartDrag;
321 property ParentBidiMode;
322 property ParentFont;
323 property ParentShowHint;
324 property PopupMenu;
325 property ShowHint;
326 property Visible;
327 end;
328
329procedure Register;
330
331implementation
332
333uses sysutils;
334
335procedure Register;
336begin
337 RegisterComponents('BGRA Controls', [TBGRANeoButton]);
338end;
339
340{ TSampleBGRANeoButton }
341
342procedure TSampleBGRANeoButton.DrawBody(AStyle: TBGRANeoButtonStyle);
343
344 procedure DrawBodyStyle(bitmap: TBGRABitmap;
345 cl1, cl2, cl3, cl4, border, light: TBGRAPixel; rx, ry, w, Value: single;
346 dir1, dir2, dir3: TGradientDirection; options: TRoundRectangleOptions = [];
347 drawlight: boolean = True);
348 var
349 texture: TBGRABitmap;
350 w2, b2: single;
351 begin
352 texture := DoubleGradientAlphaFill(Rect(0, 0, bitmap.Width, bitmap.Height),
353 cl1, cl2, cl3, cl4, dir1, dir2, dir3, Value);
354
355 b2 := 1;
356 w2 := w * 2 - 1;
357
358 FillRoundRectangleAntialiasWithTexture(bitmap, Trunc(w / 2),
359 Trunc(w / 2), bitmap.Width - b2 - Trunc(w / 2),
360 bitmap.Height - b2 - Trunc(w / 2), rx, ry, options, texture);
361 texture.Free;
362
363 if drawlight then
364 BorderRoundRectangleAntialias(bitmap, w, w,
365 bitmap.Width - b2 - w,
366 bitmap.Height - b2 - w, rx, ry, w2, options, light, False);
367
368 BorderRoundRectangleAntialias(bitmap, Trunc(w / 2), Trunc(w / 2),
369 bitmap.Width - b2 - Trunc(w / 2),
370 bitmap.Height - b2 - Trunc(w / 2), rx, ry, w, options, border, False);
371 end;
372
373begin
374 FBGRA.Fill(BGRAPixelTransparent);
375 DrawBodyStyle(FBGRA,
376 ColorToBGRA(AStyle.Gradient1.Color1, AStyle.Gradient1.Color1Alpha),
377 ColorToBGRA(AStyle.Gradient1.Color2, AStyle.Gradient1.Color2Alpha),
378 ColorToBGRA(AStyle.Gradient2.Color1, AStyle.Gradient2.Color1Alpha),
379 ColorToBGRA(AStyle.Gradient2.Color2, AStyle.Gradient2.Color2Alpha),
380 ColorToBGRA(AStyle.Border.OuterColor, AStyle.Border.OuterColorAlpha),
381 ColorToBGRA(AStyle.Border.InnerColor, AStyle.Border.InnerColorAlpha),
382 AStyle.Border.RoundX, AStyle.Border.RoundY, AStyle.Border.OuterWidth,
383 AStyle.GradientPosition,
384 gdVertical, gdVertical, gdVertical, AStyle.Border.Options);
385end;
386
387procedure TSampleBGRANeoButton.DrawText(AStyle: TBGRANeoButtonStyle);
388var
389 bmpSdw: TBGRABitmap;
390 OutTxtSize: TSize;
391 OutX, OutY: integer;
392begin
393 if (AStyle.Shadow.Alpha = 0) and (AStyle.Text.Alpha = 0) then
394 exit;
395
396 FBGRA.FontAntialias := True;
397 FBGRA.FontHeight := AStyle.Text.Font.Height;
398 FBGRA.FontStyle := AStyle.Text.Font.Style;
399 FBGRA.FontName := AStyle.Text.Font.Name;
400 FBGRA.FontQuality := AStyle.Text.Quality;
401
402 OutTxtSize := FBGRA.TextSize(Caption);
403 OutX := Round(Width / 2) - Round(OutTxtSize.cx / 2);
404 OutY := Round(Height / 2) - Round(OutTxtSize.cy / 2);
405
406 if AStyle.Shadow.Alpha > 0 then
407 begin
408 bmpSdw := TBGRABitmap.Create(OutTxtSize.cx + 2 * AStyle.Shadow.Radius,
409 OutTxtSize.cy + 2 * AStyle.Shadow.Radius);
410
411 bmpSdw.FontAntialias := True;
412 bmpSdw.FontHeight := AStyle.Text.Font.Height;
413 bmpSdw.FontStyle := AStyle.Text.Font.Style;
414 bmpSdw.FontName := AStyle.Text.Font.Name;
415 bmpSdw.FontQuality := AStyle.Text.Quality;
416
417 bmpSdw.TextOut(AStyle.Shadow.Radius, AStyle.Shadow.Radius,
418 Caption, ColorToBGRA(AStyle.Shadow.Color, AStyle.Shadow.Alpha));
419
420 BGRAReplace(bmpSdw, bmpSdw.FilterBlurRadial(AStyle.Shadow.Radius, rbFast));
421
422 FBGRA.PutImage(OutX + AStyle.Shadow.OffsetX - AStyle.Shadow.Radius,
423 OutY + AStyle.Shadow.OffsetY - AStyle.Shadow.Radius, bmpSdw,
424 dmDrawWithTransparency);
425
426 bmpSdw.Free;
427 end;
428
429 if AStyle.Text.Alpha > 0 then
430 FBGRA.TextOut(OutX, OutY, Caption, ColorToBGRA(AStyle.Text.Font.Color,
431 AStyle.Text.Alpha));
432end;
433
434{ TBGRANeoButtonStyle }
435
436procedure TBGRANeoButtonStyle.SetFBorder(AValue: TBGRANeoBorderStyle);
437begin
438 if FBorder = AValue then
439 Exit;
440 FBorder := AValue;
441end;
442
443procedure TBGRANeoButtonStyle.SetFGradient1(AValue: TBGRANeoGradientStyle);
444begin
445 if FGradient1 = AValue then
446 Exit;
447 FGradient1 := AValue;
448end;
449
450procedure TBGRANeoButtonStyle.SetFGradient2(AValue: TBGRANeoGradientStyle);
451begin
452 if FGradient2 = AValue then
453 Exit;
454 FGradient2 := AValue;
455end;
456
457procedure TBGRANeoButtonStyle.SetFGradientPosition(AValue: single);
458begin
459 if FGradientPosition = AValue then
460 Exit;
461 FGradientPosition := AValue;
462end;
463
464procedure TBGRANeoButtonStyle.SetFShadow(AValue: TBGRANeoShadowStyle);
465begin
466 if FShadow = AValue then
467 Exit;
468 FShadow := AValue;
469end;
470
471procedure TBGRANeoButtonStyle.SetFText(AValue: TBGRANeoTextStyle);
472begin
473 if FText = AValue then
474 Exit;
475 FText := AValue;
476end;
477
478constructor TBGRANeoButtonStyle.Create(AOwner: TControl);
479begin
480 inherited Create;
481 FOwner := AOwner;
482 FText := TBGRANeoTextStyle.Create(FOwner);
483 FShadow := TBGRANeoShadowStyle.Create(FOwner);
484 FGradient1 := TBGRANeoGradientStyle.Create(FOwner);
485 FGradient2 := TBGRANeoGradientStyle.Create(FOwner);
486 FGradientPosition := 0.5;
487 FBorder := TBGRANeoBorderStyle.Create(FOwner);
488end;
489
490destructor TBGRANeoButtonStyle.Destroy;
491begin
492 FText.Free;
493 FShadow.Free;
494 FGradient1.Free;
495 FGradient2.Free;
496 FBorder.Free;
497 inherited Destroy;
498end;
499
500procedure TBGRANeoButtonStyle.Assign(Source: TPersistent);
501begin
502 if Source is TBGRANeoButtonStyle then
503 begin
504 FText.Assign(TBGRANeoButtonStyle(Source).Text);
505 FShadow.Assign(TBGRANeoButtonStyle(Source).Shadow);
506 FGradient1.Assign(TBGRANeoButtonStyle(Source).Gradient1);
507 FGradient2.Assign(TBGRANeoButtonStyle(Source).Gradient2);
508 FGradientPosition := TBGRANeoButtonStyle(Source).GradientPosition;
509 FBorder.Assign(TBGRANeoButtonStyle(Source).Border);
510 end
511 else
512 inherited Assign(Source);
513end;
514
515{ TBGRANeoBorderStyle }
516
517procedure TBGRANeoBorderStyle.SetFBottomLeft(AValue: TBGRANeoRoundRectangleOption);
518begin
519 if FBottomLeft = AValue then
520 Exit;
521 FBottomLeft := AValue;
522end;
523
524procedure TBGRANeoBorderStyle.SetFBottomRight(AValue: TBGRANeoRoundRectangleOption);
525begin
526 if FBottomRight = AValue then
527 Exit;
528 FBottomRight := AValue;
529end;
530
531procedure TBGRANeoBorderStyle.SetFInnerAlpha(AValue: byte);
532begin
533 if FInnerAlpha = AValue then
534 Exit;
535 FInnerAlpha := AValue;
536end;
537
538procedure TBGRANeoBorderStyle.SetFInnerColor(AValue: TColor);
539begin
540 if FInnerColor = AValue then
541 Exit;
542 FInnerColor := AValue;
543end;
544
545procedure TBGRANeoBorderStyle.SetFInnerWidth(AValue: single);
546begin
547 if FInnerWidth = AValue then
548 Exit;
549 FInnerWidth := AValue;
550end;
551
552procedure TBGRANeoBorderStyle.SetFOuterAlpha(AValue: byte);
553begin
554 if FOuterAlpha = AValue then
555 Exit;
556 FOuterAlpha := AValue;
557end;
558
559procedure TBGRANeoBorderStyle.SetFOuterColor(AValue: TColor);
560begin
561 if FOuterColor = AValue then
562 Exit;
563 FOuterColor := AValue;
564end;
565
566procedure TBGRANeoBorderStyle.SetFOuterWidth(AValue: single);
567begin
568 if FOuterWidth = AValue then
569 Exit;
570 FOuterWidth := AValue;
571end;
572
573procedure TBGRANeoBorderStyle.SetFRoundX(AValue: single);
574begin
575 if FRoundX = AValue then
576 Exit;
577 FRoundX := AValue;
578end;
579
580procedure TBGRANeoBorderStyle.SetFRoundY(AValue: single);
581begin
582 if FRoundY = AValue then
583 Exit;
584 FRoundY := AValue;
585end;
586
587procedure TBGRANeoBorderStyle.SetFTopLeft(AValue: TBGRANeoRoundRectangleOption);
588begin
589 if FTopLeft = AValue then
590 Exit;
591 FTopLeft := AValue;
592end;
593
594procedure TBGRANeoBorderStyle.SetFTopRight(AValue: TBGRANeoRoundRectangleOption);
595begin
596 if FTopRight = AValue then
597 Exit;
598 FTopRight := AValue;
599end;
600
601constructor TBGRANeoBorderStyle.Create(AOwner: TControl);
602begin
603 inherited Create;
604 FOwner := AOwner;
605 FInnerColor := clWhite;
606 FInnerAlpha := 255;
607 FInnerWidth := 0;
608 FOuterColor := clWhite;
609 FOuterAlpha := 255;
610 FOuterWidth := 0;
611 FRoundX := 0;
612 FRoundY := 0;
613 FTopLeft := rroRound;
614 FTopRight := rroRound;
615 FBottomLeft := rroRound;
616 FBottomRight := rroRound;
617end;
618
619destructor TBGRANeoBorderStyle.Destroy;
620begin
621 inherited Destroy;
622end;
623
624procedure TBGRANeoBorderStyle.Assign(Source: TPersistent);
625begin
626 if Source is TBGRANeoBorderStyle then
627 begin
628 FInnerColor := TBGRANeoBorderStyle(Source).InnerColor;
629 FInnerAlpha := TBGRANeoBorderStyle(Source).InnerColorAlpha;
630 FInnerWidth := TBGRANeoBorderStyle(Source).InnerWidth;
631 FOuterColor := TBGRANeoBorderStyle(Source).OuterColor;
632 FOuterAlpha := TBGRANeoBorderStyle(Source).OuterColorAlpha;
633 FOuterWidth := TBGRANeoBorderStyle(Source).OuterWidth;
634 FRoundX := TBGRANeoBorderStyle(Source).RoundX;
635 FRoundY := TBGRANeoBorderStyle(Source).RoundY;
636 FTopLeft := TBGRANeoBorderStyle(Source).TopLeft;
637 FTopRight := TBGRANeoBorderStyle(Source).TopRight;
638 FBottomLeft := TBGRANeoBorderStyle(Source).BottomLeft;
639 FBottomRight := TBGRANeoBorderStyle(Source).BottomRight;
640 end
641 else
642 inherited Assign(Source);
643end;
644
645function TBGRANeoBorderStyle.Options: TRoundRectangleOptions;
646var
647 tl, tr, br, bl: TRoundRectangleOptions;
648begin
649 case TopLeft of
650 rroBevel: tl := [rrTopLeftBevel];
651 rroSquare: tl := [rrTopLeftSquare];
652 rroRound: tl := [];
653 end;
654
655 case TopRight of
656 rroBevel: tr := [rrTopRightBevel];
657 rroSquare: tr := [rrTopRightSquare];
658 rroRound: tr := [];
659 end;
660
661 case BottomRight of
662 rroBevel: br := [rrBottomRightBevel];
663 rroSquare: br := [rrBottomRightSquare];
664 rroRound: br := [];
665 end;
666
667 case BottomLeft of
668 rroBevel: bl := [rrBottomLeftBevel];
669 rroSquare: bl := [rrBottomLeftSquare];
670 rroRound: bl := [];
671 end;
672
673 Result := tl + tr + br + bl;
674end;
675
676{ TBGRANeoGradientStyle }
677
678procedure TBGRANeoGradientStyle.SetFColor1(AValue: TColor);
679begin
680 if FColor1 = AValue then
681 Exit;
682 FColor1 := AValue;
683end;
684
685procedure TBGRANeoGradientStyle.SetFColor1Alpha(AValue: byte);
686begin
687 if FColor1Alpha = AValue then
688 Exit;
689 FColor1Alpha := AValue;
690end;
691
692procedure TBGRANeoGradientStyle.SetFColor2(AValue: TColor);
693begin
694 if FColor2 = AValue then
695 Exit;
696 FColor2 := AValue;
697end;
698
699procedure TBGRANeoGradientStyle.SetFColor2Alpha(AValue: byte);
700begin
701 if FColor1Alpha = AValue then
702 Exit;
703 FColor1Alpha := AValue;
704end;
705
706procedure TBGRANeoGradientStyle.SetFSinus(AValue: boolean);
707begin
708 if FSinus = AValue then
709 Exit;
710 FSinus := AValue;
711end;
712
713procedure TBGRANeoGradientStyle.SetFStyle(AValue: TGradientType);
714begin
715 if FStyle = AValue then
716 Exit;
717 FStyle := AValue;
718end;
719
720constructor TBGRANeoGradientStyle.Create(AOwner: TControl);
721begin
722 inherited Create;
723 FOwner := AOwner;
724 FColor1 := clWhite;
725 FColor1Alpha := 255;
726 FColor2 := clWhite;
727 FColor2Alpha := 255;
728 FStyle := gtLinear;
729 FSinus := False;
730end;
731
732destructor TBGRANeoGradientStyle.Destroy;
733begin
734 inherited Destroy;
735end;
736
737procedure TBGRANeoGradientStyle.Assign(Source: TPersistent);
738begin
739 if Source is TBGRANeoGradientStyle then
740 begin
741 FColor1 := TBGRANeoGradientStyle(Source).Color1;
742 FColor1Alpha := TBGRANeoGradientStyle(Source).Color1Alpha;
743 FColor2 := TBGRANeoGradientStyle(Source).Color2;
744 FColor2Alpha := TBGRANeoGradientStyle(Source).Color2Alpha;
745 FStyle := TBGRANeoGradientStyle(Source).Style;
746 FSinus := TBGRANeoGradientStyle(Source).Sinus;
747 end
748 else
749 inherited Assign(Source);
750end;
751
752{ TBGRANeoTextStyle }
753
754procedure TBGRANeoTextStyle.SetFAlpha(AValue: byte);
755begin
756 if FAlpha = AValue then
757 Exit;
758 FAlpha := AValue;
759end;
760
761procedure TBGRANeoTextStyle.SetFFont(AValue: TFont);
762begin
763 if FFont.IsEqual(AValue) then
764 exit;
765 FFont.Assign(AValue);
766end;
767
768procedure TBGRANeoTextStyle.SetFQuality(AValue: TBGRAFontQuality);
769begin
770 if FQuality = AValue then
771 Exit;
772 FQuality := AValue;
773end;
774
775constructor TBGRANeoTextStyle.Create(AOwner: TControl);
776begin
777 inherited Create;
778 FOwner := AOwner;
779 FAlpha := 255;
780 FFont := TFont.Create;
781 FQuality := fqSystemClearType;
782end;
783
784destructor TBGRANeoTextStyle.Destroy;
785begin
786 FFont.Free;
787 inherited Destroy;
788end;
789
790procedure TBGRANeoTextStyle.Assign(Source: TPersistent);
791begin
792 if Source is TBGRANeoTextStyle then
793 begin
794 FAlpha := TBGRANeoTextStyle(Source).Alpha;
795 FFont.Assign(TBGRANeoTextStyle(Source).Font);
796 FQuality := TBGRANeoTextStyle(Source).Quality;
797 end
798 else
799 inherited Assign(Source);
800end;
801
802{ TBGRANeoShadowStyle }
803
804procedure TBGRANeoShadowStyle.SetFAlpha(AValue: byte);
805begin
806 if FAlpha = AValue then
807 Exit;
808 FAlpha := AValue;
809end;
810
811procedure TBGRANeoShadowStyle.SetFColor(AValue: TColor);
812begin
813 if FColor = AValue then
814 Exit;
815 FColor := AValue;
816end;
817
818procedure TBGRANeoShadowStyle.SetFOffsetX(AValue: integer);
819begin
820 if FOffsetX = AValue then
821 Exit;
822 FOffsetX := AValue;
823end;
824
825procedure TBGRANeoShadowStyle.SetFOffsetY(AValue: integer);
826begin
827 if FOffsetY = AValue then
828 Exit;
829 FOffsetY := AValue;
830end;
831
832procedure TBGRANeoShadowStyle.SetFRadius(AValue: integer);
833begin
834 if FRadius = AValue then
835 Exit;
836 FRadius := AValue;
837end;
838
839constructor TBGRANeoShadowStyle.Create(AOwner: TControl);
840begin
841 inherited Create;
842 FOwner := AOwner;
843 FColor := clWhite;
844 FAlpha := 255;
845 FOffsetX := 0;
846 FOffsetY := 0;
847 FRadius := 0;
848end;
849
850destructor TBGRANeoShadowStyle.Destroy;
851begin
852 inherited Destroy;
853end;
854
855procedure TBGRANeoShadowStyle.Assign(Source: TPersistent);
856begin
857 if Source is TBGRANeoShadowStyle then
858 begin
859 FColor := TBGRANeoShadowStyle(Source).Color;
860 FAlpha := TBGRANeoShadowStyle(Source).Alpha;
861 FOffsetX := TBGRANeoShadowStyle(Source).OffsetX;
862 FOffsetY := TBGRANeoShadowStyle(Source).OffsetY;
863 FRadius := TBGRANeoShadowStyle(Source).Radius;
864 end
865 else
866 inherited Assign(Source);
867end;
868
869{ TCustomBGRANeoButton }
870
871procedure TCustomBGRANeoButton.SetFStyleActive(AValue: TBGRANeoButtonStyle);
872begin
873 if FStyleActive = AValue then
874 Exit;
875 FStyleActive := AValue;
876end;
877
878procedure TCustomBGRANeoButton.SetFStyleDisabled(AValue: TBGRANeoButtonStyle);
879begin
880 if FStyleDisabled = AValue then
881 Exit;
882 FStyleDisabled := AValue;
883end;
884
885procedure TCustomBGRANeoButton.SetFStyleHover(AValue: TBGRANeoButtonStyle);
886begin
887 if FStyleHover = AValue then
888 Exit;
889 FStyleHover := AValue;
890end;
891
892procedure TCustomBGRANeoButton.SetFStyleNormal(AValue: TBGRANeoButtonStyle);
893begin
894 if FStyleNormal = AValue then
895 Exit;
896 FStyleNormal := AValue;
897end;
898
899procedure TCustomBGRANeoButton.DrawButton;
900begin
901 if Enabled then
902 case FState of
903 gbsNormal:
904 begin
905 DrawBody(StyleNormal);
906 DrawText(StyleNormal);
907 end;
908 gbsHover:
909 begin
910 DrawBody(StyleHover);
911 DrawText(StyleHover);
912 end;
913 gbsActive:
914 begin
915 DrawBody(StyleActive);
916 DrawText(StyleActive);
917 end;
918 end
919 else
920 begin
921 DrawBody(StyleDisabled);
922 DrawText(StyleDisabled);
923 end;
924end;
925
926procedure TCustomBGRANeoButton.DrawBody(AStyle: TBGRANeoButtonStyle);
927begin
928 // nothing here
929end;
930
931procedure TCustomBGRANeoButton.DrawText(AStyle: TBGRANeoButtonStyle);
932begin
933 // nothing here
934end;
935
936procedure TCustomBGRANeoButton.Paint;
937begin
938 FBGRA.SetSize(Width, Height);
939 DrawButton;
940
941 {$IFDEF DEBUG}
942 Inc(FPaintCount);
943 FBGRA.TextOut(0, 0, IntToStr(FPaintCount), BGRAWhite);
944 FBGRA.TextOut(1, 1, IntToStr(FPaintCount), BGRABlack);
945 {$ENDIF}
946
947 FBGRA.Draw(Canvas, 0, 0, False);
948end;
949
950constructor TCustomBGRANeoButton.Create(AOwner: TComponent);
951begin
952 inherited Create(AOwner);
953 FBGRA := TBGRABitmap.Create;
954 FStyleNormal := TBGRANeoButtonStyle.Create(Self);
955 FStyleHover := TBGRANeoButtonStyle.Create(Self);
956 FStyleActive := TBGRANeoButtonStyle.Create(Self);
957 FStyleDisabled := TBGRANeoButtonStyle.Create(Self);
958end;
959
960destructor TCustomBGRANeoButton.Destroy;
961begin
962 FBGRA.Free;
963 FStyleNormal.Free;
964 FStyleHover.Free;
965 FStyleActive.Free;
966 FStyleDisabled.Free;
967 inherited Destroy;
968end;
969
970procedure TCustomBGRANeoButton.Assign(Source: TPersistent);
971begin
972 inherited Assign(Source);
973end;
974
975{ TGraphicButton }
976
977procedure TGraphicButton.DoClick;
978var
979 Form: TCustomForm;
980begin
981 if ModalResult <> mrNone then
982 begin
983 Form := GetParentForm(Self);
984 if Form <> nil then
985 Form.ModalResult := ModalResult;
986 end;
987end;
988
989procedure TGraphicButton.DoMouseDown;
990var
991 NewState: TGraphicButtonState;
992begin
993 NewState := gbsActive;
994
995 if NewState <> FState then
996 begin
997 FState := NewState;
998 Invalidate;
999 end;
1000end;
1001
1002procedure TGraphicButton.DoMouseUp;
1003var
1004 NewState: TGraphicButtonState;
1005 p: TPoint;
1006begin
1007 p := ScreenToClient(Mouse.CursorPos);
1008
1009 if (p.x >= 0) and (p.x <= Width) and (p.y >= 0) and (p.y <= Height) then
1010 NewState := gbsHover
1011 else
1012 NewState := gbsNormal;
1013
1014 if NewState <> FState then
1015 begin
1016 FState := NewState;
1017 Invalidate;
1018 end;
1019end;
1020
1021procedure TGraphicButton.DoMouseEnter;
1022var
1023 NewState: TGraphicButtonState;
1024begin
1025 if Enabled then
1026 NewState := gbsHover
1027 else
1028 begin
1029 FState := gbsNormal;
1030 NewState := FState;
1031 end;
1032
1033 if NewState <> FState then
1034 begin
1035 FState := NewState;
1036 Invalidate;
1037 end;
1038end;
1039
1040procedure TGraphicButton.DoMouseLeave;
1041var
1042 NewState: TGraphicButtonState;
1043begin
1044 if Enabled then
1045 NewState := gbsNormal
1046 else
1047 begin
1048 FState := gbsNormal;
1049 NewState := FState;
1050 end;
1051
1052 if NewState <> FState then
1053 begin
1054 FState := NewState;
1055 Invalidate;
1056 end;
1057end;
1058
1059procedure TGraphicButton.Click;
1060begin
1061 DoClick;
1062 inherited Click;
1063end;
1064
1065procedure TGraphicButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
1066 X, Y: integer);
1067begin
1068 inherited MouseDown(Button, Shift, X, Y);
1069 if Button = mbLeft then
1070 DoMouseDown;
1071end;
1072
1073procedure TGraphicButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
1074 X, Y: integer);
1075begin
1076 inherited MouseUp(Button, Shift, X, Y);
1077 DoMouseUp;
1078end;
1079
1080procedure TGraphicButton.MouseEnter;
1081begin
1082 inherited MouseEnter;
1083 DoMouseEnter;
1084end;
1085
1086procedure TGraphicButton.MouseLeave;
1087begin
1088 inherited MouseLeave;
1089 DoMouseLeave;
1090end;
1091
1092end.
1093
Note: See TracBrowser for help on using the repository browser.