source: trunk/Packages/bgracontrols/bgralabel.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 27.8 KB
Line 
1{ !! THIS CONTROL IS DEPRECATED! USE BCLABEL INSTEAD !!
2 TBGRALabel 1.01v
3 Description: Component TBGRALabel simulate TLabel
4 This component is based on TBGRAButton of Dibo
5 Create by Lucas Martín in 2011. codedeep at hotmail.com
6
7 Functionality:
8 - Caption with shadow or not
9 - Full alpha and antialias support or not
10 - WordWarp or not
11 - Caption with Property Editor Multiline
12
13 Copyright (C) 2011 Krzysztof Dibowski dibowski at interia.pl
14
15 This library is free software; you can redistribute it and/or modify it
16 under the terms of the GNU Library General Public License as published by
17 the Free Software Foundation; either version 2 of the License, or (at your
18 option) any later version with the following modification:
19
20 As a special exception, the copyright holders of this library give you
21 permission to link this library with independent modules to produce an
22 executable, regardless of the license terms of these independent modules,and
23 to copy and distribute the resulting executable under terms of your choice,
24 provided that you also meet, for each linked independent module, the terms
25 and conditions of the license of that module. An independent module is a
26 module which is not derived from or based on this library. If you modify
27 this library, you may extend this exception to your version of the library,
28 but you are not obligated to do so. If you do not wish to do so, delete this
29 exception statement from your version.
30
31 This program is distributed in the hope that it will be useful, but WITHOUT
32 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
33 FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
34 for more details.
35
36 You should have received a copy of the GNU Library General Public License
37 along with this library; if not, write to the Free Software Foundation,
38 Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
39}
40unit BGRALabel;
41
42{$mode objfpc}{$H+}
43
44interface
45
46uses
47 Classes, LResources, Forms, Controls, Graphics, Dialogs, BGRABitmap, BGRABitmapTypes,
48 Buttons, BGRAGradientScanner, LCLType, types, BCTypes;
49
50type
51
52 TBGRABackgroundStyle = (bbsClear, bbsColor, bbsGradient);
53
54 { TBGRABackground }
55
56 TBGRABackground = class(TPersistent)
57 private
58 FColor: TColor;
59 FColorOpacity: byte;
60 FGradient1: TBCGradient;
61 FGradient1EndPercent: single;
62 FGradient2: TBCGradient;
63 FOwner: TControl;
64 FStyle: TBGRABackgroundStyle;
65 FLightWidth: integer;
66 FLightOpacity: byte;
67 procedure SetColor(const AValue: TColor);
68 procedure SetColorOpacity(const AValue: byte);
69 procedure SetGradient1(const AValue: TBCGradient);
70 procedure SetGradient1EndPercent(const AValue: single);
71 procedure SetGradient2(const AValue: TBCGradient);
72 procedure SetLightOpacity(const AValue: byte);
73 procedure SetLightWidth(const AValue: integer);
74 procedure SetStyle(const AValue: TBGRABackgroundStyle);
75 public
76 constructor Create(AOwner: TControl);
77 destructor Destroy; override;
78
79 procedure Assign(Source: TPersistent); override;
80 published
81 //property Action;
82 property Color: TColor Read FColor Write SetColor default clDefault;
83 property ColorOpacity: byte Read FColorOpacity Write SetColorOpacity default 255;
84 property Gradient1: TBCGradient Read FGradient1 Write SetGradient1;
85 property Gradient2: TBCGradient Read FGradient2 Write SetGradient2;
86 property Gradient1EndPercent: single Read FGradient1EndPercent
87 Write SetGradient1EndPercent default 50;
88 property Style: TBGRABackgroundStyle Read FStyle Write SetStyle default bbsClear;
89 property LightWidth: integer Read FLightWidth Write SetLightWidth;
90 property LightOpacity: byte Read FLightOpacity Write SetLightOpacity;
91 end;
92
93 { TBGRALabel }
94
95 TBGRALabel = class(TGraphicControl)
96 private
97 { Private declarations }
98 FBGRA, FBGRAText, FBGRATextShadow: TBGRABitmap;
99 FBackground: TBGRABackground;
100 FBorderWidth: integer;
101 FMouseStage: TBCMouseState;
102 FRoundX: integer;
103 FRoundY: integer;
104 FTextAlign: TBGRATextAlign;
105 FTextAntialiasing: boolean;
106 FTextShadow: boolean;
107 FTextShadowAntialiasing: boolean;
108 FTextShadowColor: TColor;
109 FTextShadowColorOpacity: byte;
110 FTextShadowOffsetX: integer;
111 FTextShadowOffsetY: integer;
112 FTextShadowRadius: integer;
113 FTextVAlign: TBGRATextVAlign;
114 FGlobalOpacity: byte;
115 FTextApplyGlobalOpacity: boolean;
116 FWordWrap: boolean;
117 FFont: TFont;
118 procedure OnChangeFont(Sender: TObject);
119 procedure CalculateTextSize(MaxWidth: integer;
120 var NeededWidth, NeededHeight: integer);
121 procedure ConvertToGrayScale;
122 procedure DrawBackground(ABackground: TBGRABackground; ARect: TRect);
123 procedure DrawText(AFontColor: TColor; AFontStyle: TFontStyles = [];
124 AFontName: string = 'Default');
125 procedure SetBackground(const AValue: TBGRABackground);
126 procedure SetBorderWidth(const AValue: integer);
127 procedure SetRoundX(const AValue: integer);
128 procedure SetRoundY(const AValue: integer);
129 procedure SeTBGRATextAlign(const AValue: TBGRATextAlign);
130 procedure SetTextShadow(const AValue: boolean);
131 procedure SetTextAntialiasing(const AValue: boolean);
132 procedure SetTextShadowAntialiasing(const AValue: boolean);
133 procedure SetTextShadowColor(const AValue: TColor);
134 procedure SetTextShadowColorOpacity(const AValue: byte);
135 procedure SetTextShadowOffsetX(const AValue: integer);
136 procedure SetTextShadowOffsetY(const AValue: integer);
137 procedure SetTextShadowRadius(const AValue: integer);
138 procedure SeTBGRATextVAlign(const AValue: TBGRATextVAlign);
139 procedure SetGlobalOpacity(const AValue: byte);
140 procedure SetTextApplyGlobalOpacity(const AValue: boolean);
141 procedure UpdateSize;
142 procedure SetFont(const AValue: TFont);
143 protected
144 { Protected declarations }
145 procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
146 WithThemeSpace: boolean); override;
147 class function GetControlClassDefaultSize: TSize; override;
148 procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
149 X, Y: integer); override;
150 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
151 procedure MouseEnter; override;
152 procedure MouseLeave; override;
153 procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
154 procedure Paint; override;
155 procedure Resize; override;
156 procedure SetEnabled(Value: boolean); override;
157 procedure TextChanged; override;
158 procedure SetWordWrap(Value: boolean);
159 public
160 { Public declarations }
161 constructor Create(AOwner: TComponent); override;
162 destructor Destroy; override;
163
164 procedure Assign(Source: TPersistent); override;
165 published
166 { Published declarations }
167 property Action;
168 property AutoSize default True;
169 property Align;
170 property Anchors;
171 property Background: TBGRABackground Read FBackground Write SetBackground;
172 property BorderWidth: integer Read FBorderWidth Write SetBorderWidth default 1;
173 property BorderSpacing;
174 property Caption;
175 property ParentColor;
176 property Enabled;
177 property PopupMenu;
178 property RoundX: integer Read FRoundX Write SetRoundX default 1;
179 property RoundY: integer Read FRoundY Write SetRoundY default 1;
180 property TextAlign: TBGRATextAlign
181 Read FTextAlign Write SeTBGRATextAlign default btaLeft;
182 property TextVAlign: TBGRATextVAlign
183 Read FTextVAlign Write SeTBGRATextVAlign default btvaTop;
184 property TextAntialiasing: boolean Read FTextAntialiasing
185 Write SetTextAntialiasing default True;
186 property TextShadowAntialiasing: boolean
187 Read FTextShadowAntialiasing Write SetTextShadowAntialiasing default True;
188 property TextShadow: boolean Read FTextShadow Write SetTextShadow default True;
189 property TextShadowColor: TColor Read FTextShadowColor
190 Write SetTextShadowColor default clBlack;
191 property TextShadowColorOpacity: byte Read FTextShadowColorOpacity
192 Write SetTextShadowColorOpacity;
193 property TextShadowOffsetX: integer Read FTextShadowOffsetX
194 Write SetTextShadowOffsetX default 5;
195 property TextShadowOffsetY: integer Read FTextShadowOffsetY
196 Write SetTextShadowOffsetY default 5;
197 property TextShadowRadius: integer Read FTextShadowRadius
198 Write SetTextShadowRadius default 5;
199 property GlobalOpacity: byte Read FGlobalOpacity Write SetGlobalOpacity;
200 property TextApplyGlobalOpacity: boolean
201 Read FTextApplyGlobalOpacity Write SetTextApplyGlobalOpacity;
202 property Visible;
203 property WordWrap: boolean Read FWordWrap Write SetWordWrap default False;
204 property Font: TFont Read FFont Write SetFont;
205 published
206 property OnClick;
207 property OnDblClick;
208 property OnMouseDown;
209 property OnMouseEnter;
210 property OnMouseLeave;
211 property OnMouseMove;
212 property OnMouseUp;
213
214 end;
215
216procedure Register;
217
218implementation
219
220uses LCLIntf, LCLProc, BGRAPolygon, BGRAFillInfo, propedits, BCTools;
221
222 //const
223 //ARR_SIZE = 8;
224 //ARR_SPACE = ARR_SIZE + 8;
225
226procedure Register;
227begin
228 {$I bgralabel_icon.lrs}
229 RegisterComponents('BGRA Controls', [TBGRALabel]);
230 RegisterPropertyEditor(TypeInfo(TTranslateString), TBGRALabel,
231 'Caption', TStringMultilinePropertyEditor);
232end;
233
234{ TBGRABackground }
235
236procedure TBGRABackground.SetColor(const AValue: TColor);
237begin
238 if FColor = AValue then
239 exit;
240 FColor := AValue;
241
242 FOwner.Invalidate;
243end;
244
245procedure TBGRABackground.SetColorOpacity(const AValue: byte);
246begin
247 if FColorOpacity = AValue then
248 exit;
249 FColorOpacity := AValue;
250
251 FOwner.Invalidate;
252end;
253
254procedure TBGRABackground.SetGradient1(const AValue: TBCGradient);
255begin
256 if FGradient1 = AValue then
257 exit;
258 FGradient1.Assign(AValue);
259
260 FOwner.Invalidate;
261end;
262
263procedure TBGRABackground.SetGradient1EndPercent(const AValue: single);
264begin
265 if FGradient1EndPercent = AValue then
266 exit;
267 FGradient1EndPercent := AValue;
268
269 FOwner.Invalidate;
270end;
271
272procedure TBGRABackground.SetGradient2(const AValue: TBCGradient);
273begin
274 if FGradient2 = AValue then
275 exit;
276 FGradient2.Assign(AValue);
277
278 FOwner.Invalidate;
279end;
280
281procedure TBGRABackground.SetLightOpacity(const AValue: byte);
282begin
283 if FLightOpacity = AValue then
284 exit;
285 FLightOpacity := AValue;
286
287 FOwner.Invalidate;
288end;
289
290procedure TBGRABackground.SetLightWidth(const AValue: integer);
291begin
292 if FLightWidth = AValue then
293 exit;
294 FLightWidth := AValue;
295
296 FOwner.Invalidate;
297end;
298
299procedure TBGRABackground.SetStyle(const AValue: TBGRABackgroundStyle);
300begin
301 if FStyle = AValue then
302 exit;
303 FStyle := AValue;
304
305 FOwner.Invalidate;
306end;
307
308constructor TBGRABackground.Create(AOwner: TControl);
309begin
310 FOwner := AOwner;
311 FColor := clBtnFace;
312 FColorOpacity := 255;
313 FGradient1 := TBCGradient.Create(FOwner);
314 FGradient2 := TBCGradient.Create(FOwner);
315 FGradient1EndPercent := 35;
316 FStyle := bbsClear;
317 FLightOpacity := 64;
318 FLightWidth := 0;
319
320 inherited Create;
321end;
322
323destructor TBGRABackground.Destroy;
324begin
325 FGradient1.Free;
326 FGradient2.Free;
327 inherited Destroy;
328end;
329
330procedure TBGRABackground.Assign(Source: TPersistent);
331begin
332 if Source is TBGRABackground then
333 begin
334 FColor := TBGRABackground(Source).FColor;
335 FStyle := TBGRABackground(Source).FStyle;
336 FGradient1EndPercent := TBGRABackground(Source).FGradient1EndPercent;
337 FLightOpacity := TBGRABackground(Source).FLightOpacity;
338 FLightWidth := TBGRABackground(Source).FLightWidth;
339 FGradient1.Assign(TBGRABackground(Source).FGradient1);
340 FGradient2.Assign(TBGRABackground(Source).FGradient2);
341
342 FOwner.Invalidate;
343 FOwner.InvalidatePreferredSize;
344 FOwner.AdjustSize;
345 end
346 else
347 inherited Assign(Source);
348end;
349
350{ TBGRALabel }
351
352procedure TBGRALabel.SetFont(const AValue: TFont);
353begin
354 if FFont = AValue then
355 exit;
356 FFont.Assign(AValue);
357
358 Invalidate;
359 UpdateSize;
360end;
361
362procedure TBGRALabel.OnChangeFont(Sender: TObject);
363begin
364 Invalidate;
365 UpdateSize;
366end;
367
368procedure TBGRALabel.CalculateTextSize(MaxWidth: integer;
369 var NeededWidth, NeededHeight: integer);
370var
371 s: TSize;
372begin
373 if (Caption = '') or (FBGRA = nil) then
374 begin
375 NeededWidth := 1;
376 NeededHeight := 1;
377 Exit;
378 end;
379
380 Canvas.Font := FFont;
381 FBGRA.FontHeight := Canvas.TextHeight(Caption);
382 FBGRA.FontStyle := FFont.Style;
383 if FFont.Name = '' then
384 FBGRA.FontName := 'default'
385 else
386 FBGRA.FontName := FFont.Name;
387 s := FBGRA.TextSize(Caption);
388 if FTextShadow then
389 begin
390 NeededWidth := s.cx + Round(1.2 * FTextShadowRadius) + FTextShadowOffsetX;
391 NeededHeight := s.cy + Round(1.2 * FTextShadowRadius) + FTextShadowOffsetY;
392 end
393 else
394 begin
395 NeededWidth := s.cx;
396 NeededHeight := s.cy;
397 end;
398end;
399
400procedure TBGRALabel.ConvertToGrayScale;
401var
402 bounds: TRect;
403 px: PBGRAPixel;
404 xb, yb: integer;
405begin
406 bounds := FBGRA.GetImageBounds;
407 if (bounds.Right <= bounds.Left) or (bounds.Bottom <= Bounds.Top) then
408 exit;
409
410 for yb := bounds.Top to bounds.bottom - 1 do
411 begin
412 px := FBGRA.scanline[yb] + bounds.left;
413 for xb := bounds.left to bounds.right - 1 do
414 begin
415 px^ := BGRAToGrayscale(px^);
416 Inc(px);
417 end;
418 end;
419 FBGRA.InvalidateBitmap;
420end;
421
422procedure TBGRALabel.DrawText(AFontColor: TColor; AFontStyle: TFontStyles;
423 AFontName: string);
424var
425 //s: TSize;
426 //x, y, gx, gy: integer;
427 //gly: TBGRABitmap;
428 ATextRect{, ATextRectShadow}: TRect;
429 style: TTextStyle;
430
431begin
432 FBGRAText.SetSize(ClientWidth + FTextShadowOffsetX + 2 * FTextShadowRadius,
433 ClientHeight + FTextShadowOffsetY + 2 * FTextShadowRadius);
434 FBGRAText.Fill(BGRAPixelTransparent);
435 FBGRAText.FontAntialias := FTextAntialiasing;
436 Canvas.Font := FFont;
437 FBGRAText.FontHeight := Canvas.TextHeight(Caption);
438 FBGRAText.FontStyle := AFontStyle;
439 FBGRAText.FontName := AFontName;
440
441 //s := FBGRAText.TextSize(Caption);
442 //gx := 0;
443 //gy := 0;
444
445 ATextRect := ClientRect;
446 //ATextRectShadow := ATextRect;
447 // ATextRectShadow.
448 {$hints off}
449 FillChar(style, sizeof(style), 0);
450 {$hints on}
451
452 style.Wordbreak := FWordWrap;
453 style.ShowPrefix := False;
454 style.Clipping := True;
455
456 { X Position }
457 case FTextAlign of
458 btaLeft:
459 begin
460 //x := 5 + gx;
461 style.Alignment := taLeftJustify;
462 end;
463 btaCenter:
464 begin
465 //x := Round((ClientWidth)/2)-Round((s.cx)/2);
466 style.Alignment := taCenter;
467 end;
468 btaRight:
469 begin
470 //x := ClientWidth-5-s.cx;
471 style.Alignment := taRightJustify;
472 end;
473 end;
474
475 { Y position }
476 case FTextVAlign of
477 btvaTop:
478 begin
479 //y := 2+FBorderWidth;
480 style.Layout := tlTop;
481 end;
482 btvaCenter:
483 begin
484 //y := Round(ClientHeight/2) - Round(s.cy/2);
485 style.Layout := tlCenter;
486 end;
487 btvaBottom:
488 begin
489 //y := ClientHeight-FBorderWidth-2-s.cy;
490 style.Layout := tlBottom;
491 end;
492 end;
493
494 if FTextShadow then
495 begin
496 //FBGRATextShadow.SetSize(s.cx+2*FTextShadowRadius,s.cy+2*FTextShadowRadius);
497 FBGRATextShadow.SetSize(ClientWidth + FTextShadowOffsetX + 2 * FTextShadowRadius,
498 ClientHeight + FTextShadowOffsetY + 2 * FTextShadowRadius);
499 FBGRATextShadow.Fill(BGRAPixelTransparent);
500 FBGRATextShadow.FontAntialias := FTextShadowAntialiasing;
501 FBGRATextShadow.FontHeight := FBGRAText.FontHeight;
502 FBGRATextShadow.FontStyle := AFontStyle;
503 FBGRATextShadow.FontName := AFontName;
504
505 //FBGRATextShadow.TextOut(FTextShadowRadius,FTextShadowRadius,Caption,ColorToBGRA(ColorToRGB(FTextShadowColor),FTextShadowColorOpacity));
506 FBGRATextShadow.TextRect(ATextRect, FTextShadowRadius, FTextShadowRadius,
507 Caption, style, ColorToBGRA(ColorToRGB(FTextShadowColor),
508 FTextShadowColorOpacity));
509 BGRAReplace(FBGRATextShadow, FBGRATextShadow.FilterBlurRadial(
510 FTextShadowRadius, rbFast));
511 FBGRA.PutImage({x + }FTextShadowOffsetX - FTextShadowRadius,{ y +}
512 FTextShadowOffsetY - FTextShadowRadius, FBGRATextShadow,
513 dmDrawWithTransparency);
514 end;
515
516 FBGRA.Bitmap;
517 //FBGRAText.TextOut(x,y,Caption,ColorToBGRA(ColorToRGB(AFontColor)));
518 FBGRAText.TextRect(ATextRect, {x}0, {y}0, Caption, style,
519 ColorToBGRA(ColorToRGB(AFontColor)));
520
521 FBGRA.PutImage(0, 0, FBGRAText, dmDrawWithTransparency);
522end;
523
524procedure TBGRALabel.DrawBackground(ABackground: TBGRABackground; ARect: TRect);
525var
526 {borcolor,} backcolor: TBGRAPixel;
527 gra: TBGRAGradientScanner;
528 back: TBGRABitmap;
529 grect1, grect2: TRect;
530 multi: TBGRAMultishapeFiller;
531 fiLight: TFillBorderRoundRectInfo;
532begin
533 { Background color }
534 case ABackground.FStyle of
535 bbsClear: backcolor := BGRAPixelTransparent;
536 bbsColor: backcolor := ColorToBGRA(ColorToRGB(ABackground.FColor),
537 ABackground.FColorOpacity);
538 end;
539
540 case ABackground.FStyle of
541 bbsClear, bbsColor:
542 { Solid background color }
543 FBGRA.RoundRectAntialias(ARect.Left, ARect.Top, ARect.Right,
544 ARect.Bottom, FRoundX, FRoundY,
545 {borcolor}BGRAPixelTransparent, FBorderWidth, backcolor);
546 bbsGradient:
547 begin
548 { Using multishape filler to merge background gradient and border }
549 multi := TBGRAMultishapeFiller.Create;
550 multi.PolygonOrder := poFirstOnTop; { Border will replace background }
551
552 {if borcolor.alpha <> 0 then
553 Let the background be wider with transparent border
554 multi.AddRoundRectangleBorder(ARect.Left, ARect.Top, ARect.Right,
555 ARect.Bottom, FRoundX, FRoundY,
556 FBorderWidth, borcolor);}
557
558 { Gradients }
559 back := TBGRABitmap.Create(ClientWidth, ClientHeight, BGRAPixelTransparent);
560 grect1 := ARect;
561 grect2 := ARect;
562 { Gradient 1 }
563 if ABackground.FGradient1EndPercent > 0 then
564 begin
565 grect1.Bottom := Round((grect1.Bottom / 100) * ABackground.FGradient1EndPercent);
566 gra := CreateGradient(ABackground.FGradient1, grect1);
567 back.FillRect(grect1.Left, grect1.Top, grect1.Right, grect1.Bottom,
568 gra, dmSet
569 );
570 gra.Free;
571 end;
572 { Gradient 2 }
573 if ABackground.FGradient1EndPercent < 100 then
574 begin
575 if grect1.Bottom < ARect.Bottom then
576 grect2.Top := grect1.Bottom - 1;
577 gra := CreateGradient(ABackground.FGradient2, grect2);
578 back.FillRect(grect2.Left, grect2.Top, grect2.Right, grect2.Bottom,
579 gra, dmSet
580 );
581 gra.Free;
582 end;
583
584 multi.AddRoundRectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom,
585 FRoundX, FRoundY, back);
586
587 multi.Draw(FBGRA);
588 multi.Free;
589 back.Free;
590
591 if ABackground.LightWidth > 0 then
592 begin
593 //compute light position
594 fiLight := TFillBorderRoundRectInfo.Create(
595 ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, FRoundX,
596 FRoundY, FBorderWidth + ABackground.LightWidth, []);
597 //check if there is an inner position
598 if fiLight.InnerBorder <> nil then
599 with fiLight.InnerBorder do //fill with light
600 FBGRA.RoundRectAntialias(topleft.x, topleft.y, bottomright.x,
601 bottomright.y, radiusx, radiusY, BGRA(255, 255, 255,
602 ABackground.LightOpacity),
603 ABackground.LightWidth);
604 fiLight.Free;
605 end;
606 end;
607 end;
608end;
609
610procedure TBGRALabel.SetBackground(const AValue: TBGRABackground);
611begin
612 if FBackground = AValue then
613 exit;
614 FBackground.Assign(AValue);
615
616 Invalidate;
617end;
618
619procedure TBGRALabel.SetBorderWidth(const AValue: integer);
620begin
621 if FBorderWidth = AValue then
622 exit;
623 FBorderWidth := AValue;
624
625 Invalidate;
626 UpdateSize;
627end;
628
629procedure TBGRALabel.SetRoundX(const AValue: integer);
630begin
631 if FRoundX = AValue then
632 exit;
633 FRoundX := AValue;
634
635 Invalidate;
636end;
637
638procedure TBGRALabel.SetRoundY(const AValue: integer);
639begin
640 if FRoundY = AValue then
641 exit;
642 FRoundY := AValue;
643
644 Invalidate;
645end;
646
647procedure TBGRALabel.SeTBGRATextAlign(const AValue: TBGRATextAlign);
648begin
649 if FTextAlign = AValue then
650 exit;
651 FTextAlign := AValue;
652
653 Invalidate;
654end;
655
656procedure TBGRALabel.SetTextShadow(const AValue: boolean);
657begin
658 if FTextShadow = AValue then
659 exit;
660 FTextShadow := AValue;
661
662 Invalidate;
663 UpdateSize;
664end;
665
666procedure TBGRALabel.SetTextAntialiasing(const AValue: boolean);
667begin
668 if FTextAntialiasing = AValue then
669 exit;
670 FTextAntialiasing := AValue;
671
672 Invalidate;
673 UpdateSize;
674end;
675
676procedure TBGRALabel.SetTextShadowAntialiasing(const AValue: boolean);
677begin
678 if FTextShadowAntialiasing = AValue then
679 exit;
680 FTextShadowAntialiasing := AValue;
681
682 Invalidate;
683 UpdateSize;
684end;
685
686procedure TBGRALabel.SetTextShadowColor(const AValue: TColor);
687begin
688 if FTextShadowColor = AValue then
689 exit;
690 FTextShadowColor := AValue;
691
692 Invalidate;
693 UpdateSize;
694end;
695
696procedure TBGRALabel.SetTextShadowColorOpacity(const AValue: byte);
697begin
698 if FTextShadowColorOpacity = AValue then
699 exit;
700 FTextShadowColorOpacity := AValue;
701
702 Invalidate;
703 UpdateSize;
704end;
705
706procedure TBGRALabel.SetTextShadowOffsetX(const AValue: integer);
707begin
708 if FTextShadowOffsetX = AValue then
709 exit;
710 FTextShadowOffsetX := AValue;
711
712 Invalidate;
713 UpdateSize;
714end;
715
716procedure TBGRALabel.SetTextShadowOffsetY(const AValue: integer);
717begin
718 if FTextShadowOffsetY = AValue then
719 exit;
720 FTextShadowOffsetY := AValue;
721
722 Invalidate;
723 UpdateSize;
724end;
725
726procedure TBGRALabel.SetTextShadowRadius(const AValue: integer);
727begin
728 if FTextShadowRadius = AValue then
729 exit;
730 FTextShadowRadius := AValue;
731
732 Invalidate;
733 UpdateSize;
734end;
735
736procedure TBGRALabel.SeTBGRATextVAlign(const AValue: TBGRATextVAlign);
737begin
738 if FTextVAlign = AValue then
739 exit;
740 FTextVAlign := AValue;
741
742 Invalidate;
743end;
744
745procedure TBGRALabel.UpdateSize;
746begin
747 InvalidatePreferredSize;
748 AdjustSize;
749end;
750
751procedure TBGRALabel.SetWordWrap(Value: boolean);
752begin
753 if FWordWrap <> Value then
754 begin
755 FWordWrap := Value;
756 Invalidate;
757 UpdateSize;
758 end;
759end;
760
761procedure TBGRALabel.CalculatePreferredSize(
762 var PreferredWidth, PreferredHeight: integer;
763 WithThemeSpace: boolean);
764var
765 AWidth: integer;
766 //gh: integer = 0;
767 //gw: integer = 0;
768begin
769 {inherited CalculatePreferredSize(PreferredWidth, PreferredHeight,
770 WithThemeSpace); }
771
772 if (Parent = nil) or (not Parent.HandleAllocated) then
773 Exit;
774 if WidthIsAnchored and WordWrap then
775 AWidth := Width
776 else
777 AWidth := 10000;
778 CalculateTextSize(AWidth, PreferredWidth, PreferredHeight);
779
780 Inc(PreferredWidth, (FBorderWidth * 2) div 2);
781 Inc(PreferredHeight, (FBorderWidth * 2) div 2);
782
783end;
784
785class function TBGRALabel.GetControlClassDefaultSize: TSize;
786begin
787 Result.CX := 123;
788 Result.CY := 33;
789end;
790
791procedure TBGRALabel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
792begin
793 inherited MouseDown(Button, Shift, X, Y);
794 if csDesigning in ComponentState then
795 exit;
796
797 if (Button = mbLeft) and Enabled and (not (FMouseStage = msClicked)) then
798 begin
799 FMouseStage := msClicked;
800 Invalidate;
801 end;
802end;
803
804procedure TBGRALabel.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
805var
806 p: TPoint;
807begin
808 inherited MouseUp(Button, Shift, X, Y);
809 if csDesigning in ComponentState then
810 exit;
811
812 if (Button = mbLeft) and Enabled and (FMouseStage = msClicked) then
813 begin
814 FMouseStage := msHover;
815 Invalidate;
816 end;
817
818 if (PopupMenu <> nil) and Enabled then
819 begin
820 p := ClientToScreen(Point(X, Y));
821 PopupMenu.PopUp(p.x, p.y);
822 end;
823end;
824
825procedure TBGRALabel.MouseEnter;
826begin
827 if csDesigning in ComponentState then
828 exit;
829 FMouseStage := msHover;
830 Invalidate;
831 inherited MouseEnter;
832end;
833
834procedure TBGRALabel.MouseLeave;
835begin
836 if csDesigning in ComponentState then
837 exit;
838 FMouseStage := msNone;
839 Invalidate;
840 inherited MouseLeave;
841end;
842
843procedure TBGRALabel.MouseMove(Shift: TShiftState; X, Y: integer);
844begin
845 inherited MouseMove(Shift, X, Y);
846
847 Invalidate;
848end;
849
850procedure TBGRALabel.Paint;
851var
852 {bodya,} bodyn: TBGRABackground;
853 baserect: TRect;
854begin
855 //inherited Paint;
856 { Mouse stage }
857 {case FMouseStage of
858 msNormal: bodya := FBackground;
859 end;}
860
861 { Calculating base rect }
862 baserect := ClientRect;
863 Inc(baserect.Left, Round(FBorderWidth / 2));
864 Inc(baserect.Top, Round(FBorderWidth / 2));
865 Dec(baserect.Right, Round(FBorderWidth / 2) + 1);
866 Dec(baserect.Bottom, Round(FBorderWidth / 2) + 1);
867
868 { Clearing previous paint }
869 FBGRA.Fill(BGRAPixelTransparent);
870
871 { Drawing background label }
872 bodyn := FBackground;
873
874 DrawBackground(bodyn, Rect(baserect.Left, baserect.Top, baserect.Right,
875 baserect.Bottom));
876
877 if FTextApplyGlobalOpacity then
878 begin
879 { Drawing text }
880 DrawText(FFont.Color, FFont.Style, FFont.Name);
881 { Set global opacity }
882 FBGRA.ApplyGlobalOpacity(FGlobalOpacity);
883 end
884 else
885 begin
886 { Set global opacity }
887 FBGRA.ApplyGlobalOpacity(FGlobalOpacity);
888 { Drawing text }
889 DrawText(FFont.Color, FFont.Style, FFont.Name);
890 end;
891
892 { Convert to gray if not enabled }
893 if not Enabled then
894 ConvertToGrayScale;
895
896 { Finally drawing on canvas }
897 FBGRA.Draw(Self.Canvas, 0, 0, False);
898end;
899
900procedure TBGRALabel.Resize;
901begin
902 inherited Resize;
903 if FBGRA <> nil then
904 FBGRA.SetSize(Width, Height);
905end;
906
907procedure TBGRALabel.SetEnabled(Value: boolean);
908begin
909 inherited SetEnabled(Value);
910 Invalidate;
911end;
912
913procedure TBGRALabel.TextChanged;
914begin
915 inherited TextChanged;
916 Invalidate;
917 UpdateSize;
918end;
919
920procedure TBGRALabel.SetGlobalOpacity(const AValue: byte);
921begin
922 if FGlobalOpacity = AValue then
923 exit;
924 FGlobalOpacity := AValue;
925 Invalidate;
926end;
927
928procedure TBGRALabel.SetTextApplyGlobalOpacity(const AValue: boolean);
929begin
930 if FTextApplyGlobalOpacity = AValue then
931 exit;
932 FTextApplyGlobalOpacity := AValue;
933 Invalidate;
934end;
935
936{procedure TBGRALabel.WMLButtonDown(var Message: TLMLButtonDown);
937begin
938
939end; }
940
941constructor TBGRALabel.Create(AOwner: TComponent);
942begin
943 inherited Create(AOwner);
944 with GetControlClassDefaultSize do
945 SetInitialBounds(0, 0, CX, CY);
946 ControlStyle := ControlStyle + [csAcceptsControls];
947 FBGRA := TBGRABitmap.Create(Width, Height, BGRAPixelTransparent);
948 FBGRA.FontAntialias := True;
949 FBGRAText := TBGRABitmap.Create(Width, Height, BGRAPixelTransparent);
950 FTextAntialiasing := True;
951 FBGRAText.FontAntialias := FTextAntialiasing;
952 FBGRATextShadow := TBGRABitmap.Create(Width, Height, BGRAPixelTransparent);
953 FTextShadowAntialiasing := True;
954 FBGRATextShadow.FontAntialias := FTextShadowAntialiasing;
955 ParentColor := False;
956 FBackground := TBGRABackground.Create(Self);
957 FMouseStage := msNone;
958 FTextAlign := btaLeft;
959 FTextVAlign := btvaTop;
960 FTextShadow := True;
961 FTextShadowRadius := 5;
962 FTextShadowColor := clBlack;
963 FTextShadowColorOpacity := 255;
964 FTextShadowOffsetX := 5;
965 FTextShadowOffsetY := 5;
966 FBorderWidth := 1;
967 FRoundX := 1;
968 FRoundY := 1;
969 FGlobalOpacity := 255;
970 FTextApplyGlobalOpacity := False;
971 FWordWrap := False;
972 FFont := TFont.Create;
973 FFont.OnChange := @OnChangeFont;
974end;
975
976destructor TBGRALabel.Destroy;
977begin
978 FBGRA.Free;
979 FBGRAText.Free;
980 FBGRATextShadow.Free;
981 FBackground.Free;
982 FFont.Free;
983 inherited Destroy;
984end;
985
986procedure TBGRALabel.Assign(Source: TPersistent);
987begin
988 if Source is TBGRALabel then
989 begin
990 FBorderWidth := TBGRALabel(Source).FBorderWidth;
991 FRoundX := TBGRALabel(Source).FRoundX;
992 FRoundY := TBGRALabel(Source).FRoundY;
993 FTextAlign := TBGRALabel(Source).FTextAlign;
994 FTextAntialiasing := TBGRALabel(Source).FTextAntialiasing;
995 FTextVAlign := TBGRALabel(Source).FTextVAlign;
996 FTextShadow := TBGRALabel(Source).FTextShadow;
997 FTextShadowAntialiasing := TBGRALabel(Source).FTextShadowAntialiasing;
998 FTextShadowColor := TBGRALabel(Source).FTextShadowColor;
999 FTextShadowColorOpacity := TBGRALabel(Source).FTextShadowColorOpacity;
1000 FTextShadowOffsetX := TBGRALabel(Source).FTextShadowOffsetX;
1001 FTextShadowOffsetY := TBGRALabel(Source).FTextShadowOffsetY;
1002 FTextShadowRadius := TBGRALabel(Source).FTextShadowRadius;
1003 FGlobalOpacity := TBGRALabel(Source).FGlobalOpacity;
1004 FTextApplyGlobalOpacity := TBGRALabel(Source).FTextApplyGlobalOpacity;
1005 FWordWrap := TBGRALabel(Source).FWordWrap;
1006
1007 FFont.Assign(TBGRALabel(Source).FFont);
1008 FBackground.Assign(TBGRALabel(Source).FBackground);
1009
1010 Invalidate;
1011 UpdateSize;
1012 end
1013 else
1014 inherited Assign(Source);
1015end;
1016
1017end.
Note: See TracBrowser for help on using the repository browser.