jvcllaz: Fix ChangeBounds loop error of TJvXPCustomToolButton. Minor improvements of JvXPCtrls demo.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6331 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-04-20 21:59:42 +00:00
parent cce7356d4c
commit 1c601ade43
7 changed files with 239 additions and 100 deletions

View File

@ -13,7 +13,6 @@
<XPManifest> <XPManifest>
<DpiAware Value="True"/> <DpiAware Value="True"/>
</XPManifest> </XPManifest>
<Icon Value="0"/>
</General> </General>
<BuildModes Count="1"> <BuildModes Count="1">
<Item1 Name="Default" Default="True"/> <Item1 Name="Default" Default="True"/>

View File

@ -12,7 +12,7 @@ object Form1: TForm1
LCLVersion = '1.9.0.0' LCLVersion = '1.9.0.0'
object JvTabBar1: TJvTabBar object JvTabBar1: TJvTabBar
Left = 0 Left = 0
Top = 40 Top = 42
Width = 614 Width = 614
Visible = False Visible = False
HotTracking = True HotTracking = True
@ -25,7 +25,7 @@ object Form1: TForm1
end end
object ToolBar: TToolBar object ToolBar: TToolBar
Left = 0 Left = 0
Height = 40 Height = 42
Top = 0 Top = 0
Width = 614 Width = 614
AutoSize = True AutoSize = True
@ -37,17 +37,17 @@ object Form1: TForm1
TabOrder = 1 TabOrder = 1
object TbOpen: TToolButton object TbOpen: TToolButton
Left = 1 Left = 1
Top = 0 Top = 2
Action = AcFileOpen Action = AcFileOpen
end end
object TbQuit: TToolButton object TbQuit: TToolButton
Left = 102 Left = 102
Top = 0 Top = 2
Action = AcFileQuit Action = AcFileQuit
end end
object TbStyle: TToolButton object TbStyle: TToolButton
Left = 47 Left = 47
Top = 0 Top = 2
Caption = 'Style' Caption = 'Style'
DropdownMenu = PopupMenu1 DropdownMenu = PopupMenu1
ImageIndex = 3 ImageIndex = 3
@ -56,18 +56,17 @@ object Form1: TForm1
object ToolButton2: TToolButton object ToolButton2: TToolButton
Left = 97 Left = 97
Height = 40 Height = 40
Top = 0 Top = 2
Caption = 'ToolButton2' Caption = 'ToolButton2'
Style = tbsDivider Style = tbsDivider
end end
end end
object Memo1: TMemo object Memo1: TMemo
Left = 4 Left = 0
Height = 244 Height = 250
Top = 67 Top = 65
Width = 606 Width = 614
Align = alClient Align = alClient
BorderSpacing.Around = 4
Font.CharSet = ANSI_CHARSET Font.CharSet = ANSI_CHARSET
Font.Color = clBlack Font.Color = clBlack
Font.Height = -11 Font.Height = -11

View File

