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
This commit is contained in:
wp_xxyyzz
2020-01-17 23:29:41 +00:00
parent a4945a3a0a
commit fb0f6f8032
4 changed files with 75 additions and 16 deletions

View File

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

View File

@ -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;

View File

@ -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.

View File

@ -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 MaxWidth: Longint read GetMaxWidth write SetMaxWidth;
property MaxHeight: Longint read GetMaxHeight write SetMaxHeight default 200;
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
A := 1;
else
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;
Reposition(0);
if HandleAllocated then
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: