jvcllaz: Fix LCL scaling for JvItemViewer components. Adapt demo.

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

components/jvcllaz/examples/JvItemViewer/JvItemViewerDemo.lpi

@@ -13,6 +13,7 @@
       </Flags>
       <SessionStorage Value="InProjectDir"/>
       <Title Value="JvItemViewerDemo"/>
+      <Scaled Value="True"/>
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
@@ -25,7 +26,6 @@
     </PublishOptions>
     <RunParams>
       <FormatVersion Value="2"/>
-      <Modes Count="0"/>
     </RunParams>
     <RequiredPackages Count="4">
       <Item1>

components/jvcllaz/examples/JvItemViewer/JvItemViewerDemo.lpr

@@ -10,7 +10,7 @@ uses
 {$R *.res}
 
 begin
-//  MemChk;
+  Application.Scaled := true;
   Application.Initialize;
   Application.CreateForm(TfrmMain, frmMain);
   Application.Run;

components/jvcllaz/examples/JvItemViewer/MainFrm.lfm

@@ -13,8 +13,7 @@ object frmMain: TfrmMain
   Font.Color = clWindowText
   OnCreate = FormCreate
   Position = poScreenCenter
-  LCLVersion = '1.9.0.0'
+  LCLVersion = '2.1.0.0'
-  Scaled = False
   object Splitter1: TSplitter
     Cursor = crSizeWE
     Left = 0
@@ -155,13 +154,13 @@ object frmMain: TfrmMain
     end
     object tabILViewer: TTabSheet
       Caption = 'TJvImageListViewer'
-      ClientHeight = 378
+      ClientHeight = 376
       ClientWidth = 698
       ImageIndex = 1
       object Label1: TLabel
         Left = 4
-        Height = 13
+        Height = 15
-        Top = 361
+        Top = 357
         Width = 690
         Align = alBottom
         BorderSpacing.Around = 4

components/jvcllaz/examples/JvItemViewer/MainFrm.pas

@@ -176,6 +176,7 @@ begin
   AInspector.Align := alLeft;
 
   ITV := TJvImagesViewer.Create(Self);
+  ITV.AutoAdjustLayout(lapAutoAdjustForDPI, 96, Font.PixelsPerInch, 0, 0);
   ITV.Align := alClient;
   ITV.PopupMenu := PopupMenu1;
 //  ITV.Cursor := crHandPoint;
@@ -197,6 +198,7 @@ begin
     edFileMask.Text := ITV.Filemask;
 
   ITV2 := TJvImageListViewer.Create(Self);
+  ITV2.AutoAdjustLayout(lapAutoAdjustForDPI, 96, Font.PixelsPerInch, 0, 0);
   ITV2.Align := alClient;
   ITV2.Options.Width := ImageList1.Width * 2;
   ITV2.Options.Height := ImageList1.Height * 2;
@@ -216,6 +218,7 @@ begin
   ITV2.Options.ShowCaptions := True;
 
   ITV3 := TJvOwnerDrawViewer.Create(Self);
+  ITV3.AutoAdjustLayout(lapAutoAdjustForDPI, 96, Font.PixelsPerInch, 0, 0);
   ITV3.Options.Smooth := True; // Smooth looks OK here, because these items renders faster
   ITV3.Options.HotTrack := False;
   ITV3.Options.Width := 18;

components/jvcllaz/examples/JvItemViewer/ViewerFrm.lfm

@@ -17,8 +17,7 @@ object frmImageViewer: TfrmImageViewer
   OnMouseWheel = FormMouseWheel
   OnResize = FormResize
   OnShow = FormShow
-  LCLVersion = '1.9.0.0'
+  LCLVersion = '2.1.0.0'
-  Scaled = False
   object StatusBar1: TStatusBar
     Left = 0
     Height = 23

components/jvcllaz/run/JvCustomControls/jvcustomitemviewer.pas

@@ -100,10 +100,6 @@ type
     FRightClickSelect: Boolean;
     FReduceMemoryUsage: Boolean;
     FDragAutoScroll: Boolean;
-    function IsHeightStored: Boolean;
-    function IsHorzSpacingStored: Boolean;
-    function IsVertSpacingStored: Boolean;
-    function IsWidthStored: Boolean;
     procedure SetRightClickSelect(const Value: Boolean);
     procedure SetShowCaptions(const Value: Boolean);
     procedure SetAlignment(const Value: TAlignment);
@@ -123,10 +119,8 @@ type
     procedure SetReduceMemoryUsage(const Value: Boolean);
   protected
     procedure Change; virtual;