@ -2,23 +2,23 @@ object frmMain: TfrmMain
Left = 291 Left = 291
Height = 191 Height = 191
Top = 290 Top = 290
Width = 456 Width = 486
BorderIcons = [biSystemMenu, biMinimize] BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle BorderStyle = bsSingle
Caption = 'frmMain' Caption = 'frmMain'
ClientHeight = 191 ClientHeight = 191
ClientWidth = 456 ClientWidth = 486
Color = clBtnFace Color = clBtnFace
DefaultMonitor = dmDesktop DefaultMonitor = dmDesktop
Font.Color = clWindowText Font.Color = clWindowText
OnCreate = FormCreate OnCreate = FormCreate
Position = poDesktopCenter Position = poDesktopCenter
LCLVersion = '1.7' LCLVersion = '1.9.0.0'
object cntHeader: TJvXPContainer object cntHeader: TJvXPContainer
Left = 0 Left = 0
Height = 15 Height = 15
Top = 0 Top = 0
Width = 456 Width = 486
Caption = 'cntHeader' Caption = 'cntHeader'
OnPaint = cntHeaderPaint OnPaint = cntHeaderPaint
Align = alTop Align = alTop
@ -35,22 +35,34 @@ object frmMain: TfrmMain
end end
end end
object cntNetPanel: TJvXPContainer object cntNetPanel: TJvXPContainer
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = cntHeader
AnchorSideTop.Side = asrBottom
AnchorSideBottom.Control = chkOfficeStyle
AnchorSideBottom.Side = asrBottom
Left = 8 Left = 8
Height = 161 Height = 162
Top = 24 Top = 23
Width = 121 Width = 129
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BoundColor = 16251903 BoundColor = 16251903
BoundLines = [blLeft, blTop, blRight, blBottom] BoundLines = [blLeft, blTop, blRight, blBottom]
Caption = 'cntNetPanel' Caption = 'cntNetPanel'
Color = 16251903 Color = 16251903
ParentColor = False ParentColor = False
Spacing = 34
OnPaint = cntNetPanelPaint OnPaint = cntNetPanelPaint
Anchors = [akTop, akLeft, akBottom]
object lbBrowse: TLabel object lbBrowse: TLabel
Left = 8 AnchorSideLeft.Control = cntNetPanel
AnchorSideTop.Control = cntNetHeader
AnchorSideTop.Side = asrBottom
Left = 9
Height = 15 Height = 15
Top = 24 Top = 21
Width = 42 Width = 42
BorderSpacing.Left = 8
BorderSpacing.Top = 3
Caption = 'Browse' Caption = 'Browse'
Font.Color = clWindowText Font.Color = clWindowText
Font.Style = [fsBold] Font.Style = [fsBold]
@ -58,44 +70,71 @@ object frmMain: TfrmMain
ParentFont = False ParentFont = False
end end
object shpSeperator: TShape object shpSeperator: TShape
Left = 8 AnchorSideLeft.Control = cntNetPanel
AnchorSideTop.Control = lbBrowse
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = cntNetPanel
AnchorSideRight.Side = asrBottom
Left = 9
Height = 1 Height = 1
Top = 37 Top = 37
Width = 108 Width = 111
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 8
BorderSpacing.Top = 1
BorderSpacing.Right = 8
Pen.Color = clSilver Pen.Color = clSilver
end end
object lbInternalPage: TLabel object lbInternalPage: TLabel
AnchorSideLeft.Control = lbConfigure
AnchorSideTop.Control = shpSeperator
AnchorSideTop.Side = asrBottom
Cursor = crHandPoint Cursor = crHandPoint
Left = 24 Left = 26
Height = 15 Height = 15
Top = 40 Top = 42
Width = 69 Width = 69
BorderSpacing.Top = 4
Caption = 'Internal Page' Caption = 'Internal Page'
ParentColor = False ParentColor = False
end end
object lbWebEditor: TLabel object lbWebEditor: TLabel
AnchorSideLeft.Control = lbConfigure
AnchorSideTop.Control = lbInternalPage
AnchorSideTop.Side = asrBottom
Cursor = crHandPoint Cursor = crHandPoint
Left = 24 Left = 26
Height = 15 Height = 15
Top = 56 Top = 59
Width = 60 Width = 60
BorderSpacing.Top = 2
Caption = 'Web-Editor' Caption = 'Web-Editor'
ParentColor = False ParentColor = False
end end
object lbConfigure: TLabel object lbConfigure: TLabel
AnchorSideLeft.Control = imgConfigure
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = imgConfigure
AnchorSideTop.Side = asrCenter
Cursor = crHandPoint Cursor = crHandPoint
Left = 24 Left = 26
Height = 15 Height = 15
Top = 80 Top = 85
Width = 62 Width = 62
BorderSpacing.Left = 4
Caption = 'Configure...' Caption = 'Configure...'
ParentColor = False ParentColor = False
end end
object imgConfigure: TImage object imgConfigure: TImage
AnchorSideLeft.Control = cntNetPanel
AnchorSideTop.Control = lbWebEditor
AnchorSideTop.Side = asrBottom
Left = 5 Left = 5
Height = 17 Height = 17
Top = 79 Top = 84
Width = 17 Width = 17
BorderSpacing.Left = 4
BorderSpacing.Top = 10
Picture.Data = { Picture.Data = {
07544269746D617036030000424D360300000000000036000000280000001000 07544269746D617036030000424D360300000000000036000000280000001000
0000100000000100180000000000000300000000000000000000000000000000 0000100000000100180000000000000300000000000000000000000000000000
@ -129,18 +168,21 @@ object frmMain: TfrmMain
end end
object cntNetHeader: TJvXPContainer object cntNetHeader: TJvXPContainer
Left = 1 Left = 1
Height = 15 Height = 17
Top = 1 Top = 1
Width = 119 Width = 127
Alignment = taLeftJustify Alignment = taLeftJustify
AutoSize = True
BoundColor = clRed
Caption = 'ToDo-List' Caption = 'ToDo-List'
Color = 14936557 Color = 14936557
ParentColor = False ParentColor = False
ShowCaption = True ShowCaption = True
Spacing = 34 Spacing = 18
Align = alTop Align = alTop
object btnLeft: TJvXPToolButton object btnLeft: TJvXPToolButton
Left = 0 Left = 0
Height = 17
Top = 0 Top = 0
ToolType = ttArrowLeft ToolType = ttArrowLeft
Align = alLeft Align = alLeft
@ -148,136 +190,200 @@ object frmMain: TfrmMain
StyleManager = styleOffice StyleManager = styleOffice
end end
object btnRight: TJvXPToolButton object btnRight: TJvXPToolButton
Left = 15 Left = 112
Height = 17
Top = 0 Top = 0
ToolType = ttArrowRight ToolType = ttArrowRight
Align = alLeft Align = alRight
ImageIndex = 0 ImageIndex = 0
StyleManager = styleOffice StyleManager = styleOffice
end end
end end
end end
object btnOK: TJvXPButton object btnOK: TJvXPButton
Left = 296 AnchorSideTop.Control = btnCancel
Top = 160 AnchorSideRight.Control = btnCancel
AnchorSideBottom.Control = btnCancel
AnchorSideBottom.Side = asrBottom
Left = 329
Top = 159
Caption = '&OK' Caption = '&OK'
TabOrder = 2 TabOrder = 2
Anchors = [akTop, akRight, akBottom]
BorderSpacing.Right = 8
Default = True Default = True
ModalResult = 1 ModalResult = 1
Anchors = [akTop, akRight]
OnClick = btnCloseClick OnClick = btnCloseClick
end end
object btnCancel: TJvXPButton object btnCancel: TJvXPButton
Left = 376 AnchorSideRight.Control = btn4
Top = 160 AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = chkOfficeStyle
AnchorSideBottom.Side = asrBottom
Left = 410
Top = 159
Caption = '&Cancel' Caption = '&Cancel'
TabOrder = 3 TabOrder = 3
Anchors = [akTop, akRight, akBottom]
BorderSpacing.Right = 8
Cancel = True Cancel = True
ModalResult = 2 ModalResult = 2
Anchors = [akTop, akRight]
end end
object btn1: TJvXPButton object btn1: TJvXPButton
Left = 136 AnchorSideLeft.Control = cntNetPanel
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = cntNetPanel
Left = 145
Height = 41 Height = 41
Top = 24 Top = 23
Width = 80
Action = acBtn1 Action = acBtn1
TabOrder = 4 TabOrder = 4
BorderSpacing.Left = 8
end end
object btn2: TJvXPButton object btn2: TJvXPButton
Left = 216 AnchorSideLeft.Control = btn1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = btn1
Left = 233
Height = 41 Height = 41
Top = 24 Top = 23
Width = 81
Action = acBtn2 Action = acBtn2
TabOrder = 5 TabOrder = 5
BorderSpacing.Left = 8
Layout = blGlyphRight Layout = blGlyphRight
end end
object btn4: TJvXPButton object btn4: TJvXPButton
Left = 376 AnchorSideLeft.Control = btn3
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = btn1
Left = 410
Height = 41 Height = 41
Top = 24 Top = 23
Width = 81
Action = acBtn4 Action = acBtn4
TabOrder = 6 TabOrder = 6
BorderSpacing.Left = 8
BorderSpacing.Right = 8
Layout = blGlyphBottom Layout = blGlyphBottom
end end
object btn3: TJvXPButton object btn3: TJvXPButton
Left = 296 AnchorSideLeft.Control = btn2
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = btn1
Left = 322
Height = 41 Height = 41
Top = 24 Top = 23
Width = 80
Action = acBtn3 Action = acBtn3
TabOrder = 7 TabOrder = 7
BorderSpacing.Left = 8
Layout = blGlyphTop Layout = blGlyphTop
end end
object chkToogleEnable: TJvXPCheckbox object chkToogleEnable: TJvXPCheckbox
Left = 136 AnchorSideLeft.Control = btn1
AnchorSideTop.Control = btn1
AnchorSideTop.Side = asrBottom
Left = 145
Height = 17 Height = 17
Top = 72 Top = 80
Width = 313 Width = 334
Caption = '&Toogle Enable-Mode' Caption = '&Toogle Enable-Mode'
TabOrder = 8 TabOrder = 8
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 16
StyleManager = styleOffice StyleManager = styleOffice
OnClick = chkToogleEnableClick OnClick = chkToogleEnableClick
end end
object chkOfficeStyle: TJvXPCheckbox object chkOfficeStyle: TJvXPCheckbox
Left = 136 AnchorSideLeft.Control = btn1
AnchorSideTop.Control = chk2
AnchorSideTop.Side = asrBottom
Left = 145
Height = 17 Height = 17
Top = 162 Top = 163
Width = 121 Width = 121
Caption = 'Office Style' Caption = 'Office Style'
TabOrder = 9 TabOrder = 9
Checked = True Checked = True
State = cbChecked State = cbChecked
BorderSpacing.Top = 16
BorderSpacing.Bottom = 8
StyleManager = styleOffice StyleManager = styleOffice
OnClick = chkOfficeStyleClick OnClick = chkOfficeStyleClick
end end
object chk1: TJvXPCheckbox object chk1: TJvXPCheckbox
Left = 136 AnchorSideLeft.Control = btn1
AnchorSideTop.Control = chkToogleEnable
AnchorSideTop.Side = asrBottom
Left = 145
Height = 17 Height = 17
Top = 104 Top = 105
Width = 121 Width = 153
Caption = 'Additional Check1' Caption = 'Additional Check1'
TabOrder = 10 TabOrder = 10
BorderSpacing.Top = 8
StyleManager = styleOffice StyleManager = styleOffice
end end
object chk2: TJvXPCheckbox object chk2: TJvXPCheckbox
Left = 136 AnchorSideLeft.Control = btn1
AnchorSideTop.Control = chk1
AnchorSideTop.Side = asrBottom
Left = 145
Height = 17 Height = 17
Top = 128 Top = 130
Width = 121 Width = 153
Caption = 'Additional Check2' Caption = 'Additional Check2'
TabOrder = 11 TabOrder = 11
BorderSpacing.Top = 8
StyleManager = styleOffice StyleManager = styleOffice
end end
object dxToolButton1: TJvXPToolButton object dxToolButton1: TJvXPToolButton
Left = 300 AnchorSideLeft.Control = btnOK
Top = 129 AnchorSideTop.Control = chk2
AnchorSideTop.Side = asrCenter
Left = 329
Top = 131
ImageIndex = 0 ImageIndex = 0
StyleManager = styleOffice StyleManager = styleOffice
end end
object dxToolButton2: TJvXPToolButton object dxToolButton2: TJvXPToolButton
Left = 316 AnchorSideLeft.Control = dxToolButton1
Top = 129 AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = dxToolButton1
Left = 344
Top = 131
ToolType = ttMaximize ToolType = ttMaximize
ImageIndex = 0 ImageIndex = 0
StyleManager = styleOffice StyleManager = styleOffice
end end
object dxToolButton3: TJvXPToolButton object dxToolButton3: TJvXPToolButton
Left = 332 AnchorSideLeft.Control = dxToolButton2
Top = 129 AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = dxToolButton1
Left = 359
Top = 131
ToolType = ttMinimize ToolType = ttMinimize
ImageIndex = 0 ImageIndex = 0
StyleManager = styleOffice StyleManager = styleOffice
end end
object dxToolButton4: TJvXPToolButton object dxToolButton4: TJvXPToolButton
Left = 364 AnchorSideLeft.Control = dxToolButton5
Top = 129 AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = dxToolButton1
Left = 389
Top = 131
ToolType = ttPopup ToolType = ttPopup
ImageIndex = 0 ImageIndex = 0
StyleManager = styleOffice StyleManager = styleOffice
end end
object dxToolButton5: TJvXPToolButton object dxToolButton5: TJvXPToolButton
Left = 348 AnchorSideLeft.Control = dxToolButton3
Top = 130 AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = dxToolButton1
Left = 374
Top = 131
ToolType = ttRestore ToolType = ttRestore
ImageIndex = 0 ImageIndex = 0
StyleManager = styleOffice StyleManager = styleOffice

View File

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="10"/> <Version Value="11"/>
<PathDelim Value="\"/> <PathDelim Value="\"/>
<General> <General>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
@ -17,9 +17,10 @@
<Version Value="2"/> <Version Value="2"/>
</PublishOptions> </PublishOptions>
<RunParams> <RunParams>
<local> <FormatVersion Value="2"/>
<FormatVersion Value="1"/> <Modes Count="1">
</local> <Mode0 Name="default"/>
</Modes>
</RunParams> </RunParams>
<RequiredPackages Count="2"> <RequiredPackages Count="2">
<Item1> <Item1>

View File

@ -31,7 +31,7 @@ unit JvXPButtons;
interface interface
uses uses
Classes, TypInfo, LCLIntf, LCLType, LCLProc, LMessages, Graphics, Classes, TypInfo, LCLIntf, LCLType, LCLProc, LMessages, Types, Graphics,
Controls, Forms, ActnList, ImgList, Menus, Controls, Forms, ActnList, ImgList, Menus,
JvXPCore, JvXPCoreUtils; JvXPCore, JvXPCoreUtils;
@ -202,13 +202,13 @@ type
procedure SetDropDownMenu(const Value: TPopupMenu); procedure SetDropDownMenu(const Value: TPopupMenu);
procedure DoImagesChange(Sender: TObject); procedure DoImagesChange(Sender: TObject);
protected protected
class function GetControlClassDefaultSize: TSize; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X: Integer; Y: Integer); override; X: Integer; Y: Integer); override;
procedure SetToolType(Value: TJvXPToolType); virtual; procedure SetToolType(Value: TJvXPToolType); virtual;
procedure Paint; override; procedure Paint; override;
procedure HookResized; override; procedure HookResized; override;
property ToolType: TJvXPToolType read FToolType write SetToolType default ttClose; property ToolType: TJvXPToolType read FToolType write SetToolType default ttClose;
property DropDownMenu: TPopupMenu read FDropDownMenu write SetDropDownMenu; property DropDownMenu: TPopupMenu read FDropDownMenu write SetDropDownMenu;
property Images: TCustomImageList read FImages write SetImages; property Images: TCustomImageList read FImages write SetImages;
@ -286,7 +286,6 @@ type
implementation implementation
//{$R ../resource/JvXPCore.res}
//=== { TJvXPCustomButtonActionLink } ======================================== //=== { TJvXPCustomButtonActionLink } ========================================
@ -593,13 +592,6 @@ begin
} }
end; end;
{
procedure TJvXPCustomButton.HookResized;
begin
UpdateBitmaps;
inherited;
end;
}
procedure TJvXPCustomButton.SetBounds(ALeft, ATop, AWidth, AHeight: integer); procedure TJvXPCustomButton.SetBounds(ALeft, ATop, AWidth, AHeight: integer);
begin begin
@ -787,7 +779,8 @@ begin
FToolType := ttClose; FToolType := ttClose;
FChangeLink := TChangeLink.Create; FChangeLink := TChangeLink.Create;
FChangeLink.OnChange := DoImagesChange; FChangeLink.OnChange := DoImagesChange;
HookResized; Width := 15;
Height := 15;
end; end;
destructor TJvXPCustomToolButton.Destroy; destructor TJvXPCustomToolButton.Destroy;
@ -796,13 +789,24 @@ begin
inherited Destroy; inherited Destroy;
end; end;
class function TJvXPCustomToolButton.GetControlClassDefaultSize: TSize;
begin
Result.CX := 15;
Result.CY := 15;
end;
procedure TJvXPCustomToolButton.HookResized; procedure TJvXPCustomToolButton.HookResized;
begin begin
// Don't change the size here - it will cause an infinite ChangeBoundsLoop
// And: why must the size stay at 15 x 15 pixels?
{
inherited;
if ToolType <> ttImage then if ToolType <> ttImage then
begin begin
Height := 15; Height := 15;
Width := 15; Width := 15;
end; end;
}
end; end;
procedure TJvXPCustomToolButton.SetToolType(Value: TJvXPToolType); procedure TJvXPCustomToolButton.SetToolType(Value: TJvXPToolType);

