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

VirtualTreeView: Improved LCL scaling.

Browse Source 
(cherry picked from commit 402cffbdfd)
This commit is contained in:
wp_xyz 2024-10-04 17:34:21 +02:00
parent 2f3f3f50bc
commit f636905fff
3 changed files with 53 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

127
components/virtualtreeview/laz.virtualtrees.pas
View File

@ -267,6 +267,7 @@ const
DEFAULT_MARGIN = 4;
DEFAULT_NODE_HEIGHT = 18;
DEFAULT_SPACING = 3;
DEFAULT_MINHEIGHT = 10;
LIS_NORMAL = 1;
{$EXTERNALSYM LIS_NORMAL}
@ -1228,7 +1229,7 @@ type
TVTHeaderStyle = (
hsThickButtons, // TButton look and feel
hsFlatButtons, // flatter look than hsThickButton, like an always raised flat TToolButton
hsPlates // flat TToolButton look and feel (raise on hover etc.)
hsPlates // flat TToolButton look and feel (raise on hover etc.)
);
TVTHeaderOption = (
@ -1320,6 +1321,7 @@ type
function IsDefaultHeightStored: Boolean;
function IsFontStored: Boolean;
function IsHeightStored: Boolean;
function IsMinHeightStored: Boolean;
procedure SetAutoSizeIndex(Value: TColumnIndex);
procedure SetBackground(Value: TColor);
procedure SetColumns(Value: TVirtualTreeColumns);
@ -1415,7 +1417,7 @@ type
{$IFEND}
property MainColumn: TColumnIndex read GetMainColumn write SetMainColumn default 0;
property MaxHeight: Integer read FMaxHeight write SetMaxHeight default 10000;
property MinHeight: Integer read FMinHeight write SetMinHeight default 10;
property MinHeight: Integer read FMinHeight write SetMinHeight stored IsMinHeightStored;
property Options: TVTHeaderOptions read FOptions write SetOptions default [hoColumnResize, hoDrag, hoShowSortGlyphs];
property ParentFont: Boolean read FParentFont write SetParentFont default False;
property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
@ -2167,7 +2169,6 @@ type
FCustomCheckImages: TCustomImageList; // application defined check images
FCheckImageKind: TCheckImageKind; // light or dark, cross marks or tick marks
FCheckImages: TCustomImageList; // Reference to global image list to be used for the check images.
FButtonSize: Integer; // Size of the expand/collapse buttons
FImageChangeLink,
FStateChangeLink,
FCustomCheckChangeLink: TChangeLink; // connections to the image lists
@ -6914,13 +6915,8 @@ begin
inherited Create(Collection);
{$IF LCL_FullVersion >= 1080000}
FMargin := Owner.Header.TreeView.Scale96ToFont(DEFAULT_MARGIN);
FSpacing := Owner.Header.TreeView.Scale96ToFont(DEFAULT_SPACING);
{$ELSE}
FMargin := DEFAULT_MARGIN;
FSpacing := DEFAULT_SPACING;
{$IFEND}
FWidth := Owner.FDefaultWidth;
FLastWidth := Owner.FDefaultWidth;
@ -7040,22 +7036,14 @@ end;
function TVirtualTreeColumn.IsMarginStored: Boolean;
begin
{$IF LCL_FullVersion >= 1080000}
Result := FMargin <> Owner.Header.TreeView.Scale96ToFont(DEFAULT_MARGIN);
{$ELSE}
Result := FMargin <> DEFAULT_MARGIN;
{$IFEND}
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualTreeColumn.IsSpacingStored: Boolean;
begin
{$IF LCL_FullVersion >= 1080000}
Result := FSpacing <> Owner.Header.TreeView.Scale96ToFont(DEFAULT_SPACING);
{$ELSE}
Result := FSpacing <> DEFAULT_SPACING;
{$IFEND}
end;
//----------------------------------------------------------------------------------------------------------------------
@ -8092,11 +8080,7 @@ begin
FClickIndex := NoColumn;
FDropTarget := NoColumn;
FTrackIndex := NoColumn;
{$IF LCL_FullVersion >= 1080000}
FDefaultWidth := Header.TreeView.Scale96ToFont(DEFAULT_COLUMN_WIDTH);
{$ELSE}
FDefaultWidth := DEFAULT_COLUMN_WIDTH;
{$IFEND}
end;
//----------------------------------------------------------------------------------------------------------------------
@ -8143,11 +8127,7 @@ end;
function TVirtualTreeColumns.IsDefaultWidthStored: Boolean;
begin
{$IF LCL_FullVersion >= 1080000}
Result := FDefaultWidth <> Header.TreeView.Scale96ToFont(DEFAULT_COLUMN_WIDTH);
{$ELSE}
Result := FDefaultWidth <> DEFAULT_COLUMN_WIDTH;
{$IFEND}
end;
//----------------------------------------------------------------------------------------------------------------------
@ -9859,14 +9839,9 @@ begin
inherited Create;
FOwner := AOwner;
FColumns := GetColumnsClass.Create(Self);
{$IF LCL_FullVersion >= 1080000}
FHeight := FOwner.Scale96ToFont(DEFAULT_HEADER_HEIGHT);
FDefaultHeight := FOwner.Scale96ToFont(DEFAULT_HEADER_HEIGHT);
{$ELSE}
FHeight := DEFAULT_HEADER_HEIGHT;
FDefaultHeight := DEFAULT_HEADER_HEIGHT;
{$IFEND}
FMinHeight := 10;
FMinHeight := DEFAULT_MINHEIGHT;
FMaxHeight := 10000;
FFont := TFont.Create;
FFont.OnChange := FontChanged;
@ -9960,11 +9935,7 @@ end;
function TVTHeader.IsDefaultHeightStored: Boolean;
begin
{$IF LCL_FullVersion >= 1080000}
Result := FDefaultHeight <> FOwner.Scale96ToFont(DEFAULT_HEADER_HEIGHT);
{$ELSE}
Result := FDefaultHeight <> DEFAULT_HEADER_HEIGHT;
{$IFEND}
end;
//----------------------------------------------------------------------------------------------------------------------
@ -9979,15 +9950,16 @@ end;
function TVTHeader.IsHeightStored: Boolean;
begin
{$IF LCL_FullVersion >= 1080000}
Result := FHeight <> FOwner.Scale96ToFont(DEFAULT_HEADER_HEIGHT);
{$ELSE}
Result := FHeight <> DEFAULT_HEADER_HEIGHT;
{$IFEND}
end;
//----------------------------------------------------------------------------------------------------------------------
function TVTHeader.IsMinHeightStored: Boolean;
begin
Result := FMinHeight <> DEFAULT_MINHEIGHT;
end;
procedure TVTHeader.SetAutoSizeIndex(Value: TColumnIndex);
begin
@ -11492,15 +11464,17 @@ var
i: Integer;
col: TVirtualTreeColumn;
begin
if IsDefaultHeightStored then
FDefaultHeight := Round(FDefaultHeight * AYProportion);
if IsHeightStored then
FHeight := Round(FHeight * AYProportion);
if Columns.IsDefaultWidthStored then
Columns.DefaultWidth := Round(Columns.DefaultWidth * AXProportion);
// if not (toAutoChangeScale in Treeview.TreeOptions.AutoOptions) then
// begin
{
if IsDefaultHeightStored then
FDefaultHeight := Round(FDefaultHeight * AYProportion);
}
FMinHeight := Round(FMinHeight * AYProportion);
{
if Columns.IsDefaultWidthStored then
Columns.DefaultWidth := Round(Columns.DefaultWidth * AXProportion);
}
for i := 0 to Columns.Count-1 do begin
col := Columns[i];
if col.IsWidthStored then
@ -11510,6 +11484,10 @@ begin
if col.IsMarginStored then
col.Margin := Round(col.Margin * AXProportion);
end;
// FontChanged(nil);
if IsHeightStored then
FHeight := Round(FHeight * AYProportion);
end;
{$IFEND}
@ -12363,23 +12341,13 @@ begin
FDragImageKind := diComplete;
FLastSelectionLevel := -1;
FSelectionBlendFactor := 128;
FButtonSize := 9;
{$IF LCL_FullVersion >= 1080000}
FDefaultNodeHeight := Scale96ToFont(DEFAULT_NODE_HEIGHT);
FIndent := Scale96ToFont(DEFAULT_INDENT);
FMargin := Scale96ToFont(DEFAULT_MARGIN);
FTextMargin := Scale96ToFont(DEFAULT_MARGIN);
FDragHeight := Scale96ToFont(DEFAULT_DRAG_HEIGHT);
FDragWidth := Scale96ToFont(DEFAULT_DRAG_WIDTH);
{$ELSE}
FDefaultNodeHeight := DEFAULT_NODE_HEIGHT;
FIndent := DEFAULT_INDENT;
FMargin := DEFAULT_MARGIN;
FTextMargin := DEFAULT_MARGIN;
FDragHeight := DEFAULT_DRAG_HEIGHT;
FDragWidth := DEFAULT_DRAG_WIDTH;
{$IFEND}
FPlusBM := TBitmap.Create;
FHotPlusBM := TBitmap.Create;
@ -14058,11 +14026,7 @@ end;
function TBaseVirtualTree.IsDefaultNodeHeightStored: Boolean;
begin
{$IF LCL_FullVersion >= 1080000}
Result := FDefaultNodeHeight <> Scale96ToFont(DEFAULT_NODE_HEIGHT);
{$ELSE}
Result := FDefaultNodeHeight <> DEFAULT_NODE_HEIGHT;
{$IFEND}
end;
//----------------------------------------------------------------------------------------------------------------------
@ -14105,44 +14069,28 @@ end;
function TBaseVirtualTree.IsDragHeightStored: Boolean;
begin
{$IF LCL_FullVersion >= 1080000}
Result := FDragHeight <> Scale96ToFont(DEFAULT_DRAG_HEIGHT);
{$ELSE}
Result := FDragHeight <> DEFAULT_DRAG_HEIGHT;
{$IFEND}
end;
//----------------------------------------------------------------------------------------------------------------------
function TBaseVirtualTree.IsDragWidthStored: Boolean;
begin
{$IF LCL_FullVersion >= 1080000}
Result := FDragWidth <> Scale96ToFont(DEFAULT_DRAG_WIDTH);
{$ELSE}
Result := FDragWidth <> DEFAULT_DRAG_WIDTH;
{$IFEND}
end;
//----------------------------------------------------------------------------------------------------------------------
function TBaseVirtualTree.IsIndentStored: Boolean;
begin
{$IF LCL_FullVersion >= 1080000}
Result := FIndent <> Scale96ToFont(DEFAULT_INDENT);
{$ELSE}
Result := FIndent <> DEFAULT_INDENT;
{$IFEND}
end;
//----------------------------------------------------------------------------------------------------------------------
function TBaseVirtualTree.IsMarginStored: Boolean;
begin
{$IF LCL_FullVersion >= 1080000}
Result := FMargin <> Scale96ToFont(DEFAULT_MARGIN);
{$ELSE}
Result := FMargin <> DEFAULT_MARGIN;
{$IFEND}
end;
//----------------------------------------------------------------------------------------------------------------------
@ -14156,11 +14104,7 @@ end;
function TBaseVirtualTree.IsTextMarginStored: Boolean;
begin
{$IF LCL_FullVersion >= 1080000}
Result := FTextMargin <> Scale96ToFont(DEFAULT_MARGIN);
{$ELSE}
Result := FTextMargin <> DEFAULT_MARGIN;
{$IFEND}
end;
//----------------------------------------------------------------------------------------------------------------------
@ -14392,10 +14336,11 @@ var
fmTransparent:
canv.Brush.Style := bsClear;
end;
canv.Pen.FPColor := TColorToFPColor(ColorToRGB(clWindowText));
m := c div 2; //FButtonSize div 2; //FButtonSize div 8;
canv.Pen.FPColor := TColorToFPColor(ColorToRGB(FColors.TreeLineColor)); //clWindowText));
m := c div 2;
if m = 0 then m := 1;
canv.Rectangle(0, 0, img.Width, img.Height);
canv.Pen.FPColor := TColorToFPColor(ColorToRGB(clWindowText));
canv.Line(c-m, c, c+m, c);
if IsPlus then
canv.Line(c, c-m, c, c+m);
@ -14440,8 +14385,9 @@ var
//--------------- end local function ----------------------------------------
begin
Size.cx := FButtonSize;
Size.cy := FButtonSize;
Size.cx := Scale96ToFont(9);
if not odd(Size.cx) then dec(Size.cx);
Size.cy := Size.cx;
{$ifdef ThemeSupport}
{$ifdef LCLWin}
@ -14899,11 +14845,7 @@ procedure TBaseVirtualTree.SetDefaultNodeHeight(Value: Cardinal);
begin
if Value = 0 then
{$IF LCL_FullVersion >= 2000000}
Value := Scale96ToFont(DEFAULT_NODE_HEIGHT);
{$ELSE}
Value := DEFAULT_NODE_HEIGHT;
{$IFEND}
if FDefaultNodeHeight <> Value then
begin
Inc(Integer(FRoot.TotalHeight), Integer(Value) - Integer(FDefaultNodeHeight));
@ -24341,11 +24283,7 @@ var
begin
{$ifdef DEBUG_VTV}Logger.EnterMethod([lcCheck],'PaintCheckImage');{$endif}
{$if LCL_FullVersion >= 1080000}
checkSize := Scale96ToFont(DEFAULT_CHECK_WIDTH);
{$else}
checkSize := DEFAULT_CHECK_WIDTH;
{$ifend}
with ImageInfo do
begin
@ -26920,8 +26858,7 @@ begin
if IsDragWidthStored then
FDragWidth := Round(FDragWidth * AXProportion);
FHeader.AutoAdjustLayout(AXProportion, AYProportion);
FButtonSize := Round(FButtonSize * AXProportion);
if not Odd(FButtonSize) then dec(FButtonSize);
PrepareBitmaps(true, false);
finally
EnableAutoSizing;
end;

36
examples/virtualtreeview/vst_advanced/GeneralAbilitiesDemo.lfm
View File

@ -2,11 +2,11 @@ object GeneralForm: TGeneralForm
Left = 291
Height = 536
Top = 185
Width = 804
Width = 817
ActiveControl = TreeFontButton
Caption = 'GeneralForm'
ClientHeight = 536
ClientWidth = 804
ClientWidth = 817
KeyPreview = True
ShowHint = True
LCLVersion = '3.99.0.0'
@ -15,7 +15,7 @@ object GeneralForm: TGeneralForm
AnchorSideLeft.Control = DrawSelectionModeRadioGroup
AnchorSideTop.Control = DrawSelectionModeRadioGroup
AnchorSideTop.Side = asrBottom
Left = 575
Left = 588
Height = 15
Top = 387
Width = 113
@ -27,7 +27,7 @@ object GeneralForm: TGeneralForm
AnchorSideLeft.Control = CheckMarkCombo
AnchorSideTop.Control = CheckMarkCombo
AnchorSideTop.Side = asrBottom
Left = 575
Left = 588
Height = 15
Top = 437
Width = 112
@ -41,7 +41,7 @@ object GeneralForm: TGeneralForm
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = SaveButton
AnchorSideRight.Side = asrBottom
Left = 575
Left = 588
Height = 60
Top = 48
Width = 221
@ -53,10 +53,10 @@ object GeneralForm: TGeneralForm
end
object VST2: TLazVirtualStringTree
AnchorSideRight.Control = Label8
Left = 5
Left = 11
Height = 523
Top = 8
Width = 562
Width = 569
Anchors = [akTop, akLeft, akRight, akBottom]
AutoExpandDelay = 300
BorderSpacing.Right = 8
@ -67,6 +67,7 @@ object GeneralForm: TGeneralForm
'Unicode text'
'Virtual Tree Data'
)
Color = clBtnFace
Colors.BorderColor = clScrollBar
Colors.DropTargetColor = clActiveBorder
Colors.DropTargetBorderColor = clActiveCaption
@ -83,7 +84,6 @@ object GeneralForm: TGeneralForm
item
ImageIndex = 10
Position = 1
Spacing = 20
Text = 'Initial main column'
Width = 300
end
@ -100,10 +100,10 @@ object GeneralForm: TGeneralForm
ImageIndex = 4
Options = [coAllowClick, coEnabled, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus]
Position = 2
Spacing = 20
Text = 'Language column'
Width = 300
end>
Header.Height = 32
Header.Options = [hoColumnResize, hoDblClickResize, hoDrag, hoHotTrack, hoShowHint, hoVisible]
Header.ParentFont = True
Header.Style = hsFlatButtons
@ -138,7 +138,7 @@ object GeneralForm: TGeneralForm
AnchorSideLeft.Control = DrawSelectionModeRadioGroup
AnchorSideTop.Control = SwitchCheckImagesLabel
AnchorSideTop.Side = asrBottom
Left = 575
Left = 588
Height = 23
Top = 404
Width = 211
@ -165,7 +165,7 @@ object GeneralForm: TGeneralForm
AnchorSideLeft.Control = SwitchMainColumnLabel
AnchorSideTop.Control = SwitchMainColumnLabel
AnchorSideTop.Side = asrBottom
Left = 575
Left = 588
Height = 21
Top = 454
Width = 41
@ -182,7 +182,7 @@ object GeneralForm: TGeneralForm
object TreeFontButton: TBitBtn
AnchorSideTop.Control = Owner
AnchorSideRight.Control = SaveButton
Left = 575
Left = 588
Height = 34
Hint = 'Pick a font to be used by this tree.'
Top = 8
@ -216,7 +216,7 @@ object GeneralForm: TGeneralForm
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = ThemeRadioGroup
AnchorSideRight.Side = asrBottom
Left = 575
Left = 588
Height = 93
Top = 204
Width = 221
@ -257,7 +257,7 @@ object GeneralForm: TGeneralForm
'transparent color'
)
Style = csDropDownList
TabOrder = 3
TabOrder = 2
Text = 'tree''s background color'
OnChange = ButtonFillModeComboChange
end
@ -268,7 +268,7 @@ object GeneralForm: TGeneralForm
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = TreeButtonLookRadioGroup
AnchorSideRight.Side = asrBottom
Left = 575
Left = 588
Height = 70
Top = 307
Width = 221
@ -301,7 +301,7 @@ object GeneralForm: TGeneralForm
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = SaveButton
AnchorSideRight.Side = asrBottom
Left = 575
Left = 588
Height = 70
Top = 124
Width = 221
@ -333,7 +333,7 @@ object GeneralForm: TGeneralForm
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = TreeFontButton
AnchorSideBottom.Side = asrBottom
Left = 700
Left = 713
Height = 34
Top = 8
Width = 96
@ -349,7 +349,7 @@ object GeneralForm: TGeneralForm
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = MainColumnUpDown
AnchorSideTop.Side = asrCenter
Left = 624
Left = 637
Height = 15
Top = 457
Width = 98

4
examples/virtualtreeview/vst_advanced/GeneralAbilitiesDemo.pas
View File

@ -21,7 +21,7 @@ interface
uses
LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, Laz.VTHeaderPopup, Laz.VirtualTrees, ComCtrls, ExtCtrls, Menus,
ActnList, LResources, ImgList;
ActnList, LResources, ImgList;
type
TGeneralForm = class(TForm)
@ -426,11 +426,13 @@ begin
begin
VST2.TreeOptions.PaintOptions := VST2.TreeOptions.PaintOptions + [toShowTreeLines];
VST2.ButtonStyle := bsRectangle;
ButtonFillModeCombo.Enabled := (Sender as TRadioGroup).Enabled;
end
else
begin
VST2.TreeOptions.PaintOptions := VST2.TreeOptions.PaintOptions - [toShowTreeLines];
VST2.ButtonStyle := bsTriangle;
ButtonFillModeCombo.Enabled := false;
end;
end;