1 // SPDX-License-Identifier: LGPL-3.0-only (modified to allow linking)
2 { Base framework classes
3 
4   originally written in 2012 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 
12 unit BCBaseCtrls;
13 
14 {$I bgracontrols.inc}
15 
16 interface
17 
18 uses
19   Classes, SysUtils, Controls, ExtCtrls, Graphics,
20   {$IFNDEF FPC}Windows, Messages, BGRAGraphics, GraphType, FPImage, {$ELSE} LCLType,{$ENDIF}
21   BGRABitmap, BGRABitmapTypes;
22 
23 type
24 
25 {$IFNDEF FPC}
26   TSpacingSize = Integer;
27   TControlCellAlign = (
28     ccaFill,
29     ccaLeftTop,
30     ccaRightBottom,
31     ccaCenter
32     );
33   TControlCellAligns = set of TControlCellAlign;
34 
35   TControlBorderSpacingDefault = record
36     Left: TSpacingSize;
37     Top: TSpacingSize;
38     Right: TSpacingSize;
39     Bottom: TSpacingSize;
40     Around: TSpacingSize;
41   end;
42   PControlBorderSpacingDefault = ^TControlBorderSpacingDefault;
43 
44 
45   TBGRAGraphicCtrl = class;
46   TBGRACustomCtrl  = class;
47   TControlBorderSpacing = class;
48 
49   ILCLControl = interface
50    ['{97A3D274-C4BD-4095-9B23-8E50D6E0EA24}']
51     procedure DoOnResize;
52     procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;{%H-}WithThemeSpace: boolean);
53     procedure MouseEnter;
54     procedure MouseLeave;
55     procedure TextChanged;
56     procedure FontChanged(Sender: TObject);
57     procedure RealSetText(const Value: TCaption);
58     procedure Resize;
59     procedure SetColor(Value: TColor);
GetColornull60     function GetColor : TColor;
ColorIsStorednull61     function ColorIsStored: boolean;
RealGetTextnull62     function RealGetText: TCaption;
CreateControlBorderSpacingnull63     function CreateControlBorderSpacing: TControlBorderSpacing;
64     procedure SetBorderSpacing(const AValue: TControlBorderSpacing);
65     procedure SetInitialBounds(aLeft, aTop, aWidth, aHeight: integer);
66     procedure InvalidatePreferredSize;
67     procedure EnableAutoSizing;
68     procedure DoBorderSpacingChange(Sender: TObject; InnerSpaceChanged: Boolean);
GetInstancenull69     function  GetInstance : TObject;
IsInnerBorderStorednull70     function IsInnerBorderStored: boolean;
71   end;
72 
73   TControlBorderSpacing = class(TPersistent)
74   private
75     FAround: TSpacingSize;
76     FBottom: TSpacingSize;
77     FCellAlignHorizontal: TControlCellAlign;
78     FCellAlignVertical: TControlCellAlign;
79     FControl: ILCLControl;
80     FInnerBorder: Integer;
81     FLeft: TSpacingSize;
82     FOnChange: TNotifyEvent;
83     FRight: TSpacingSize;
84     FTop: TSpacingSize;
85     FDefault: PControlBorderSpacingDefault;
GetAroundBottomnull86     function GetAroundBottom: Integer;
GetAroundLeftnull87     function GetAroundLeft: Integer;
GetAroundRightnull88     function GetAroundRight: Integer;
GetAroundTopnull89     function GetAroundTop: Integer;
GetControlBottomnull90     function GetControlBottom: Integer;
GetControlHeightnull91     function GetControlHeight: Integer;
GetControlLeftnull92     function GetControlLeft: Integer;
GetControlRightnull93     function GetControlRight: Integer;
GetControlTopnull94     function GetControlTop: Integer;
GetControlWidthnull95     function GetControlWidth: Integer;
IsAroundStorednull96     function IsAroundStored: boolean;
IsBottomStorednull97     function IsBottomStored: boolean;
IsInnerBorderStorednull98     function IsInnerBorderStored: boolean;
IsLeftStorednull99     function IsLeftStored: boolean;
IsRightStorednull100     function IsRightStored: boolean;
IsTopStorednull101     function IsTopStored: boolean;
102     procedure SetAround(const AValue: TSpacingSize);
103     procedure SetBottom(const AValue: TSpacingSize);
104     procedure SetCellAlignHorizontal(const AValue: TControlCellAlign);
105     procedure SetCellAlignVertical(const AValue: TControlCellAlign);
106     procedure SetInnerBorder(const AValue: Integer);
107     procedure SetLeft(const AValue: TSpacingSize);
108     procedure SetRight(const AValue: TSpacingSize);
109     procedure SetSpace(Kind: TAnchorKind; const AValue: integer);
110     procedure SetTop(const AValue: TSpacingSize);
111   protected
112     procedure Change(InnerSpaceChanged: Boolean); virtual;
113   public
114     constructor Create(OwnerControl: ILCLControl; ADefault: PControlBorderSpacingDefault = nil);
115     procedure Assign(Source: TPersistent); override;
116     procedure AssignTo(Dest: TPersistent); override;
IsEqualnull117     function IsEqual(Spacing: TControlBorderSpacing): boolean;
118     procedure GetSpaceAround(var SpaceAround: TRect); virtual;
GetSideSpacenull119     function GetSideSpace(Kind: TAnchorKind): Integer; // Around+GetSpace
GetSpacenull120     function GetSpace(Kind: TAnchorKind): Integer; virtual;
121     procedure AutoAdjustLayout(const AXProportion, AYProportion: Double);
122   public
123     property Control: ILCLControl read FControl;
124     property Space[Kind: TAnchorKind]: integer read GetSpace write SetSpace;
125     property AroundLeft: Integer read GetAroundLeft;
126     property AroundTop: Integer read GetAroundTop;
127     property AroundRight: Integer read GetAroundRight;
128     property AroundBottom: Integer read GetAroundBottom;
129     property ControlLeft: Integer read GetControlLeft;
130     property ControlTop: Integer read GetControlTop;
131     property ControlWidth: Integer read GetControlWidth;
132     property ControlHeight: Integer read GetControlHeight;
133     property ControlRight: Integer read GetControlRight;
134     property ControlBottom: Integer read GetControlBottom;
135   published
136     property OnChange: TNotifyEvent read FOnChange write FOnChange;
137     property Left: TSpacingSize read FLeft write SetLeft stored IsLeftStored;
138     property Top: TSpacingSize read FTop write SetTop stored IsTopStored;
139     property Right: TSpacingSize read FRight write SetRight stored IsRightStored;
140     property Bottom: TSpacingSize read FBottom write SetBottom stored IsBottomStored;
141     property Around: TSpacingSize read FAround write SetAround stored IsAroundStored;
142     property InnerBorder: Integer read FInnerBorder write SetInnerBorder stored IsInnerBorderStored default 0;
143     property CellAlignHorizontal: TControlCellAlign read FCellAlignHorizontal write SetCellAlignHorizontal default ccaFill;
144     property CellAlignVertical: TControlCellAlign read FCellAlignVertical write SetCellAlignVertical default ccaFill;
145   end;
146 
147   TChildControlResizeStyle = (
148       crsAnchorAligning, // (like Delphi)
149       crsScaleChilds, // scale children equally, keep space between children fixed
150       crsHomogenousChildResize, // enlarge children equally (i.e. by the same amount of pixel)
151       crsHomogenousSpaceResize // enlarge space between children equally
152       {$IFDEF EnablecrsSameSize}
153       ,crsSameSize  // each child gets the same size (maybe one pixel difference)
154       {$ENDIF}
155     );
156 
157   TControlChildrenLayout = (
158       cclNone,
159       cclLeftToRightThenTopToBottom, // if BiDiMode <> bdLeftToRight then it becomes RightToLeft
160       cclTopToBottomThenLeftToRight
161     );
162 
163   TControlChildSizing = class(TPersistent)
164   private
165     FControl: ILCLControl;
166     FControlsPerLine: integer;
167     FEnlargeHorizontal: TChildControlResizeStyle;
168     FEnlargeVertical: TChildControlResizeStyle;
169     FHorizontalSpacing: integer;
170     FLayout: TControlChildrenLayout;
171     FLeftRightSpacing: integer;
172     FOnChange: TNotifyEvent;
173     FShrinkHorizontal: TChildControlResizeStyle;
174     FShrinkVertical: TChildControlResizeStyle;
175     FTopBottomSpacing: integer;
176     FVerticalSpacing: integer;
177     procedure SetControlsPerLine(const AValue: integer);
178     procedure SetEnlargeHorizontal(const AValue: TChildControlResizeStyle);
179     procedure SetEnlargeVertical(const AValue: TChildControlResizeStyle);
180     procedure SetHorizontalSpacing(const AValue: integer);
181     procedure SetLayout(const AValue: TControlChildrenLayout);
182     procedure SetLeftRightSpacing(const AValue: integer);
183     procedure SetShrinkHorizontal(const AValue: TChildControlResizeStyle);
184     procedure SetShrinkVertical(const AValue: TChildControlResizeStyle);
185     procedure SetTopBottomSpacing(const AValue: integer);
186     procedure SetVerticalSpacing(const AValue: integer);
187   protected
188     procedure Change; virtual;
189   public
190     constructor Create(OwnerControl: ILCLControl);
191     procedure Assign(Source: TPersistent); override;
192     procedure AssignTo(Dest: TPersistent); override;
IsEqualnull193     function IsEqual(Sizing: TControlChildSizing): boolean;
194     procedure SetGridSpacing(Spacing: integer);
195   public
196     property Control: ILCLControl read FControl;
197     property OnChange: TNotifyEvent read FOnChange write FOnChange;
198   published
199     property LeftRightSpacing: integer read FLeftRightSpacing write SetLeftRightSpacing default 0;
200     property TopBottomSpacing: integer read FTopBottomSpacing write SetTopBottomSpacing default 0;
201     property HorizontalSpacing: integer read FHorizontalSpacing write SetHorizontalSpacing default 0;
202     property VerticalSpacing: integer read FVerticalSpacing write SetVerticalSpacing default 0;
203     property EnlargeHorizontal: TChildControlResizeStyle read FEnlargeHorizontal
204                            write SetEnlargeHorizontal default crsAnchorAligning;
205     property EnlargeVertical: TChildControlResizeStyle read FEnlargeVertical
206                              write SetEnlargeVertical default crsAnchorAligning;
207     property ShrinkHorizontal: TChildControlResizeStyle read FShrinkHorizontal
208                             write SetShrinkHorizontal default crsAnchorAligning;
209     property ShrinkVertical: TChildControlResizeStyle read FShrinkVertical
210                               write SetShrinkVertical default crsAnchorAligning;
211     property Layout: TControlChildrenLayout read FLayout write SetLayout default cclNone;
212     property ControlsPerLine: integer read FControlsPerLine write SetControlsPerLine default 0;
213   end;
214 {$ENDIF}
215 
216 {$IFDEF FPC}
217   TBGRAGraphicCtrl = class(TGraphicControl)
218 {$ELSE}
219   TBGRAGraphicCtrl = class(TGraphicControl, ILCLControl)
220   protected
221     FBorderSpacing: TControlBorderSpacing;
222     FOnChange: TNotifyEvent;
223     FMouseInClient: boolean;
224     procedure DoOnResize; virtual;
225     procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;{%H-}WithThemeSpace: boolean); virtual;
226     procedure MouseEnter;  virtual;
227     procedure MouseLeave;  virtual;
228     procedure TextChanged; virtual;
229     procedure FontChanged(Sender: TObject); virtual;
230     procedure RealSetText(const Value: TCaption); virtual;
231     procedure Resize; override;
GetControlClassDefaultSizenull232     class function GetControlClassDefaultSize: TSize; virtual;
233     procedure SetColor(Value: TColor); virtual;
GetColornull234     function GetColor : TColor;
235     procedure CMMouseEnter(var Message :TMessage); message CM_MOUSEENTER;
236     procedure CMMouseLeave(var Message :TMessage); message CM_MOUSELEAVE;
237     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
ColorIsStorednull238     function ColorIsStored: boolean; virtual;
RealGetTextnull239     function RealGetText: TCaption; virtual;
CreateControlBorderSpacingnull240     function CreateControlBorderSpacing: TControlBorderSpacing; virtual;
241     procedure SetBorderSpacing(const AValue: TControlBorderSpacing);
242     procedure DoBorderSpacingChange(Sender: TObject; InnerSpaceChanged: Boolean); virtual;
GetInstancenull243     function  GetInstance : TObject;
IsInnerBorderStorednull244     function IsInnerBorderStored: boolean;
245   public
246     constructor Create(TheOwner: TComponent);override;
247     destructor Destroy;override;
248     procedure SetInitialBounds(aLeft, aTop, aWidth, aHeight: integer); virtual;
249     procedure InvalidatePreferredSize; virtual;
250     procedure EnableAutoSizing;
251     property Color: TColor read GetColor write SetColor stored ColorIsStored default clWindow;
252     property BorderSpacing: TControlBorderSpacing read FBorderSpacing write SetBorderSpacing;
253     property Caption;
254     property Canvas;
255 {$ENDIF}
256   end;
257 
258 {$IFDEF FPC}
259   TBGRACustomCtrl = class(TCustomControl)
260 {$ELSE}
261   TBGRACustomCtrl = class(TCustomControl, ILCLControl)
262   protected
263     FBorderSpacing: TControlBorderSpacing;
264     FChildSizing: TControlChildSizing;
265     FOnChange: TNotifyEvent;
266     FMouseInClient: boolean;
267     procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;{%H-}WithThemeSpace: boolean); {$IFDEF FPC}override;{$ELSE}virtual;{$ENDIF}
268     procedure DoOnResize; virtual;
269     procedure MouseEnter; virtual;
270     procedure MouseLeave; virtual;
271     procedure TextChanged; virtual;
272     procedure FontChanged(Sender: TObject); virtual;
GetDefaultDockCaptionnull273     function GetDefaultDockCaption: String; virtual;
274     procedure RealSetText(const Value: TCaption); virtual;
275     procedure EnabledChanged; virtual;
276     procedure Resize; override;
GetControlClassDefaultSizenull277     class function GetControlClassDefaultSize: TSize; virtual;
278     procedure SetColor(Value: TColor); virtual;
GetColornull279     function  GetColor : TColor;
280     procedure UTF8KeyPress(var UTF8Key: {$IFDEF FPC}TUTF8Char{$ELSE}String{$ENDIF}); virtual;
281     procedure CMMouseEnter(var Message :TMessage); message CM_MOUSEENTER;
282     procedure CMMouseLeave(var Message :TMessage); message CM_MOUSELEAVE;
283     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
ColorIsStorednull284     function ColorIsStored: boolean; virtual;
RealGetTextnull285     function RealGetText: TCaption; virtual;
CreateControlBorderSpacingnull286     function CreateControlBorderSpacing: TControlBorderSpacing; virtual;
287     procedure SetBorderSpacing(const AValue: TControlBorderSpacing);
288     procedure DoBorderSpacingChange(Sender: TObject; InnerSpaceChanged: Boolean); virtual;
GetInstancenull289     function  GetInstance : TObject;
IsInnerBorderStorednull290     function IsInnerBorderStored: boolean;
291     procedure SetChildSizing(const AValue: TControlChildSizing);
292     procedure DoChildSizingChange(Sender: TObject); virtual;
293   public
294     constructor Create(TheOwner: TComponent);override;
295     destructor Destroy;override;
296     procedure SetInitialBounds(aLeft, aTop, aWidth, aHeight: integer); virtual;
297     procedure InvalidatePreferredSize; virtual;
298     procedure EnableAutoSizing;
299     property Color: TColor read GetColor write SetColor stored ColorIsStored default clWindow;
300     property BorderSpacing: TControlBorderSpacing read FBorderSpacing write SetBorderSpacing;
301     property ChildSizing: TControlChildSizing read FChildSizing write SetChildSizing;
302     property Caption;
303     property Canvas;
304 {$ENDIF}
305   end;
306 
307 
308 {$IFDEF FPC}
309   TBGRACustomPanel = class(TCustomPanel)
310 {$ELSE}
311   TBGRACustomPanel = class(TCustomPanel, ILCLControl)
312   protected
313     FBorderSpacing: TControlBorderSpacing;
314     FChildSizing: TControlChildSizing;
315     FOnChange: TNotifyEvent;
316     FMouseInClient: boolean;
317     procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;{%H-}WithThemeSpace: boolean); {$IFDEF FPC}override;{$ELSE}virtual;{$ENDIF}
318     procedure DoOnResize; virtual;
319     procedure MouseEnter; virtual;
320     procedure MouseLeave; virtual;
321     procedure TextChanged; virtual;
322     procedure FontChanged(Sender: TObject); virtual;
GetDefaultDockCaptionnull323     function GetDefaultDockCaption: String; virtual;
324     procedure RealSetText(const Value: TCaption); virtual;
325     procedure EnabledChanged; virtual;
326     procedure Resize; override;
GetControlClassDefaultSizenull327     class function GetControlClassDefaultSize: TSize; virtual;
328     procedure SetColor(Value: TColor); virtual;
GetColornull329     function  GetColor : TColor;
330     procedure UTF8KeyPress(var UTF8Key: {$IFDEF FPC}TUTF8Char{$ELSE}String{$ENDIF}); virtual;
331     procedure CMMouseEnter(var Message :TMessage); message CM_MOUSEENTER;
332     procedure CMMouseLeave(var Message :TMessage); message CM_MOUSELEAVE;
333     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
ColorIsStorednull334     function ColorIsStored: boolean; virtual;
RealGetTextnull335     function RealGetText: TCaption; virtual;
CreateControlBorderSpacingnull336     function CreateControlBorderSpacing: TControlBorderSpacing; virtual;
337     procedure SetBorderSpacing(const AValue: TControlBorderSpacing);
338     procedure DoBorderSpacingChange(Sender: TObject; InnerSpaceChanged: Boolean); virtual;
GetInstancenull339     function  GetInstance : TObject;
IsInnerBorderStorednull340     function IsInnerBorderStored: boolean;
341     procedure SetChildSizing(const AValue: TControlChildSizing);
342     procedure DoChildSizingChange(Sender: TObject); virtual;
343   public
344     constructor Create(TheOwner: TComponent);override;
345     destructor Destroy;override;
346     procedure SetInitialBounds(aLeft, aTop, aWidth, aHeight: integer); virtual;
347     procedure InvalidatePreferredSize; virtual;
348     procedure EnableAutoSizing;
349     property Color: TColor read GetColor write SetColor stored ColorIsStored default clWindow;
350     property BorderSpacing: TControlBorderSpacing read FBorderSpacing write SetBorderSpacing;
351     property ChildSizing: TControlChildSizing read FChildSizing write SetChildSizing;
352     property Canvas;
353 {$ENDIF}
354   end;
355 
356   TOnBCPropertyChange = procedure(ASender: TObject; AData: PtrInt) of object;
357 
358   { TBCProperty
359     Base BC Property with OnChange event support
360   }
361 
362   TBCProperty = class(TPersistent)
363   private
364     FOnChange: TOnBCPropertyChange;
365   protected
366     FControl: TControl;
367     procedure Change(AData: PtrInt = 0); virtual;
368   public
369     constructor Create(AControl: TControl); virtual;
370   public
371     property Control: TControl read FControl;
372     property OnChange: TOnBCPropertyChange read FOnChange write FOnChange;
373   end;
374 
375   { TBGRABitmapEx
376     Some BGRABitmap descendant which can store custom data and has NeedRender flag
377   }
378 
379   TBGRABitmapEx = class(TBGRABitmap)
380   private
381     FCustomData: PtrInt;
382     FNeedRender: Boolean;
383   protected
384     procedure Init; override;
385   public
386     property NeedRender: Boolean read FNeedRender write FNeedRender;
387     property CustomData: PtrInt read FCustomData write FCustomData;
388     procedure Discard;
389   end;
390 
391   { TBCGraphicControl
392     BC graphic control with some basic functionality like begin/end update and
393     debug functions
394   }
395 
396   TBCGraphicControl = class(TBGRAGraphicCtrl)
397   private
398     {$IFDEF INDEBUG}
399     FPaintCount: Integer;
400     {$ENDIF}
401     FUpdateCount: Integer;
402   protected
403     procedure DoOnResize; override;
404   protected
405     {$IFDEF INDEBUG}
GetDebugTextnull406     function GetDebugText: String; virtual;
407     {$ENDIF}
408     procedure Paint; override; // do not override in descendants!
409     // All descendants should use DrawControl method instead of Paint.
410     // DrawControl is not called between BeginUpdate and EndUpdate
411     procedure DrawControl; virtual;
412     // This method is called when control should be rendered (when some
413     // general action occur which change "body" e.g. resize)
414     procedure RenderControl; virtual;
415   public
416     {$IFDEF FPC}
417     { Save all published settings to file }
418     procedure SaveToFile(AFileName: string); virtual; abstract;
419     { Load and assign all published settings from file }
420     procedure LoadFromFile(AFileName: string); virtual; abstract;
421     { Assign the properties from AFileName to this instance }
422     procedure AssignFromFile(AFileName: string); virtual; abstract;
423     { Used by SaveToFile/LoadFromFile }
424     {$ENDIF}
425     constructor Create(AOwner: TComponent); override;
426     // This disable DrawControl method
427     procedure BeginUpdate; virtual;
428     // This enable DrawControl method
429     procedure EndUpdate; virtual;
430     // Called on EndUpdate if FUpdateCount is 0
431     procedure UpdateControl; virtual;
432     // Check if BeginUpdate was called
IsUpdatingnull433     function IsUpdating: Boolean;
434   end;
435 
436   { TBCStyleDummyProperty
437     This is only dummy property type for access to style editor from
438     object inspector
439   }
440 
441   TBCStyleDummyProperty = class(TBCProperty)
442 
443   end;
444 
445   { TBCStyleGraphicControl
446     All descendants of this class have support for saving and loading styles and
447     access to style editor from object inspector or component context menu
448   }
449 
450   TBCStyleGraphicControl = class(TBCGraphicControl)
451   private
452     FAssignStyle: TBCStyleDummyProperty;
453   protected
GetStyleExtensionnull454     function GetStyleExtension: String; virtual; abstract;
455     // Dummy property for access to style editor dialog
456     property AssignStyle: TBCStyleDummyProperty read FAssignStyle;
457   public
458     constructor Create(AOwner: TComponent); override;
459     destructor Destroy; override;
460     property StyleExtension: String read GetStyleExtension;
461   end;
462 
463   { TBCCustomControl
464     BC custom control with some basic functionality like begin/end update and
465     debug functions
466   }
467 
468   TBCCustomControl = class(TBGRACustomCtrl)
469   private
470     {$IFDEF INDEBUG}
471     FPaintCount: Integer;
472     {$ENDIF}
473     FUpdateCount: Integer;
474   protected
475     procedure DoOnResize; override;
476   protected
477     {$IFDEF INDEBUG}
GetDebugTextnull478     function GetDebugText: String; virtual;
479     {$ENDIF}
480     procedure Paint; override; // do not override in descendants!
481     // All descendants should use DrawControl method instead of Paint.
482     // DrawControl is not called between BeginUpdate and EndUpdate
483     procedure DrawControl; virtual;
484     // This method is called when control should be rendered (when some
485     // general action occur which change "body" e.g. resize)
486     procedure RenderControl; virtual;
487   public
488     constructor Create(AOwner: TComponent); override;
489     // This disable DrawControl method
490     procedure BeginUpdate; virtual;
491     // This enable DrawControl method
492     procedure EndUpdate; virtual;
493     // Called on EndUpdate if FUpdateCount is 0
494     procedure UpdateControl; virtual;
495     // Check if BeginUpdate was called
IsUpdatingnull496     function IsUpdating: Boolean;
497   end;
498 
499   { TBCStyleCustomControl
500     All descendants of this class have support for saving and loading styles and
501     access to style editor from object inspector or component context menu
502   }
503 
504   TBCStyleCustomControl = class(TBCCustomControl)
505   private
506     FAssignStyle: TBCStyleDummyProperty;
507   protected
GetStyleExtensionnull508     function GetStyleExtension: String; virtual; abstract;
509     // Dummy property for access to style editor dialog
510     property AssignStyle: TBCStyleDummyProperty read FAssignStyle;
511   public
512     constructor Create(AOwner: TComponent); override;
513     destructor Destroy; override;
514     property StyleExtension: String read GetStyleExtension;
515   end;
516 
517 {$IFDEF FPC}procedure Register;{$ENDIF}
518 
519 implementation
520 
521 //{$IFDEF INDEBUG} uses Graphics; {$ENDIF}
522 
523 {$IFDEF FPC}
524 procedure Register;
525 begin
526   RegisterNoIcon([TBCCustomControl]);
527 end;
528 {$ENDIF}
529 
530 { TBCStyleCustomControl }
531 
532 constructor TBCStyleCustomControl.Create(AOwner: TComponent);
533 begin
534   inherited Create(AOwner);
535 
536   FAssignStyle := TBCStyleDummyProperty.Create(Self);
537 end;
538 
539 destructor TBCStyleCustomControl.Destroy;
540 begin
541   FAssignStyle.Free;
542   inherited Destroy;
543 end;
544 
545 { TBCStyleGraphicControl }
546 
547 constructor TBCStyleGraphicControl.Create(AOwner: TComponent);
548 begin
549   inherited Create(AOwner);
550 
551   FAssignStyle := TBCStyleDummyProperty.Create(Self);
552 end;
553 
554 destructor TBCStyleGraphicControl.Destroy;
555 begin
556   FAssignStyle.Free;
557   inherited Destroy;
558 end;
559 
560 { TBCCustomControl }
561 
562 procedure TBCCustomControl.DoOnResize;
563 begin
564   inherited DoOnResize;
565   RenderControl;
566 end;
567 
568 {$IFDEF INDEBUG}
GetDebugTextnull569 function TBCCustomControl.GetDebugText: String;
570 begin
571   Result := EmptyStr;
572 end;
573 {$ENDIF}
574 
575 procedure TBCCustomControl.Paint;
576 begin
577   if (csCreating in ControlState) or IsUpdating then
578     Exit;
579 
580   DrawControl;
581   {$IFDEF INDEBUG}
582   FPaintCount := FPaintCount +1;
583   Canvas.Brush.Style := bsSolid;
584   Canvas.Brush.Color := clBlack;
585   Canvas.Font.Color := clWhite;
586   Canvas.TextOut(1,1,'P: '+IntToStr(FPaintCount)+' '+GetDebugText);
587   {$ENDIF}
588   inherited Paint;
589 end;
590 
591 procedure TBCCustomControl.DrawControl;
592 begin
593 
594 end;
595 
596 procedure TBCCustomControl.RenderControl;
597 begin
598 
599 end;
600 
601 constructor TBCCustomControl.Create(AOwner: TComponent);
602 begin
603   inherited Create(AOwner);
604   {$IFDEF INDEBUG}
605   FPaintCount := 0;
606   {$ENDIF}
607 end;
608 
609 procedure TBCCustomControl.BeginUpdate;
610 begin
611   FUpdateCount := FUpdateCount +1;
612 end;
613 
614 procedure TBCCustomControl.EndUpdate;
615 begin
616   if FUpdateCount > 0 then
617   begin
618     FUpdateCount := FUpdateCount -1;
619     if FUpdateCount=0 then
620       UpdateControl;
621   end;
622 end;
623 
624 procedure TBCCustomControl.UpdateControl;
625 begin
626   Self.Invalidate;
627 end;
628 
TBCCustomControl.IsUpdatingnull629 function TBCCustomControl.IsUpdating: Boolean;
630 begin
631   Result := FUpdateCount>0;
632 end;
633 
634 { TBCProperty }
635 
636 procedure TBCProperty.Change(AData: PtrInt);
637 begin
638   if Assigned(FOnChange) then
639     FOnChange(Self,AData);
640 end;
641 
642 constructor TBCProperty.Create(AControl: TControl);
643 begin
644   FControl := AControl;
645 
646   inherited Create;
647 end;
648 
649 { TBCGraphicControl }
650 
651 procedure TBCGraphicControl.DoOnResize;
652 begin
653   inherited DoOnResize;
654   RenderControl;
655 end;
656 
657 {$IFDEF INDEBUG}
TBCGraphicControl.GetDebugTextnull658 function TBCGraphicControl.GetDebugText: String;
659 begin
660   Result := EmptyStr;
661 end;
662 {$ENDIF}
663 
664 procedure TBCGraphicControl.Paint;
665 begin
666   //inherited Paint;
667   if (csCreating in ControlState) or IsUpdating then
668     Exit;
669   DrawControl;
670   {$IFDEF INDEBUG}
671   FPaintCount := FPaintCount +1;
672   Canvas.Brush.Style := bsSolid;
673   Canvas.Brush.Color := clBlack;
674   Canvas.Font.Color := clWhite;
675   Canvas.TextOut(1,1,'P: '+IntToStr(FPaintCount)+' '+GetDebugText);
676   {$ENDIF}
677 end;
678 
679 procedure TBCGraphicControl.DrawControl;
680 begin
681 
682 end;
683 
684 procedure TBCGraphicControl.RenderControl;
685 begin
686 
687 end;
688 
689 constructor TBCGraphicControl.Create(AOwner: TComponent);
690 begin
691   inherited Create(AOwner);
692   {$IFDEF INDEBUG}
693   FPaintCount := 0;
694   {$ENDIF}
695 end;
696 
697 procedure TBCGraphicControl.BeginUpdate;
698 begin
699   FUpdateCount := FUpdateCount +1;
700 end;
701 
702 procedure TBCGraphicControl.EndUpdate;
703 begin
704   if FUpdateCount > 0 then
705   begin
706     FUpdateCount := FUpdateCount -1;
707     if FUpdateCount=0 then
708       UpdateControl;
709   end;
710 end;
711 
712 procedure TBCGraphicControl.UpdateControl;
713 begin
714   Invalidate;
715 end;
716 
TBCGraphicControl.IsUpdatingnull717 function TBCGraphicControl.IsUpdating: Boolean;
718 begin
719   Result := FUpdateCount>0;
720 end;
721 
722 { TBGRABitmapEx }
723 
724 procedure TBGRABitmapEx.Init;
725 begin
726   inherited Init;
727   FNeedRender := True;
728   FCustomData := 0;
729 end;
730 
731 procedure TBGRABitmapEx.Discard;
732 begin
733   FNeedRender := true;
734   SetSize(0,0);
735 end;
736 
737 {$IFNDEF FPC}
738 constructor TBGRAGraphicCtrl.Create(TheOwner: TComponent);
739 begin
740   inherited Create(TheOwner);
741   FBorderSpacing := CreateControlBorderSpacing;
742   FOnChange := Font.OnChange;
743   Font.OnChange := FontChanged;
744 end;
745 
TBGRAGraphicCtrl.CreateControlBorderSpacingnull746 function TBGRAGraphicCtrl.CreateControlBorderSpacing: TControlBorderSpacing;
747 begin
748   Result := TControlBorderSpacing.Create(Self);
749 end;
750 
751 destructor TBGRAGraphicCtrl.Destroy;
752 begin
753   FreeAndNil(FBorderSpacing);
754   inherited;
755 end;
756 
757 procedure TBGRAGraphicCtrl.DoBorderSpacingChange(Sender: TObject; InnerSpaceChanged: Boolean);
758 var
759   IParent : ILCLControl;
760 begin
761   if Parent <> nil then
762     if Supports(Parent, ILCLControl, IParent) then
763        IParent.InvalidatePreferredSize;
764   AdjustSize;
765 end;
766 
767 procedure TBGRAGraphicCtrl.DoOnResize;
768 begin
769   if Assigned(OnResize) then
770     OnResize(Self);
771 end;
772 
773 procedure TBGRAGraphicCtrl.SetBorderSpacing(const AValue: TControlBorderSpacing);
774 begin
775   if FBorderSpacing=AValue then exit;
776   FBorderSpacing.Assign(AValue);
777 end;
778 
779 procedure TBGRAGraphicCtrl.SetColor(Value: TColor);
780 begin
781   if inherited Color <> Value then
782   begin
783     inherited Color := Value;
784     ParentColor := False;
785     Perform(CM_COLORCHANGED, 0, 0);
786     Invalidate;
787   end;
788 end;
789 
GetColornull790 function TBGRAGraphicCtrl.GetColor: TColor;
791 begin
792    Result := inherited Color;
793 end;
794 
795 procedure TBGRAGraphicCtrl.EnableAutoSizing;
796 begin
797 end;
798 
TBGRAGraphicCtrl.GetControlClassDefaultSizenull799 class function TBGRAGraphicCtrl.GetControlClassDefaultSize: TSize;
800 begin
801   Result.CX := 75;
802   Result.CY := 50;
803 end;
804 
GetInstancenull805 function TBGRAGraphicCtrl.GetInstance: TObject;
806 begin
807   result := Self;
808 end;
809 
810 procedure TBGRAGraphicCtrl.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;{%H-}WithThemeSpace: boolean);
811 begin
812   PreferredWidth:=0;
813   PreferredHeight:=0;
814 end;
815 
816 procedure TBGRAGraphicCtrl.MouseEnter;
817 begin
818   if Assigned(OnMouseEnter) then
819     OnMouseEnter(Self);
820 end;
821 
822 procedure TBGRAGraphicCtrl.MouseLeave;
823 begin
824   if Assigned(OnMouseLeave) then
825     OnMouseLeave(Self);
826 end;
827 
828 procedure TBGRAGraphicCtrl.TextChanged;
829 begin
830   // overrided;
831 end;
832 
833 procedure TBGRAGraphicCtrl.FontChanged(Sender: TObject);
834 begin
835   ParentFont := False;
836   DesktopFont := False;
837   Invalidate;
838   Perform(CM_FONTCHANGED, 0, 0);
839   if AutoSize then
840   begin
841     InvalidatePreferredSize;
842     AdjustSize;
843   end;
844   if Assigned(FOnChange) then
845     FOnChange(Self);
846 end;
847 
RealGetTextnull848 function TBGRAGraphicCtrl.RealGetText: TCaption;
849 begin
850   Result := Caption;
851 end;
852 
853 procedure TBGRAGraphicCtrl.RealSetText(const Value: TCaption);
854 begin
855   if RealGetText = Value then Exit;
856   Caption := Value;
857   Perform(CM_TEXTCHANGED, 0, 0);
858 end;
859 
860 procedure TBGRAGraphicCtrl.InvalidatePreferredSize;
861 begin
862 //  Invalidate;
863 end;
864 
IsInnerBorderStorednull865 function TBGRAGraphicCtrl.IsInnerBorderStored: boolean;
866 begin
867   Result:=BorderSpacing.InnerBorder<>0;
868 end;
869 
870 procedure TBGRAGraphicCtrl.Resize;
871 begin
872   inherited;
873   Invalidate;
874   DoOnResize;
875 end;
876 
TBGRAGraphicCtrl.ColorIsStorednull877 function TBGRAGraphicCtrl.ColorIsStored: boolean;
878 begin
879   Result := not ParentColor;
880 end;
881 
882 procedure TBGRAGraphicCtrl.SetInitialBounds(aLeft, aTop, aWidth, aHeight: integer);
883 begin
884   {if (csLoading in ComponentState)
885   or ((Owner<>nil) and (csLoading in Owner.ComponentState)) then
886     exit;}
887   SetBounds(aLeft,aTop,aWidth,aHeight);
888 //  DoOnResize;
889 end;
890 
891 procedure TBGRAGraphicCtrl.CMTextChanged(var Message: TMessage);
892 begin
893   inherited;
894   TextChanged;
895 end;
896 
897 procedure TBGRAGraphicCtrl.CMMouseEnter(var Message: TMessage);
898 begin
899   if FMouseInClient then
900     Exit;
901 
902   FMouseInClient := True;
903 
904   // broadcast to parents first
905   if Assigned(Parent) then
906     Parent.Perform(CM_MOUSEENTER, 0, LParam(Self));
907 
908   // if it is not a child message then perform an event
909   if (Message.LParam = 0) then
910     MouseEnter;
911 end;
912 
913 procedure TBGRAGraphicCtrl.CMMouseLeave(var Message: TMessage);
914 begin
915   if not FMouseInClient then
916     Exit;
917 
918   FMouseInClient := False;
919 
920   // broadcast to parents first
921   if Assigned(Parent) then
922     Parent.Perform(CM_MOUSELEAVE, 0, LParam(Self));
923 
924   // if it is not a child message then perform an event
925   if (Message.LParam = 0) then
926     MouseLeave;
927 end;
928 
929 {TBGRACustomCtrl}
930 
931 constructor TBGRACustomCtrl.Create(TheOwner: TComponent);
932 begin
933   inherited Create(TheOwner);
934   FBorderSpacing := CreateControlBorderSpacing;
935   FChildSizing:=TControlChildSizing.Create(Self);
936   FChildSizing.OnChange := DoChildSizingChange;
937   FOnChange := Font.OnChange;
938   Font.OnChange := FontChanged;
939 end;
940 
CreateControlBorderSpacingnull941 function TBGRACustomCtrl.CreateControlBorderSpacing: TControlBorderSpacing;
942 begin
943   Result := TControlBorderSpacing.Create(Self);
944 end;
945 
946 destructor TBGRACustomCtrl.Destroy;
947 begin
948   FreeAndNil(FBorderSpacing);
949   FreeAndNil(FChildSizing);
950   inherited;
951 end;
952 
953 procedure TBGRACustomCtrl.DoBorderSpacingChange(Sender: TObject; InnerSpaceChanged: Boolean);
954 var
955   IParent : ILCLControl;
956 begin
957   if Parent <> nil then
958     if Supports(Parent, ILCLControl, IParent) then
959        IParent.InvalidatePreferredSize;
960   AdjustSize;
961 end;
962 
963 procedure TBGRACustomCtrl.DoChildSizingChange(Sender: TObject);
964 begin
965   //debugln('TWinControl.DoChildSizingChange ',DbgSName(Self));
966   if ControlCount=0 then exit;
967   InvalidatePreferredSize;
968   ReAlign;
969 end;
970 
971 procedure TBGRACustomCtrl.DoOnResize;
972 begin
973   if Assigned(OnResize) then
974     OnResize(Self);
975 end;
976 
977 procedure TBGRACustomCtrl.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;{%H-}WithThemeSpace: boolean);
978 begin
979   PreferredWidth:=0;
980   PreferredHeight:=0;
981 end;
982 
983 procedure TBGRACustomCtrl.MouseEnter;
984 begin
985   if Assigned(OnMouseEnter) then
986     OnMouseEnter(Self);
987 end;
988 
989 procedure TBGRACustomCtrl.MouseLeave;
990 begin
991   if Assigned(OnMouseLeave) then
992     OnMouseLeave(Self);
993 end;
994 
995 procedure TBGRACustomCtrl.TextChanged;
996 begin
997   // overrided;
998 end;
999 
1000 procedure TBGRACustomCtrl.FontChanged(Sender: TObject);
1001 begin
1002   ParentFont := False;
1003   DesktopFont := False;
1004   Invalidate;
1005   Perform(CM_FONTCHANGED, 0, 0);
1006   if AutoSize then
1007   begin
1008     InvalidatePreferredSize;
1009     AdjustSize;
1010   end;
1011   if Assigned(FOnChange) then
1012     FOnChange(Self);
1013 end;
1014 
TBGRACustomCtrl.GetDefaultDockCaptionnull1015 function TBGRACustomCtrl.GetDefaultDockCaption: String;
1016 begin
1017 end;
1018 
GetInstancenull1019 function TBGRACustomCtrl.GetInstance: TObject;
1020 begin
1021   result := Self;
1022 end;
1023 
RealGetTextnull1024 function TBGRACustomCtrl.RealGetText: TCaption;
1025 begin
1026   Result := Caption;
1027 end;
1028 
1029 procedure TBGRACustomCtrl.RealSetText(const Value: TCaption);
1030 begin
1031   if RealGetText = Value then Exit;
1032   Caption := Value;
1033   Perform(CM_TEXTCHANGED, 0, 0);
1034 end;
1035 
1036 procedure TBGRACustomCtrl.EnabledChanged;
1037 begin
1038 end;
1039 
1040 procedure TBGRACustomCtrl.InvalidatePreferredSize;
1041 begin
1042 //  Invalidate;
1043 end;
1044 
IsInnerBorderStorednull1045 function TBGRACustomCtrl.IsInnerBorderStored: boolean;
1046 begin
1047   Result:=BorderSpacing.InnerBorder<>0;
1048 end;
1049 
1050 procedure TBGRACustomCtrl.Resize;
1051 begin
1052   inherited;
1053   Invalidate;
1054   DoOnResize;
1055 end;
1056 
1057 procedure TBGRACustomCtrl.SetBorderSpacing(const AValue: TControlBorderSpacing);
1058 begin
1059   if FBorderSpacing=AValue then exit;
1060   FBorderSpacing.Assign(AValue);
1061 end;
1062 
1063 procedure TBGRACustomCtrl.SetChildSizing(const AValue: TControlChildSizing);
1064 begin
1065   if (FChildSizing=AValue) then exit;
1066   FChildSizing.Assign(AValue);
1067 end;
1068 
1069 procedure TBGRACustomCtrl.SetColor(Value: TColor);
1070 begin
1071   if inherited Color <> Value then
1072   begin
1073     inherited Color := Value;
1074     ParentColor := False;
1075     Perform(CM_COLORCHANGED, 0, 0);
1076     Invalidate;
1077   end;
1078 end;
1079 
GetColornull1080 function TBGRACustomCtrl.GetColor : TColor;
1081 begin
1082   Result := inherited Color;
1083 end;
1084 
1085 procedure TBGRACustomCtrl.UTF8KeyPress(var UTF8Key: {$IFDEF FPC}TUTF8Char{$ELSE}String{$ENDIF});
1086 begin
1087 end;
1088 
1089 procedure TBGRACustomCtrl.EnableAutoSizing;
1090 begin
1091 end;
1092 
TBGRACustomCtrl.ColorIsStorednull1093 function TBGRACustomCtrl.ColorIsStored: boolean;
1094 begin
1095   Result := not ParentColor;
1096 end;
1097 
1098 procedure TBGRACustomCtrl.SetInitialBounds(aLeft, aTop, aWidth, aHeight: integer);
1099 begin
1100   {if (csLoading in ComponentState)
1101   or ((Owner<>nil) and (csLoading in Owner.ComponentState)) then
1102     exit;}
1103   SetBounds(aLeft,aTop,aWidth,aHeight);
1104 //  DoOnResize;
1105 end;
1106 
TBGRACustomCtrl.GetControlClassDefaultSizenull1107 class function TBGRACustomCtrl.GetControlClassDefaultSize: TSize;
1108 begin
1109   Result.CX := 75;
1110   Result.CY := 50;
1111 end;
1112 
1113 procedure TBGRACustomCtrl.CMTextChanged(var Message: TMessage);
1114 begin
1115   TextChanged;
1116 end;
1117 
1118 procedure TBGRACustomCtrl.CMMouseEnter(var Message: TMessage);
1119 begin
1120   if FMouseInClient then
1121     Exit;
1122 
1123   FMouseInClient := True;
1124 
1125   // broadcast to parents first
1126   if Assigned(Parent) then
1127     Parent.Perform(CM_MOUSEENTER, 0, LParam(Self));
1128 
1129   // if it is not a child message then perform an event
1130   if (Message.LParam = 0) then
1131     MouseEnter;
1132 end;
1133 
1134 procedure TBGRACustomCtrl.CMMouseLeave(var Message: TMessage);
1135 begin
1136   if not FMouseInClient then
1137     Exit;
1138 
1139   FMouseInClient := False;
1140 
1141   // broadcast to parents first
1142   if Assigned(Parent) then
1143     Parent.Perform(CM_MOUSELEAVE, 0, LParam(Self));
1144 
1145   // if it is not a child message then perform an event
1146   if (Message.LParam = 0) then
1147     MouseLeave;
1148 end;
1149 
1150 {TBGRACustomPanel}
1151 
1152 constructor TBGRACustomPanel.Create(TheOwner: TComponent);
1153 begin
1154   inherited Create(TheOwner);
1155   FBorderSpacing := CreateControlBorderSpacing;
1156   FChildSizing:=TControlChildSizing.Create(Self);
1157   FChildSizing.OnChange := DoChildSizingChange;
1158   FOnChange := Font.OnChange;
1159   Font.OnChange := FontChanged;
1160 end;
1161 
CreateControlBorderSpacingnull1162 function TBGRACustomPanel.CreateControlBorderSpacing: TControlBorderSpacing;
1163 begin
1164   Result := TControlBorderSpacing.Create(Self);
1165 end;
1166 
1167 destructor TBGRACustomPanel.Destroy;
1168 begin
1169   FreeAndNil(FBorderSpacing);
1170   FreeAndNil(FChildSizing);
1171   inherited;
1172 end;
1173 
1174 procedure TBGRACustomPanel.DoBorderSpacingChange(Sender: TObject; InnerSpaceChanged: Boolean);
1175 var
1176   IParent : ILCLControl;
1177 begin
1178   if Parent <> nil then
1179     if Supports(Parent, ILCLControl, IParent) then
1180        IParent.InvalidatePreferredSize;
1181   AdjustSize;
1182 end;
1183 
1184 procedure TBGRACustomPanel.DoChildSizingChange(Sender: TObject);
1185 begin
1186   //debugln('TWinControl.DoChildSizingChange ',DbgSName(Self));
1187   if ControlCount=0 then exit;
1188   InvalidatePreferredSize;
1189   ReAlign;
1190 end;
1191 
1192 procedure TBGRACustomPanel.DoOnResize;
1193 begin
1194   if Assigned(OnResize) then
1195     OnResize(Self);
1196 end;
1197 
1198 procedure TBGRACustomPanel.CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;{%H-}WithThemeSpace: boolean);
1199 begin
1200   PreferredWidth:=0;
1201   PreferredHeight:=0;
1202 end;
1203 
1204 procedure TBGRACustomPanel.MouseEnter;
1205 begin
1206   if Assigned(OnMouseEnter) then
1207     OnMouseEnter(Self);
1208 end;
1209 
1210 procedure TBGRACustomPanel.MouseLeave;
1211 begin
1212   if Assigned(OnMouseLeave) then
1213     OnMouseLeave(Self);
1214 end;
1215 
1216 procedure TBGRACustomPanel.TextChanged;
1217 begin
1218   // overrided;
1219 end;
1220 
1221 procedure TBGRACustomPanel.FontChanged(Sender: TObject);
1222 begin
1223   ParentFont := False;
1224   DesktopFont := False;
1225   Invalidate;
1226   Perform(CM_FONTCHANGED, 0, 0);
1227   if AutoSize then
1228   begin
1229     InvalidatePreferredSize;
1230     AdjustSize;
1231   end;
1232   if Assigned(FOnChange) then
1233     FOnChange(Self);
1234 end;
1235 
TBGRACustomPanel.GetDefaultDockCaptionnull1236 function TBGRACustomPanel.GetDefaultDockCaption: String;
1237 begin
1238 end;
1239 
GetInstancenull1240 function TBGRACustomPanel.GetInstance: TObject;
1241 begin
1242   result := Self;
1243 end;
1244 
RealGetTextnull1245 function TBGRACustomPanel.RealGetText: TCaption;
1246 begin
1247   Result := Caption;
1248 end;
1249 
1250 procedure TBGRACustomPanel.RealSetText(const Value: TCaption);
1251 begin
1252   if RealGetText = Value then Exit;
1253   Caption := Value;
1254   Perform(CM_TEXTCHANGED, 0, 0);
1255 end;
1256 
1257 procedure TBGRACustomPanel.EnabledChanged;
1258 begin
1259 end;
1260 
1261 procedure TBGRACustomPanel.InvalidatePreferredSize;
1262 begin
1263 //  Invalidate;
1264 end;
1265 
IsInnerBorderStorednull1266 function TBGRACustomPanel.IsInnerBorderStored: boolean;
1267 begin
1268   Result:=BorderSpacing.InnerBorder<>0;
1269 end;
1270 
1271 procedure TBGRACustomPanel.Resize;
1272 begin
1273   inherited;
1274   Invalidate;
1275   DoOnResize;
1276 end;
1277 
1278 procedure TBGRACustomPanel.SetBorderSpacing(const AValue: TControlBorderSpacing);
1279 begin
1280   if FBorderSpacing=AValue then exit;
1281   FBorderSpacing.Assign(AValue);
1282 end;
1283 
1284 procedure TBGRACustomPanel.SetChildSizing(const AValue: TControlChildSizing);
1285 begin
1286   if (FChildSizing=AValue) then exit;
1287   FChildSizing.Assign(AValue);
1288 end;
1289 
1290 procedure TBGRACustomPanel.SetColor(Value: TColor);
1291 begin
1292   if inherited Color <> Value then
1293   begin
1294     inherited Color := Value;
1295     ParentColor := False;
1296     Perform(CM_COLORCHANGED, 0, 0);
1297     Invalidate;
1298   end;
1299 end;
1300 
GetColornull1301 function TBGRACustomPanel.GetColor : TColor;
1302 begin
1303   Result := inherited Color;
1304 end;
1305 
1306 procedure TBGRACustomPanel.UTF8KeyPress(var UTF8Key: {$IFDEF FPC}TUTF8Char{$ELSE}String{$ENDIF});
1307 begin
1308 end;
1309 
1310 procedure TBGRACustomPanel.EnableAutoSizing;
1311 begin
1312 end;
1313 
TBGRACustomPanel.ColorIsStorednull1314 function TBGRACustomPanel.ColorIsStored: boolean;
1315 begin
1316   Result := not ParentColor;
1317 end;
1318 
1319 procedure TBGRACustomPanel.SetInitialBounds(aLeft, aTop, aWidth, aHeight: integer);
1320 begin
1321   {if (csLoading in ComponentState)
1322   or ((Owner<>nil) and (csLoading in Owner.ComponentState)) then
1323     exit;}
1324   SetBounds(aLeft,aTop,aWidth,aHeight);
1325 //  DoOnResize;
1326 end;
1327 
TBGRACustomPanel.GetControlClassDefaultSizenull1328 class function TBGRACustomPanel.GetControlClassDefaultSize: TSize;
1329 begin
1330   Result.CX := 75;
1331   Result.CY := 50;
1332 end;
1333 
1334 procedure TBGRACustomPanel.CMTextChanged(var Message: TMessage);
1335 begin
1336   TextChanged;
1337 end;
1338 
1339 procedure TBGRACustomPanel.CMMouseEnter(var Message: TMessage);
1340 begin
1341   if FMouseInClient then
1342     Exit;
1343 
1344   FMouseInClient := True;
1345 
1346   // broadcast to parents first
1347   if Assigned(Parent) then
1348     Parent.Perform(CM_MOUSEENTER, 0, LParam(Self));
1349 
1350   // if it is not a child message then perform an event
1351   if (Message.LParam = 0) then
1352     MouseEnter;
1353 end;
1354 
1355 procedure TBGRACustomPanel.CMMouseLeave(var Message: TMessage);
1356 begin
1357   if not FMouseInClient then
1358     Exit;
1359 
1360   FMouseInClient := False;
1361 
1362   // broadcast to parents first
1363   if Assigned(Parent) then
1364     Parent.Perform(CM_MOUSELEAVE, 0, LParam(Self));
1365 
1366   // if it is not a child message then perform an event
1367   if (Message.LParam = 0) then
1368     MouseLeave;
1369 end;
1370 
1371 {$ENDIF}
1372 
1373 {$IFNDEF FPC}
1374 
1375 { TControlBorderSpacing }
1376 
1377 procedure TControlBorderSpacing.SetAround(const AValue: TSpacingSize);
1378 begin
1379   if FAround=AValue then exit;
1380   FAround:=AValue;
1381   Change(false);
1382 end;
1383 
TControlBorderSpacing.IsAroundStorednull1384 function TControlBorderSpacing.IsAroundStored: boolean;
1385 begin
1386   if FDefault = nil
1387   then Result := FAround <> 0
1388   else Result := FAround <> FDefault^.Around;
1389 end;
1390 
IsBottomStorednull1391 function TControlBorderSpacing.IsBottomStored: boolean;
1392 begin
1393   if FDefault = nil
1394   then Result := FBottom <> 0
1395   else Result := FBottom <> FDefault^.Bottom;
1396 end;
1397 
IsInnerBorderStorednull1398 function TControlBorderSpacing.IsInnerBorderStored: boolean;
1399 begin
1400   if Control <> nil then
1401     Result:=Control.IsInnerBorderStored
1402   else
1403     Result:=True;
1404 end;
1405 
IsLeftStorednull1406 function TControlBorderSpacing.IsLeftStored: boolean;
1407 begin
1408   if FDefault = nil
1409   then Result := FLeft <> 0
1410   else Result := FLeft <> FDefault^.Left;
1411 end;
1412 
IsRightStorednull1413 function TControlBorderSpacing.IsRightStored: boolean;
1414 begin
1415   if FDefault = nil
1416   then Result := FRight <> 0
1417   else Result := FRight <> FDefault^.Right;
1418 end;
1419 
IsTopStorednull1420 function TControlBorderSpacing.IsTopStored: boolean;
1421 begin
1422   if FDefault = nil
1423   then Result := FTop <> 0
1424   else Result := FTop <> FDefault^.Top;
1425 end;
1426 
1427 procedure TControlBorderSpacing.SetBottom(const AValue: TSpacingSize);
1428 begin
1429   if FBottom=AValue then exit;
1430   FBottom:=AValue;
1431   Change(false);
1432 end;
1433 
1434 procedure TControlBorderSpacing.SetCellAlignHorizontal(
1435   const AValue: TControlCellAlign);
1436 begin
1437   if FCellAlignHorizontal=AValue then exit;
1438   FCellAlignHorizontal:=AValue;
1439   Change(false);
1440 end;
1441 
1442 procedure TControlBorderSpacing.SetCellAlignVertical(
1443   const AValue: TControlCellAlign);
1444 begin
1445   if FCellAlignVertical=AValue then exit;
1446   FCellAlignVertical:=AValue;
1447   Change(false);
1448 end;
1449 
1450 procedure TControlBorderSpacing.SetInnerBorder(const AValue: Integer);
1451 begin
1452   if FInnerBorder=AValue then exit;
1453   FInnerBorder:=AValue;
1454   if Control<>nil then Control.InvalidatePreferredSize;
1455   Change(true);
1456 end;
1457 
1458 procedure TControlBorderSpacing.SetLeft(const AValue: TSpacingSize);
1459 begin
1460   if FLeft=AValue then exit;
1461   FLeft:=AValue;
1462   Change(false);
1463 end;
1464 
1465 procedure TControlBorderSpacing.SetRight(const AValue: TSpacingSize);
1466 begin
1467   if FRight=AValue then exit;
1468   FRight:=AValue;
1469   Change(false);
1470 end;
1471 
1472 procedure TControlBorderSpacing.SetSpace(Kind: TAnchorKind;
1473   const AValue: integer);
1474 begin
1475   case Kind of
1476   akLeft: Left:=AValue;
1477   akTop: Top:=AValue;
1478   akBottom: Bottom:=AValue;
1479   akRight: Right:=AValue;
1480   end;
1481 end;
1482 
1483 procedure TControlBorderSpacing.SetTop(const AValue: TSpacingSize);
1484 begin
1485   if FTop=AValue then exit;
1486   FTop:=AValue;
1487   Change(false);
1488 end;
1489 
1490 constructor TControlBorderSpacing.Create(OwnerControl: ILCLControl; ADefault: PControlBorderSpacingDefault);
1491 begin
1492   FControl := OwnerControl;
1493   FDefault := ADefault;
1494   if ADefault <> nil then
1495   begin
1496     FLeft := ADefault^.Left;
1497     FRight := ADefault^.Right;
1498     FTop := ADefault^.Top;
1499     FBottom := ADefault^.Bottom;
1500     FAround := ADefault^.Around;
1501   end;
1502   FCellAlignHorizontal := ccaFill;
1503   FCellAlignVertical := ccaFill;
1504   inherited Create;
1505 end;
1506 
1507 procedure TControlBorderSpacing.Assign(Source: TPersistent);
1508 var
1509   SrcSpacing: TControlBorderSpacing;
1510 begin
1511   if Source is TControlBorderSpacing then begin
1512     SrcSpacing:=TControlBorderSpacing(Source);
1513     if IsEqual(SrcSpacing) then exit;
1514 
1515     FAround:=SrcSpacing.Around;
1516     FBottom:=SrcSpacing.Bottom;
1517     FLeft:=SrcSpacing.Left;
1518     FRight:=SrcSpacing.Right;
1519     FTop:=SrcSpacing.Top;
1520     FInnerBorder:=SrcSpacing.InnerBorder;
1521     FCellAlignHorizontal:=SrcSpacing.CellAlignHorizontal;
1522     FCellAlignVertical:=SrcSpacing.CellAlignVertical;
1523 
1524     Change(false);
1525   end else
1526     inherited Assign(Source);
1527 end;
1528 
1529 procedure TControlBorderSpacing.AssignTo(Dest: TPersistent);
1530 begin
1531   Dest.Assign(Self);
1532 end;
1533 
1534 procedure TControlBorderSpacing.AutoAdjustLayout(const AXProportion,
1535   AYProportion: Double);
1536 
1537   procedure Scale(var Value: Integer; const Proportion: Double; var Changed: Boolean);
1538   begin
1539     if Value<>0 then
1540     begin
1541       Value := Round(Value * Proportion);
1542       Changed := True;
1543     end;
1544   end;
1545 var
1546   InnerChanged, OuterChanged: Boolean;
1547 begin
1548   InnerChanged := False;
1549   OuterChanged := False;
1550 
1551   Scale(FAround, AXProportion, OuterChanged);
1552   Scale(FInnerBorder, AXProportion, InnerChanged);
1553   Scale(FLeft, AXProportion, OuterChanged);
1554   Scale(FTop, AYProportion, OuterChanged);
1555   Scale(FRight, AXProportion, OuterChanged);
1556   Scale(FBottom, AYProportion, OuterChanged);
1557 
1558   if OuterChanged or InnerChanged then
1559   begin
1560     if Control<>nil then Control.InvalidatePreferredSize;
1561     Change(InnerChanged);
1562   end;
1563 end;
1564 
TControlBorderSpacing.IsEqualnull1565 function TControlBorderSpacing.IsEqual(Spacing: TControlBorderSpacing
1566   ): boolean;
1567 begin
1568   Result:=(FAround=Spacing.Around)
1569       and (FBottom=Spacing.Bottom)
1570       and (FLeft=Spacing.Left)
1571       and (FRight=Spacing.Right)
1572       and (FTop=Spacing.Top);
1573 end;
1574 
1575 procedure TControlBorderSpacing.GetSpaceAround(var SpaceAround: TRect);
1576 begin
1577   SpaceAround.Left:=Left+Around;
1578   SpaceAround.Top:=Top+Around;
1579   SpaceAround.Right:=Right+Around;
1580   SpaceAround.Bottom:=Bottom+Around;
1581 end;
1582 
1583 
GetSideSpacenull1584 function TControlBorderSpacing.GetSideSpace(Kind: TAnchorKind): Integer;
1585 begin
1586   Result:=Around+GetSpace(Kind);
1587 end;
1588 
GetSpacenull1589 function TControlBorderSpacing.GetSpace(Kind: TAnchorKind): Integer;
1590 begin
1591   case Kind of
1592   akLeft: Result:=Left;
1593   akTop: Result:=Top;
1594   akRight: Result:=Right;
1595   akBottom: Result:=Bottom;
1596   end;
1597 end;
1598 
1599 procedure TControlBorderSpacing.Change(InnerSpaceChanged: Boolean);
1600 begin
1601   if FControl <> nil then
1602     FControl.DoBorderSpacingChange(Self,InnerSpaceChanged);
1603   if Assigned(OnChange) then OnChange(Self);
1604 end;
1605 
GetAroundBottomnull1606 function TControlBorderSpacing.GetAroundBottom: Integer;
1607 begin
1608   Result := Around+Bottom;
1609 end;
1610 
TControlBorderSpacing.GetAroundLeftnull1611 function TControlBorderSpacing.GetAroundLeft: Integer;
1612 begin
1613   Result := Around+Left;
1614 end;
1615 
TControlBorderSpacing.GetAroundRightnull1616 function TControlBorderSpacing.GetAroundRight: Integer;
1617 begin
1618   Result := Around+Right;
1619 end;
1620 
TControlBorderSpacing.GetAroundTopnull1621 function TControlBorderSpacing.GetAroundTop: Integer;
1622 begin
1623   Result := Around+Top;
1624 end;
1625 
GetControlBottomnull1626 function TControlBorderSpacing.GetControlBottom: Integer;
1627 begin
1628   if  (FControl<>nil) and (FControl.GetInstance<>nil) and FControl.GetInstance.InheritsFrom(TControl) then
1629     Result := TControl(FControl.GetInstance).Top +TControl(FControl.GetInstance).Height +Around+Bottom
1630   else
1631     Result := 0;
1632 end;
1633 
GetControlHeightnull1634 function TControlBorderSpacing.GetControlHeight: Integer;
1635 begin
1636   if (FControl<>nil) and (FControl.GetInstance<>nil) and FControl.GetInstance.InheritsFrom(TControl) then
1637     Result := TControl(FControl.GetInstance).Height+Around*2+Top+Bottom
1638   else
1639     Result := 0;
1640 end;
1641 
GetControlLeftnull1642 function TControlBorderSpacing.GetControlLeft: Integer;
1643 begin
1644   if  (FControl<>nil) and (FControl.GetInstance<>nil) and FControl.GetInstance.InheritsFrom(TControl) then
1645     Result := TControl(FControl.GetInstance).Left-Around-Left
1646   else
1647     Result := 0;
1648 end;
1649 
GetControlRightnull1650 function TControlBorderSpacing.GetControlRight: Integer;
1651 begin
1652   if  (FControl<>nil) and (FControl.GetInstance<>nil) and FControl.GetInstance.InheritsFrom(TControl) then
1653     Result := TControl(FControl.GetInstance).Left+TControl(FControl.GetInstance).Width+Around+Right
1654   else
1655     Result := 0;
1656 end;
1657 
GetControlTopnull1658 function TControlBorderSpacing.GetControlTop: Integer;
1659 begin
1660   if (FControl<>nil) and (FControl.GetInstance<>nil) and FControl.GetInstance.InheritsFrom(TControl) then
1661     Result := TControl(FControl.GetInstance).Top-Around-Top
1662   else
1663     Result := 0;
1664 end;
1665 
GetControlWidthnull1666 function TControlBorderSpacing.GetControlWidth: Integer;
1667 begin
1668   if (FControl<>nil) and (FControl.GetInstance<>nil) and FControl.GetInstance.InheritsFrom(TControl) then
1669     Result := TControl(FControl.GetInstance).Width+Around*2+Left+Right
1670   else
1671     Result := 0;
1672 end;
1673 
1674 { TControlChildSizing }
1675 
1676 procedure TControlChildSizing.SetEnlargeHorizontal(
1677   const AValue: TChildControlResizeStyle);
1678 begin
1679   if FEnlargeHorizontal=AValue then exit;
1680   FEnlargeHorizontal:=AValue;
1681   Change;
1682 end;
1683 
1684 procedure TControlChildSizing.SetControlsPerLine(const AValue: integer);
1685 begin
1686   if FControlsPerLine=AValue then exit;
1687   FControlsPerLine:=AValue;
1688   Change;
1689 end;
1690 
1691 procedure TControlChildSizing.SetEnlargeVertical(
1692   const AValue: TChildControlResizeStyle);
1693 begin
1694   if FEnlargeVertical=AValue then exit;
1695   FEnlargeVertical:=AValue;
1696   Change;
1697 end;
1698 
1699 procedure TControlChildSizing.SetHorizontalSpacing(const AValue: integer);
1700 begin
1701   if FHorizontalSpacing=AValue then exit;
1702   FHorizontalSpacing:=AValue;
1703   Change;
1704 end;
1705 
1706 procedure TControlChildSizing.SetLayout(const AValue: TControlChildrenLayout);
1707 begin
1708   if FLayout=AValue then exit;
1709   FLayout:=AValue;
1710   //debugln('TControlChildSizing.SetLayout ',DbgSName(Control));
1711   Change;
1712 end;
1713 
1714 procedure TControlChildSizing.SetLeftRightSpacing(const AValue: integer);
1715 begin
1716   if FLeftRightSpacing=AValue then exit;
1717   FLeftRightSpacing:=AValue;
1718   Change;
1719 end;
1720 
1721 procedure TControlChildSizing.SetShrinkHorizontal(
1722   const AValue: TChildControlResizeStyle);
1723 begin
1724   if FShrinkHorizontal=AValue then exit;
1725   FShrinkHorizontal:=AValue;
1726   Change;
1727 end;
1728 
1729 procedure TControlChildSizing.SetShrinkVertical(
1730   const AValue: TChildControlResizeStyle);
1731 begin
1732   if FShrinkVertical=AValue then exit;
1733   FShrinkVertical:=AValue;
1734   Change;
1735 end;
1736 
1737 procedure TControlChildSizing.SetTopBottomSpacing(const AValue: integer);
1738 begin
1739   if FTopBottomSpacing=AValue then exit;
1740   FTopBottomSpacing:=AValue;
1741   Change;
1742 end;
1743 
1744 procedure TControlChildSizing.SetVerticalSpacing(const AValue: integer);
1745 begin
1746   if FVerticalSpacing=AValue then exit;
1747   FVerticalSpacing:=AValue;
1748   Change;
1749 end;
1750 
1751 constructor TControlChildSizing.Create(OwnerControl: ILCLControl);
1752 begin
1753   inherited Create;
1754   FControl := OwnerControl;
1755   FLayout := cclNone;
1756   FEnlargeHorizontal :=crsAnchorAligning;
1757   FEnlargeVertical := crsAnchorAligning;
1758   FShrinkHorizontal := crsAnchorAligning;
1759   FShrinkVertical := crsAnchorAligning;
1760 end;
1761 
1762 procedure TControlChildSizing.Assign(Source: TPersistent);
1763 var
1764   SrcSizing: TControlChildSizing;
1765 begin
1766   if Source is TControlChildSizing then begin
1767     SrcSizing:=TControlChildSizing(Source);
1768     if IsEqual(SrcSizing) then exit;
1769 
1770     FEnlargeHorizontal:=SrcSizing.EnlargeHorizontal;
1771     FEnlargeVertical:=SrcSizing.EnlargeVertical;
1772     FShrinkHorizontal:=SrcSizing.ShrinkHorizontal;
1773     FShrinkVertical:=SrcSizing.ShrinkVertical;
1774     FEnlargeHorizontal:=SrcSizing.EnlargeHorizontal;
1775     FEnlargeVertical:=SrcSizing.EnlargeVertical;
1776     FShrinkHorizontal:=SrcSizing.ShrinkHorizontal;
1777     FShrinkVertical:=SrcSizing.ShrinkVertical;
1778     FControlsPerLine:=SrcSizing.ControlsPerLine;
1779     FLayout:=SrcSizing.Layout;
1780     FLeftRightSpacing:=SrcSizing.LeftRightSpacing;
1781     FTopBottomSpacing:=SrcSizing.TopBottomSpacing;
1782     FHorizontalSpacing:=SrcSizing.HorizontalSpacing;
1783     FVerticalSpacing:=SrcSizing.VerticalSpacing;
1784 
1785     Change;
1786   end else
1787     inherited Assign(Source);
1788 end;
1789 
1790 procedure TControlChildSizing.AssignTo(Dest: TPersistent);
1791 begin
1792   Dest.Assign(Self);
1793 end;
1794 
TControlChildSizing.IsEqualnull1795 function TControlChildSizing.IsEqual(Sizing: TControlChildSizing): boolean;
1796 begin
1797   Result:=(FEnlargeHorizontal=Sizing.EnlargeHorizontal)
1798       and (FEnlargeVertical=Sizing.EnlargeVertical)
1799       and (FShrinkHorizontal=Sizing.ShrinkHorizontal)
1800       and (FShrinkVertical=Sizing.ShrinkVertical)
1801       and (FEnlargeHorizontal=Sizing.EnlargeHorizontal)
1802       and (FEnlargeVertical=Sizing.EnlargeVertical)
1803       and (FShrinkHorizontal=Sizing.ShrinkHorizontal)
1804       and (FShrinkVertical=Sizing.ShrinkVertical)
1805       and (FControlsPerLine=Sizing.ControlsPerLine)
1806       and (FLayout=Sizing.Layout)
1807       and (FLeftRightSpacing=Sizing.LeftRightSpacing)
1808       and (FTopBottomSpacing=Sizing.TopBottomSpacing)
1809       and (FHorizontalSpacing=Sizing.HorizontalSpacing)
1810       and (FVerticalSpacing=Sizing.VerticalSpacing);
1811 end;
1812 
1813 procedure TControlChildSizing.SetGridSpacing(Spacing: integer);
1814 begin
1815   if (LeftRightSpacing=Spacing)
1816   and (TopBottomSpacing=Spacing)
1817   and (HorizontalSpacing=Spacing)
1818   and (VerticalSpacing=Spacing) then exit;
1819   fLeftRightSpacing:=Spacing;
1820   fTopBottomSpacing:=Spacing;
1821   fHorizontalSpacing:=Spacing;
1822   fVerticalSpacing:=Spacing;
1823   Change;
1824 end;
1825 
1826 procedure TControlChildSizing.Change;
1827 begin
1828   if (FControl<>nil) and (FControl.GetInstance<>nil) and FControl.GetInstance.InheritsFrom(TBGRACustomCtrl) then
1829     TBGRACustomCtrl(FControl.GetInstance).DoChildSizingChange(Self);
1830   if Assigned(FOnChange) then
1831    FOnChange(Self);
1832 end;
1833 
1834 {$ENDIF}
1835 
1836 end.
1837 
1838