paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 14:58:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revision(s) 54810 #ee8a7ab7a7, 55109-55114 #3c692e825d-#3c692e825d, 55118 #dd3f611b28, 55122 #ff8b49aedd, 55126 #48dbf5c56d from trunk:

Browse Source 
LCL: new Database Login dialog. Modified patch by LacaK, issue #27764
........
LCL: TToolBar: remove in 1.7 introduced incompatiblity and use real values for ButtonHeight, ButtonWidth, ButtonDropWidth.
........
LCL: TTreeView: remove in 1.7 introduced incompatiblity and use real values for ExpandSignSize and Indent.
........
LCL: TTreeView: replace wrong property default for DefaultItemHeight with stored function
........
LCL: TTreeView: fix signs for r55110 #73e1e2caee
........
LCL: Implement TControl.AddHandlerOnMouseWheel/RemoveHandlerOnMouseWheel.Part of Issue #0031868.
........
TUpDown: Handle MouseWheel of Associate. Issue #0031868.
........
LCL: TTreeView: Win32 Fixed warning TResourceCacheItem.IncreaseRefCount 1000 TPenHandleCache. Issue #30661
........
LCL: TTreeView: Fix non-standard scrolling behaviour on selecting in multiline treeview. Issue #31681. Patch by Eric Heijnen.
........
LCL: listbox: fix default value for Options
........

git-svn-id: branches/fixes_1_8@55151 -
This commit is contained in:
maxim 2017-06-01 22:51:43 +00:00
parent 4d79b6c9e4
commit e8cfa79139
13 changed files with 370 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -7155,6 +7155,7 @@ lcl/forms.pp svneol=native#text/pascal
lcl/forms/calcform.pas svneol=native#text/pascal
lcl/forms/calendarpopup.lfm svneol=native#text/plain
lcl/forms/calendarpopup.pas svneol=native#text/plain
lcl/forms/dblogdlg.pas svneol=native#text/pascal
lcl/forms/finddlgunit.lfm svneol=native#text/plain
lcl/forms/finddlgunit.pas svneol=native#text/plain
lcl/forms/replacedlgunit.lfm svneol=native#text/plain

38
lcl/comctrls.pp
View File

