NiceSideBar: High-dpi support for Lazarus version.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8857 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-06-26 12:29:59 +00:00
parent 45880ce30c
commit c67979a1f9
3 changed files with 963 additions and 163 deletions

File diff suppressed because it is too large Load Diff

View File

@ -16,7 +16,12 @@ uses
Dialogs, StdCtrls, ExtCtrls, NiceSideBar, ImgList;
type
{ TForm1 }
TForm1 = class(TForm)
ImageList2: TImageList;
ImageList1: TImageList;
Shape1: TShape;
Shape2: TShape;
Label1: TLabel;
@ -24,8 +29,6 @@ type
Label3: TLabel;
Label4: TLabel;
NiceSideBar1: TNiceSideBar;
ImageList1: TImageList;
ImageList2: TImageList;
Label5: TLabel;
Panel1: TPanel;
Panel2: TPanel;
@ -58,7 +61,7 @@ type
procedure WMNCHittest(var Msg: TMessage); message WM_NCHITTEST;
{$ENDIF}
protected
procedure CreateParams(var Params: TCreateParams); override;
//procedure CreateParams(var Params: TCreateParams); override;
public
end;
@ -73,13 +76,13 @@ implementation
{$ELSE}
{$R *.dfm}
{$ENDIF}
{
procedure TForm1.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := (Params.Style and WS_POPUP or WS_BORDER) and not WS_DLGFRAME;
//Params.Style := (Params.Style and WS_POPUP or WS_BORDER) and not WS_DLGFRAME;
end;
}
procedure TForm1.Image1Click(Sender: TObject);
begin // not used
//ShowMessage('Wah, gampang sekali!!!!');

View File

@ -285,6 +285,11 @@ type
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
procedure WMMouseWheel(var Msg: TWMMouseWheel); message WM_MOUSEWHEEL;
{$ENDIF}
function IsStoredItemHeight: Boolean;
function IsStoredSubItemHeight: Boolean;
function IsStoredMargin: Boolean;
function IsStoredIndent: Boolean;
function IsStoredGroupSeparator: Boolean;
procedure SetItems(Value: TSideBarItems);
procedure SetItemIndex(Value: Integer);
procedure SetSubItemIndex(Value: Integer);
@ -343,12 +348,12 @@ type
property Items: TSideBarItems read FItems write SetItems;
property ItemIndex: Integer read FItemIndex write SetItemIndex default -1;
property SubItemIndex: Integer read FSubItemIndex write SetSubItemIndex default -1;
property ItemHeight: Integer read FItemHeight write SetItemHeight default 30;
property SubItemHeight: Integer read FSubItemHeight write SetSubItemHeight default 18;
property ItemHeight: Integer read FItemHeight write SetItemHeight stored IsStoredItemHeight;
property SubItemHeight: Integer read FSubItemHeight write SetSubItemHeight stored IsStoredSubItemHeight;
property Alignment: TSideBarAlign read FAlignment write SetAlignment default saLeft;
property Margin: Integer read FMargin write SetMargin default 8;
property GroupSeparator: Integer read FGroupSeparator write SetGroupSeparator default 10;
property Indent: Integer read FIndent write SetIndent default 10;
property Margin: Integer read FMargin write SetMargin stored IsStoredMargin;
property GroupSeparator: Integer read FGroupSeparator write SetGroupSeparator stored IsStoredGroupSeparator;
property Indent: Integer read FIndent write SetIndent stored IsStoredIndent;
property AlwaysExpand: Boolean read FAlwaysExpand write SetAlwaysExpand;
property Images: TImageList read FImages write SetImages;
property HoverImages: TImageList read FHoverImages write SetHoverImages;
@ -381,6 +386,13 @@ type
implementation
const
DEFAULT_ITEMHEIGHT = 30; // Values at 96 ppi
DEFAULT_SUBITEMHEIGHT = 18;
DEFAULT_MARGIN = 8;
DEFAULT_INDENT = 10;
DEFAULT_GROUPSEPARATOR = 10;
type
TSBInfo = record
ItemIndex: Integer;
@ -669,13 +681,13 @@ begin
FItemIndex := -1;
FSubItemIndex := -1;
FItemHeight := 30;
FSubItemHeight := 18;
FItemHeight := DEFAULT_ITEMHEIGHT;
FSubItemHeight := DEFAULT_SUBITEMHEIGHT;
FAlignment := saLeft;
FHandPointCursor := False;
FMargin := 8;
FGroupSeparator := 10;
FIndent := 10;
FMargin := DEFAULT_MARGIN;
FGroupSeparator := DEFAULT_GROUPSEPARATOR;
FIndent := DEFAULT_INDENT;
FAlwaysExpand := True;
FItemStyle := TSideBarItemStyle.Create(Self);
@ -714,7 +726,7 @@ end;
procedure TNiceSidebar.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double);
begin
inherited;
inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion);
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
FItemHeight := round(FItemHeight * AYProportion);
@ -722,6 +734,7 @@ begin
FMargin := round(FMargin * AXProportion);
FIndent := round(FIndent * AXProportion);
FGroupSeparator := round(FGroupSeparator * AYProportion);
ListChange(true);
end;
end;
@ -973,6 +986,7 @@ var
P: PSBInfo;
x, y, v: Integer;
Item: TSideBarItem;
delta: Integer;
begin
if IsUpdating
then Exit;
@ -1037,14 +1051,19 @@ begin
BottomIndex := FList.Count-1;
ScBottomVisible := False;
end;
{$IFDEF FPC}
delta := Scale96ToFont(12);
{$ELSE}
delta := 12;
{$ENDIF}
if (FAlignment = saRight) then
begin
ScTop := Rect(FMargin + 10, 10, FMargin + 21, 21);
ScBottom := Rect(FMargin + 10, ClientHeight - 21, FMargin + 21, ClientHeight - 10);
ScTop := Rect(FMargin + delta, delta, FMargin + 2*delta + 1, 2*delta + 1);
ScBottom := Rect(FMargin + delta, ClientHeight - 2*delta - 1, FMargin + 2*delta + 1, ClientHeight - delta);
end else
begin
ScTop := Rect(ClientWidth - FMargin - 21, 10, ClientWidth - FMargin - 10, 21);
ScBottom := Rect(ClientWidth - FMargin - 21, ClientHeight - 21, ClientWidth - FMargin - 10, ClientHeight - 10);
ScTop := Rect(ClientWidth - FMargin - 2*delta - 1, delta, ClientWidth - FMargin - delta, 2*delta+1);
ScBottom := Rect(ClientWidth - FMargin - 2*delta - 1, ClientHeight - 2*delta-1, ClientWidth - FMargin - delta, ClientHeight - delta);
end;
end;
end;
@ -1133,8 +1152,14 @@ procedure TNiceSideBar.DrawItem(ACanvas: TCanvas; Rc: TRect; Str: string;
States: TSideBarStates; ImageIndex: Integer);
var
w, h, x, y: Integer;
Img: TImageList;
RcItem: TRect;
Img: TImageList;
ImgWidth: Integer;
ImgHeight: Integer;
{$IFDEF FPC}
imgR: TScaledImageListResolution;
ppi: Integer;
{$ENDIF}
begin
CopyRect(RcItem, Rc);
with ACanvas do
@ -1207,12 +1232,25 @@ begin
then Img := FImages;
end;
if Assigned(Img) then
begin
{$IFDEF FPC}
ppi := NeedParentDesignControl(Self).PixelsPerInch;
ImgWidth := Img.WidthForPPI[0, ppi];
ImgHeight := Img.HeightForPPI[0, ppi];
ImgR := Img.ResolutionForPPI[0, ppi, GetCanvasScaleFactor];
{$ELSE}
ImgWidth := Img.Width;
ImgHeight := Img.Height;
{$ENDIF}
end;
w := TextWidth(Str);
h := TextHeight('Ag');
x := 0;
if Assigned(Img) and (ImageIndex > -1)
then w := w + Img.Width + FIndent;
then w := w + ImgWidth + FIndent;
case FAlignment of
saLeft: x := RcItem.Left;
@ -1224,13 +1262,13 @@ begin
begin
if (ImageIndex > -1) then
begin
y := RcItem.Top + ((FItemHeight - Img.Height) div 2);
y := RcItem.Top + ((FItemHeight - ImgHeight) div 2);
if (FAlignment <> saRight) then
begin
Img.Draw(ACanvas, x, y, ImageIndex, dsTransparent, itImage);
Inc(x, Img.Width + FIndent);
{$IFDEF FPC}ImgR{$ELSE}Img{$ENDIF}.Draw(ACanvas, x, y, ImageIndex, dsTransparent, itImage);
Inc(x, ImgWidth + FIndent);
end else
Img.Draw(ACanvas, RcItem.Right - Img.Width, y, ImageIndex, dsTransparent, itImage);
{$IFDEF FPC}ImgR{$ELSE}Img{$ENDIF}.Draw(ACanvas, RcItem.Right - ImgWidth, y, ImageIndex, dsTransparent, itImage);
end;
end;
@ -1398,6 +1436,7 @@ procedure TNiceSideBar.DrawScroller(ACanvas: TCanvas; Rc: TRect;
Up: Boolean; Hover: Boolean);
var
Old: TColor;
dist: Integer;
begin
with ACanvas do
begin
@ -1422,20 +1461,39 @@ begin
Brush.Color := FScrollers.FNormalArrowColor;
Pen.Color := FScrollers.FNormalArrowColor;
end;
{$IFDEF FPC}
dist := Scale96ToFont(3);
{$ELSE}
dist := 3;
{$ENDIF}
if Up then
begin
Polygon([
Point(Rc.Left + dist, Rc.Bottom - dist - 1),
Point(Rc.Right - dist - 1, Rc.Bottom - dist - 1),
Point((Rc.Left + Rc.Right) div 2, Rc.Top + dist)
]);
{
Polygon([
Point(Rc.Left+3, Rc.Bottom-5),
Point(Rc.Right-4, Rc.Bottom-5),
Point(Rc.Left+5, Rc.Top+3)
]);
}
end else
begin
Polygon([
Point(Rc.Left + dist, Rc.Top + dist),
Point(Rc.Right - dist - 1, Rc.Top + dist),
Point((Rc.Left + Rc.Right) div 2, Rc.Bottom - dist - 1)
]);
{
Polygon([
Point(Rc.Left+3, Rc.Top+4),
Point(Rc.Right-4, Rc.Top+4),
Point(Rc.Left+5, Rc.Bottom-4)
]);
}
end;
Pen.Color := Old;
end;
@ -1573,6 +1631,31 @@ begin
Invalidate;
end;
function TNiceSideBar.IsStoredItemHeight: Boolean;
begin
Result := FItemHeight <> DEFAULT_ITEMHEIGHT;
end;
function TNiceSideBar.IsStoredSubItemHeight: Boolean;
begin
Result := FSubItemHeight <> DEFAULT_SUBITEMHEIGHT;
end;
function TNiceSideBar.IsStoredMargin: Boolean;
begin
Result := FMargin <> DEFAULT_MARGIN;
end;
function TNiceSideBar.IsStoredIndent: Boolean;
begin
Result := FIndent <> DEFAULT_INDENT;
end;
function TNiceSideBar.IsStoredGroupSeparator: Boolean;
begin
Result := FGroupSeparator <> DEFAULT_GROUPSEPARATOR;
end;
procedure TNiceSideBar.SetItemIndex(Value: Integer);
var
x: Integer;