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>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -395,10 +395,15 @@ begin
Rect := Bounds(0, 0, ABitmap.Width, ABitmap.Height);
ColorMap := TBitmap.Create;
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);
ABitmap.FreeImage;
with ColorMap.Canvas do
begin
// Replace color clBlack by AColor
Brush.Color := AColor;
BrushCopy(Rect, ABitmap, Rect, clBlack);
end;