View File

@ -56,7 +56,7 @@ type
FLayout: TTextLayout; FLayout: TTextLayout;
FShowBoundLines: Boolean; FShowBoundLines: Boolean;
FShowCaption: Boolean; FShowCaption: Boolean;
FSpacing: Byte; FSpacing: Integer;
FWordWrap: Boolean; FWordWrap: Boolean;
FOnEnabledChanged: TNotifyEvent; FOnEnabledChanged: TNotifyEvent;
FOnPaint: TJvXPPaintEvent; FOnPaint: TJvXPPaintEvent;
@ -70,15 +70,18 @@ type
procedure SetLayout(Value: TTextLayout); procedure SetLayout(Value: TTextLayout);
procedure SetShowBoundLines(Value: Boolean); procedure SetShowBoundLines(Value: Boolean);
procedure SetShowCaption(Value: Boolean); procedure SetShowCaption(Value: Boolean);
procedure SetSpacing(Value: Byte); procedure SetSpacing(Value: Integer);
procedure SetWordWrap(Value: Boolean); procedure SetWordWrap(Value: Boolean);
protected protected
procedure CreateParams(var Params: TCreateParams); override; procedure CreateParams(var Params: TCreateParams); override;
procedure AdjustClientRect(var Rect: TRect); override; procedure AdjustClientRect(var Rect: TRect); override;
procedure GetPreferredSize(var PreferredWidth, PreferredHeight: integer;
Raw: boolean = false; WithThemeSpace: boolean = true); override;
procedure HookEnabledChanged; override; procedure HookEnabledChanged; override;
procedure HookMouseDown; override; procedure HookMouseDown; override;
procedure HookPosChanged; override; procedure HookPosChanged; override;
procedure Paint; override; procedure Paint; override;
procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
property Alignment: TAlignment read FAlignment write SetAlignment default taCenter; property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 0; property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 0;
property BoundColor: TColor read FBoundColor write SetBoundColor default clGray; property BoundColor: TColor read FBoundColor write SetBoundColor default clGray;
@ -94,7 +97,7 @@ type
default True; default True;
property ShowCaption: Boolean read FShowCaption write SetShowCaption property ShowCaption: Boolean read FShowCaption write SetShowCaption
default False; default False;
property Spacing: Byte read FSpacing write SetSpacing default 5; property Spacing: Integer read FSpacing write SetSpacing default 5;
property Width default 185; property Width default 185;
property WordWrap: Boolean read FWordWrap write SetWordWrap default False; property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
property OnEnabledChanged: TNotifyEvent read FOnEnabledChanged write FOnEnabledChanged; property OnEnabledChanged: TNotifyEvent read FOnEnabledChanged write FOnEnabledChanged;
@ -190,8 +193,9 @@ constructor TJvXPCustomContainer.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
ControlStyle := ControlStyle + [csAcceptsControls]; ControlStyle := ControlStyle + [csAcceptsControls];
Height := 41; SetInitialBounds(0, 0, 41, 185);
Width := 185; // Height := 41;
// Width := 185;
FAlignment := taCenter; FAlignment := taCenter;
FBoundColor := clGray; FBoundColor := clGray;
FBoundLines := []; FBoundLines := [];
@ -222,6 +226,18 @@ begin
end; end;
procedure TJvXPCustomContainer.GetPreferredSize(
var PreferredWidth, PreferredHeight: integer;
Raw: boolean = false; WithThemeSpace: boolean = true);
begin
inherited;
if FShowCaption and (Caption <> '') and HandleAllocated then begin
Canvas.Font.Assign(Font);
PreferredHeight := Canvas.TextHeight('Tg') + 2;
end;
end;
procedure TJvXPCustomContainer.HookEnabledChanged; procedure TJvXPCustomContainer.HookEnabledChanged;
var var
I: Integer; I: Integer;
@ -268,6 +284,16 @@ begin
end; end;
end; end;
procedure TJvXPCustomContainer.SetBorderWidth(Value: TBorderWidth);
begin
if Value <> FBorderWidth then
begin
FBorderWidth := Value;
Realign;
InternalRedraw;
end;
end;
procedure TJvXPCustomContainer.SetBoundColor(Value: TColor); procedure TJvXPCustomContainer.SetBoundColor(Value: TColor);
begin begin
if Value <> FBoundColor then if Value <> FBoundColor then
@ -287,14 +313,13 @@ begin
end; end;
end; end;
procedure TJvXPCustomContainer.SetBorderWidth(Value: TBorderWidth); procedure TJvXPCustomContainer.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
begin begin
if Value <> FBorderWidth then if (ALeft = Left) and (ATop = Top) and (AWidth = Width) and (AHeight = Height) then
begin exit;
FBorderWidth := Value; if AutoSize and WordWrap then
Realign; InvalidatePreferredSize;
InternalRedraw; inherited;
end;
end; end;
procedure TJvXPCustomContainer.SetEnabledMode(Value: TJvXPEnabledMode); procedure TJvXPCustomContainer.SetEnabledMode(Value: TJvXPEnabledMode);
@ -353,7 +378,7 @@ begin
end; end;
end; end;
procedure TJvXPCustomContainer.SetSpacing(Value: Byte); procedure TJvXPCustomContainer.SetSpacing(Value: Integer);
begin begin
if Value <> FSpacing then if Value <> FSpacing then
begin begin
@ -390,6 +415,7 @@ var
begin begin
with AParent, Canvas do with AParent, Canvas do
begin begin
Canvas.Font.Assign(AFont);
DrawStyle := Alignments[AAlignment]; DrawStyle := Alignments[AAlignment];
if (DrawStyle <> DT_LEFT) and (ARect.Right - ARect.Left < TextWidth(ACaption)) then if (DrawStyle <> DT_LEFT) and (ARect.Right - ARect.Left < TextWidth(ACaption)) then
DrawStyle := DT_LEFT; DrawStyle := DT_LEFT;
@ -437,7 +463,6 @@ begin
end; end;
if FShowCaption then if FShowCaption then
begin begin
Font.Assign(Self.Font);
InflateRect(Rect, -FSpacing, -1); InflateRect(Rect, -FSpacing, -1);
if csDesigning in ComponentState then if csDesigning in ComponentState then
begin begin

View File

@ -395,10 +395,15 @@ begin
Rect := Bounds(0, 0, ABitmap.Width, ABitmap.Height); Rect := Bounds(0, 0, ABitmap.Width, ABitmap.Height);
ColorMap := TBitmap.Create; ColorMap := TBitmap.Create;
try try
// Just the create the handle
ColorMap.Canvas.Brush.Color := clWhite;
ColorMap.Canvas.FillRect(0, 0, 1, 1);
// Assign the source bitmap
ColorMap.Assign(ABitmap); ColorMap.Assign(ABitmap);
ABitmap.FreeImage; ABitmap.FreeImage;
with ColorMap.Canvas do with ColorMap.Canvas do
begin begin
// Replace color clBlack by AColor
Brush.Color := AColor; Brush.Color := AColor;
BrushCopy(Rect, ABitmap, Rect, clBlack); BrushCopy(Rect, ABitmap, Rect, clBlack);
end; end;