jvcllaz: Make JvTabBar support the high-res imagelist. Add AutoSize.

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

components/jvcllaz/examples/JvTabBar/main.lfm

@@ -67,6 +67,7 @@ object Form1: TForm1
     Top = 65
     Width = 614
     Align = alClient
+    BorderStyle = bsNone
     Font.CharSet = ANSI_CHARSET
     Font.Color = clBlack
     Font.Height = -11

components/jvcllaz/run/JvCustomControls/JvTabBar.pas

@@ -61,7 +61,6 @@ type
   TJvTabBarItem = class(TCollectionItem)
   private
     FLeft: Integer; // used for calculating DisplayRect
-
     FImageIndex: TImageIndex;
     FEnabled: Boolean;
     FVisible: Boolean;
@@ -151,16 +150,20 @@ type
   protected
     procedure Changed; virtual;
     procedure DrawBackground(Canvas: TCanvas; TabBar: TJvCustomTabBar; R: TRect); virtual; abstract;
-    procedure DrawTab(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect); virtual; abstract;
     procedure DrawDivider(Canvas: TCanvas; LeftTab: TJvTabBarItem; R: TRect); virtual; abstract;
     procedure DrawMoveDivider(Canvas: TCanvas; Tab: TJvTabBarItem; MoveLeft: Boolean); virtual; abstract;
-    function GetDividerWidth(Canvas: TCanvas; LeftTab: TJvTabBarItem): Integer; virtual; abstract;
-    function GetTabSize(Canvas: TCanvas; Tab: TJvTabBarItem): TSize; virtual; abstract;
-    function GetCloseRect(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect): TRect; virtual; abstract;
-    function Options: TJvTabBarPainterOptions; virtual; abstract;
     procedure DrawScrollButton(Canvas: TCanvas; TabBar: TJvCustomTabBar; Button: TJvTabBarScrollButtonKind;
       State: TJvTabBarScrollButtonState; R: TRect); virtual;
+    procedure DrawTab(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect); virtual; abstract;
+    function GetCloseRect(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect): TRect; virtual; abstract;
+    function GetDividerWidth(Canvas: TCanvas; LeftTab: TJvTabBarItem): Integer; virtual; abstract;
+    function GetPixelsPerInch: Integer; virtual; abstract;
+    function GetRealImageSize(ATab: TJvTabBarItem): TSize;
     procedure GetScrollButtons(TabBar: TJvCustomTabBar; var LeftButton, RightButton: TRect); {virtual; reserved for future use }
+    function GetTabBar(ATab: TJvTabBarItem): TJvCustomTabBar;
+    function GetTabSize(Canvas: TCanvas; Tab: TJvTabBarItem): TSize; virtual; abstract;
+    function Options: TJvTabBarPainterOptions; virtual; abstract;
+    function Scale96(AValue: Integer): Integer;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -211,9 +214,9 @@ type
     procedure DrawTab(Canvas: TCanvas; Tab: TJvTabBarItem; ATabRect: TRect); override;
     function GetCloseRect(Canvas: TCanvas; Tab: TJvTabBarItem; ATabRect: TRect): TRect; override;
     function GetDividerWidth(Canvas: TCanvas; LeftTab: TJvTabBarItem): Integer; override;
+    function GetPixelsPerInch: Integer; override;
     function GetTabSize(Canvas: TCanvas; Tab: TJvTabBarItem): TSize; override;
     function Options: TJvTabBarPainterOptions; override;
-    function Scale96(AValue: Integer): Integer;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -233,7 +236,6 @@ type
     property DividerColor: TColor read FDividerColor write SetDividerColor default $99A8AC;
     property MoveDividerColor: TColor read FMoveDividerColor write FMoveDividerColor default clBlack;
     property TabWidth: Integer read FTabWidth write SetTabWidth default 0;
-
     property Font: TFont read FFont write SetFont;
     property DisabledFont: TFont read FDisabledFont write SetDisabledFont;
     property SelectedFont: TFont read FSelectedFont write SetSelectedFont;
@@ -261,6 +263,7 @@ type
     FCloseButton: Boolean;
     FRightClickSelect: Boolean;
     FImages: TCustomImageList;
+    FImagesWidth: Integer;
     FHotTracking: Boolean;
     FHotTab: TJvTabBarItem;
     FSelectedTab: TJvTabBarItem;
@@ -300,6 +303,7 @@ type
     FScrollRepeatedClicked: Boolean;
     FOnLeftTabChange: TNotifyEvent;
 
+    function GetHeight: Integer;
     function GetLeftTab: TJvTabBarItem;
     procedure SetLeftTab(Value: TJvTabBarItem);
     procedure SetSelectedTab(Value: TJvTabBarItem);
@@ -308,7 +312,6 @@ type
     procedure SetImages(Value: TCustomImageList);
     procedure SetCloseButton(Value: Boolean);
     procedure SetMargin(Value: Integer);
-
     procedure SetHotTab(Tab: TJvTabBarItem);
     procedure SetClosingTab(Tab: TJvTabBarItem);
     procedure UpdateScrollButtons;
@@ -318,16 +321,26 @@ type
     procedure SetPageList(const Value: TCustomControl);
     procedure SetOrientation(const Value: TJvTabBarOrientation);
     procedure TimerExpired(Sender: TObject);
+    procedure SetHeight(AValue: Integer);
+ {$IF LCL_FullVersion >= 1090000}
+  private
+    procedure SetImagesWidth(const AValue: Integer);
+  protected
+    property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0;
+{$ENDIF}
   protected
-    procedure DrawScrollBarGlyph(ACanvas: TCanvas; X, Y: Integer; ALeft, Disabled: Boolean);
-    procedure Resize; override;
     procedure CalcTabsRects;
+    procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
+      WithThemeSpace: Boolean); override;
+    procedure DrawScrollBarGlyph(ACanvas: TCanvas; X, Y: Integer; ALeft, Disabled: Boolean);
     procedure Paint; override;
-    procedure PaintTab(ACanvas: TCanvas; Tab: TJvTabBarItem); virtual;
     procedure PaintScrollButtons;
+    procedure PaintTab(ACanvas: TCanvas; Tab: TJvTabBarItem); virtual;
+    procedure Resize; override;
 
-    function GetTabWidth(Tab: TJvTabBarItem): Integer;
+    class function GetControlClassDefaultSize: TSize;
     function GetTabHeight(Tab: TJvTabBarItem): Integer;
+    function GetTabWidth(Tab: TJvTabBarItem): Integer;
 
     function CurrentPainter: TJvTabBarPainter;
     procedure Notification(Component: TComponent; Operation: TOperation); override;
@@ -358,6 +371,7 @@ type
     procedure CMMouseLeave(var Msg: TLMessage); message CM_MOUSELEAVE;
     procedure WMEraseBkgnd(var Msg: TLMEraseBkgnd); message LM_ERASEBKGND;
     procedure Loaded; override;
+
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -393,6 +407,7 @@ type
     property SelectBeforeClose: Boolean read FSelectBeforeClose write FSelectBeforeClose default False;
     property Margin: Integer read FMargin write SetMargin default 6;
     property FlatScrollButtons: Boolean read FFlatScrollButtons write SetFlatScrollButtons default True;
+    property Height read GetHeight write SetHeight;
     property Hint: TCaption read FHint write SetHint;
     property AllowTabMoving: Boolean read FAllowTabMoving write FAllowTabMoving default False;
 
@@ -414,10 +429,13 @@ type
   TJvTabBar = class(TJvCustomTabBar)
   published
     property Align default alTop;
+    property AutoSize default true;
+    property BorderSpacing;
+    property Constraints;
     property Cursor;
     property PopupMenu;
     property ShowHint default False;
-    property Height default 23;
+    property Height;
     property Hint;
     property Visible;
     property Enabled;
@@ -437,6 +455,9 @@ type
     property PageList;
     property Painter;
     property Images;
+   {$IF LCL_FullVersion >= 1090000}
+    property ImagesWidth;
+   {$ENDIF}
     property Tabs;
 
     property OnTabClosing;
@@ -479,8 +500,8 @@ const
   RIGHT_MARGIN = 6;
   TEXT_MARGIN_LEft = 2;
   TEXT_MARGIN_RIGHT = 4;
-  TOP_MARGIN = 2;
+  TOP_MARGIN = 4;
-  BOTTOM_MARGIN = 2;
+  BOTTOM_MARGIN = 4;
   CLOSE_BUTTON_SIZE = 12;
   CROSS_MARGIN = 3;
 
@@ -572,11 +593,13 @@ begin
   FCloseButton := True;
   FAutoFreeClosed := True;
   FFlatScrollButtons := True;
-
   FMargin := 6;
-
   Align := alTop;
-  Height := 23;
+
+  with GetControlClassDefaultSize do
+    SetInitialBounds(0, 0, CX, CY);
+
+  AutoSize := true;
 end;
 
 destructor TJvCustomTabBar.Destroy;
@@ -727,6 +750,13 @@ begin
       Invalidate;
 end;
 
+procedure TJvCustomTabBar.SetImagesWidth(const AValue: Integer);
+begin
+  if AValue = FImagesWidth then exit;
+  FImagesWidth := AValue;
+  Invalidate;
+end;
+
 procedure TJvCustomTabBar.SetCloseButton(Value: Boolean);
 begin
   if Value <> FCloseButton then
@@ -1384,6 +1414,45 @@ begin
   FLastTabRight := X;
 end;
 
+procedure TJvCustomTabBar.CalculatePreferredSize(
+  var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean);
+var
+  tabSize: TSize;
+  imgSize: TSize;
+  h: Integer;
+ {$IF LCL_FullVersion >= 1090000}
+  imgRes: TScaledImageListResolution;
+ {$ENDIF}
+begin
+  // Text height
+  Canvas.Font.Assign(Font);
+  PreferredHeight := Canvas.TextHeight('Tg');
+
+  // Icon height
+  if FImages <> nil then begin
+   {$IF LCL_FullVersion >= 1090000}
+    imgRes := FImages.ResolutionForPPI[FImagesWidth, Font.PixelsPerInch, GetCanvasScaleFactor];
+    h := imgRes.Height;
+    if imgRes.Height > PreferredHeight then
+      PreferredHeight := imgRes.Height;
+   {$ELSE}
+    h := Images.Height;
+   {$ENDIF}
+    if h > PReferredHeight then
+      PreferredHeight := h;
+  end;
+
+  // Close button height
+  if FCloseButton then begin
+    h := Scale96ToForm(CLOSE_BUTTON_SIZE);
+    if h > PreferredHeight then
+      PreferredHeight := h;
+  end;
+
+  // Margins
+  inc(PreferredHeight, Scale96ToForm(TOP_MARGIN) + Scale96ToForm(BOTTOM_MARGIN));
+end;
+
 procedure TJvCustomTabBar.Paint;
 var
   I: Integer;
@@ -1453,6 +1522,12 @@ begin
   CurrentPainter.DrawScrollButton(Canvas, Self, sbScrollRight, FBtnRightScroll.State, FBtnRightScroll.Rect);
 end;
 
+class function TJvCustomTabBar.GetControlClassDefaultSize: TSize;
+begin
+  Result.CX := 100;
+  Result.CY := 24;
+end;
+
 function TJvCustomTabBar.GetTabHeight(Tab: TJvTabBarItem): Integer;
 begin
   Result := CurrentPainter.GetTabSize(Canvas, Tab).cy;
@@ -1687,6 +1762,18 @@ begin
   end;
 end;
 
+function TJvCustomTabBar.GetHeight: Integer;
+begin
+  Result := inherited Height;
+end;
+
+procedure TJvCustomTabBar.SetHeight(AValue: Integer);
+begin
+  if AValue = GetHeight then exit;
+  AutoSize := false;
+  inherited Height := AValue;
+end;
+
 procedure TJvCustomTabBar.SetPageList(const Value: TCustomControl);
 var
   PageListIntf: IPageList;
@@ -2082,12 +2169,40 @@ begin
     TJvCustomTabBar(FOnChangeList[i]).ImagesChanged(Self);
 end;
 
+function TJvTabBarPainter.GetRealImageSize(ATab: TJvTabBarItem): TSize;
+{$IF LCL_FullVersion >= 1090000}
+var
+  imgRes: TScaledImageListResolution;
+  tabBar: TJvCustomTabBar;
+  f: Double;
+  ppi: Integer;
+begin
+  tabBar := GetTabBar(ATab);
+  f := tabBar.GetCanvasScaleFactor;
+  ppi := GetPixelsPerInch;
+  imgRes := ATab.GetImages.ResolutionForPPI[tabBar.ImagesWidth, ppi, f];
+  Result.CX := imgRes.Width;
+  Result.CY := imgRes.Height;
+end;
+{$ELSE}
+begin
+  Result.CX := ATab.GetImages.Width;
+  Result.CY := ATab.GetImages.Height;
+end;
+{$ENDIF}
+
 procedure TJvTabBarPainter.GetScrollButtons(TabBar: TJvCustomTabBar; var LeftButton, RightButton: TRect);
 begin
   { reserved for future use }
 end;
 
-procedure TJvTabBarPainter.DrawScrollButton(Canvas: TCanvas; TabBar: TJvCustomTabBar; Button: TJvTabBarScrollButtonKind;
+function TJvTabBarPainter.GetTabBar(ATab: TJvTabBarItem): TJvCustomTabBar;
+begin
+  Result := TJvTabBarItems(ATab.Collection).TabBar;
+end;
+
+procedure TJvTabBarPainter.DrawScrollButton(Canvas: TCanvas;
+  TabBar: TJvCustomTabBar; Button: TJvTabBarScrollButtonKind;
   State: TJvTabBarScrollButtonState; R: TRect);
 {$IFDEF JVCLThemesEnabled}
 const
@@ -2117,6 +2232,12 @@ begin
   end;
 end;
 
+function TJvTabBarPainter.Scale96(AValue: Integer): Integer;
+begin
+  Result := MulDiv(AValue, GetPixelsPerInch, 96);
+end;
+
+
 //=== { TJvModernTabBarPainter } =============================================
 
 constructor TJvModernTabBarPainter.Create(AOwner: TComponent);
@@ -2240,6 +2361,14 @@ var
   R, CloseR: TRect;
   ts: TTextStyle;
   margin: Integer;
+  x, y: Integer;
+  imgsize: TSize;
+ {$IF LCL_FullVersion >= 1090000}
+  imageRes: TScaledImageListResolution;
+  f: Double;
+  ppi: Integer;
+  tabBar: TJvCustomTabBar;
+ {$ENDIF}
 begin
   R := ATabRect;
 
@@ -2316,7 +2445,7 @@ begin
         Pen.Color := CloseCrossColorDisabled;
       Pen.Width := 2;
 
-      // Draw close cross
+      { Draw close cross }
       margin := Scale96(CROSS_MARGIN);
       Line(CloseR.Left + margin, CloseR.Top + margin, CloseR.Right - margin - 1, CloseR.Bottom - margin - 1);
       Line(CloseR.Left + margin, CloseR.Bottom - margin - 1, CloseR.Right - margin - 1, CloseR.Top + margin);
@@ -2329,12 +2458,22 @@ begin
     end;
 
     { Draw image from image list }
-
     if (Tab.ImageIndex <> -1) and (Tab.GetImages <> nil) then
     begin
-      Tab.GetImages.Draw(Canvas, R.Left, (R.Top + R.Bottom - Tab.GetImages.Height) div 2,
+      imgsize := GetRealImageSize(Tab);
-        Tab.ImageIndex, Tab.Enabled);
+      x := R.Left;
-      Inc(R.Left, Tab.GetImages.Width + Scale96(TEXT_MARGIN_LEFT));
+      y := (R.Top + R.Bottom - imgSize.CY) div 2;
+     {$IF LCL_FullVersion >= 1090000}
+      tabBar := GetTabBar(Tab);
+      f := tabBar.GetCanvasScalefactor;
+      ppi := GetPixelsPerInch;
+      if Tab.GetImages <> nil then
+        imageRes := Tab.GetImages.ResolutionForPPI[tabBar.ImagesWidth, ppi, f];
+      imageRes.Draw(Canvas, x, y, Tab.ImageIndex, tab.Enabled);
+     {$ELSE}
+       Tab.GetImages.Draw(Canvas, x, y, Tab.ImageIndex, Tab.Enabled);
+      {$ENDIF}
+      Inc(R.Left, imgSize.CX + Scale96(TEXT_MARGIN_LEFT));
     end;
 
     if Tab.Enabled then
@@ -2373,10 +2512,15 @@ begin
   Result := 1;
 end;
 
+function TJvModernTabBarPainter.GetPixelsPerInch: Integer;
+begin
+  Result := Font.PixelsPerInch;
+end;
+
 function TJvModernTabBarPainter.GetTabSize(Canvas: TCanvas; Tab: TJvTabBarItem): TSize;
 var
-  w: Integer;
+  w, h: Integer;
-  h: Integer;
+  imgSize: TSize;
 begin
   if Tab.Enabled then
   begin
@@ -2406,24 +2550,13 @@ begin
 
   // Extend width and height by image
   if (Tab.ImageIndex <> -1) and (Tab.GetImages <> nil) then begin
-    w := Tab.GetImages.Width;
+    imgSize := GetRealImageSize(Tab);
-    h := Tab.GetImages.Height;
+    inc(Result.CX, imgSize.CX + Scale96(TEXT_MARGIN_LEFT));
-    inc(Result.CX, w + Scale96(TEXT_MARGIN_LEFT));
+    if Result.CY < imgSize.CY then
-    if Result.CY < h then
+      Result.CY := imgSize.CY;
-      Result.CY := h;
   end;
   inc(Result.CY, Scale96(TOP_MARGIN) + Scale96(BOTTOM_MARGIN));
 
-    (*
-
-  Result.cx := Canvas.TextWidth(Tab.Caption) + 11;
-  Result.cy := Canvas.TextHeight(Tab.Caption + 'Ag') + 7;
-  if Tab.TabBar.CloseButton then
-    Result.cx := Result.cx + 15;
-  if (Tab.ImageIndex <> -1) and (Tab.GetImages <> nil) then
-    Result.cx := Result.cx + Tab.GetImages.Width + 2;
-      *)
-
   // Override width if TabWidth is fixed.
   if TabWidth > 0 then
     Result.cx := TabWidth;
@@ -2439,11 +2572,6 @@ begin
   Changed;
 end;
 
-function TJvModernTabBarPainter.Scale96(AValue: Integer): Integer;
-begin
-  Result := MulDiv(AValue, Font.PixelsPerInch, 96);
-end;
-
 procedure TJvModernTabBarPainter.SetBorderColor(const Value: TColor);
 begin
   if Value <> FBorderColor then