@ -1884,6 +1884,8 @@ type
protected
class procedure WSRegisterClass; override;
procedure AssociateKeyDown(Sender: TObject; var Key: Word; ShiftState : TShiftState);
procedure AssociateMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint; var Handled: Boolean);
procedure OnAssociateChangeBounds(Sender: TObject);
procedure OnAssociateChangeEnabled(Sender: TObject);
procedure OnAssociateChangeVisible(Sender: TObject);
@ -2168,7 +2170,9 @@ type
FOnPaintButton: TToolBarOnPaintButton;
FButtonHeight: Integer;
FRealizedButtonHeight,
FRealizedButtonWidth: integer;
FRealizedButtonWidth,
FRealizedDropDownWidth,
FRealizedButtonDropWidth: integer;
FButtons: TList;
FButtonWidth: Integer;
FDisabledImageChangeLink: TChangeLink;
@ -2197,6 +2201,10 @@ type
procedure CloseCurrentMenu;
function GetButton(Index: Integer): TToolButton;
function GetButtonCount: Integer;
function GetButtonDropWidth: Integer;
function GetButtonWidth: Integer;
function GetButtonHeight: Integer;
function GetDropDownWidth: Integer;
function GetTransparent: Boolean;
procedure SetButtonHeight(const AValue: Integer);
procedure SetButtonWidth(const AValue: Integer);
@ -2226,6 +2234,9 @@ type
function IsVertical: Boolean; virtual;
class procedure WSRegisterClass; override;
procedure AdjustClientRect(var ARect: TRect); override;
function ButtonHeightIsStored: Boolean;
function ButtonWidthIsStored: Boolean;
function DropDownWidthIsStored: Boolean;
class function GetControlClassDefaultSize: TSize; override;
procedure DoAutoSize; override;
procedure CalculatePreferredSize(var PreferredWidth,
@ -2255,23 +2266,20 @@ type
function GetEnumerator: TToolBarEnumerator;
procedure SetButtonSize(NewButtonWidth, NewButtonHeight: integer);
function CanFocus: Boolean; override;
function GetRealDropDownWidth: Integer;
function GetRealButtonDropWidth: Integer;
function GetRealButtonWidth: Integer;
function GetRealButtonHeight: Integer;
public
property ButtonCount: Integer read GetButtonCount;
property Buttons[Index: Integer]: TToolButton read GetButton;
property ButtonList: TList read FButtons;
property RowCount: Integer read FRowCount;
property ButtonDropWidth: Integer read GetButtonDropWidth;
published
property Align default alTop;
property Anchors;
property AutoSize;
property BorderSpacing;
property BorderWidth;
property ButtonHeight: Integer read FButtonHeight write SetButtonHeight default 0;
property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 0;
property ButtonHeight: Integer read GetButtonHeight write SetButtonHeight stored ButtonHeightIsStored;
property ButtonWidth: Integer read GetButtonWidth write SetButtonWidth stored ButtonWidthIsStored;
property Caption;
property ChildSizing;
property Constraints;
@ -2280,7 +2288,7 @@ type
property DragCursor;
property DragKind;
property DragMode;
property DropDownWidth: Integer read FDropDownWidth write SetDropDownWidth default 0;
property DropDownWidth: Integer read GetDropDownWidth write SetDropDownWidth stored DropDownWidthIsStored;
property EdgeBorders default [ebTop];
property EdgeInner;
property EdgeOuter;
@ -3304,6 +3312,7 @@ type
FTopItem: TTreeNode;
FTreeLineColor: TColor;
FTreeLinePenStyle: TPenStyle;
FTreeLinePenPattern: TPenPattern;
FExpandSignColor : TColor;
FTreeNodes: TTreeNodes;
FHintWnd: THintWindow;
@ -3312,8 +3321,10 @@ type
function GetBackgroundColor: TColor;
function GetBottomItem: TTreeNode;
function GetDropTarget: TTreeNode;
function GetExpandSignSize: integer;
function GetHideSelection: boolean;
function GetHotTrack: boolean;
function GetIndent: Integer;
function GetKeepCollapsedNodes: boolean;
function GetMultiSelect: Boolean;
function GetReadOnly: boolean;
@ -3400,8 +3411,10 @@ type
Stage: TCustomDrawStage): Boolean; virtual;
function CustomDrawItem(Node: TTreeNode; State: TCustomDrawState;
Stage: TCustomDrawStage; var PaintImages: Boolean): Boolean; virtual;
function DefaultItemHeightIsStored: Boolean;
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
function ExpandSignSizeIsStored: Boolean;
function GetDragImages: TDragImageList; override;
function GetMaxLvl: integer;
function GetMaxScrollLeft: integer;
@ -3409,6 +3422,7 @@ type
function GetNodeAtY(Y: Integer): TTreeNode;
function GetNodeDrawAreaHeight: integer;
function GetNodeDrawAreaWidth: integer;
function IndentIsStored: Boolean;
function IsCustomDrawn(Target: TCustomDrawTarget;
Stage: TCustomDrawStage): Boolean; virtual;
function IsNodeVisible(ANode: TTreeNode): Boolean;
@ -3432,8 +3446,6 @@ type
procedure EndEditing(Cancel: boolean = false); virtual;
procedure EnsureNodeIsVisible(ANode: TTreeNode);
procedure Expand(Node: TTreeNode); virtual;
function GetRealExpandSignSize: integer;
function GetRealIndent: Integer;
procedure GetImageIndex(Node: TTreeNode); virtual;
procedure GetSelectedIndex(Node: TTreeNode); virtual;
procedure InitializeWnd; override;
@ -3474,7 +3486,7 @@ type
property HideSelection: Boolean
read GetHideSelection write SetHideSelection default True;
property HotTrack: Boolean read GetHotTrack write SetHotTrack default False;
property Indent: Integer read FIndent write SetIndent default 0;
property Indent: Integer read GetIndent write SetIndent stored IndentIsStored;
property MultiSelect: Boolean read GetMultiSelect write SetMultiSelect default False;
property OnAddition: TTVExpandedEvent read FOnAddition write FOnAddition;
property OnAdvancedCustomDraw: TTVAdvancedCustomDrawEvent
@ -3566,10 +3578,10 @@ type
property BorderWidth default 0;
property BottomItem: TTreeNode read GetBottomItem write SetBottomItem;
property Color default clWindow;
property DefaultItemHeight: integer read FDefItemHeight write SetDefaultItemHeight default DefaultTreeNodeHeight;
property DefaultItemHeight: integer read FDefItemHeight write SetDefaultItemHeight stored DefaultItemHeightIsStored;
property DropTarget: TTreeNode read GetDropTarget write SetDropTarget;
property ExpandSignColor: TColor read FExpandSignColor write FExpandSignColor default clWindowFrame;
property ExpandSignSize: integer read FExpandSignSize write SetExpandSignSize default 0; // use 0 for default
property ExpandSignSize: integer read GetExpandSignSize write SetExpandSignSize stored ExpandSignSizeIsStored;
property ExpandSignType: TTreeViewExpandSignType
read FExpandSignType write SetExpandSignType default tvestTheme;
property Images: TCustomImageList read FImages write SetImages;

9
lcl/controls.pp
View File

@ -922,7 +922,8 @@ type
chtOnEnabledChanging,
chtOnEnabledChanged,
chtOnKeyDown,
chtOnBeforeDestruction
chtOnBeforeDestruction,
chtOnMouseWheel
);
TLayoutAdjustmentPolicy = (
@ -1412,6 +1413,9 @@ type
procedure DoCallNotifyHandler(HandlerType: TControlHandlerType);
procedure DoCallKeyEventHandler(HandlerType: TControlHandlerType;
var Key: Word; Shift: TShiftState);
procedure DoCallMouseWheelEventHandler(HandlerType: TControlHandlerType;
Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
var Handled: Boolean);
procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); virtual;
procedure SetZOrder(TopMost: Boolean); virtual;
class function GetControlClassDefaultSize: TSize; virtual;
@ -1621,6 +1625,9 @@ type
procedure AddHandlerOnBeforeDestruction(const OnBeforeDestructionEvent: TNotifyEvent;
AsFirst: boolean = false);
procedure RemoveHandlerOnBeforeDestruction(const OnBeforeDestructionEvent: TNotifyEvent);
procedure AddHandlerOnMouseWheel(const OnMouseWheelEvent: TMouseWheelEvent;
AsFirst: boolean = false);
procedure RemoveHandlerOnMouseWheel(const OnMouseWheelEvent: TMouseWheelEvent);
public
// standard properties, which should be supported by all descendants
property AccessibleDescription: TCaption read GetAccessibleDescription write SetAccessibleDescription;

