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

components/nicesidebar/Demo1/common/Unit1.pas

@@ -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!!!!');

components/nicesidebar/source/NiceSideBar.pas

@@ -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 ItemHeight: Integer read FItemHeight write SetItemHeight stored IsStoredItemHeight;
-    property SubItemHeight: Integer read FSubItemHeight write SetSubItemHeight default 18;
+    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 Margin: Integer read FMargin write SetMargin stored IsStoredMargin;
-    property GroupSeparator: Integer read FGroupSeparator write SetGroupSeparator default 10;
+    property GroupSeparator: Integer read FGroupSeparator write SetGroupSeparator stored IsStoredGroupSeparator;
-    property Indent: Integer read FIndent write SetIndent default 10;
+    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;
+  FItemHeight := DEFAULT_ITEMHEIGHT;
-  FSubItemHeight := 18;
+  FSubItemHeight := DEFAULT_SUBITEMHEIGHT;
   FAlignment := saLeft;
   FHandPointCursor := False;
-  FMargin := 8;
+  FMargin := DEFAULT_MARGIN;
-  FGroupSeparator := 10;
+  FGroupSeparator := DEFAULT_GROUPSEPARATOR;
-  FIndent := 10;
+  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);
+      ScTop := Rect(FMargin + delta, delta, FMargin + 2*delta + 1, 2*delta + 1);
-      ScBottom := Rect(FMargin + 10, ClientHeight - 21, FMargin + 21, ClientHeight - 10);
+      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);
+      ScTop := Rect(ClientWidth - FMargin - 2*delta - 1, delta, ClientWidth - FMargin - delta, 2*delta+1);
-      ScBottom := Rect(ClientWidth - FMargin - 21, ClientHeight - 21, ClientWidth - FMargin - 10, ClientHeight - 10);
+      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);
+          {$IFDEF FPC}ImgR{$ELSE}Img{$ENDIF}.Draw(ACanvas, x, y, ImageIndex, dsTransparent, itImage);
-          Inc(x, Img.Width + FIndent);
+          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;