tvplanit: Make NavBar componente edit Hi-DPI aware (except for icons). Cleanup.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6385 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/tvplanit/images/regbasepng_files.txt

@@ -63,9 +63,9 @@ components/VpToday24.png
 components/VpToday32.png
 
 components/VpUpArrow.png
-components/VpUpArrow_150.png
+components/VpUpArrow150.png
-components/VpUpArrow_200.png
+components/VpUpArrow200.png
 
 components/VpDownArrow.png
-components/VpDownArrow_150.png
+components/VpDownArrow150.png
-components/VpdownArrow_200.png
+components/VpdownArrow200.png

components/tvplanit/source/design/vpnabed.lfm

@@ -13,7 +13,8 @@ object frmNavBarEd: TfrmNavBarEd
   OnCreate = FormCreate
   OnDestroy = FormDestroy
   OnShow = FormShow
-  Position = poScreenCenter
+  Position = poDefaultPosOnly
+  ShowHint = True
   LCLVersion = '1.9.0.0'
   object pnlFoldersAndItems: TPanel
     Left = 0
@@ -217,12 +218,12 @@ object frmNavBarEd: TfrmNavBarEd
         AnchorSideLeft.Control = pnlItems
         AnchorSideTop.Control = Panel4
         AnchorSideTop.Side = asrBottom
-        AnchorSideRight.Control = lbImages
+        AnchorSideRight.Control = btnUseImage
         AnchorSideBottom.Control = Panel1
         Left = 0
         Height = 307
         Top = 24
-        Width = 248
+        Width = 221
         Anchors = [akTop, akLeft, akRight, akBottom]
         BorderSpacing.Right = 4
         ItemHeight = 13
@@ -393,11 +394,23 @@ object frmNavBarEd: TfrmNavBarEd
         Width = 48
         Anchors = [akTop, akRight, akBottom]
         ItemHeight = 0
-        OnClick = lbImagesClick
         OnDrawItem = lbImagesDrawItem
         Style = lbOwnerDrawFixed
         TabOrder = 3
       end
+      object btnUseImage: TSpeedButton
+        AnchorSideTop.Control = lbImages
+        AnchorSideTop.Side = asrCenter
+        AnchorSideRight.Control = lbImages
+        Left = 225
+        Height = 22
+        Hint = 'Use image in navigation bar'
+        Top = 166
+        Width = 23
+        Anchors = [akTop, akRight]
+        BorderSpacing.Right = 4
+        OnClick = btnUseImageClick
+      end
     end
     object Bevel1: TBevel
       AnchorSideLeft.Control = pnlFoldersAndItems

components/tvplanit/source/design/vpnabed.pas

@@ -34,9 +34,7 @@ unit VpNabEd;
 interface
 
 uses
-  lazlogger,
+  LCLProc, LCLType, LCLIntf, LCLVersion,
-
-  LCLProc, LCLType, LCLIntf,
   PropEdits, LazarusPackageIntf, FieldsEditor, ComponentEditors,
   SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, ExtCtrls, Buttons,
@@ -77,25 +75,24 @@ type
     btnFolderDown: TSpeedButton;
     Panel6: TPanel;
     Label1: TLabel;
+    btnUseImage: TSpeedButton;
 
     procedure btnFolderAddClick(Sender: TObject);
     procedure btnFolderDeleteClick(Sender: TObject);
     procedure btnFolderDownClick(Sender: TObject);
     procedure btnFolderUpClick(Sender: TObject);
-
     procedure btnItemAddClick(Sender: TObject);
     procedure btnItemDeleteClick(Sender: TObject);
     procedure btnItemDownClick(Sender: TObject);
     procedure btnItemUpClick(Sender: TObject);
+    procedure btnUseImageClick(Sender: TObject);
 
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
-//    procedure FormResize(Sender: TObject);
     procedure FormShow(Sender: TObject);
 
     procedure lbFoldersClick(Sender: TObject);
-    procedure lbImagesClick(Sender: TObject);
     procedure lbImagesDrawItem(Control: TWinControl; Index: Integer;
       ARect: TRect; State: TOwnerDrawState);
     procedure lbItemsClick(Sender: TObject);
@@ -122,6 +119,10 @@ type
     procedure OnSetSelection(const ASelection: TPersistentSelectionList);
 
   protected
+    {$IF LCL_FullVersion >= 1080000}
+     procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
+       const AXProportion, AYProportion: Double); override;
+    {$ENDIF}
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
 
   public
@@ -144,13 +145,18 @@ implementation
 
 uses
   PropEditUtils, IDEWindowIntf, StrUtils, ImgList,
-  VpMisc;
+  VpConst, VpMisc;
 
 const
   ITEMS_MARGIN = 2;
   IMG_MARGIN_HOR = 8;
   IMG_MARGIN_VERT = 4;
 
