You've already forked lazarus-ccr
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:
@ -57,6 +57,8 @@ begin
|
||||
RegisterComponentEditor(TJvCustomOutlookBar, TJvOutlookBarEditor);
|
||||
|
||||
// Thumbnails
|
||||
RegisterPropertyEditor(TypeInfo(String), TJvThumbView,
|
||||
'Filter', TFileDlgFilterProperty);
|
||||
RegisterPropertyToSkip(TJvThumbnail, 'ClientWidth', 'Redundant', '');
|
||||
RegisterPropertyToSkip(TJvThumbnail, 'ClientHeight', 'Redundant', '');
|
||||
|
||||
|
@ -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;
|
||||
|
@ -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.
|
||||
|
||||
|
@ -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:
|
||||
|
Reference in New Issue
Block a user