tvplanit: Support scaled imagelist of Laz 1.9+ in VpNavBar. Fix compilation with Laz 1.6.4/fpc 2.6.4.

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

components/tvplanit/source/vpconst.pas

@@ -275,12 +275,11 @@ const
 {$IFDEF LCL}
  {$IF LCL_FULLVERSION >= 1080100}
   VP_LCL_SCALING = 2;
- {$ELSE}
+ {$ELSEIF LCL_FULLVERSION >= 1080000}
- {$IF LCL_FULLVERSION >= 1080000}
   VP_LCL_SCALING = 1;
  {$ELSE}
   VP_LCL_SCALING = 0;
- {$ENDIF}{$ENDIF}
+ {$ENDIF}
 {$ELSE}
   VL_LCL_SCALING := 0;
 {$ENDIF}
@@ -289,7 +288,10 @@ const
 implementation
 
 initialization
-{$IFNDEF LCL}
+
+{$IFDEF LCL}
+  //
+{$ELSE}
   ClickDelay :=  GetDoubleClickTime;                                     
 {$ENDIF}
 

components/tvplanit/source/vpjsonds.pas

@@ -486,7 +486,11 @@ begin
   stream := TFileStream.Create(FFilename, fmOpenRead + fmShareDenyWrite);
   try
     Resources.ClearResources;
+    {$IF FPC_FullVersion >= 30000}
     p := TJSONParser.Create(stream, [joUTF8]);
+    {$ELSE}
+    p := TJSONParser.Create(stream, true);
+    {$ENDIF}
     try
       json := p.Parse as TJSONObject;
       resObjArray := json.Find('Resources', jtArray) as TJSONArray;
@@ -647,6 +651,9 @@ var
   task: TvpTask;
   i, j: Integer;
   stream: TStream;
+ {$IF FPC_FullVersion < 30000}
+  s: TJSONStringType;
+ {$ENDIF}
 begin
   if FFilename = '' then
     raise Exception.Create(RSNoFilenameSpecified);

components/tvplanit/source/vpnavbar.pas

@@ -190,11 +190,13 @@ type
     FBackgroundMethod: TVpBackgroundMethod;
 //    FBorderStyle: TBorderStyle;
     FButtonHeight: Integer;
+    FCanvasScaleFactor: Double;
     FContainers: TVpContainerList;
     FDrawingStyle: TVpFolderDrawingStyle;
     FFolders: TVpCollection;
     FHotFolder: Integer;
     FImages: TImageList;
+    FImagesWidth: Integer;
     FItemFont: TFont;
     FItemSpacing: Integer;
     FPreviousFolder: Integer;
@@ -257,6 +259,7 @@ type
 //    procedure SetBorderStyle(const Value: TBorderStyle);
     procedure SetButtonHeight(Value: Integer);
     procedure SetImages(Value: TImageList);
+    procedure SetImagesWidth(const AValue: Integer);
     procedure SetItemFont(Value: TFont);
     procedure SetItemSpacing(Value: Integer);
     procedure SetSelectedItemFont(Value: TFont);
@@ -345,6 +348,7 @@ type
     property DrawingStyle: TVpFolderDrawingStyle read FDrawingStyle write SetDrawingStyle;
     property FolderCollection: TVpCollection read FFolders write FFolders;
     property Images: TImageList read FImages write SetImages;
+    property ImagesWidth: Integer read FImagesWidth write SetImagesWidth;
     property ItemFont: TFont read FItemFont write SetItemFont;
     property ItemSpacing: Integer read FItemSpacing write SetItemSpacing stored IsStoredItemSpacing;
     property PlaySounds: Boolean read FPlaySounds write FPlaySounds;
@@ -420,6 +424,9 @@ type
     property DrawingStyle;
     property FolderCollection;
     property Images;
+    {$IFDEF LCL}{$IF LCL_FullVersion >= 1090000}
+    property ImagesWidth;
+    {$ENDIF}{$ENDIF}
     property ItemFont;
     property ItemSpacing;
     property PlaySounds;
@@ -1021,7 +1028,7 @@ begin
 
   FItemSpacing := DEFAULT_ITEMSPACING;
   {$IF VP_LCL_SCALING = 0}
-  FItemSpacing := ScaleY(FItemSpacing, DesignTimeDPI)}
+  FItemSpacing := ScaleY(FItemSpacing, DesignTimeDPI);
   {$ENDIF}
 
   FSelectedItemFont := TFont.Create;
@@ -2070,6 +2077,10 @@ procedure TVpCustomNavBar.Paint;
 var
   painter: TVpNavBarPainter;
 begin
+  {$IFDEF LCL}{$IF LCL_FullVersion >= 1090000}
+  FCanvasScaleFactor := GetCanvasScaleFactor;
+  {$IFEND}{$ENDIF}
+
   painter := TVpNavBarPainter.Create(Self);
   try
     painter.Paint;
@@ -2941,6 +2952,13 @@ begin
 end;
 {=====}
 
+procedure TVpCustomNavBar.SetImagesWidth(const AValue: Integer);
+begin
+  if AValue = FImagesWidth then exit;
+  FImagesWidth := AValue;
+  Invalidate;
+end;
+
 procedure TVpCustomNavBar.SetItemFont(Value: TFont);
 begin
   if Assigned(Value) then

components/tvplanit/source/vpnavbarpainter.pas

@@ -6,7 +6,7 @@ interface
 
 uses
   {$IFDEF LCL}
-  LCLProc, LCLType, LCLIntf,
+  LCLProc, LCLType, LCLIntf, LCLVersion,
   {$ELSE}
   Windows, Messages, MMSystem,
   {$ENDIF}
@@ -62,7 +62,7 @@ type
 
     procedure DrawItemHighlight(Canvas: TCanvas; R: TRect; Enable: Boolean);
     function DrawItemText(Canvas: TCanvas; AItem: TVpNavBtnItem; CurPos: Integer;
-      AText: String; AtLargeIcon: Boolean; out AWidth: Integer): Boolean;
+      AText: String; AtLargeIcon: Boolean; out AHeight: Integer): Boolean;
     function DrawLargeIcon(Canvas: TCanvas; AItem: TVpNavBtnItem;
       CurPos: Integer): Boolean;
     function DrawSmallIcon(Canvas: TCanvas; AItem: TVpNavBtnItem;
@@ -92,7 +92,7 @@ function GetLargeIconDisplayName(Canvas: TCanvas; Rect: TRect; const Name: strin
 implementation
 
 uses
-  Math, Themes,
+  Math, Themes, imglist,
   VpConst, VpMisc;
 
 type
@@ -138,28 +138,42 @@ procedure TVpNavBarPainter.DrawActiveFolderItems(Canvas: TCanvas; var CurPos: In
 const
   BUTTON_DISTANCE = 8;
   LARGE_ICON_OFFSET = 4;
-  SMALL_ICON_OFFSET = 3;
+  SMALL_ICON_TEXT_DISTANCE = 6;
 var
   folder: TVpNavFolder;
   item: TVpNavBtnItem;
   J: Integer;
   text: String;
-  X: Integer;
+  h: Integer;
   R: TRect;
   largeIconOffs: Integer;
   smallIconOffs: Integer;
+ {$IFDEF LCL}
+  {$IF LCL_FullVersion >= 1090000}
+  imgres: TScaledImageListResolution;
+  f: Double;
+  ppi: Integer;
+  {$IFEND}
+ {$ENDIF}
 begin
   folder := FNavBar.Folders[FActiveFolder];
   largeIconOffs := ScaleY(LARGE_ICON_OFFSET, DesignTimeDPI);
-  smallIconOffs := ScaleX(SMALL_ICON_OFFSET, DesignTimeDPI);
+  smallIconOffs := ScaleX(SMALL_ICON_TEXT_DISTANCE, DesignTimeDPI);
 
   if FImages <> nil then begin
-    FLargeImagesSize := FImages.Width;
+   {$IFDEF LCL}{$IF LCL_FullVersion >= 1090000}
-    FSmallImagesSize := FImages.Width div 2;
+    with  TVpNavBarOpener(FNavBar) do begin
-  end else begin
+      f := FCanvasScaleFactor;
-    FLargeImagesSize := 32;
+      ppi := Font.PixelsPerInch;
-    FSmallImagesSize := 16;
+      imgRes := FImages.ResolutionForPPI[FImagesWidth, ppi, f];
     end;
+    FLargeImagesSize := imgRes.Width;
+   {$ELSE}
+    FLargeImagesSize := FImages.Width;
+   {$ENDIF}{$ENDIF}
+  end else
+    FLargeImagesSize := 32;
+  FSmallImagesSize := FLargeImagesSize div 2;
 
   if folder.FolderType = ftDefault then begin
     if folder.ItemCount = 0 then
@@ -206,9 +220,9 @@ begin
         CurPos := item.IconRect.Bottom;
 
         {now, draw the text}
-        if not DrawItemText(Canvas, item, CurPos, text, true, X) then
+        if not DrawItemText(Canvas, item, CurPos, text, true, h) then
           Continue;
-        Inc(CurPos, FItemSpacing + X);
+        Inc(CurPos, FItemSpacing + h);
       end else
       begin
         { Small Icons }
@@ -221,9 +235,9 @@ begin
         item.IconRect := R;
 
         {now, draw the text}
-        if not DrawItemText(Canvas, item, CurPos, text, false, X) then
+        if not DrawItemText(Canvas, item, CurPos, text, false, h) then
           Continue;
-        Inc(CurPos, FItemSpacing + X);
+        Inc(CurPos, FItemSpacing + h);
       end;  { if folder.IconSize ... }
     end;  { for J }
   end;  { if folder.FolderType = ftDefault ... }
@@ -522,7 +536,7 @@ begin
 end;
 
 function TVpNavBarPainter.DrawItemText(Canvas: TCanvas; AItem: TVpNavBtnItem;
-  CurPos: Integer; AText: String; AtLargeIcon: Boolean; out AWidth: Integer): Boolean;
+  CurPos: Integer; AText: String; AtLargeIcon: Boolean; out AHeight: Integer): Boolean;
 const
   HOR_MARGIN = 5;
 var
@@ -533,20 +547,19 @@ var
   horDist: Integer;
 begin
   Result := false;
+  horDist := ScaleX(HOR_MARGIN, DesignTimeDPI);
 
   if AtLargeIcon then
   begin
-    horDist := ScaleX(HOR_MARGIN, DesignTimeDPI);
-
     R.Top := CurPos;
     R.Bottom := CurPos + FButtonHeight div 2 - 7;   // what is -7 good for?
     R.Left := 0;
     R.Right := FNavBar.ClientWidth - 1;
     AItem.LabelRect := R;
     AItem.DisplayName := GetLargeIconDisplayName(Canvas, R, AText);
-    AWidth := Canvas.TextWidth(AItem.DisplayName);
+    txtWidth := Canvas.TextWidth(AItem.DisplayName);
-    R.Left := Max(horDist, (FNavBar.ClientWidth - AWidth) div 2);
+    R.Left := Max(horDist, (FNavBar.ClientWidth - txtWidth) div 2);
-    R.Right := Min(R.Left + AWidth, FNavBar.ClientWidth - hordist);
+    R.Right := Min(R.Left + txtWidth, FNavBar.ClientWidth - hordist);
     AItem.LabelRect := R;
     if R.Top > nabItemsRect^.Bottom then
       Exit;
@@ -559,32 +572,40 @@ begin
     AItem.LabelRect := R;
 
     bkMode := SetBkMode(Canvas.Handle, TRANSPARENT);
-    AWidth := DrawText(Canvas.Handle, PChar(s), Length(s), R, DT_CENTER or DT_VCENTER or DT_WORDBREAK);
+    AHeight:= DrawText(Canvas.Handle, PChar(s), Length(s), R, DT_CENTER or DT_VCENTER or DT_WORDBREAK);
     SetBkMode(Canvas.Handle, bkMode);
-
   end else
   begin
     R.Top := CurPos;
-    R.Bottom := CurPos + FButtonHeight div 2 - 7;
+    R.Bottom := CurPos + Canvas.TextHeight('Tg');
+//    R.Bottom := CurPos + FButtonHeight div 2 - 7;
     R.Left := AItem.IconRect.Right;
-    R.Right := R.Left + FNavBar.ClientWidth - R.Left - ScaleX(7, DesignTimeDPI);
+    R.Right := FNavBar.ClientWidth - 2*AItem.IconRect.Left; // - 2*horDist;
+//    R.Right := R.Left + FNavBar.ClientWidth - R.Left - ScaleX(7, DesignTimeDPI);
     AItem.LabelRect := R;
     if R.Top > nabItemsRect^.Bottom then
       Exit;
 
+    // Measure size of display string
     R := AItem.LabelRect;
     s := GetDisplayString(Canvas, AText, 1, WidthOf(R));
     AItem.DisplayName := s;
-    DrawText(Canvas.Handle, PChar(s), Length(s), R, DT_LEFT or DT_VCENTER or DT_CALCRECT);
+    DrawText(Canvas.Handle, PChar(s), Length(s), R, DT_LEFT or DT_CALCRECT);
     txtWidth := WidthOf(R);
+    AHeight := HeightOf(R);
     R.Right := R.Left + txtWidth + 1;
+    {$IFDEF MSWINDOWS}
+    OffsetRect(R, 0, -1);   // Better centering of text
+    {$ENDIF}
     AItem.LabelRect := R;
 
     bkMode := SetBkMode(Canvas.Handle, TRANSPARENT);
-    AWidth := DrawText(Canvas.Handle, PChar(s), Length(s), R, DT_LEFT or DT_VCENTER);
+    Canvas.TextOut(R.Left, (R.Top + R.Bottom - AHeight) div 2, s);
+//    AHeight := DrawText(Canvas.Handle, PChar(s), Length(s), R, DT_LEFT or DT_VCENTER);
     SetBkMode(Canvas.Handle, bkMode);
 
-    if AWidth < 16 then AWidth := 16;  // This it the width of the small icons
+    if AHeight < FSmallImagesSize then
+      AHeight := FSmallImagesSize;
   end;
   Result := true;
 end;
@@ -599,19 +620,27 @@ var
   W, H: Integer;
   R: TRect;
   dist: Integer;
+ {$IFDEF LCL}{$IF LCL_FullVersion >= 1090000}
+  imgres: TScaledImageListResolution;
+  f: Double;
+  ppi: Integer;
+ {$ENDIF}{$ENDIF}
 begin
   Result := false;
 
   { If an image list is assigned then use the image size.
     If no image list is assinged then assume a 32 x 32 image size. }
   dist := ScaleX(MARGIN, DesignTimeDPI);
+  W := FLargeImagesSize + 2*dist;
+  H := FLargeImagesSize + 2*dist;
+  {
   if Assigned(FImages) then begin
     W := FImages.Width + 2*dist;
     H := FImages.Height + 2*dist;
   end else begin
     W := ScaleX(32, DesignTimeDPI);
     H := ScaleY(32, DesignTimeDPI);
-  end;
+  end;}
 
   R.Top := CurPos;
   R.Bottom := CurPos + H;
@@ -625,7 +654,18 @@ begin
   if FShowButtons then begin
     DrawItemHighlight(Canvas, R, FActiveItem = AItem.Index);
     if Assigned(FImages) and (AItem.IconIndex >= 0) and (AItem.IconIndex < FImages.Count) then
+    begin
+     {$IFDEF LCL}{$IF LCL_FullVersion >= 1090000}
+      with TVpNavBarOpener(FNavBar) do begin
+        f := FCanvasScalefactor;
+        ppi := Font.PixelsPerInch;
+      end;
+      imgRes := FImages.ResolutionForPPI[FImages.Width, ppi, f];
+      imgRes.Draw(Canvas, R.Left + dist, R.Top + dist, AItem.IconIndex);
+     {$ELSE}
       FImages.Draw(Canvas, R.Left + dist, R.Top + dist, AItem.IconIndex);
+     {$ENDIF}{$ENDIF}
+    end;
   end;
 
   Result := true;
@@ -636,17 +676,26 @@ function TVpNavBarPainter.DrawSmallIcon(Canvas: TCanvas; AItem: TVpNavBtnItem;
   CurPos: Integer): Boolean;
 const
   DELTA = 8;
+  MARGIN = 2;
 var
   lOffset: Integer;
-  bmp: TBitmap;
   R: TRect;
   del: Integer;
+  m: Integer;
+ {$IFDEF LCL}{$IF LCL_FullVersion >= 1090000}
+  imgres: TScaledImageListResolution;
+  f: Double;
+  ppi: Integer;
+ {$ELSE}
+  bmp: TBitmap;
+ {$ENDIF}{$ENDIF}
 begin
   Result := false;
 
   {glyph is at the left}
   R.Top := CurPos;
   del := ScaleY(DELTA, DesignTimeDPI);
+  m := ScaleX(MARGIN, DesignTimeDPI);
   lOffset := abs(Canvas.Font.Height) div 2;
   if lOffset > del then
     R.Top := R.Top + lOffset - del;
@@ -660,6 +709,14 @@ begin
   if FShowButtons then begin
     DrawItemHighlight(Canvas, R, FActiveItem = AItem.Index);
     if Assigned(FImages) then begin
+     {$IFDEF LCL}{$IF LCL_FullVersion >= 1090000}
+      with TVpNavBarOpener(FNavBar) do begin
+        f := FCanvasScalefactor;
+        ppi := Font.PixelsPerInch;
+      end;
+      imgRes := FImages.ResolutionForPPI[FImages.Width div 2, ppi, f];
+      imgRes.Draw(Canvas, R.Left, R.Top, AItem.IconIndex);
+     {$ELSE}
       bmp := TBitmap.Create;
       try
         FImages.GetBitmap(AItem.IconIndex, bmp);
@@ -668,6 +725,7 @@ begin
       finally
         bmp.Free;
       end;
+      {$ENDIF}{$ENDIF}
     end;
   end;