-    {$IF LCL_FullVersion >= 1080000}
     procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
       const AXProportion, AYProportion: Double); virtual;
-    {$IFEND}
   public
     constructor Create(AOwner: TJvCustomItemViewer); virtual;
     destructor Destroy; override;
@@ -136,19 +130,19 @@ type
     property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
     property DragAutoScroll: Boolean read FDragAutoScroll write FDragAutoScroll default True;
     property Layout: TTextLayout read FLayout write SetLayout default tlBottom;
-    property Width: Integer read FWidth write SetWidth stored IsWidthStored;
+    property Width: Integer read FWidth write SetWidth default DEFAULT_ITEMVIEWEROPTIONS_WIDTH;
-    property Height: Integer read FHeight write SetHeight stored IsHeightStored;
+    property Height: Integer read FHeight write SetHeight default DEFAULT_ITEMVIEWEROPTIONS_HEIGHT;
-    property VertSpacing: Integer read FVertSpacing write SetVertSpacing stored IsVertSpacingStored;
+    property VertSpacing: Integer read FVertSpacing write SetVertSpacing default DEFAULT_ITEMVIEWEROPTIONS_VERTSPACING;
-    property HorzSpacing: Integer read FHorzSpacing write SetHorzSpacing stored IsHorzSpacingStored;
+    property HorzSpacing: Integer read FHorzSpacing write SetHorzSpacing default DEFAULT_ITEMVIEWEROPTIONS_VERTSPACING;
     property ScrollBar: TJvItemViewerScrollBar read FScrollBar write SetScrollBar default tvVertical;
     property ShowCaptions: Boolean read FShowCaptions write SetShowCaptions default True;
     property LazyRead: Boolean read FLazyRead write SetLazyRead default True;
     property ReduceMemoryUsage: Boolean read FReduceMemoryUsage write SetReduceMemoryUsage default False;
-    property AutoCenter: Boolean read FAutoCenter write SetAutoCenter;
+    property AutoCenter: Boolean read FAutoCenter write SetAutoCenter default False;
     property Smooth: Boolean read FSmooth write SetSmooth default False;
     property Tracking: Boolean read FTracking write SetTracking default True;
-    property HotTrack: Boolean read FHotTrack write SetHotTrack;
+    property HotTrack: Boolean read FHotTrack write SetHotTrack default False;
-    property MultiSelect: Boolean read FMultiSelect write SetMultiSelect;
+    property MultiSelect: Boolean read FMultiSelect write SetMultiSelect default False;
     property BrushPattern: TJvBrushPattern read FBrushPattern write SetBrushPattern;
     property RightClickSelect: Boolean read FRightClickSelect write SetRightClickSelect default False;
   end;
@@ -309,10 +303,8 @@ type
     procedure CustomSort(Compare:TListSortCompare);virtual;
 
     function ClientDisplayRect: TRect;
-    {$IF LCL_FullVersion >= 1080000}
     procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
       const AXProportion, AYProportion: Double); override;
-    {$IFEND}
 
     property TopLeftIndex: Integer read FTopLeftIndex;
     property BottomRightIndex: Integer read FBottomRightIndex;
@@ -570,10 +562,10 @@ constructor TJvCustomItemViewerOptions.Create(AOwner: TJvCustomItemViewer);
 begin
   inherited Create;
   FOwner := AOwner;
-  FWidth := FOwner.Scale96ToFont(DEFAULT_ITEMVIEWEROPTIONS_WIDTH);
+  FWidth := DEFAULT_ITEMVIEWEROPTIONS_WIDTH;
-  FHeight := FOwner.Scale96ToFont(DEFAULT_ITEMVIEWEROPTIONS_HEIGHT);
+  FHeight := DEFAULT_ITEMVIEWEROPTIONS_HEIGHT;
-  FVertSpacing := FOwner.Scale96ToFont(DEFAULT_ITEMVIEWEROPTIONS_VERTSPACING);
+  FVertSpacing := DEFAULT_ITEMVIEWEROPTIONS_VERTSPACING;
-  FHorzSpacing := FOwner.Scale96ToFont(DEFAULT_ITEMVIEWEROPTIONS_HORZSPACING);
+  FHorzSpacing := DEFAULT_ITEMVIEWEROPTIONS_HORZSPACING;
   FScrollBar := tvVertical;
   FSmooth := False;
   FTracking := True;
@@ -623,45 +615,19 @@ begin
     FOwner.OptionsChanged;
 end;
 
-{$IF LCL_FullVersion >= 1080000}
 procedure TJvCustomItemViewerOptions.DoAutoAdjustLayout(
   const AMode: TLayoutAdjustmentPolicy;
   const AXProportion, AYProportion: Double);
 begin
   if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
   begin
