pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7290 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-01-17 15:27:02 +00:00
parent 2bc0d54d4c
commit 265696cb97
8 changed files with 60 additions and 77 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/jvcllaz/examples/JvItemViewer/JvItemViewerDemo.lpi
View File

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

2
components/jvcllaz/examples/JvItemViewer/JvItemViewerDemo.lpr
View File

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

9
components/jvcllaz/examples/JvItemViewer/MainFrm.lfm
View File

@ -13,8 +13,7 @@ object frmMain: TfrmMain
Font.Color = clWindowText
OnCreate = FormCreate
Position = poScreenCenter
LCLVersion = '1.9.0.0'
Scaled = False
LCLVersion = '2.1.0.0'
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
Top = 361
Height = 15
Top = 357
Width = 690
Align = alBottom
BorderSpacing.Around = 4

3
components/jvcllaz/examples/JvItemViewer/MainFrm.pas
View File

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

3
components/jvcllaz/examples/JvItemViewer/ViewerFrm.lfm
View File

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

68
components/jvcllaz/run/JvCustomControls/jvcustomitemviewer.pas
View File

@ -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 Height: Integer read FHeight write SetHeight stored IsHeightStored;
property VertSpacing: Integer read FVertSpacing write SetVertSpacing stored IsVertSpacingStored;
property HorzSpacing: Integer read FHorzSpacing write SetHorzSpacing stored IsHorzSpacingStored;
property Width: Integer read FWidth write SetWidth default DEFAULT_ITEMVIEWEROPTIONS_WIDTH;
property Height: Integer read FHeight write SetHeight default DEFAULT_ITEMVIEWEROPTIONS_HEIGHT;
property VertSpacing: Integer read FVertSpacing write SetVertSpacing default DEFAULT_ITEMVIEWEROPTIONS_VERTSPACING;
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 MultiSelect: Boolean read FMultiSelect write SetMultiSelect;
property HotTrack: Boolean read FHotTrack write SetHotTrack default False;
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);
FHeight := FOwner.Scale96ToFont(DEFAULT_ITEMVIEWEROPTIONS_HEIGHT);
FVertSpacing := FOwner.Scale96ToFont(DEFAULT_ITEMVIEWEROPTIONS_VERTSPACING);
FHorzSpacing := FOwner.Scale96ToFont(DEFAULT_ITEMVIEWEROPTIONS_HORZSPACING);
FWidth := DEFAULT_ITEMVIEWEROPTIONS_WIDTH;
FHeight := DEFAULT_ITEMVIEWEROPTIONS_HEIGHT;
FVertSpacing := DEFAULT_ITEMVIEWEROPTIONS_VERTSPACING;
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);
if IsHeightStored then
FHeight := Round(FHeight * AYProportion);
if IsHorzSpacingStored then
FHorzSpacing := Round(FHorzSpacing * AXProportion);
if IsVertSpacingStored then
FVertSpacing := Round(FVertSpacing * AYProportion);
FWidth := Round(FWidth * AXProportion);
FHeight := Round(FHeight * AYProportion);
FHorzSpacing := Round(FHorzSpacing * AXProportion);
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);

33
components/jvcllaz/run/JvCustomControls/jvimagelistviewer.pas
View File

@ -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);
Y := AItemRect.Top + (RectHeight(AItemRect) - Images.Height) div 2;
X := Max(AItemRect.Left, AItemRect.Left + (RectWidth(AItemRect) - imgWidth) 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;

17
components/jvcllaz/run/JvCustomControls/jvimagesviewer.pas
View File

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