+var
+  vITEMS_MARGIN: Integer = ITEMS_MARGIN;
+  vIMG_MARGIN_HOR: Integer = IMG_MARGIN_HOR;
+  vIMG_MARGIN_VERT: Integer = IMG_MARGIN_VERT;
+
 var
   EditorForms : TList = nil;
 
@@ -268,6 +274,26 @@ begin
   end;
 end;
 
+{$IF LCL_FullVersion >= 1080000}
+ procedure TFrmNavBarEd.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
+   const AXProportion, AYProportion: Double);
+ begin
+   inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion);
+   if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
+   begin
+     DisableAutoSizing;
+     try
+       vITEMS_MARGIN := round(ITEMS_MARGIN * AXProportion);
+       vIMG_MARGIN_HOR := round(IMG_MARGIN_HOR * AXProportion);
+       vIMG_MARGIN_VERT := round(IMG_MARGIN_VERT * AYProportion);
+     finally
+       EnableAutoSizing;
+     end;
+   end;
+ end;
+
+{$ENDIF}
+
 procedure TfrmNavBarEd.FormClose(Sender: TObject;
   var Action: TCloseAction);
 begin
@@ -278,6 +304,17 @@ end;
 procedure TfrmNavBarEd.FormCreate(Sender: TObject);
 begin
   IDEDialogLayoutList.ApplyLayout(Self);
+
+ {$IFDEF NEW_ICONS}
+  LoadGlyphFromRCDATA(btnUseImage.Glyph, 'VpLArrow', 16, 24, 32);
+ {$ELSE}
+  vtnUseImage.Glyph.LoadFromResourceName(HINSTANCE, 'VPLEFTARROW');
+ {$ENDIF}
+
+ {$IF VP_LCL_SCALING = 0}
+  btnUseImage.Width := ScaleX(btnUseImage.Width, DesignTimeDPI);
+  btnUseImage.Height := ScaleY(btnUseImage.Width, DesignTimeDPI);
+ {$ENDIF}
 end;
 
 procedure TfrmNavBarEd.FormDestroy(Sender: TObject);
@@ -346,11 +383,6 @@ procedure TfrmNavBarEd.OnPersistentAdded(APersistent: TPersistent; Select: boole
 var
   i: Integer;
 begin
-  if APersistent = nil then
-    DebugLn('OnPersistentAdded: Persistent = nil')
-  else
-    DebugLn('OnPersistentAdded: Persistent = ' + APersistent.ClassName);
-
   if not Assigned(APersistent) then
     exit;
 
@@ -469,8 +501,8 @@ begin
   for i:=0 to FBar.Images.Count-1 do
     lbImages.Items.Add('');
 
-  lbImages.ItemHeight := FBar.Images.Width + 2*IMG_MARGIN_HOR;
+  lbImages.ItemHeight := FBar.Images.Width + 2*vIMG_MARGIN_HOR;
-  lbImages.ClientWidth := FBar.Images.Width + 2*IMG_MARGIN_VERT + GetScrollbarWidth;
+  lbImages.ClientWidth := FBar.Images.Width + 2*vIMG_MARGIN_VERT + GetScrollbarWidth;
 end;
 
 procedure TfrmNavBarEd.PopulateItemList;
@@ -536,26 +568,6 @@ begin
   UpdateBtnStates;
 end;
 
-procedure TfrmNavBarEd.lbImagesClick(Sender: TObject);
-var
-  btn: TVpNavBtnItem;
-  res: Integer;
-begin
-  if (lbImages.ItemIndex <> -1) and (lbItems.ItemIndex <> -1) then begin
-    btn := TVpNavBtnItem(lbItems.Items.Objects[lbItems.ItemIndex]);
-    if btn.IconIndex <> -1 then begin
-      res := MessageDlg('Do you want to replace the button icon by this one?',
-        mtConfirmation, [mbYes, mbNo, mbCancel], 0);
-      if res <> mrYes then
-        exit;
-    end;
-    btn.IconIndex := lbImages.ItemIndex;
-    lbItems.Invalidate;
-    if Assigned(Designer) then
-      Designer.Modified;
-  end;
-end;
-
 procedure TfrmNavBarEd.lbImagesDrawItem(Control: TWinControl; Index: Integer;
   ARect: TRect; State: TOwnerDrawState);
 var
@@ -580,7 +592,7 @@ procedure TfrmNavBarEd.lbItemsMeasureItem(Control: TWinControl;
 begin
   Unused(Control, Index);
   if (FBar <> nil) and (Bar.Images <> nil) then
-    Height := Bar.Images.Height + 2 * ITEMS_MARGIN;
+    Height := Bar.Images.Height + 2 * vITEMS_MARGIN;
 end;
 
 procedure TfrmNavBarEd.lbItemsDrawItem(Control: TWinControl;
@@ -600,7 +612,7 @@ begin
     exit;
 
   // Draw button image
-  delta := ITEMS_MARGIN;
+  delta := vITEMS_MARGIN;
   btn := TVpNavBtnItem(lbItems.Items.Objects[Index]);
   if (FBar.Images <> nil) and (btn <> nil) and
      (btn.IconIndex > -1) and (btn.IconIndex < Bar.Images.Count) then
@@ -796,14 +808,32 @@ begin
   UpdateBtnStates;
 end;
 
+procedure TfrmNavBarEd.btnUseImageClick(Sender: TObject);
+var
+  btn: TVpNavBtnItem;
+  res: Integer;
+begin
+  if (lbImages.ItemIndex <> -1) and (lbItems.ItemIndex <> -1) then begin
+    btn := TVpNavBtnItem(lbItems.Items.Objects[lbItems.ItemIndex]);
+    if btn.IconIndex = lbImages.itemIndex then
+      exit;
+    if btn.IconIndex <> -1 then begin
+      res := MessageDlg('Do you want to replace the button icon by this one?',
+        mtConfirmation, [mbYes, mbNo, mbCancel], 0);
+      if res <> mrYes then
+        exit;
+    end;
+    btn.IconIndex := lbImages.ItemIndex;
+    lbItems.Invalidate;
+    if Assigned(Designer) then
+      Designer.Modified;
+  end;
+end;
+
 procedure TfrmNavBarEd.SelectionChanged(AOrderChanged: Boolean = false);
 var
   SelList: TPersistentSelectionList;
 begin
-  {
-  if (FUpdateSelectionCount>0) or (GlobalDesignHook=nil) then
-    exit;
-  }
   GlobalDesignHook.RemoveHandlerSetSelection(OnSetSelection);
   try
     SelList := TPersistentSelectionList.Create;
@@ -857,6 +887,7 @@ begin
   end;
 end;
 
+
 initialization
   InitFormsList;
 

components/tvplanit/source/vpmisc.pas

@@ -982,6 +982,11 @@ begin
   end;
 end;
 
+function ResToStr(AValue: Integer): String;
+begin
+  if AValue > 0 then Result := IntToStr(AVAlue) else Result := '';
+end;
+
 procedure LoadGlyphFromRCDATA(AGlyph: TBitmap; ABaseResName: String;
   ALowRes, AMedRes, AHighRes: Integer);
 var
@@ -990,11 +995,11 @@ var
 begin
   ppiFactor := MulDiv(Screen.PixelsPerInch, 100, 96);
   if ppiFactor >= 145 then
-    resName := ABaseResName + IntToStr(AHighRes)
+    resName := ABaseResName + ResToStr(AHighRes)
   else if ppiFactor >= 115 then
-    resName := ABaseResName + IntToStr(AMedRes)
+    resName := ABaseResName + ResToStr(AMedRes)
   else
-    resName := ABaseResName + IntToStr(ALowRes);
+    resName := ABaseResName + ResToStr(ALowRes);
 
   LoadGlyphFromRCDATA(AGlyph, resName);
 end;
@@ -1008,11 +1013,11 @@ var
 begin
   ppiFactor := MulDiv(Screen.PixelsPerInch, 100, 96);
   if ppiFactor >= 145 then
-    resName := ABaseResName + IntToStr(AHighRes)
+    resName := ABaseResName + ResToStr(AHighRes)
   else if ppiFactor >= 115 then
-    resName := ABaseResName + IntToStr(AMedRes)
+    resName := ABaseResName + ResToStr(AMedRes)
   else
-    resName := ABaseResName + IntToStr(ALowRes);
+    resName := ABaseResName + ResToStr(ALowRes);
 
   stream := TResourceStream.Create(HINSTANCE, resName, RT_RCDATA);
   try

components/tvplanit/source/vpnavbar.pas

@@ -1030,8 +1030,11 @@ begin
     Visible := False;
     Parent := Self;
     OnClick := nabScrollUpBtnClick;
-//    Glyph.LoadFromResourceName(HINSTANCE, 'VPUPARROW');
+   {$IFDEF NEW_ICONS}
-    LoadGlyphFromRCDATA(Glyph, 'VPUPARROW');
+    LoadGlyphFromRCDATA(Glyph, 'VPUPARROW', -1, 150, 200);
+   {$ELSE}
+    Glyph.LoadFromResourceName(HINSTANCE, 'VPUPARROW');
+   {$ENDIF}
     NumGlyphs := 1;
     Left := -20;
     Height := 15;
@@ -1043,8 +1046,11 @@ begin
     Visible := False;
     Parent := Self;
     OnClick := nabScrollDownBtnClick;
-//    Glyph.LoadFromResourceName(HINSTANCE, 'VPDOWNARROW');
+   {$IFDEF NEW_ICONS}
-    LoadGlyphFromRCDATA(Glyph, 'VPDOWNARROW');
+    LoadGlyphFromRCDATA(Glyph, 'VPDOWNARROW', -1, 150, 200);
+   {$ELSE}
+    Glyph.LoadFromResourceName(HINSTANCE, 'VPDOWNARROW');
+   {$ENDIF}
     NumGlyphs := 1;
     Left := -20;
     Height := 15;