-    if IsWidthStored then
+    FWidth := Round(FWidth * AXProportion);
-      FWidth := Round(FWidth * AXProportion);
+    FHeight := Round(FHeight * AYProportion);
-    if IsHeightStored then
+    FHorzSpacing := Round(FHorzSpacing * AXProportion);
-      FHeight := Round(FHeight * AYProportion);
+    FVertSpacing := Round(FVertSpacing * AYProportion);
-    if IsHorzSpacingStored then
-      FHorzSpacing := Round(FHorzSpacing * AXProportion);
-    if IsVertSpacingStored then
-      FVertSpacing := Round(FVertSpacing * AYProportion);
     Change;
   end;
 end;
-{$IFEND}
-
-function TJvCustomItemViewerOptions.IsHeightStored: Boolean;
-begin
-  Result := FHeight <> FOwner.Scale96ToFont(DEFAULT_ITEMVIEWEROPTIONS_HEIGHT);
-end;
-
-function TJvCustomItemViewerOptions.IsHorzSpacingStored: Boolean;
-begin
-  Result := FHorzSpacing <> FOwner.Scale96ToFont(DEFAULT_ITEMVIEWEROPTIONS_HORZSPACING);
-end;
-
-function TJvCustomItemViewerOptions.IsVertSpacingStored: Boolean;
-begin
-  Result := FVertSpacing <> FOwner.Scale96ToFont(DEFAULT_ITEMVIEWEROPTIONS_VERTSPACING);
-end;
-
-function TJvCustomItemViewerOptions.IsWidthStored: Boolean;
-begin
-  Result := FWidth <> FOwner.Scale96ToFont(DEFAULT_ITEMVIEWEROPTIONS_WIDTH);
-end;
 
 procedure TJvCustomItemViewerOptions.SetAlignment(const Value: TAlignment);
 begin
@@ -932,7 +898,6 @@ begin
   DoReduceMemory;
 end;
 
-{$IF LCL_FullVersion >= 1080000}
 procedure TJvCustomItemViewer.DoAutoAdjustLayout(
   const AMode: TLayoutAdjustmentPolicy;
   const AXProportion, AYProportion: Double);
@@ -943,7 +908,6 @@ begin
     FOptions.DoAutoAdjustLayout(AMode, AXProportion, AYProportion);
   end;
 end;
-{$IFEND}
 
 class function TJvCustomItemViewer.GetControlClassDefaultSize: TSize;
 begin
@@ -1315,6 +1279,8 @@ var
 begin
   if FUpdateCount <> 0 then
     Exit;
+  if not HandleAllocated then
+    Exit;
   if (Item <> nil) then
   begin
     I := FItems.IndexOf(Item);

components/jvcllaz/run/JvCustomControls/jvimagelistviewer.pas

@@ -29,6 +29,7 @@ interface
 {$MODE OBJFPC}{$H+}
 
 uses
+  LCLVersion,
   SysUtils, Classes, Controls, Graphics, StdCtrls, ComCtrls, ImgList,
   JvCustomItemViewer;
 
@@ -73,6 +74,11 @@ type
     procedure SetImages(const Value: TCustomImageList);
     function GetOptions: TJvImageListViewerOptions;
     procedure SetOptions(const Value: TJvImageListViewerOptions);
+  private
+    {$IF LCL_FullVersion >= 2000000}
+    FImagesWidth: Integer;
+    procedure SetImagesWidth(const Value: Integer);
+    {$IFEND}
   protected
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     procedure DoImageChange(Sender: TObject);
@@ -85,6 +91,9 @@ type
     destructor Destroy; override;
   published
     property Images: TCustomImageList read FImages write SetImages;
+    {$IF LCL_FUllVersion >= 2000000}
+    property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0;
+    {$IFEND}
     property Options: TJvImageListViewerOptions read GetOptions write SetOptions;
     property SelectedIndex;
     property Align;
@@ -238,6 +247,8 @@ var
   S: WideString;
   DrawStyle: TDrawingStyle;
   Flags: Cardinal;
+  imgWidth, imgHeight: Integer;
+  imgList: TCustomImageList;
 begin
   ACanvas.Brush.Color := Color;
   ACanvas.Font := Self.Font;
@@ -245,9 +256,17 @@ begin
   begin
     Flags := DT_END_ELLIPSIS or DT_EDITCONTROL;
     S := GetCaption(Index);
