jvcllaz: Make outlookbar component editor high-dpi aware.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6359 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-04-26 22:01:42 +00:00
parent a20e7f7f74
commit 468c8c7e08
5 changed files with 67 additions and 24 deletions

View File

@ -1,12 +1,12 @@
object FrmOLBEditor: TFrmOLBEditor
Left = 311
Height = 462
Height = 461
Top = 151
Width = 258
Width = 247
BorderIcons = [biSystemMenu]
Caption = 'OutlookBar Editor'
ClientHeight = 462
ClientWidth = 258
ClientHeight = 461
ClientWidth = 247
Constraints.MinHeight = 200
Constraints.MinWidth = 150
OnActivate = FormActivate
@ -21,11 +21,12 @@ object FrmOLBEditor: TFrmOLBEditor
Left = 0
Height = 36
Top = 0
Width = 258
Width = 247
AutoSize = True
ButtonHeight = 34
ButtonWidth = 30
Caption = 'TbTop'
ParentFont = False
ParentShowHint = False
PopupMenu = popToolbar
ShowCaptions = True
@ -50,23 +51,24 @@ object FrmOLBEditor: TFrmOLBEditor
Style = tbsDivider
end
object BtnUp: TToolButton
Left = 120
Left = 118
Top = 2
Action = AcMoveUp
end
object BtnDown: TToolButton
Left = 150
Left = 148
Top = 2
Action = AcMoveDown
end
end
object TvItems: TTreeView
Left = 0
Height = 403
Height = 402
Top = 36
Width = 258
Width = 247
Align = alClient
HideSelection = False
ParentFont = False
RightClickSelect = True
ShowButtons = False
TabOrder = 1
@ -79,12 +81,13 @@ object FrmOLBEditor: TFrmOLBEditor
object StatusBar1: TStatusBar
Left = 0
Height = 23
Top = 439
Width = 258
Top = 438
Width = 247
Panels = <
item
Width = 50
end>
ParentFont = False
SimplePanel = False
end
object AlActions: TActionList

View File

@ -5,7 +5,8 @@ unit JvOutlookBarForm;
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, ActnList, Menus,
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls,
ActnList, Menus, LclVersion,
PropEdits, ComponentEditors,
JvOutlookBar;
@ -91,6 +92,10 @@ type
procedure Modified;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SelectionChanged(AOrderChanged: Boolean = false);
{$IF LCL_FullVersion >= 1080000}
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
{$ENDIF}
public
constructor Create(AOwner: TComponent); override;
@ -109,6 +114,9 @@ implementation
uses
PropEditUtils, IDEWindowIntf, IDEImagesIntf, ObjInspStrConsts,
{$IF LCL_FullVersion < 1080000}
JvJVCLUtils,
{$ENDIF}
JvConsts;
type
@ -117,23 +125,30 @@ type
const
SDamagedTreeStructure = 'Dameged tree structure.';
LARGE_TOOLBUTTON_SIZE = 40;
SMALL_TOOLBUTTON_SIZE = 22;
{ TFrmOLBEditor }
constructor TFrmOLBEditor.Create(AOwner: TComponent);
begin
inherited;
FLargeToolBtnSize := 34;
FSmallToolBtnSize := 22;
TbTop.ButtonHeight := FLargeToolBtnSize;
TbTop.ButtonWidth := TbTop.ButtonHeight;
AlActions.Images := IDEImages.Images_16;
{$IF LCL_FullVersion >= 1080000}
AcNewPage.ImageIndex := IDEImages.LoadImage('laz_add');
AcNewButton.ImageIndex := IDEImages.LoadImage('laz_add');
AcDelete.ImageIndex := IDEImages.LoadImage('laz_delete');
AcMoveDown.ImageIndex := IDEImages.LoadImage('arrow_down');
AcMoveUp.ImageIndex := IDEImages.LoadImage('arrow_up');
{$ELSE}
AcNewPage.ImageIndex := IDEImages.LoadImage(16, 'laz_add');
AcNewButton.ImageIndex := IDEImages.LoadImage(16, 'laz_add');
AcDelete.ImageIndex := IDEImages.LoadImage(16, 'laz_delete');
AcMoveDown.ImageIndex := IDEImages.LoadImage(16, 'arrow_down');
AcMoveUp.ImageIndex := IDEImages.LoadImage(16, 'arrow_up');
{$ENDIF}
TbTop.Images := AlActions.Images;
popNew.Images := AlActions.Images;
@ -385,6 +400,24 @@ begin
end;
end;
{$IF LCL_FullVersion >= 1080000}
procedure TFrmOLBEditor.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double);
begin
inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion);
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
DisableAutoSizing;
try
FLargeToolBtnSize := round(LARGE_TOOLBUTTON_SIZE * AXProportion);
FSmallToolBtnSize := round(SMALL_TOOLBUTTON_SIZE * AXProportion);
finally
EnableAutoSizing;
end;
end;
end;
{$ENDIF}
procedure TFrmOLBEditor.EndUpdateSelection;
begin
dec(FUpdateSelectionCount);
@ -498,8 +531,17 @@ end;
procedure TFrmOLBEditor.FormShow(Sender: TObject);
begin
FLargeToolBtnSize := Scale96ToForm(LARGE_TOOLBUTTON_SIZE);
FSmallToolBtnSize := Scale96ToForm(SMALL_TOOLBUTTON_SIZE);
if AcShowToolbarCaptions.Checked then
TbTop.ButtonHeight := FLargeToolBtnSize
else
TbTop.ButtonHeight := FSmallToolBtnSize;
TbTop.ButtonWidth := TbTop.ButtonHeight;
if (FOutlookBar = nil) or (FDesigner = nil) then
exit;
BuildTreeData;
end;

View File

@ -1,13 +1,12 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="OLBarDemo"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
@ -21,10 +20,9 @@
<Version Value="2"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default"/>
</Modes>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>

View File

@ -7,7 +7,7 @@ uses
{$R *.res}
begin
Application.Scaled:=True; // Please remove this if Lazarus is older than 1.8
Application.Scaled := True; // Remove this line if Lazarus is older than 1.8
Application.Initialize;
Application.CreateForm(TOLBarMainForm, OLBarMainForm);
Application.Run;

View File

@ -852,7 +852,7 @@ function ReplaceComponentReference(This, NewReference: TComponent; var VarRefere
function ReplaceImageListReference(This: TComponent; NewReference: TCustomImageList;
var VarReference: TCustomImageList; ChangeLink: TChangeLink): Boolean;
{$IF LCL_FullVersion < 3000000}
{$IF LCL_FullVersion < 1080000}
function Scale96ToForm(ASize: Integer): Integer;
{$ENDIF}