146
lcl/forms/dblogdlg.pas Normal file
View File

@ -0,0 +1,146 @@
unit DBLogDlg;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, StdCtrls, ButtonPanel, DB;
type
{ TLoginDialog }
TLoginDialog = class(TForm)
protected
lDatabaseName: TLabel;
lDatabase: TLabel;
lUserName: TLabel;
lPassword: TLabel;
eUserName: TEdit;
ePassword: TEdit;
BtnPanel: TButtonPanel;
public
constructor Create(TheOwner: TComponent); override;
end;
function LoginDialogEx(const ADatabaseName: string; var AUserName, APassword: string;
UserNameReadOnly: Boolean=False): Boolean;
resourcestring
rsDBLogDlgCaption = 'Database Login';
rsDBLogDlgDatabase = 'Database';
rsDBLogDlgUserName = '&User Name';
rsDBLogDlgPassword = '&Password';
rsDBLogDlgLogin = '&Login';
implementation
{ TLoginDialog }
constructor TLoginDialog.Create(TheOwner: TComponent);
begin
inherited CreateNew(TheOwner, 0);
Caption := rsDBLogDlgCaption;
Position := poScreenCenter;
AutoSize := True;
BorderStyle := bsDialog;
ChildSizing.LeftRightSpacing := Scale96ToForm(16);
ChildSizing.TopBottomSpacing := Scale96ToForm(10);
lDatabase := TLabel.Create(Self);
lDatabase.Parent := Self;
lDatabase.Caption := rsDBLogDlgDatabase;
lDatabaseName := TLabel.Create(Self);
lDatabaseName.Parent := Self;
lDatabaseName.AnchorSide[akTop].Control := lDatabase;
lDatabaseName.AnchorSide[akTop].Side := asrCenter;
lDatabaseName.AnchorSide[akLeft].Control := lDatabase;
lDatabaseName.AnchorSide[akLeft].Side := asrLeft;
lDatabaseName.BorderSpacing.Left := Scale96ToForm(80);
lUserName := TLabel.Create(Self);
lUserName.Parent := Self;
lUserName.Caption := rsDBLogDlgUserName;
lUserName.AnchorSide[akTop].Control := lDatabase;
lUserName.AnchorSide[akTop].Side := asrBottom;
lUserName.BorderSpacing.Top := Scale96ToForm(14);
eUserName := TEdit.Create(Self);
eUserName.Parent := Self;
eUserName.Width := Scale96ToForm(164);
eUserName.AnchorSide[akTop].Control := lUserName;
eUserName.AnchorSide[akTop].Side := asrCenter;
eUserName.AnchorSide[akLeft].Control := lUserName;
eUserName.AnchorSide[akLeft].Side := asrLeft;
eUserName.Anchors := [akTop, akLeft];
eUserName.BorderSpacing.Left := lDatabaseName.BorderSpacing.Left;
lUserName.FocusControl := eUserName;
lPassword := TLabel.Create(Self);
lPassword.Parent := Self;
lPassword.Caption := rsDBLogDlgPassword;
lPassword.AnchorSide[akTop].Control := lUserName;
lPassword.AnchorSide[akTop].Side := asrBottom;
lPassword.BorderSpacing.Top := Scale96ToForm(12);
ePassword := TEdit.Create(Self);
ePassword.Parent := Self;
ePassword.Width := eUserName.Width;
ePassword.PasswordChar := '*';
ePassword.AnchorSide[akTop].Control := lPassword;
ePassword.AnchorSide[akTop].Side := asrCenter;
ePassword.AnchorSide[akLeft].Control := lPassword;
ePassword.AnchorSide[akLeft].Side := asrLeft;
ePassword.Anchors := [akTop, akLeft];
ePassword.BorderSpacing.Left := lDatabaseName.BorderSpacing.Left;
lPassword.FocusControl := ePassword;
BtnPanel := TButtonPanel.Create(Self);
BtnPanel.Parent := Self;
BtnPanel.ShowBevel:= False;
BtnPanel.ShowButtons := [pbOK, pbCancel];
BtnPanel.OKButton.Caption := rsDBLogDlgLogin;
BtnPanel.AnchorSide[akTop].Control := ePassword;
BtnPanel.AnchorSide[akTop].Side := asrBottom;
BtnPanel.AnchorSide[akRight].Control := ePassword;
BtnPanel.AnchorSide[akRight].Side := asrRight;
BtnPanel.Anchors := [akTop, akRight];
BtnPanel.BorderSpacing.Top := Scale96ToForm(10);
end;
function LoginDialogEx(const ADatabaseName: string; var AUserName, APassword: string;
UserNameReadOnly: Boolean=False): Boolean;
var
F: TLoginDialog;
begin
F := TLoginDialog.Create(nil);
try
F.lDatabaseName.Caption := ADatabaseName;
F.eUserName.Text := AUserName;
F.ePassword.Text := APassword;
if UserNameReadOnly then
begin
F.eUserName.ReadOnly := True;
F.ActiveControl := F.ePassword;
end;
Result := F.ShowModal = mrOK;
if Result then
begin
AUserName := F.eUserName.Text;
APassword := F.ePassword.Text;
end;
finally
F.Free;
end;
end;
initialization
if not Assigned(LoginDialogExProc) then
LoginDialogExProc := @LoginDialogEx;
end.

35
lcl/include/control.inc
View File

@ -1983,6 +1983,22 @@ begin
TKeyEvent(FControlHandlers[HandlerType][i])(Self, Key, Shift);
end;
procedure TControl.DoCallMouseWheelEventHandler(HandlerType: TControlHandlerType;
Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint; var Handled: Boolean);
var
i: Integer;
begin
i := FControlHandlers[HandlerType].Count;
//debugln('TControl.DoCallMouseWheelEventHandler A: Handled = ',DbgS(Handled),', Count = ',DbgS(i));
while (not Handled) and FControlHandlers[HandlerType].NextDownIndex(i) do
begin
TMouseWheelEvent(FControlHandlers[HandlerType][i])(Self, Shift, WheelDelta, MousePos, Handled);
//debugln('TControl.DoCallMouseWheelEventHandler B: i = ',Dbgs(i),', Handled = ',DbgS(Handled));
end;
//debugln('TControl.DoCallMouseWheelEventHandler End: Handled = ',DbgS(Handled));
end;
{------------------------------------------------------------------------------
procedure TControl.DoContextPopup(const MousePos: TPoint;
var Handled: Boolean);
@ -2292,7 +2308,12 @@ begin
Result := False;
if Assigned(FOnMouseWheel)
then FOnMouseWheel(Self, Shift, WheelDelta, MousePos, Result);
then FOnMouseWheel(Self, Shift, WheelDelta, MousePos, Result);
if not Result then
begin
//debugln('TControl.DoMouseWheel calling DoCallMouseWheelEventHandler');
DoCallMouseWheelEventHandler(chtOnMouseWheel, Shift, WheelDelta, MousePos, Result);
end;
if not Result
then begin
@ -4862,6 +4883,18 @@ begin
RemoveHandler(chtOnBeforeDestruction,TMethod(OnBeforeDestructionEvent));
end;
procedure TControl.AddHandlerOnMouseWheel(
const OnMouseWheelEvent: TMouseWheelEvent; AsFirst: boolean);
begin
AddHandler(chtOnMouseWheel,TMethod(OnMouseWheelEvent),AsFirst);
end;
procedure TControl.RemoveHandlerOnMouseWheel(
const OnMouseWheelEvent: TMouseWheelEvent);
begin
RemoveHandler(chtOnMouseWheel,TMethod(OnMouseWheelEvent));
end;
procedure TControl.RemoveAllHandlersOfObject(AnObject: TObject);
var
HandlerType: TControlHandlerType;

7
lcl/include/customlistbox.inc
View File

@ -128,11 +128,6 @@ begin
UnlockSelectionChange;
end;
function TCustomListBox.IsOptionsStored: Boolean;
begin
Result := (FOptions = [lboDrawFocusRect]);
end;
{------------------------------------------------------------------------------
procedure TCustomListBox.FinalizeWnd
------------------------------------------------------------------------------}
@ -556,7 +551,7 @@ begin
FItemIndex:=-1;
FExtendedSelect := true;
//FScrollWidth := 0;
FOptions := [lboDrawFocusRect];
FOptions := DefOptions;
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
ParentColor := false;

19
lcl/include/customupdown.inc
View File

@ -358,6 +358,7 @@ begin
FAssociate.AddHandlerOnChangeBounds(@OnAssociateChangeBounds,true);
FAssociate.AddHandlerOnEnabledChanged(@OnAssociateChangeEnabled,true);
FAssociate.AddHandlerOnVisibleChanged(@OnAssociateChangeVisible,true);
FAssociate.AddHandlerOnMouseWheel(@AssociateMouseWheel,true);
end;
end;
@ -390,6 +391,24 @@ begin
Key := 0;
end;
procedure TCustomUpDown.AssociateMouseWheel(Sender: TObject;
Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
var Handled: Boolean);
begin
//debugln('TCustomUpDown.AssociateMouseWheel A: Handled = ',DbgS(Handled));
if (WheelDelta > 0) then
begin
TCustomSpeedButton(FMaxBtn).Click;
Handled := True;
end
else if (WheelDelta < 0) then
begin
TCustomSpeedButton(FMinBtn).Click;
Handled := True;
end;
//debugln('TCustomUpDown.AssociateMouseWheel End: Handled = ',DbgS(Handled));
end;
procedure TCustomUpDown.OnAssociateChangeBounds(Sender: TObject);
begin
UpdateAlignButtonPos;

95
lcl/include/toolbar.inc
View File

@ -24,7 +24,7 @@ begin
if not (Control1.Parent is TToolBar) then Exit;
ToolBar := TToolBar(Control1.Parent);
BtnHeight := ToolBar.FRealizedButtonHeight;
BtnHeight := ToolBar.ButtonHeight;
if BtnHeight <= 0 then BtnHeight := 1;
HalfBtnHeight := BtnHeight div 2;
@ -56,7 +56,7 @@ begin
if not (Control1.Parent is TToolBar) then Exit;
ToolBar := TToolBar(Control1.Parent);
BtnWidth := ToolBar.FRealizedButtonWidth;
BtnWidth := ToolBar.ButtonWidth;
if BtnWidth <= 0 then BtnWidth := 1;
HalfBtnWidth := BtnWidth div 2;
@ -93,6 +93,9 @@ begin
FThemeDropDownWidth := ThemeServices.GetDetailSize(Details).cx;
Details := ThemeServices.GetElementDetails(ttbDropDownButtonNormal);
FThemeButtonDropWidth := ThemeServices.GetDetailSize(Details).cx;
FButtonHeight := -1;
FButtonWidth := -1;
FDropDownWidth := -1;
FNewStyle := True;
FWrapable := True;
FButtons := TList.Create;
@ -261,6 +264,16 @@ begin
Buttons[i].Font := Font;
end;
function TToolBar.ButtonHeightIsStored: Boolean;
begin
Result := FButtonHeight >= 0;
end;
function TToolBar.ButtonWidthIsStored: Boolean;
begin
Result := FButtonWidth >= 0;
end;
function TToolBar.GetButton(Index: Integer): TToolButton;
begin
Result := TToolButton(FButtons[Index]);
@ -347,8 +360,16 @@ begin
begin
BeginUpdate;
try
SetButtonSize(Round(ButtonWidth * AXProportion), Round(ButtonHeight * AYProportion));
DropDownWidth := Round(DropDownWidth * AXProportion);
if ButtonWidthIsStored then
ButtonWidth := Round(ButtonWidth * AXProportion);
if ButtonHeightIsStored then
ButtonHeight := Round(ButtonHeight * AYProportion);
if DropDownWidthIsStored then
DropDownWidth := Round(DropDownWidth * AXProportion);
FRealizedButtonHeight := 0;
FRealizedButtonWidth := 0;
FRealizedDropDownWidth := 0;
FRealizedButtonDropWidth := 0;
FToolBarFlags := FToolBarFlags + [tbfUpdateVisibleBarNeeded];
finally
EndUpdate;
@ -442,35 +463,47 @@ begin
Result := TToolBarEnumerator.Create(Self);
end;
function TToolBar.GetRealDropDownWidth: Integer;
function TToolBar.GetDropDownWidth: Integer;
begin
if FDropDownWidth = 0 then
Result := MulDiv(FThemeDropDownWidth, Font.PixelsPerInch, Screen.PixelsPerInch)
else
if FDropDownWidth < 0 then
begin
if FRealizedDropDownWidth = 0 then
FRealizedDropDownWidth := ScaleScreenToFont(FThemeDropDownWidth);
Result := FRealizedDropDownWidth;
end else
Result := FDropDownWidth;
end;
function TToolBar.GetRealButtonDropWidth: Integer;
function TToolBar.GetButtonDropWidth: Integer;
begin
if FDropDownWidth = 0 then
Result := MulDiv(FThemeButtonDropWidth, Font.PixelsPerInch, Screen.PixelsPerInch)
else
if FDropDownWidth < 0 then
begin
if FRealizedButtonDropWidth = 0 then
FRealizedButtonDropWidth := ScaleScreenToFont(FThemeButtonDropWidth);
Result := FRealizedButtonDropWidth;
end else
Result := FDropDownWidth+FThemeButtonDropWidth-FThemeDropDownWidth;
end;
function TToolBar.GetRealButtonHeight: Integer;
function TToolBar.GetButtonHeight: Integer;
begin
if FButtonHeight = 0 then
Result := Scale96ToFont(cDefButtonHeight)
else
if FButtonHeight < 0 then
begin
if FRealizedButtonHeight = 0 then
FRealizedButtonHeight := Scale96ToFont(cDefButtonHeight);
Result := FRealizedButtonHeight;
end else
Result := FButtonHeight;
end;
function TToolBar.GetRealButtonWidth: Integer;
function TToolBar.GetButtonWidth: Integer;
begin
if FButtonWidth = 0 then
Result := Scale96ToFont(cDefButtonWidth)
else
if FButtonWidth < 0 then
begin
if FRealizedButtonWidth = 0 then
FRealizedButtonWidth := Scale96ToFont(cDefButtonWidth);
Result := FRealizedButtonWidth;
end else
Result := FButtonWidth;
end;
@ -500,8 +533,8 @@ begin
FButtonWidth:=NewButtonWidth;
FButtonHeight:=NewButtonHeight;
RealButtonWidth := GetRealButtonWidth;
RealButtonHeight := GetRealButtonHeight;
RealButtonWidth := ButtonWidth;
RealButtonHeight := ButtonHeight;
if FUpdateCount > 0 then Exit;
if [csLoading, csDestroying] * ComponentState <> [] then Exit;
@ -554,6 +587,11 @@ begin
// children are moved in ControlsAligned independent of AutoSize=true
end;
function TToolBar.DropDownWidthIsStored: Boolean;
begin
Result := FDropDownWidth >= 0;
end;
procedure TToolBar.CalculatePreferredSize(var PreferredWidth,
PreferredHeight: integer; WithThemeSpace: Boolean);
var
@ -797,8 +835,8 @@ var
begin
//DebugLn(['WrapButtons ',DbgSName(Self),' Wrapable=',Wrapable,' ',dbgs(BoundsRect),' Vertical=',IsVertical,' RTL=',UseRightToLeftAlignment,' Simulate=',Simulate]);
Result := True;
RealButtonWidth := GetRealButtonWidth;
RealButtonHeight := GetRealButtonHeight;
RealButtonWidth := ButtonWidth;
RealButtonHeight := ButtonHeight;
Vertical := IsVertical;
NewWidth := 0;
NewHeight := 0;
@ -842,10 +880,6 @@ begin
end;
end;
// sort OrderedControls
if FRealizedButtonHeight = 0 then
FRealizedButtonHeight := RealButtonHeight;
if FRealizedButtonWidth = 0 then
FRealizedButtonWidth := RealButtonWidth;
if Vertical then
OrderedControls.Sort(TListSortCompare(@CompareToolBarControlVert))
else
@ -969,7 +1003,6 @@ begin
end;
end;
end;
FRealizedButtonHeight := RealButtonHeight;
finally
ObstacleControls.Free;
OrderedControls.Free;
@ -1015,6 +1048,10 @@ procedure TToolBar.FontChanged(Sender: TObject);
begin
inherited FontChanged(Sender);
ApplyFontForButtons;
FRealizedButtonWidth := 0;
FRealizedButtonHeight := 0;
FRealizedDropDownWidth := 0;
FRealizedButtonDropWidth := 0;
end;
function TToolBar.CheckMenuDropdown(Button: TToolButton): Boolean;

28
lcl/include/toolbutton.inc
View File

@ -324,11 +324,11 @@ begin
begin
DropDownButtonRect := ButtonRect;
if Style = tbsDropDown then
DropDownButtonRect.Left := DropDownButtonRect.Right-FToolBar.GetRealDropDownWidth
DropDownButtonRect.Left := DropDownButtonRect.Right-FToolBar.DropDownWidth
else
begin
DropDownButtonRect.Left := DropDownButtonRect.Right-FToolBar.GetRealButtonDropWidth;
DropDownButtonRect.Right := DropDownButtonRect.Left + FToolBar.GetRealDropDownWidth;
DropDownButtonRect.Left := DropDownButtonRect.Right-FToolBar.ButtonDropWidth;
DropDownButtonRect.Right := DropDownButtonRect.Left + FToolBar.DropDownWidth;
end;
MainBtnRect.Right := DropDownButtonRect.Left;
if Style = tbsDropDown then
@ -470,7 +470,7 @@ function TToolButton.PointInArrow(const X, Y: Integer): Boolean;
begin
Result := (Style = tbsDropDown) and (FToolBar <> nil)
and (Y >= 0) and (Y <= ClientHeight)
and (X > ClientWidth - FToolBar.GetRealDropDownWidth) and (X <= ClientWidth);
and (X > ClientWidth - FToolBar.DropDownWidth) and (X <= ClientWidth);
end;
procedure TToolButton.Loaded;
@ -867,8 +867,8 @@ begin
inherited GetPreferredSize(PreferredWidth, PreferredHeight, Raw, WithThemeSpace);
if FToolbar = nil then Exit;
RealButtonWidth := FToolbar.GetRealButtonWidth;
RealButtonHeight := FToolbar.GetRealButtonHeight;
RealButtonWidth := FToolbar.ButtonWidth;
RealButtonHeight := FToolbar.ButtonHeight;
if RealButtonHeight <= 0 then Exit;
// buttonheight overrules in hor toolbar
if FToolBar.IsVertical then
@ -1039,16 +1039,16 @@ begin
begin
if not TToolBar(AParent).IsVertical then begin
if Style in [tbsButton,tbsDropDown,tbsButtonDrop,tbsCheck] then
NewWidth := TToolBar(AParent).GetRealButtonWidth
NewWidth := TToolBar(AParent).ButtonWidth
else
NewWidth := Width;
NewHeight := TToolBar(AParent).GetRealButtonHeight;
NewHeight := TToolBar(AParent).ButtonHeight;
end else begin
if Style in [tbsButton,tbsDropDown,tbsButtonDrop,tbsCheck] then
NewHeight := TToolBar(AParent).GetRealButtonHeight
NewHeight := TToolBar(AParent).ButtonHeight
else
NewHeight := Height;
NewWidth := TToolBar(AParent).GetRealButtonWidth;
NewWidth := TToolBar(AParent).ButtonWidth;
end;
SetBoundsKeepBase(Left, Top, NewWidth, NewHeight);
end;
@ -1195,11 +1195,11 @@ begin
begin
inc(PreferredWidth, 4);
inc(PreferredHeight, 4);
PreferredWidth := Max(PreferredWidth, FToolBar.GetRealButtonWidth);
PreferredHeight := Max(PreferredHeight, FToolBar.GetRealButtonHeight);
PreferredWidth := Max(PreferredWidth, FToolBar.ButtonWidth);
PreferredHeight := Max(PreferredHeight, FToolBar.ButtonHeight);
case Style of
tbsDropDown: inc(PreferredWidth, FToolBar.GetRealDropDownWidth);
tbsButtonDrop: inc(PreferredWidth, FToolBar.GetRealButtonDropWidth-cDefButtonDropDecArrowWidth);
tbsDropDown: inc(PreferredWidth, FToolBar.DropDownWidth);
tbsButtonDrop: inc(PreferredWidth, FToolBar.ButtonDropWidth-cDefButtonDropDecArrowWidth);
end;
end
else

61
lcl/include/treeview.inc
View File

@ -1676,7 +1676,7 @@ var
begin
Result := 0;
TV := TreeView;
RealIndent := TV.GetRealIndent;
RealIndent := TV.Indent;
if TV = nil then Exit;
l := Level;
if not (tvoShowRoot in TV.Options) then
@ -1692,7 +1692,7 @@ begin
begin
Result.Left := DisplayExpandSignLeft;
Result.Top := Top;
Result.Right := Result.Left + TreeView.GetRealIndent;
Result.Right := Result.Left + TreeView.Indent;
Result.Bottom := Top + Height;
end;
end;
@ -1701,7 +1701,7 @@ function TTreeNode.DisplayExpandSignRight: integer;
begin
Result := DisplayExpandSignLeft;
if TreeView <> nil then
inc(Result, TreeView.GetRealIndent);
inc(Result, TreeView.Indent);
end;
function TTreeNode.DisplayIconLeft: integer;
@ -1743,7 +1743,7 @@ begin
Result := DisplayTextLeft;
TV := TreeView;
if TV <> nil then
Inc(Result, TV.Canvas.TextWidth(Text) + TV.GetRealIndent div 2);
Inc(Result, TV.Canvas.TextWidth(Text) + TV.Indent div 2);
end;
function TTreeNode.AlphaSort: Boolean;
@ -2771,12 +2771,12 @@ begin
//select again
bGoNext := (FirstNode.Index <= Node.Index);
I := FirstNode;
I.Selected:=True;
I.MultiSelected:=True;
while (I<>Node) do
begin
_TakeNext(I);
if I=nil then Break;
I.Selected:=True;
I.MultiSelected:=True;
end;
FStartMultiSelected := FirstNode;
@ -3210,7 +3210,7 @@ begin
// FBackgroundColor := clWindow;
FDefItemHeight := DefaultTreeNodeHeight;
FExpandSignType := tvestTheme;
FExpandSignSize := 0;
FExpandSignSize := -1;
Details := ThemeServices.GetElementDetails(ttGlyphOpened);
FThemeExpandSignSize := ThemeServices.GetDetailSize(Details).cx;
FTreeNodes := CreateNodes;
@ -3221,7 +3221,7 @@ begin
Items.KeepCollapsedNodes:=KeepCollapsedNodes;
FScrollBars:=ssBoth;
FDragImage := TDragImageList.CreateSize(32, 32);
FIndent:=0;
FIndent:=-1;
FChangeTimer := TTimer.Create(Self);
FChangeTimer.Enabled := False;
FChangeTimer.Interval := 1;
@ -3237,6 +3237,9 @@ begin
FStates:=[tvsMaxLvlNeedsUpdate,tvsMaxRightNeedsUpdate,tvsScrollbarChanged];
FTreeLineColor := clWindowFrame;
FTreeLinePenStyle := psPattern;
SetLength(FTreeLinePenPattern, 2);
FTreeLinePenPattern[0] := 1;
FTreeLinePenPattern[1] := 1;
FExpandSignColor := clWindowFrame;
// Accessibility
AccessibleDescription := rsTTreeViewAccessibilityDescription;
@ -3302,10 +3305,12 @@ begin
begin
DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TCustomTreeView.DoAutoAdjustLayout'){$ENDIF};
try
if not (tvoAutoItemHeight in Options) then
if DefaultItemHeightIsStored then
DefaultItemHeight := Round(DefaultItemHeight*AYProportion);
FIndent := Round(FIndent*AXProportion);
FExpandSignSize := Round(FExpandSignSize*AXProportion);
if IndentIsStored then
FIndent := Round(FIndent*AXProportion);
if ExpandSignSizeIsStored then
FExpandSignSize := Round(FExpandSignSize*AXProportion);
finally
EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TCustomTreeView.DoAutoAdjustLayout'){$ENDIF};
end;
@ -3399,6 +3404,11 @@ begin
end;
end;
function TCustomTreeView.DefaultItemHeightIsStored: Boolean;
begin
Result := not(tvoAutoItemHeight in Options);
end;
function TCustomTreeView.DefaultTreeViewSort(Node1, Node2: TTreeNode): Integer;
begin
if Assigned(OnCompare) then begin
@ -3628,7 +3638,7 @@ const
var
Node: TTreeNode;
i: integer;
FMaxTextLen: Integer;
FMaxTextLen, AIndent: Integer;
Cnt: Integer;
begin
if not (tvsMaxRightNeedsUpdate in FStates) then exit;
@ -3636,6 +3646,7 @@ begin
FMaxTextLen := 0;
Node := Items.GetFirstNode;
Cnt := 0;
AIndent := Indent;
while Node <> nil do
begin
if not Node.AreParentsExpandedAndVisible then
@ -3646,7 +3657,7 @@ begin
inc(Cnt);
if (Cnt < LargeItemCount) then
begin
i := Node.DisplayTextRight + ScrolledLeft + GetRealIndent div 2;
i := Node.DisplayTextRight + ScrolledLeft + AIndent div 2;
end else
begin
// computing DisplayTextRight is too expensive when the tree
@ -4507,9 +4518,9 @@ begin
Result:=(tvoReadOnly in FOptions);
end;
function TCustomTreeView.GetRealExpandSignSize: integer;
function TCustomTreeView.GetExpandSignSize: integer;
begin
if FExpandSignSize>0 then
if FExpandSignSize>=0 then
Result := FExpandSignSize
else
if ExpandSignType = tvestTheme then
@ -4518,9 +4529,9 @@ begin
Result := Scale96ToFont(DefaultTreeNodeExpandSignSize);
end;
function TCustomTreeView.GetRealIndent: Integer;
function TCustomTreeView.GetIndent: Integer;
begin
if FIndent=0 then
if FIndent<0 then
Result := Scale96ToFont(15)
else
Result := FIndent;
@ -5154,8 +5165,8 @@ var
PaintImages: boolean;
OverlayIndex: Integer;
begin
RealExpandSignSize := GetRealExpandSignSize;
RealIndent := GetRealIndent;
RealExpandSignSize := ExpandSignSize;
RealIndent := Indent;
NodeRect := Node.DisplayRect(False);
if (NodeRect.Bottom < 0) or (NodeRect.Top >= ClientHeight) then
Exit;
@ -5187,6 +5198,8 @@ begin
// draw tree lines
Pen.Color := TreeLineColor;
Pen.Style := TreeLinePenStyle;
if Pen.Style = psPattern then
Pen.SetPattern(FTreeLinePenPattern);
x := DrawTreeLines(Node);
Pen.Style := psSolid;
@ -5317,6 +5330,11 @@ begin
if Assigned(FOnExpanded) then FOnExpanded(Self, Node);
end;
function TCustomTreeView.ExpandSignSizeIsStored: Boolean;
begin
Result := FExpandSignSize >= 0;
end;
function TCustomTreeView.CanExpand(Node: TTreeNode): Boolean;
begin
Result := True;
@ -5408,6 +5426,11 @@ begin
Invalidate;
end;
function TCustomTreeView.IndentIsStored: Boolean;
begin
Result := FIndent >= 0;
end;
procedure TCustomTreeView.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var

5
lcl/interfaces/win32/win32winapi.inc
View File

@ -1352,6 +1352,11 @@ begin
LB.lbColor := ColorToRGB(TColor(lplb.lbColor));
LB.lbHatch := lplb.lbHatch;
Result := Windows.ExtCreatePen(dwPenStyle, dwWidth, LB, dwStyleCount, lpStyle);
// Note Michl: When style PS_USERSTYLE is used, lpStyle can't be nil, there
// must be dwSytleCount >= 1, see issue #30661
if Result = 0 then
DebugLn('TWin32WidgetSet.ExtCreatePen returns 0. Reason = ' + GetLastErrorText(Windows.GetLastError));
end;
{------------------------------------------------------------------------------

7
lcl/lclbase.lpk
View File

@ -27,7 +27,7 @@
<License Value="modified LGPL-2
"/>
<Version Major="1" Minor="8" Build="1"/>
<Files Count="285">
<Files Count="286">
<Item1>
<Filename Value="checklst.pas"/>
<UnitName Value="CheckLst"/>
@ -1171,6 +1171,11 @@
<Filename Value="jsonpropstorage.pas"/>
<UnitName Value="JSONPropStorage"/>
</Item285>
<Item286>
<Filename Value="forms/dblogdlg.pas"/>
<AddToUsesPkgSection Value="False"/>
<UnitName Value="DBLogDlg"/>
</Item286>
</Files>
<LazDoc Paths="../docs/xml/lcl"/>
<i18n>

5
lcl/stdctrls.pp
View File

@ -495,6 +495,8 @@ type
{ TCustomListBox }
TCustomListBox = class(TWinControl)
private const
DefOptions = [lboDrawFocusRect];
private
FCacheValid: Boolean;
FCanvas: TCanvas;
@ -519,7 +521,6 @@ type
function GetCount: Integer;
function GetScrollWidth: Integer;
function GetTopIndex: Integer;
function IsOptionsStored: Boolean;
procedure RaiseIndexOutOfBounds(AIndex: integer);
procedure SetColumns(const AValue: Integer);
procedure SetScrollWidth(const AValue: Integer);
@ -621,7 +622,7 @@ type
property OnSelectionChange: TSelectionChangeEvent read FOnSelectionChange
write FOnSelectionChange;
property OnUTF8KeyPress;
property Options: TListBoxOptions read FOptions write FOptions stored IsOptionsStored;
property Options: TListBoxOptions read FOptions write FOptions default DefOptions;
property ParentColor default False;
property ParentFont;
property ParentShowHint;