+    {$IF LCL_FullVersion >= 2000000}
+    imgList := Images.ResolutionForPPI[FImagesWidth, Font.PixelsPerInch, GetCanvasScaleFactor].Resolution.ImageList;
+    {$ELSE}
+    imgList := Images;
+    {$IFEND}
+    imgWidth := imgList.Width;
+    imgHeight := imgList.Height;
+
     // determine where to draw image
-    X := Max(AItemRect.Left, AItemRect.Left + (RectWidth(AItemRect) - Images.Width) div 2);
+    X := Max(AItemRect.Left, AItemRect.Left + (RectWidth(AItemRect) - imgWidth) div 2);
-    Y := AItemRect.Top + (RectHeight(AItemRect) - Images.Height) div 2;
+    Y := AItemRect.Top + (RectHeight(AItemRect) - imgHeight) div 2;
     if not Options.FillCaption then
       OffsetRect(TextRect,0,2);
     if cdsSelected in State then
@@ -281,7 +300,7 @@ begin
       DrawStyle := {DrawingStyles[}Options.DrawingStyle{]};
     //ImageList_Draw(Images.Handle, Index, ACanvas.Handle, X, Y,
     //  DrawStyle or DrawMask[Images.ImageType = itImage]);
-    Images.Draw(ACanvas, X, Y, Index, DrawStyle, itImage);
+    imgList.Draw(ACanvas, X, Y, Index, DrawStyle, itImage);
     if S <> '' then
     begin
       if cdsSelected in State then
@@ -344,6 +363,14 @@ begin
   end;
 end;
 
+{$IF LCL_FullVersion >= 2000000}
+procedure TJvImageListVIewer.SetImagesWidth(const Value: Integer);
+begin
+  if FImagesWidth = Value then exit;
+  FImagesWidth := Value;
+  Invalidate;
+end;
+{$IFEND}
 procedure TJvImageListViewer.SetOptions(const Value: TJvImageListViewerOptions);
 begin
   inherited Options := Value;

components/jvcllaz/run/JvCustomControls/jvimagesviewer.pas

@@ -72,17 +72,14 @@ type
     FHotFrameSize: Integer;
     FHotColor: TColor;
     FTransparent: Boolean;
-    function IsImagePaddingStored: Boolean;
     procedure SetImagePadding(const Value: Integer);
     procedure SetFrameColor(const Value: TColor);
     procedure SetHotColor(const Value: TColor);
     procedure SetHotFrameSize(const Value: Integer);
     procedure SetTransparent(const Value: Boolean);
   protected
-    {$IF LCL_FullVersion >= 1080000}
     procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
       const AXProportion, AYProportion: Double); override;
-    {$IFEND}
   public
     constructor Create(AOwner: TJvCustomItemViewer); override;
   published
@@ -96,7 +93,7 @@ type
     property HotColor: TColor read FHotColor write SetHotColor default clHighlight;
     property HotFrameSize: Integer read FHotFrameSize write SetHotFrameSize default 2;
     property HotTrack;
-    property ImagePadding: Integer read FImagePadding write SetImagePadding stored IsImagePaddingStored;
+    property ImagePadding: Integer read FImagePadding write SetImagePadding default DEFAULT_IMAGEVIEWEROPTIONS_IMAGEPADDING;
     property Layout;
     property LazyRead;
     property MultiSelect;
@@ -234,14 +231,13 @@ uses
 constructor TJvImageViewerOptions.Create(AOwner: TJvCustomItemViewer);
 begin
   inherited Create(AOwner);
-  FImagePadding := Owner.Scale96ToFont(DEFAULT_IMAGEVIEWEROPTIONS_IMAGEPADDING);
+  FImagePadding := DEFAULT_IMAGEVIEWEROPTIONS_IMAGEPADDING;
   FFrameColor := clGray;
   FHotColor := clHighlight;
   FHotFrameSize := 2;
   ShowCaptions := True;
 end;
 
-{$IF LCL_FullVersion >= 1080000}
 procedure TJvImageViewerOptions.DoAutoAdjustLayout(
   const AMode: TLayoutAdjustmentPolicy;
   const AXProportion, AYProportion: Double);
@@ -249,16 +245,9 @@ begin
   inherited;
   if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
   begin
-    if IsImagePaddingStored then
+    FImagePadding := Round(FImagePadding * AXProportion);
-      FImagePadding := Round(FImagePadding * AXProportion);
   end;
 end;
-{$IFEND}
-
-function TJvImageViewerOptions.IsImagePaddingStored: Boolean;
-begin
-  Result := FImagePadding <> Owner.Scale96ToFont(DEFAULT_IMAGEVIEWEROPTIONS_IMAGEPADDING);
-end;
 
 procedure TJvImageViewerOptions.SetFrameColor(const Value: TColor);
 begin