jvcllaz: Make TJvThumbView high-dpi aware. Provide FileDlgFilter property editor for TJvThumbView.Filter.

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

components/jvcllaz/design/JvCustomControls/jvcustomreg.pas

@@ -57,6 +57,8 @@ begin
   RegisterComponentEditor(TJvCustomOutlookBar, TJvOutlookBarEditor);
 
   // Thumbnails
+  RegisterPropertyEditor(TypeInfo(String), TJvThumbView,
+    'Filter', TFileDlgFilterProperty);
   RegisterPropertyToSkip(TJvThumbnail, 'ClientWidth', 'Redundant', '');
   RegisterPropertyToSkip(TJvThumbnail, 'ClientHeight', 'Redundant', '');
 

components/jvcllaz/run/JvCustomControls/jvbasethumbnail.pas

@@ -154,8 +154,7 @@ type
 
   TJvBaseThumbnail = class(TPanel)  //JvExPanel)
   protected
-    { wp removed
+    { function DoEraseBackground(Canvas: TCanvas; Param: LPARAM): Boolean; override; }
-    function DoEraseBackground(Canvas: TCanvas; Param: LPARAM): Boolean; override; }
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
       X, Y: Integer); override;
     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;

components/jvcllaz/run/JvCustomControls/jvthumbnails.pas

@@ -56,7 +56,7 @@ uses
   {$IFDEF UNIX}
   baseunix,
   {$ENDIF}
-  LCLIntf, LCLType, LMessages, Types,
+  LCLIntf, LCLType, LCLVersion, LMessages, Types,
   Classes, Controls, ExtCtrls, SysUtils, Graphics, Forms,
   JvThumbImage, JvBaseThumbnail, Dialogs;
 
@@ -149,6 +149,17 @@ type
     procedure UpdateTitlePanelHeight;
     procedure WMPaint(var Msg: TLMPaint); message LM_PAINT;
 
+  { LCL Scaling }
+  protected
+    procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
+      const AXProportion, AYProportion: Double); override;
+  public
+    procedure ScaleFontsPPI({$IF LCL_FullVersion >= 1080100}const AToPPI: Integer;{$IFEND}
+      const AProportion: Double); override;
+    {$IF LCL_FullVersion >= 2010000}
+    procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
+    {$IFEND}
+
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -746,5 +757,36 @@ begin
   inherited;
 end;
 
+
+{ LCL scaling routines }
+
+procedure TJvThumbnail.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
+  const AXProportion, AYProportion: Double);
+begin
+  inherited;
+  if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
+  begin
+    FMargin := round(FMargin * AXProportion);
+    FHShadowOffset := round(FHShadowOffset * AXProportion);
+    FVShadowOffset := round(FVShadowOffset * AYProportion);
+  end;
+end;
+
+{$IF LCL_FullVersion >= 2010000}
+procedure TJvThumbnail.FixDesignFontsPPI(const ADesignTimePPI: Integer);
+begin
+  inherited;
+  DoFixDesignFontPPI(FTitleFont, ADesignTimePPI);
+end;
+{$IFEND}
+
+procedure TJvThumbnail.ScaleFontsPPI(
+  {$IF LCL_FullVersion >= 1080100}const AToPPI: Integer;{$IFEND}
+  const AProportion: Double);
+begin
+  inherited;
+  DoScaleFontPPI(FTitleFont, AToPPI, AProportion);
+end;
+
 end.
 

components/jvcllaz/run/JvCustomControls/jvthumbviews.pas

@@ -82,7 +82,7 @@ type
     FThumbBevelOuter: TPanelBevel;
     FThumbBorderStyle: TBorderStyle;
     FThumbColor: TColor;
-    FThumbGap: Byte;
+    FThumbGap: Integer;
     FThumbList: TJvThumbList;
     FThumbSize: TPoint;
     FThumbTitleBevelInner: TPanelBevel;
@@ -130,7 +130,7 @@ type
     procedure SetThumbBevelOuter(const AValue: TPanelBevel);
     procedure SetThumbBorderStyle(const AValue: TBorderStyle);
     procedure SetThumbColor(const AValue: TColor);
