1 // SPDX-License-Identifier: LGPL-3.0-only (modified to allow linking)
2 { Common types for BGRA Controls package
3 
4   originally written in 2011 by Krzysztof Dibowski dibowski at interia.pl
5 }
6 {******************************* CONTRIBUTOR(S) ******************************
7 - Edivando S. Santos Brasil | mailedivando@gmail.com
8   (Compatibility with delphi VCL 11/2018)
9 
10 ***************************** END CONTRIBUTOR(S) *****************************}
11 unit BCTypes;
12 
13 {$I bgracontrols.inc}
14 
15 interface
16 
17 uses
18   Classes, Controls, {$IFNDEF FPC}Types, Windows, BGRAGraphics, GraphType, FPImage, {$ENDIF}
19   BGRABitmap, BGRABitmapTypes, Graphics, BCBasectrls;
20 
21 type
22 
23   {$IFDEF FPC}
24     {$IFDEF CPU64}
25     BGRAPtrInt      = PtrInt;           //    Cardinal;//PtrInt;
26     BGRAPtrUInt     = PtrUInt;          //    Cardinal;//PtrUInt;
27     {$ELSE}
28     BGRAPtrInt      = PtrInt;           //    LongInt;//PtrInt;
29     BGRAPtrUInt     = PtrUInt;          //    Cardinal;//PtrUInt;
30     BGRAQWord       = Int64;            //    Cardinal;//QWord;
31     {$ENDIF}
32     BGRAWord        = Word;                        //    Word;
33     PBGRAWord       = PWord;                       //    PWord;
34     BGRADWord       = DWord;          //    Cardinal;  //DWord;
35     BGRALongWord    = LongWord;       //    Cardinal;  //LongWord;
36     PBGRAQWord      = PQWord;         //    PCardinal; //PQWord;
37     PBGRADWord      = PDWord;         //    PCardinal; //PDWord;
38     PBGRALongWord   = PLongWord;      //    PCardinal; //PLongWord;
39     BGRANativeInt   = NativeInt;      //    NativeInt;  //NativeInt;
40     BGRANativeUInt  = NativeUInt;     //    Cardinal;  //NativeUInt;
41     BGRALongInt     = LongInt;        //    Cardinal;  //LongInt;
42     BGRAInt64       = Int64;                       //    Int64;
43     BGRAUInt64      = Int64;                      //    UInt64;
44     BGRACardinal    = Cardinal;                    //    Cardinal;
45     PBGRACardinal   = PCardinal;                   //    PCardinal;
46 
47     HDC             = {$IFDEF BGRABITMAP_USE_LCL}LCLType.HDC{$ELSE}BGRAPtrUInt{$ENDIF};
48     PPTrint         = ^PtrInt;
49   {$ELSE}
50     ValReal         = Extended;
51     {$IFDEF CPU64}
52     BGRAPtrInt      = Int64;
53     BGRAPtrUInt     = QWord;
54     {$ELSE}
55     BGRAPtrInt      = LongInt;        //      LongInt;//LongInt;
56     BGRAPtrUInt     = LongWord;       //      Cardinal;//LongWord;
57     BGRAQWord       = Int64;          //      Cardinal;//LongWord;
58     {$ENDIF}
59     BGRAWord        = Word;           //                 Word;
60     PBGRAWord       = PWord;          //                 PWord;
61     BGRADWord       = DWord;          //      Cardinal;//DWord;
62     BGRALongWord    = LongWord;       //      Cardinal;//LongWord;
63     PBGRAPtrInt     = ^BGRAPtrInt;    //     PCardinal;//^BGRAPtrInt;
64     PBGRAPtrUInt    = ^BGRAPtrUInt;   //     PCardinal;//^BGRAPtrUInt;
65     PBGRAQWord      = ^BGRAQWord;     //     PCardinal;//^BGRAQWord;
66     PBGRADWord      = PDWord;         //     PCardinal;//PDWord;
67     PBGRALongWord   = PLongWord;      //     PCardinal;//PLongWord;
68     BGRANativeInt   = NativeInt;      //     NativeInt;//NativeInt;
69     BGRANativeUInt  = NativeUInt;     //      Cardinal;//NativeUInt;
70     BGRALongInt     = LongInt;        //                 LongInt;
71     BGRAInt64       = Int64;          //                 Int64;
72     BGRAUInt64      = Int64;          //                 UInt64;
73     BGRACardinal    = Cardinal;       //                 Cardinal;
74     PBGRACardinal   = PCardinal;      //                 PCardinal;
75 
76     HDC             = Windows.HDC;    //
77     PUnicodeChar    = Windows.PWChar; //
78     UnicodeChar     = Windows.WCHAR;  //
79 (*    ValReal         = FPImage.ValReal;
80     {$IFDEF CPU64}     //WORD = 2 bytes = 4 nybbles = 16 bits    for 32bits
81     BGRAPtrInt      = FPImage.BGRAPtrInt;
82     BGRAPtrUInt     = FPImage.BGRAPtrUInt;  //QWORD = 2 DWORDs = 4 WORDs = �.. = 64 bits       for 32bits
83     {$ELSE}               //BGRADWord = 2 WORDs = 4 bytes = 8 nybbles = 32 bits   for 32bits
84     BGRAPtrInt      = FPImage.BGRAPtrInt;
85     BGRAPtrUInt     = FPImage.BGRAPtrUInt;
86     BGRAQWord       = FPImage.BGRAQWord;
87     {$ENDIF}
88     BGRADWord       = FPImage.BGRADWord;
89     BGRALongWord    = FPImage.BGRALongWord;
90     PBGRAPtrInt     = FPImage.PBGRAPtrInt;
91     PBGRAPtrUInt    = FPImage.PBGRAPtrUInt;
92     PBGRAQWord      = FPImage.PBGRAQWord;
93     PBGRADWord      = FPImage.PBGRADWord;
94     HDC             = FPImage.HDC;
95     BGRANativeInt   = FPImage.BGRANativeInt;
96     PBGRALongWord   = FPImage.PBGRALongWord;
97 
98     PUnicodeChar    = FPImage.PUnicodeChar;
99     UnicodeChar     = FPImage.UnicodeChar;    *)
100   {$ENDIF}
101 
102 
103   TBCMouseState = (msNone, msHover, msClicked);
104   TBCAlignment = (bcaLeftTop, bcaLeftCenter, bcaLeftBottom,
105     bcaCenterTop, bcaCenter, bcaCenterBottom, bcaRightTop, bcaRightCenter,
106     bcaRightBottom);
107   TBCBackgroundStyle = (bbsClear, bbsColor, bbsGradient);
108   TBCBorderStyle = (bboNone, bboSolid);
109   TBCArrowDirection = (badLeft, badRight, badUp, badDown);
110   TBCStretchMode = (smNone, smShrink, smStretch, smCover);
111   TBCCanvasScaleMode = (csmAuto, csmScaleBitmap, csmFullResolution);
112   TBGRATextAlign = (btaLeft, btaCenter, btaRight); // deprecated
113   TBGRATextVAlign = (btvaTop, btvaCenter, btvaBottom); // deprecated
114   TBGRARedrawEvent = procedure(Sender: TObject; Bitmap: TBGRABitmap) of object;
115 
116 type
117   { TBCGradient }
118 
119   TBCGradient = class(TBCProperty)
120   private
121     FColorCorrection: boolean;
122     FDrawMode: TDrawMode;
123     FGradientType: TGradientType;
124     FEndColor: TColor;
125     FEndColorOpacity: byte;
126     FPoint1XPercent: single;
127     FPoint1YPercent: single;
128     FPoint2XPercent: single;
129     FPoint2YPercent: single;
130     FSinus: boolean;
131     FStartColor: TColor;
132     FStartColorOpacity: byte;
133     procedure SetColorCorrection(const AValue: boolean);
134     procedure SetDrawMode(const AValue: TDrawMode);
135     procedure SetEndColor(const AValue: TColor);
136     procedure SetEndColorOpacity(const AValue: byte);
137     procedure SetGradientType(const AValue: TGradientType);
138     procedure SetPoint1XPercent(const AValue: single);
139     procedure SetPoint1YPercent(const AValue: single);
140     procedure SetPoint2XPercent(const AValue: single);
141     procedure SetPoint2YPercent(const AValue: single);
142     procedure SetSinus(const AValue: boolean);
143     procedure SetStartColor(const AValue: TColor);
144     procedure SetStartColorOpacity(const AValue: byte);
145   public
146     constructor Create(AControl: TControl); override;
147 
148     procedure Assign(Source: TPersistent); override;
149     procedure Scale(AScale: single);
150   published
151     property StartColor: TColor read FStartColor write SetStartColor;
152     property StartColorOpacity: byte read FStartColorOpacity write SetStartColorOpacity default 255;
153     property DrawMode: TDrawMode read FDrawMode write SetDrawMode default dmSet;
154     property EndColor: TColor read FEndColor write SetEndColor;
155     property EndColorOpacity: byte read FEndColorOpacity write SetEndColorOpacity default 255;
156     property ColorCorrection: boolean read FColorCorrection write SetColorCorrection default true;
157     property GradientType: TGradientType read FGradientType write SetGradientType;
158     property Point1XPercent: single read FPoint1XPercent write SetPoint1XPercent default EmptySingle;
159     property Point1YPercent: single read FPoint1YPercent write SetPoint1YPercent default EmptySingle;
160     property Point2XPercent: single read FPoint2XPercent write SetPoint2XPercent default EmptySingle;
161     property Point2YPercent: single read FPoint2YPercent write SetPoint2YPercent default EmptySingle;
162     property Sinus: boolean read FSinus write SetSinus default false;
163   end;
164 
165   { TBCFont }
166 
167   TBCFont = class(TBCProperty)
168   private
169     FColor: TColor;
170     FEndEllipsis: boolean;
171     FFontQuality: TBGRAFontQuality;
172     FHeight: integer;
173     FName: string;
174     FPaddingBottom: integer;
175     FPaddingLeft: integer;
176     FPaddingRight: integer;
177     FPaddingTop: integer;
178     FShadow: boolean;
179     FShadowColor: TColor;
180     FShadowColorOpacity: byte;
181     FShadowOffsetX: shortint;
182     FShadowOffsetY: shortint;
183     FShadowRadius: byte;
184     FSingleLine: boolean;
185     FStyle: TFontStyles;
186     FTextAlignment: TBCAlignment;
187     FWordBreak: boolean;
IsNamStorednull188     function IsNamStored: boolean;
189     procedure SetColor(AValue: TColor);
190     procedure SetEndEllipsis(AValue: boolean);
191     procedure SetFontQuality(AValue: TBGRAFontQuality);
192     procedure SetHeight(AValue: integer);
193     procedure SetName(AValue: string);
194     procedure SetPaddingBottom(AValue: integer);
195     procedure SetPaddingLeft(AValue: integer);
196     procedure SetPaddingRight(AValue: integer);
197     procedure SetPaddingTop(AValue: integer);
198     procedure SetShadow(AValue: boolean);
199     procedure SetShadowColor(AValue: TColor);
200     procedure SetShadowColorOpacity(AValue: byte);
201     procedure SetShadowOffsetX(AValue: shortint);
202     procedure SetShadowOffsetY(AValue: shortint);
203     procedure SetShadowRadius(AValue: byte);
204     procedure SetSingleLine(AValue: boolean);
205     procedure SetStyle(AValue: TFontStyles);
206     procedure SetTextAlignment(AValue: TBCAlignment);
207     procedure SetWordBreak(AValue: boolean);
208   public
209     constructor Create(AControl: TControl); override;
210     procedure Assign(Source: TPersistent); override;
211     procedure Scale(AScale: single; APreserveDefaultHeight: boolean = true);
212   published
213     property Color: TColor read FColor write SetColor;
214     property EndEllipsis: boolean read FEndEllipsis write SetEndEllipsis default false;
215     property FontQuality: TBGRAFontQuality read FFontQuality write SetFontQuality;
216     property Height: integer read FHeight write SetHeight default 0;
217     property Name: string read FName write SetName stored IsNamStored;
218     property SingleLine: boolean read FSingleLine write SetSingleLine default true;
219     property Shadow: boolean read FShadow write SetShadow;
220     property ShadowColor: TColor read FShadowColor write SetShadowColor default clBlack;
221     property ShadowColorOpacity: byte read FShadowColorOpacity
222       write SetShadowColorOpacity default 255;
223     property ShadowRadius: byte read FShadowRadius write SetShadowRadius;
224     property ShadowOffsetX: shortint read FShadowOffsetX write SetShadowOffsetX;
225     property ShadowOffsetY: shortint read FShadowOffsetY write SetShadowOffsetY;
226     property Style: TFontStyles read FStyle write SetStyle;
227     property TextAlignment: TBCAlignment read FTextAlignment write SetTextAlignment default bcaCenter;
228     property WordBreak: boolean read FWordBreak write SetWordBreak default false;
229     property PaddingLeft: integer read FPaddingLeft write SetPaddingLeft default 0;
230     property PaddingRight: integer read FPaddingRight write SetPaddingRight default 0;
231     property PaddingTop: integer read FPaddingTop write SetPaddingTop default 0;
232     property PaddingBottom: integer read FPaddingBottom write SetPaddingBottom default 0;
233   end;
234 
235   { TBCBackground }
236 
237   TBCBackground = class(TBCProperty)
238   private
239     FColor: TColor;
240     FColorOpacity: byte;
241     FGradient1: TBCGradient;
242     FGradient1EndPercent: single;
243     FGradient2: TBCGradient;
244     FStyle: TBCBackgroundStyle;
245     procedure OnChangeChildProperty({%H-}Sender: TObject; AData: PtrInt);
246     procedure SetColor(AValue: TColor);
247     procedure SetColorOpacity(AValue: byte);
248     procedure SetGradient1(AValue: TBCGradient);
249     procedure SetGradient1EndPercent(AValue: single);
250     procedure SetGradient2(AValue: TBCGradient);
251     procedure SetStyle(AValue: TBCBackgroundStyle);
252   public
253     constructor Create(AControl: TControl); override;
254     destructor Destroy; override;
255 
256     procedure Assign(Source: TPersistent); override;
257     procedure Scale(AScale: single);
258   published
259     property Color: TColor read FColor write SetColor default clBlack;
260     property ColorOpacity: byte read FColorOpacity write SetColorOpacity default 255;
261     property Gradient1: TBCGradient read FGradient1 write SetGradient1;
262     property Gradient2: TBCGradient read FGradient2 write SetGradient2;
263     property Gradient1EndPercent: single read FGradient1EndPercent write SetGradient1EndPercent;
264     property Style: TBCBackgroundStyle read FStyle write SetStyle;
265   end;
266 
267   { TBCBorder }
268 
269   TBCBorder = class(TBCProperty)
270   private
271     FColor: TColor;
272     FColorOpacity: byte;
273     FLightColor: TColor;
274     FLightOpacity: byte;
275     FLightWidth: integer;
276     FStyle: TBCBorderStyle;
277     FWidth: integer;
278     procedure SetColor(AValue: TColor);
279     procedure SetColorOpacity(AValue: byte);
280     procedure SetLightColor(AValue: TColor);
281     procedure SetLightOpacity(AValue: byte);
282     procedure SetLightWidth(AValue: integer);
283     procedure SetStyle(AValue: TBCBorderStyle);
284     procedure SetWidth(AValue: integer);
285   public
286     constructor Create(AControl: TControl); override;
287     procedure Assign(Source: TPersistent); override;
288     procedure Scale(AScale: single);
289   published
290     property Color: TColor read FColor write SetColor default clBlack;
291     property ColorOpacity: byte read FColorOpacity write SetColorOpacity default 255;
292     property LightColor: TColor read FLightColor write SetLightColor default clWhite;
293     property LightOpacity: byte read FLightOpacity write SetLightOpacity default 255;
294     property LightWidth: integer read FLightWidth write SetLightWidth default 0;
295     property Style: TBCBorderStyle read FStyle write SetStyle;
296     property Width: integer read FWidth write SetWidth default 1;
297   end;
298 
299   { TBCRounding }
300 
301   TBCRounding = class(TBCProperty)
302   private
303     FRoundOptions: TRoundRectangleOptions;
304     FRoundX: byte;
305     FRoundY: byte;
306     procedure SetRoundOptions(AValue: TRoundRectangleOptions);
307     procedure SetRoundX(AValue: byte);
308     procedure SetRoundY(AValue: byte);
309   public
310     constructor Create(AControl: TControl); override;
311     procedure Assign(Source: TPersistent); override;
312     procedure Scale(AScale: single);
313   published
314     property RoundX: byte read FRoundX write SetRoundX;
315     property RoundY: byte read FRoundY write SetRoundY;
316     property RoundOptions: TRoundRectangleOptions
317       read FRoundOptions write SetRoundOptions default [];
318   end;
319 
320   { TBCPixel }
321 
322   TBCPixel = class(TBCProperty)
323   private
324     FPixel: TBGRAPixel;
325   public
326     { Constructor }
327     constructor Create(AControl: TControl); overload; override;
328     constructor Create(AControl: TControl; APixel: TBGRAPixel); overload;
329     constructor Create(AControl: TControl; AColor: TColor); overload;
330     { Assign values to Pixel }
331     procedure Assign(Source: TPersistent); overload;  override;
332     procedure Assign(Source: TBGRAPixel); overload;
333     procedure Assign(Source: TColor; Opacity: byte = 255);overload;
334     procedure Assign(Source: string); overload;
335     { Read values }
336     property Pixel: TBGRAPixel read FPixel write FPixel;
Colornull337     function Color: TColor;
Hexnull338     function Hex: string;
339     { Color functions }
340     procedure ApplyLightness(lightness: word);
341     procedure ApplyIntensity(lightness: longword);
342     procedure ToGrayscale;
343   published
344     { Streaming }
345     property Red: byte read FPixel.red write FPixel.red;
346     property Green: byte read FPixel.green write FPixel.green;
347     property Blue: byte read FPixel.blue write FPixel.blue;
348     property Alpha: byte read FPixel.alpha write FPixel.alpha;
349   end;
350 
351 {const
352   DEF_START_COL      = $00EFE6D2;
353   DEF_END_COL        = $00C87511;
354   DEF_BORD_COL       = $00AB713B;
355   DEF_BORD_COL_HOVER = $00D7B697;
356   DEF_FONT_COLOR     = $0072412A; }
357 
358 implementation
359 
360 uses math;
361 
362 { TBCPixel }
363 
364 constructor TBCPixel.Create(AControl: TControl);
365 begin
366   inherited Create(AControl);
367 end;
368 
369 constructor TBCPixel.Create(AControl: TControl; APixel: TBGRAPixel);
370 begin
371   inherited Create(AControl);
372   Pixel := APixel;
373 end;
374 
375 constructor TBCPixel.Create(AControl: TControl; AColor: TColor);
376 begin
377   inherited Create(AControl);
378   Assign(AColor);
379 end;
380 
381 procedure TBCPixel.Assign(Source: TPersistent);
382 begin
383   if Source is TBCPixel then
384     Pixel := TBCPixel(Source).Pixel
385   else
386     inherited Assign(Source);
387 end;
388 
389 procedure TBCPixel.Assign(Source: TBGRAPixel);
390 begin
391   Pixel := Source;
392 end;
393 
394 procedure TBCPixel.Assign(Source: TColor; Opacity: byte);
395 begin
396   Pixel.FromColor(Source, Opacity);
397 end;
398 
399 procedure TBCPixel.Assign(Source: string);
400 begin
401   Pixel := StrToBGRA(Source);
402 end;
403 
TBCPixel.Colornull404 function TBCPixel.Color: TColor;
405 begin
406   Result := Pixel;
407 end;
408 
Hexnull409 function TBCPixel.Hex: string;
410 begin
411   Result := Pixel.ToString;
412 end;
413 
414 procedure TBCPixel.ApplyLightness(lightness: word);
415 begin
416   Pixel := ApplyLightnessFast(Pixel, lightness);
417 end;
418 
419 procedure TBCPixel.ApplyIntensity(lightness: longword);
420 begin
421   Pixel := ApplyIntensityFast(Pixel, lightness);
422 end;
423 
424 procedure TBCPixel.ToGrayscale;
425 begin
426   Pixel := BGRAToGrayscale(Pixel);
427 end;
428 
429 { TBCRounding }
430 
431 procedure TBCRounding.SetRoundOptions(AValue: TRoundRectangleOptions);
432 begin
433   if FRoundOptions = AValue then
434     Exit;
435   FRoundOptions := AValue;
436 
437   Change;
438 end;
439 
440 procedure TBCRounding.SetRoundX(AValue: byte);
441 begin
442   if FRoundX = AValue then
443     Exit;
444   FRoundX := AValue;
445 
446   Change;
447 end;
448 
449 procedure TBCRounding.SetRoundY(AValue: byte);
450 begin
451   if FRoundY = AValue then
452     Exit;
453   FRoundY := AValue;
454 
455   Change;
456 end;
457 
458 constructor TBCRounding.Create(AControl: TControl);
459 begin
460   inherited Create(AControl);
461 
462   FRoundX := 1;
463   FRoundY := 1;
464   FRoundOptions := [];
465 end;
466 
467 procedure TBCRounding.Assign(Source: TPersistent);
468 begin
469   if Source is TBCRounding then
470   begin
471     FRoundX := TBCRounding(Source).FRoundX;
472     FRoundY := TBCRounding(Source).FRoundY;
473     FRoundOptions := TBCRounding(Source).FRoundOptions;
474   end
475   else
476     inherited Assign(Source);
477 end;
478 
479 procedure TBCRounding.Scale(AScale: single);
480 begin
481   RoundX := min(high(RoundX), round(RoundX * AScale));
482   RoundY := min(high(RoundY), round(RoundY * AScale));
483 end;
484 
485 { TBCGradient }
486 
487 procedure TBCGradient.SetColorCorrection(const AValue: boolean);
488 begin
489   if FColorCorrection = AValue then
490     exit;
491   FColorCorrection := AValue;
492 
493   Change;
494 end;
495 
496 procedure TBCGradient.SetDrawMode(const AValue: TDrawMode);
497 begin
498   if FDrawMode = AValue then
499     exit;
500   FDrawMode := AValue;
501 
502   Change;
503 end;
504 
505 procedure TBCGradient.SetEndColor(const AValue: TColor);
506 begin
507   if FEndColor = AValue then
508     exit;
509   FEndColor := AValue;
510 
511   Change;
512 end;
513 
514 procedure TBCGradient.SetEndColorOpacity(const AValue: byte);
515 begin
516   if FEndColorOpacity = AValue then
517     exit;
518   FEndColorOpacity := AValue;
519 
520   Change;
521 end;
522 
523 procedure TBCGradient.SetGradientType(const AValue: TGradientType);
524 begin
525   if FGradientType = AValue then
526     exit;
527   FGradientType := AValue;
528 
529   Change;
530 end;
531 
532 procedure TBCGradient.SetPoint1XPercent(const AValue: single);
533 begin
534   if FPoint1XPercent = AValue then
535     exit;
536   FPoint1XPercent := AValue;
537 
538   Change;
539 end;
540 
541 procedure TBCGradient.SetPoint1YPercent(const AValue: single);
542 begin
543   if FPoint1YPercent = AValue then
544     exit;
545   FPoint1YPercent := AValue;
546 
547   Change;
548 end;
549 
550 procedure TBCGradient.SetPoint2XPercent(const AValue: single);
551 begin
552   if FPoint2XPercent = AValue then
553     exit;
554   FPoint2XPercent := AValue;
555 
556   Change;
557 end;
558 
559 procedure TBCGradient.SetPoint2YPercent(const AValue: single);
560 begin
561   if FPoint2YPercent = AValue then
562     exit;
563   FPoint2YPercent := AValue;
564 
565   Change;
566 end;
567 
568 procedure TBCGradient.SetSinus(const AValue: boolean);
569 begin
570   if FSinus = AValue then
571     exit;
572   FSinus := AValue;
573 
574   Change;
575 end;
576 
577 procedure TBCGradient.SetStartColor(const AValue: TColor);
578 begin
579   if FStartColor = AValue then
580     exit;
581   FStartColor := AValue;
582 
583   Change;
584 end;
585 
586 procedure TBCGradient.SetStartColorOpacity(const AValue: byte);
587 begin
588   if FStartColorOpacity = AValue then
589     exit;
590   FStartColorOpacity := AValue;
591 
592   Change;
593 end;
594 
595 constructor TBCGradient.Create(AControl: TControl);
596 begin
597   FStartColor := clWhite;
598   FStartColorOpacity := 255;
599   FDrawMode := dmSet;
600   FEndColor := clBlack;
601   FEndColorOpacity := 255;
602   FGradientType := gtLinear;
603   FColorCorrection := True;
604   FSinus := False;
605 
606   FPoint1XPercent := 0;
607   FPoint1YPercent := 0;
608   FPoint2XPercent := 0;
609   FPoint2YPercent := 100;
610 
611   inherited Create(AControl);
612 end;
613 
614 procedure TBCGradient.Assign(Source: TPersistent);
615 begin
616   if Source is TBCGradient then
617   begin
618     FStartColor := TBCGradient(Source).FStartColor;
619     FStartColorOpacity := TBCGradient(Source).FStartColorOpacity;
620     FDrawMode := TBCGradient(Source).FDrawMode;
621     FEndColor := TBCGradient(Source).FEndColor;
622     FEndColorOpacity := TBCGradient(Source).FEndColorOpacity;
623     FColorCorrection := TBCGradient(Source).FColorCorrection;
624     FGradientType := TBCGradient(Source).FGradientType;
625     FPoint1XPercent := TBCGradient(Source).FPoint1XPercent;
626     FPoint1YPercent := TBCGradient(Source).FPoint1YPercent;
627     FPoint2XPercent := TBCGradient(Source).FPoint2XPercent;
628     FPoint2YPercent := TBCGradient(Source).FPoint2YPercent;
629     FSinus := TBCGradient(Source).FSinus;
630 
631     Change;
632   end
633   else
634     inherited Assign(Source);
635 end;
636 
637 procedure TBCGradient.Scale(AScale: single);
638 begin
639   //nothing
640 end;
641 
642 { TBCFont }
643 
IsNamStorednull644 function TBCFont.IsNamStored: boolean;
645 begin
646   Result := DefFontData.Name <> Name;
647 end;
648 
649 procedure TBCFont.SetColor(AValue: TColor);
650 begin
651   if FColor = AValue then
652     Exit;
653   FColor := AValue;
654 
655   Change;
656 end;
657 
658 procedure TBCFont.SetEndEllipsis(AValue: boolean);
659 begin
660   if FEndEllipsis = AValue then
661     Exit;
662   FEndEllipsis := AValue;
663 
664   Change;
665 end;
666 
667 procedure TBCFont.SetFontQuality(AValue: TBGRAFontQuality);
668 begin
669   if FFontQuality = AValue then
670     Exit;
671   FFontQuality := AValue;
672 
673   Change;
674 end;
675 
676 procedure TBCFont.SetHeight(AValue: integer);
677 begin
678   if FHeight = AValue then
679     Exit;
680   FHeight := AValue;
681 
682   Change;
683 end;
684 
685 procedure TBCFont.SetName(AValue: string);
686 begin
687   if FName = AValue then
688     Exit;
689   FName := AValue;
690   if FName = '' then
691     FName := 'default';
692   Change;
693 end;
694 
695 procedure TBCFont.SetPaddingBottom(AValue: integer);
696 begin
697   if FPaddingBottom=AValue then Exit;
698   FPaddingBottom:=AValue;
699 
700   Change;
701 end;
702 
703 procedure TBCFont.SetPaddingLeft(AValue: integer);
704 begin
705   if FPaddingLeft=AValue then Exit;
706   FPaddingLeft:=AValue;
707 
708   Change;
709 end;
710 
711 procedure TBCFont.SetPaddingRight(AValue: integer);
712 begin
713   if FPaddingRight=AValue then Exit;
714   FPaddingRight:=AValue;
715 
716   Change;
717 end;
718 
719 procedure TBCFont.SetPaddingTop(AValue: integer);
720 begin
721   if FPaddingTop=AValue then Exit;
722   FPaddingTop:=AValue;
723 
724   Change;
725 end;
726 
727 procedure TBCFont.SetShadow(AValue: boolean);
728 begin
729   if FShadow = AValue then
730     Exit;
731   FShadow := AValue;
732 
733   Change;
734 end;
735 
736 procedure TBCFont.SetShadowColor(AValue: TColor);
737 begin
738   if FShadowColor = AValue then
739     Exit;
740   FShadowColor := AValue;
741 
742   Change;
743 end;
744 
745 procedure TBCFont.SetShadowColorOpacity(AValue: byte);
746 begin
747   if FShadowColorOpacity = AValue then
748     Exit;
749   FShadowColorOpacity := AValue;
750 
751   Change;
752 end;
753 
754 procedure TBCFont.SetShadowOffsetX(AValue: shortint);
755 begin
756   if FShadowOffsetX = AValue then
757     Exit;
758   FShadowOffsetX := AValue;
759 
760   Change;
761 end;
762 
763 procedure TBCFont.SetShadowOffsetY(AValue: shortint);
764 begin
765   if FShadowOffsetY = AValue then
766     Exit;
767   FShadowOffsetY := AValue;
768 
769   Change;
770 end;
771 
772 procedure TBCFont.SetShadowRadius(AValue: byte);
773 begin
774   if FShadowRadius = AValue then
775     Exit;
776   FShadowRadius := AValue;
777 
778   Change;
779 end;
780 
781 procedure TBCFont.SetSingleLine(AValue: boolean);
782 begin
783   if FSingleLine = AValue then
784     Exit;
785   FSingleLine := AValue;
786 
787   if FSingleLine then
788     FWordBreak := False;
789 
790   Change;
791 end;
792 
793 procedure TBCFont.SetStyle(AValue: TFontStyles);
794 begin
795   if FStyle = AValue then
796     Exit;
797   FStyle := AValue;
798 
799   Change;
800 end;
801 
802 procedure TBCFont.SetTextAlignment(AValue: TBCAlignment);
803 begin
804   if FTextAlignment = AValue then
805     Exit;
806   FTextAlignment := AValue;
807 
808   Change;
809 end;
810 
811 procedure TBCFont.SetWordBreak(AValue: boolean);
812 begin
813   if FWordBreak = AValue then
814     Exit;
815   FWordBreak := AValue;
816 
817   if FWordBreak then
818     FSingleLine := False;
819 
820   Change;
821 end;
822 
823 constructor TBCFont.Create(AControl: TControl);
824 begin
825   inherited Create(AControl);
826 
827   // That is temporary. BGRABitmap draw some yellow background when fqSystemClearType.
828   // This problem is reported
829   {$IFDEF LCLGTK2}
830   FFontQuality := fqFineAntialiasing;
831   {$ELSE}
832   FFontQuality := fqSystemClearType;
833   {$ENDIF}
834   FShadow := False;
835   FShadowColor := clBlack;
836   FShadowColorOpacity := 255;
837   FShadowRadius := 5;
838   FShadowOffsetX := 5;
839   FShadowOffsetY := 5;
840   FHeight := 0;
841   FTextAlignment := bcaCenter;
842   FStyle := [];
843   FName := DefFontData.Name;
844   FColor := clDefault;
845   FWordBreak := False;
846   FSingleLine := True;
847   FEndEllipsis := False;
848 end;
849 
850 procedure TBCFont.Assign(Source: TPersistent);
851 begin
852   if Source is TBCFont then
853   begin
854     FColor := TBCFont(Source).FColor;
855     FEndEllipsis := TBCFont(Source).FEndEllipsis;
856     FFontQuality := TBCFont(Source).FFontQuality;
857     FHeight := TBCFont(Source).FHeight;
858     FName := TBCFont(Source).FName;
859     FSingleLine := TBCFont(Source).FSingleLine;
860     FShadow := TBCFont(Source).FShadow;
861     FShadowColor := TBCFont(Source).FShadowColor;
862     FShadowColorOpacity := TBCFont(Source).FShadowColorOpacity;
863     FShadowRadius := TBCFont(Source).FShadowRadius;
864     FShadowOffsetX := TBCFont(Source).FShadowOffsetX;
865     FShadowOffsetY := TBCFont(Source).FShadowOffsetY;
866     FStyle := TBCFont(Source).FStyle;
867     FTextAlignment := TBCFont(Source).FTextAlignment;
868     FWordBreak := TBCFont(Source).FWordBreak;
869     FPaddingLeft:= TBCFont(Source).PaddingLeft;
870     FPaddingTop:= TBCFont(Source).PaddingTop;
871     FPaddingRight:= TBCFont(Source).PaddingRight;
872     FPaddingBottom:= TBCFont(Source).PaddingBottom;
873 
874     Change;
875   end else
876   if Source is TFont then
877   begin
878     FColor := TFont(Source).Color;
879     FHeight := -TFont(Source).Height;
880     FName := TFont(Source).Name;
881     FStyle:= TFont(Source).Style;
882 
883     Change;
884   end else
885     inherited Assign(Source);
886 end;
887 
888 procedure TBCFont.Scale(AScale: single; APreserveDefaultHeight: boolean);
889 var
890   bmp: TBitmap;
891 begin
892   // we need to have an actual height and not the default value
893   if (Height = 0) and not APreserveDefaultHeight then
894   begin
895     bmp := TBitmap.Create;
896     bmp.Canvas.Font.Name:= Name;
897     bmp.Canvas.Font.Height:= 0;
898     bmp.Canvas.Font.Style:= Style;
899     Height := -bmp.Canvas.TextHeight('Bgra');
900     bmp.Free;
901   end;
902   Height := round(Height * AScale);
903   ShadowRadius:= min(high(ShadowRadius), round(ShadowRadius * AScale));
904   ShadowOffsetX:= max(low(ShadowOffsetX), min(high(ShadowOffsetX), round(ShadowOffsetX*AScale)));
905   ShadowOffsetY:= max(low(ShadowOffsetY), min(high(ShadowOffsetY), round(ShadowOffsetY*AScale)));
906   PaddingLeft:= round(PaddingLeft * AScale);
907   PaddingTop:= round(PaddingTop * AScale);
908   PaddingRight:= round(PaddingRight * AScale);
909   PaddingBottom:= round(PaddingBottom * AScale);
910 end;
911 
912 { TBCBackground }
913 
914 procedure TBCBackground.SetStyle(AValue: TBCBackgroundStyle);
915 begin
916   if FStyle = AValue then
917     Exit;
918   FStyle := AValue;
919 
920   Change;
921 end;
922 
923 constructor TBCBackground.Create(AControl: TControl);
924 begin
925   FStyle := bbsColor;
926   FColorOpacity := 255;
927   FGradient1 := TBCGradient.Create(AControl);
928   FGradient2 := TBCGradient.Create(AControl);
929   FGradient1EndPercent := 35;
930 
931   FGradient1.OnChange := OnChangeChildProperty;
932   FGradient2.OnChange := OnChangeChildProperty;
933   inherited Create(AControl);
934 end;
935 
936 destructor TBCBackground.Destroy;
937 begin
938   FGradient1.Free;
939   FGradient2.Free;
940   inherited Destroy;
941 end;
942 
943 procedure TBCBackground.Assign(Source: TPersistent);
944 begin
945   if Source is TBCBackground then
946   begin
947     FColor := TBCBackground(Source).FColor;
948     FColorOpacity := TBCBackground(Source).FColorOpacity;
949     FGradient1EndPercent := TBCBackground(Source).FGradient1EndPercent;
950     FStyle := TBCBackground(Source).FStyle;
951     FGradient1.Assign(TBCBackground(Source).FGradient1);
952     FGradient2.Assign(TBCBackground(Source).FGradient2);
953   end
954   else
955     inherited Assign(Source);
956 end;
957 
958 procedure TBCBackground.Scale(AScale: single);
959 begin
960   FGradient1.Scale(AScale);
961   FGradient2.Scale(AScale);
962 end;
963 
964 procedure TBCBackground.SetGradient1(AValue: TBCGradient);
965 begin
966   if FGradient1 = AValue then
967     Exit;
968   FGradient1 := AValue;
969 
970   Change;
971 end;
972 
973 procedure TBCBackground.OnChangeChildProperty(Sender: TObject; AData: PtrInt);
974 begin
975   Change(AData);
976 end;
977 
978 procedure TBCBackground.SetColor(AValue: TColor);
979 begin
980   if FColor = AValue then
981     Exit;
982   FColor := AValue;
983 
984   Change;
985 end;
986 
987 procedure TBCBackground.SetColorOpacity(AValue: byte);
988 begin
989   if FColorOpacity = AValue then
990     Exit;
991   FColorOpacity := AValue;
992 
993   Change;
994 end;
995 
996 procedure TBCBackground.SetGradient1EndPercent(AValue: single);
997 begin
998   if FGradient1EndPercent = AValue then
999     Exit;
1000   FGradient1EndPercent := AValue;
1001 
1002   Change;
1003 end;
1004 
1005 procedure TBCBackground.SetGradient2(AValue: TBCGradient);
1006 begin
1007   if FGradient2 = AValue then
1008     Exit;
1009   FGradient2 := AValue;
1010 
1011   Change;
1012 end;
1013 
1014 { TBCBorder }
1015 
1016 procedure TBCBorder.SetLightColor(AValue: TColor);
1017 begin
1018   if FLightColor = AValue then
1019     Exit;
1020   FLightColor := AValue;
1021 
1022   Change;
1023 end;
1024 
1025 procedure TBCBorder.SetColor(AValue: TColor);
1026 begin
1027   if FColor = AValue then
1028     Exit;
1029   FColor := AValue;
1030 
1031   Change;
1032 end;
1033 
1034 procedure TBCBorder.SetColorOpacity(AValue: byte);
1035 begin
1036   if FColorOpacity = AValue then
1037     Exit;
1038   FColorOpacity := AValue;
1039 
1040   Change;
1041 end;
1042 
1043 procedure TBCBorder.SetLightOpacity(AValue: byte);
1044 begin
1045   if FLightOpacity = AValue then
1046     Exit;
1047   FLightOpacity := AValue;
1048 
1049   Change;
1050 end;
1051 
1052 procedure TBCBorder.SetLightWidth(AValue: integer);
1053 begin
1054   if FLightWidth = AValue then
1055     Exit;
1056   FLightWidth := AValue;
1057 
1058   Change;
1059 end;
1060 
1061 procedure TBCBorder.SetStyle(AValue: TBCBorderStyle);
1062 begin
1063   if FStyle = AValue then
1064     Exit;
1065   FStyle := AValue;
1066 
1067   Change;
1068 end;
1069 
1070 procedure TBCBorder.SetWidth(AValue: integer);
1071 begin
1072   if FWidth = AValue then
1073     Exit;
1074   FWidth := AValue;
1075 
1076   Change;
1077 end;
1078 
1079 constructor TBCBorder.Create(AControl: TControl);
1080 begin
1081   FColor := clBlack;
1082   FColorOpacity := 255;
1083   FLightWidth := 0;
1084   FLightOpacity := 255;
1085   FLightColor := clWhite;
1086   FStyle := bboSolid;
1087   FWidth := 1;
1088   inherited Create(AControl);
1089 end;
1090 
1091 procedure TBCBorder.Assign(Source: TPersistent);
1092 begin
1093   if Source is TBCBorder then
1094   begin
1095     FColor := TBCBorder(Source).FColor;
1096     FColorOpacity := TBCBorder(Source).FColorOpacity;
1097     FLightColor := TBCBorder(Source).FLightColor;
1098     FLightOpacity := TBCBorder(Source).FLightOpacity;
1099     FLightWidth := TBCBorder(Source).FLightWidth;
1100     FStyle := TBCBorder(Source).FStyle;
1101     FWidth := TBCBorder(Source).FWidth;
1102   end
1103   else
1104     inherited Assign(Source);
1105 end;
1106 
1107 procedure TBCBorder.Scale(AScale: single);
1108 begin
1109   LightWidth:= round(LightWidth * AScale);
1110   Width := round(Width * AScale);
1111 end;
1112 
1113 end.
1114