-    procedure SetThumbGap(Sp: Byte);
+    procedure SetThumbGap(Sp: Integer);
     procedure SetThumbTitleColor(const AValue: TColor);
     procedure SetThumbTitleBevelInner(const AValue: TPanelBevel);
     procedure SetThumbTitleBevelOuter(const AValue: TPanelBevel);
@@ -142,6 +142,8 @@ type
 
   protected
     procedure CreateHandle; override;
+    procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
+      const AXProportion, AYProportion: Double); override;
     (*********** NOT CONVERTED **
     procedure GetDlgCode(var Code: TDlgCodes); override;
     *****)
@@ -182,8 +184,8 @@ type
     property Count: Word read GetCount default 0;
     property Directory: string read FDirectory write SetDirectory;
     property Filter: string read FFilter write FFilter;
-    property MaxHeight: Longint read GetMaxHeight write SetMaxHeight;
+    property MaxHeight: Longint read GetMaxHeight write SetMaxHeight default 200;
-    property MaxWidth: Longint read GetMaxWidth write SetMaxWidth;
+    property MaxWidth: Longint read GetMaxWidth write SetMaxWidth default 200;
     property MinMemory: Boolean read FMinMemory write FMinMemory default true;
     property ScrollMode: TScrollMode read FScrollMode write SetScrollMode default smHorizontal;
     property Selected: Longint read FSelected write SetSelected default -1;
@@ -200,7 +202,7 @@ type
       read FThumbBorderStyle write SetThumbBorderStyle default bsNone;
     property ThumbColor: TColor
       read FThumbColor write SetThumbColor default clDefault;
-    property ThumbGap: Byte
+    property ThumbGap: Integer
       read FThumbGap write SetThumbGap default 4;
     property ThumbTitleBevelInner: TPanelBevel
       read FThumbTitleBevelInner write SetThumbTitleBevelInner default bvNone;
@@ -308,6 +310,7 @@ var
   Thb: TJvThumbnail;
 begin
   Thb := TJvThumbnail.Create(Self);
+  Thb.AutoAdjustlayout(lapAutoAdjustForDPI, 96, Font.PixelsPerInch, 0, 0);
   if Assigned(FOnGetTitle) then
   begin
     ThumbnailTitle := ExtractFilename(AFile);
@@ -446,9 +449,6 @@ procedure TJvThumbView.CalculateMaxX;
 var
   A: Longint;
 begin
-  if not HandleAllocated then
-    exit;
-
   case FScrollMode of
     smVertical:
       A := (Width - 20) div (FThumbSize.X + FThumbGap);
@@ -456,8 +456,8 @@ begin
       A := (Height - 20) div (FThumbSize.Y + FThumbGap);
     smBoth:
       A := JkCeil(Sqrt(FThumbList.Count));
-  else
+    else
-    A := 1;
+      A := 1;
   end;
   if A < 1 then
     A := 1;
@@ -590,6 +590,19 @@ begin
   end
 end;
 
+procedure TJvThumbView.DoAutoAdjustLayout(
+  const AMode: TLayoutAdjustmentPolicy;
+  const AXProportion, AYProportion: Double);
+begin
+  inherited;
+  if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
+  begin
+    FMaxSize.X := round(FMaxSize.X * AXProportion);
+    FMaxSize.Y := round(FMaxSize.Y * AYProportion);
+    FThumbGap := round(FThumbGap * AXProportion);
+  end;
+end;
+
 procedure TJvThumbView.DoInvalidImage(Sender: TObject; const FileName: string);
 begin
   if Assigned(FOnInvalidImage) then
@@ -925,8 +938,11 @@ end;
 
 procedure TJvThumbView.Resize;
 begin
-  CalculateMaxX;
+  if HandleAllocated then
-  Reposition(0);
+  begin
+    CalculateMaxX;
+    Reposition(0);
+  end;
   inherited Resize;
 end;
 
@@ -1266,7 +1282,7 @@ begin
     FThumbList.Thumbnail[i].Color := FThumbColor;
 end;
 
-procedure TJvThumbView.SetThumbGap(Sp: Byte);
+procedure TJvThumbView.SetThumbGap(Sp: Integer);
 begin
   case FAlignView of
     vtNormal, vtCenter: