lazarus-ccr/components/jvcllaz/run/JvCustomControls/jvthumbnails.pas

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvThumbNail.PAS, released on 2002-07-03.

The Initial Developer of the Original Code is John Kozikopulos [Stdreamer att Excite dott com]
Portions created by John Kozikopulos are Copyright (C) 2002 John Kozikopulos.
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org

Description:
  Thumbimage, ThumbNail components
  Thumbimage is a TImage descentant wich passes the control of the mouse events
  to the ThumbNail and have the ability to change an images look by changing
  the rgb values with the changergb,changergbcurve procedures.
  You can have precise control over the images look.
  The changergb procedure just adds the values you pass to its rgb variables to
  the actual values of the image.
  The Changergbcurves procedure just replaces the value of the rgb values
  accordingly with the values that passed in the the arrays.
  e.g.
  the r array in the position 15 has a value of 35 this meens that wherever in
  the Picture there is a pixels which has a red value equall to 15 it will be ]
  replaced with the value 35.

  ThumbNail is what the name says a component to simply shrink an image
  proportionally to fit in a portion of the screen with some extra mouse handling
  to Create a Button like effect. Just give it a FileName and it will do the work
  for you.

Known Issues:
-----------------------------------------------------------------------------}
// $Id$

unit JvThumbnails;

{$MODE objfpc}{$H+}

interface

uses
  {$IFDEF WINDOWS}
  Windows,
  {$ENDIF}
  {$IFDEF UNIX}
  baseunix,
  {$ENDIF}
  LCLIntf, LCLType, LCLVersion, LMessages, Types,
  Classes, Controls, ExtCtrls, SysUtils, Graphics, Forms,
  JvThumbImage, JvBaseThumbnail, Dialogs;

const
  TH_IMAGESIZECHANGED = WM_USER + 1;

type
  // (rom) elements renamed
  TTitlePos = (tpUp, tpDown, tpNone);

  TTitleNotify = procedure(Sender: TObject; FileName: string;
    var ThumbnailTitle: string) of object;

  TJvThumbnail = class(TJvBaseThumbnail)
  private
    FTitle: string;
    FTitlePanel: TJvThumbTitle;
    FTitleColor: TColor;
    FTitleFont: TFont;
    FStreamFileKind: TGRFKind;
    FDFileCreated: TDateTime;
    FDFileChanged: TDateTime;
    FDFileAccessed: TDateTime;
    FShowTitle: Boolean;
    FDFileSize: Longint;
    FStream: TStream;
    FImageWidth: Longint;
    FImageHeight: Longint;
    FThumbHeight: Word;
    FThumbWidth: Word;
    FShadowObj: TShape;
    FUpdated: Boolean;
    FImageReady: Boolean;
    FTitlePlacement: TTitlePos;
    FPhotoName: TJvFileName;
    FPhoto: TJvThumbImage;
    FOnGetTitle: TTitleNotify;
    FMousePressed: Boolean;
    FDestroying: Boolean;
    FAsButton: Boolean;
    FMinimizeMemory: Boolean;
    FAutoLoad: Boolean; // if True then load the image either from a thumb file or Create it from the FileName
    FShadowColor: TColor;
    FShowShadow: Boolean;
    FHShadowOffset: Word;
    FVShadowOffset: Word;
    FMargin: Integer;
    (************** NOT CONVERTED ***
    procedure PhotoOnProgress(Sender: TObject; Stage: TProgressStage;
      PercentDone: Byte; RedrawNow: Boolean;
      const R: TRect; const Msg: string);
    *******************************)
    procedure GetFileInfo(AName: string);
    function GetFileName: string;
    function GetTitleBevelInner: TPanelBevel;
    function GetTitleBevelOuter: TPanelBevel;
    function GetTitleBorderStyle: TBorderStyle;
    function IsTitleFontStored: Boolean;
    procedure RefreshFont(Sender: TObject);
    procedure SetDummyCard({%H-}AInt: Longint);
    procedure SetDummyStr({%H-}AStr: string);
    procedure SetFileName(const AFile: string);
    procedure SetMargin(AValue: Integer);
    procedure SetMinimizeMemory(Min: Boolean);
    //procedure SetShadowColor(aColor: TColor);
    procedure SetShowShadow(AShow: Boolean);
    procedure SetStream(const AStream: TStream);
    procedure SetShowTitle(const AState: Boolean);
    procedure SetTitle(const Value: string);
    procedure SetTitleBevelInner(const Value: TPanelBevel);
    procedure SetTitleBevelOuter(const Value: TPanelBevel);
    procedure SetTitleBorderStyle(const Value: TBorderStyle);
    procedure SetTitleColor(const Value: TColor);
    procedure SetTitleFont(const Value: TFont);
    procedure SetTitlePlacement(const AState: TTitlePos);

  protected
    procedure BoundsChanged; override;
    procedure CalculateImageSize; virtual;
    procedure CreateHandle; override;
    procedure THSizeChanged(var {%H-}Msg: TLMessage); message TH_IMAGESIZECHANGED;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    function LoadFile(AFile: string): string;
    procedure UpdateThumbHeight;
    procedure UpdateThumbWidth;
    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;
    procedure SetTitlePanel(ATitle: string; AFont: TFont; AColor: TColor);
    procedure Refresh;
    property ImageHeight: Longint read FImageHeight default 0;
    property ImageReady: Boolean read FImageReady;
    property ImageWidth: Longint read FImageWidth default 0;
    property Stream: TStream read FStream write SetStream;
    property Photo: TJvThumbImage read FPhoto write FPhoto;
  published
    property AutoLoad: Boolean read FAutoLoad write FAutoLoad default true;
    property AsButton: Boolean read FAsButton write FAsButton default false;
    property FileName: string read GetFileName write SetFileName;
    property Margin: Integer read FMargin write SetMargin default 8;
    property MinimizeMemory: Boolean read FMinimizeMemory write SetMinimizeMemory default true;
    property ShadowColor: TColor read FShadowColor write FShadowColor;
    property ShowShadow: Boolean read FShowShadow write SetShowShadow default false;
    property ShowTitle: Boolean read FShowTitle write SetShowTitle default true;
    property StreamFileType: TGRFKind read FStreamFileKind write FStreamFileKind default grBMP;
    property Title: string read FTitle write SetTitle;
    property TitleBevelInner: TPanelBevel read GetTitleBevelInner write SetTitleBevelInner default bvNone;
    property TitleBevelOuter: TPanelBevel read GetTitleBevelOuter write SetTitleBevelOuter default bvLowered;
    property TitleBorderStyle: TBorderStyle read GetTitleBorderStyle write SetTitleBorderStyle default bsNone;
    property TitleColor: TColor read FTitleColor write SetTitleColor default clDefault;
    property TitleFont: TFont read FTitleFont write SetTitleFont stored IsTitleFontStored;
    property TitlePlacement: TTitlePos read FTitlePlacement write SetTitlePlacement default tpUp;
    property OnGetTitle: TTitleNotify read FOnGetTitle write FOnGetTitle;
    { Do not store dummies }
    property FileSize: Longint read FDFileSize stored false; // write SetDummyCard stored False;
    property FileAccessed: TDateTime read FDFileAccessed stored false; // write SetDummyStr stored False;
    property FileCreated: TDateTime read FDFileCreated stored false; // write SetDummyStr stored False;
    property FileChanged: TDateTime read FDFileChanged stored false; // write SetDummyStr stored False;
  end;


implementation

uses
  FileUtil, DateUtils,
  JvThumbViews; //, JvResources;

constructor TJvThumbnail.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FShowTitle := True;
  FMargin := 8;
  FHShadowOffset := 3;
  FVShadowOffset := 3;
  FShowShadow := False;
  FShadowColor := clSilver;
  FTitleColor := clDefault; //clBtnFace;
  FTitlePlacement := tpUp;
  FTitle := '';
  FUpdated := False;

  FPhotoName := TJvFileName.Create;

  Photo := TJvThumbImage.Create(Self);
  Photo.AutoSize := False;
  Photo.Align := alNone;
  Photo.Stretch := True;
  (************** NOT CONVERTED)
  Photo.OnProgress := PhotoOnProgress;
  **************)

  FShadowObj := TShape.Create(Self);
  FShadowObj.Visible := FShowShadow;
  FShadowObj.Brush.Color := FShadowColor;
  FShadowObj.Parent := Self;
  FShadowObj.Pen.Style := psClear;
  FShadowObj.Width := Photo.Width;
  FShadowObj.Height := Photo.Height;
  FShadowObj.Left := Photo.Left + FHShadowOffset;
  FShadowObj.Top := Photo.Top + FVShadowOffset;

  FTitleFont := TFont.Create;
  FTitleFont.Name := 'default';
  FTitleFont.Size := 0;
  FTitleFont.OnChange := @RefreshFont;

  FTitlePanel := TJvThumbTitle.Create(Self);
  FTitlePanel.Align := alTop;
  FTitlePanel.Height := 15;
  FTitlePanel.Alignment := taCenter;
  FTitlePanel.Color := FTitleColor;
  FTitlePanel.BevelOuter := bvLowered;
  FTitlePanel.ParentColor := True;
//  FTitlePanel.Color := Self.Color;
  FTitlePanel.Visible := (FTitlePlacement <> tpNone) and FShowTitle;

  InsertControl(Photo);
  InsertControl(FTitlePanel);
  Align := alNone;
  if AOwner is TJvThumbView then
  begin
    Width := TJvThumbView(Owner).MaxWidth;
    Height := TJvThumbView(Owner).MaxHeight;
  end else
  begin
    Width := 120;
    Height := 120;
  end;
  FMinimizeMemory := True;
  AsButton := False;
  Left := 10;
  Top := 10;
  Visible := True;
  BevelOuter := bvRaised;
  StreamFileType := grBMP;
  FAutoLoad := True;
end;

destructor TJvThumbnail.Destroy;
begin
  FDestroying := True;
  (************* NOT CONVERTED ***
  Photo.OnProgress := nil;
  **********)
  FPhotoName.Free;
  FTitleFont.OnChange := nil;
  FTitleFont.Free;
  inherited Destroy;
end;

procedure TJvThumbnail.BoundsChanged;
begin
  CalculateImageSize;
  inherited BoundsChanged;
end;

procedure TJvThumbnail.CalculateImageSize;
var
  Percent: Byte;
  TempX, TempY: Single;
begin
  if (Photo = nil) or (Photo.Picture = nil) then
    exit;
  UpdateThumbHeight;
  UpdateThumbWidth;
  if (Photo.Picture.Width > FThumbWidth) or (Photo.Picture.Height > FThumbHeight) then
  begin
    TempX := (FThumbWidth / Photo.Picture.Width) * 100;
    TempY := (FThumbHeight / Photo.Picture.Height) * 100;
  end
  else
  begin
    TempX := 100;
    TempY := 100;
  end;
  if TempX <= TempY then
    Percent := Trunc(TempX)
  else
    Percent := Trunc(TempY);
  Photo.Width := Trunc((Photo.Picture.Width / 100) * Percent);
  Photo.Height := Trunc((Photo.Picture.Height / 100) * Percent);
  Photo.Left := Trunc(Width / 2 - Photo.Width / 2);
  Photo.Top := (Height div 2) - (Photo.Height div 2);
  case FTitlePlacement of
    tpUp:
      Photo.Top := Photo.Top + (FTitlePanel.Height div 2);
    tpDown:
      Photo.Top := Photo.Top - (FTitlePanel.Height div 2);
  end;
  FShadowObj.SetBounds(Photo.Left + FHShadowOffset, Photo.Top + FVShadowOffset,
    Photo.Width, Photo.Height);
end;

procedure TJvThumbnail.CreateHandle;
begin
  inherited;
  if not (csDesigning in ComponentState) and (FTitleColor = clDefault) then
    FTitleColor := Color;
  UpdateTitlePanelHeight;
end;

procedure TJvThumbnail.GetFileInfo(AName: String);
var
  {$IFDEF WINDOWS}
  info: TWin32FindDataW;
  dft: DWORD = 0;
  lft: TFileTime;
  H: THandle;
  ws: WideString;
  {$ENDIF}
  {$IFDEF UNIX}
  info: stat;
  {$ENDIF}
begin
  {$IFDEF WINDOWS}
  ws := UTF8Decode(AName);
  H := Windows.FindFirstFileW(PWideChar(ws), info{%H-});
  if H <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(H);
    //fdFileAccessed
    FileTimeToLocalFileTime(info.ftLastAccessTime, lft{%H-});
    FileTimeToDosDateTime(lft, LongRec(dft).Hi, LongRec(dft).Lo);
    try
      FDFileAccessed := FileDateToDateTime(dft);
    except
      FDFileAccessed := 0;
    end;
    //fdFilechanged
    FileTimeToLocalFileTime(info.ftLastwriteTime, lft);
    FileTimeToDosDateTime(lft, LongRec(dft).Hi, LongRec(dft).Lo);
    try
      FDFileChanged := FileDateToDateTime(dft);
    except
      FDFileChanged := 0;
    end;
    //fdFileCreated
    FileTimeToLocalFileTime(info.ftCreationTime, lft);
    FileTimeToDosDateTime(lft, LongRec(dft).Hi, LongRec(dft).Lo);
    try
      FDFileCreated := FileDateToDateTime(dft);
    except
      FDFileCreated := 0;
    end;
    FDFileSize := info.nFileSizeHigh * MAXDWORD + info.nFileSizeLow;
  end;
  {$ENDIF}

  {$IFDEF UNIX}
  if fpstat(AName, info) = 0 then begin
    FDFileAccessed := UnixToDateTime(info.st_atime);
    FDFileChanged := UnixToDateTime(info.st_mtime);
    FDFileCreated := UnixToDateTime(info.st_ctime);
    {$IFDEF DARWIN}
    FDFileSize := info.st_size;
    {$ELSE}
    FDFileSize := info.Size;
    {$ENDIF}
  end;
  {$ENDIF}
end;

function TJvThumbnail.GetFileName: string;
begin
  Result := FPhotoName.FileName;
end;

function TJvThumbnail.GetTitleBevelInner: TPanelBevel;
begin
  Result := FTitlePanel.BevelInner;
end;

function TJvThumbnail.GetTitleBevelOuter: TPanelBevel;
begin
  Result := FTitlePanel.BevelOuter;
end;

function TJvThumbnail.GetTitleBorderStyle: TBorderStyle;
begin
  Result := FTitlePanel.BorderStyle;
end;

function TJvThumbnail.IsTitleFontStored: Boolean;
begin
  Result := not FTitleFont.IsDefault;
end;

function TJvThumbnail.LoadFile(AFile: string): string;
var
  FName: string;
begin
  try
    FName := AFile;
    Photo.LoadFromFile(AFile);
    FImageWidth := Photo.Picture.Width;
    FImageHeight := Photo.Picture.Height;
    FUpdated := False;
    CalculateImageSize;
    Photo.Visible := True;
  except
    // (rom) ShowMessage removed
    FName := '';
  end;
  if MinimizeMemory and (FPhotoName.FileName <> '') then
  begin
    if Owner is TJvThumbView then
      Photo.ScaleDown(TJvThumbView(Owner).MaxWidth, TJvThumbView(Owner).MaxHeight)
    else
      Photo.ScaleDown(FThumbWidth, FThumbHeight);
  end;
  Result := FName;
end;

procedure TJvThumbnail.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if AsButton then
    if Button = mbLeft then
    begin
      FMousePressed := True;
      BevelOuter := bvLowered;
      FTitlePanel.BevelOuter := bvRaised;
    end;
  inherited MouseDown(Button, Shift, X, Y);
end;

procedure TJvThumbnail.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if AsButton then
    if FMousePressed then
    begin
      if (X < 0) or (X > Width) or (Y < 0) or (Y > Height) then
      begin
        BevelOuter := bvRaised;
        FTitlePanel.BevelOuter := bvLowered
      end
      else
      begin
        BevelOuter := bvLowered;
        FTitlePanel.BevelOuter := bvRaised;
      end;
    end;
  inherited MouseMove(Shift, X, Y);
end;

procedure TJvThumbnail.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if AsButton then
    if Button = mbLeft then
    begin
      FMousePressed := False;
      BevelOuter := bvRaised;
      FTitlePanel.BevelOuter := bvLowered;
    end;
  inherited MouseUp(Button, Shift, X, Y);
end;

(********** NOT CONVERTED ***
procedure TJvThumbnail.PhotoOnProgress(Sender: TObject; Stage: TProgressStage;
  PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
begin
  FImageReady := (Stage = psEnding);
end;
***************************)

procedure TJvThumbnail.Refresh;
begin
  CalculateImageSize;
  inherited Refresh;
end;

procedure TJvThumbnail.RefreshFont(Sender: TObject);
begin
  FTitlePanel.Font.Assign(FTitleFont);
  UpdateTitlePanelHeight;
end;

// dummy property functions to allow the object inspector to
// show the properties and their values
procedure TJvThumbnail.SetDummyStr(AStr: string);
begin
end;

procedure TJvThumbnail.SetDummyCard(AInt: Longint);
begin
end;

procedure TJvThumbnail.SetFileName(const AFile: string);
var
  FName: string;
//  Pos: Longint;
//  tmp: TJvThumbImage;
//  D1, D2: TdateTime;
begin
  if AFile <> '' then
  begin
    GetFileInfo(AFile);
    if FAutoLoad then
      FName := LoadFile(AFile);
  end
  else
    FName := ''; {}
  if FName = AFile then
    if (Title = ExtractFileName(FPhotoName.FileName)) or (Title = '') then
      Title := ExtractFileName(FName);
  FPhotoName.FileName := FName;
end;

procedure TJvThumbnail.SetMargin(AValue: Integer);
begin
  if AValue <> FMargin then begin
    FMargin := AValue;
    CalculateImageSize;
//    UpdateThumbWidth;
//    UpdateThumbHeight;
    Invalidate;
  end;
end;

procedure TJvThumbnail.SetMinimizeMemory(Min: Boolean);
begin
  if Assigned(Photo.Picture.Graphic) then
  begin
    if FMinimizeMemory <> Min then
    begin
      if Min then
      begin
        if Owner is TJvThumbView then
          Photo.ScaleDown(TJvThumbView(Owner).MaxWidth, TJvThumbView(Owner).MaxHeight)
        else
          Photo.ScaleDown(Width, Height);
      end
      else
      if FMinimizeMemory then
        Photo.Picture.LoadFromFile(FileName);
      FMinimizeMemory := Min;
    end;
  end
  else
    FMinimizeMemory := Min;
end;

{procedure TJvThumbnail.SetShadowColor(aColor: TColor);
begin
  FShadowObj.Brush.Color := aColor;
  FShadowColor := aColor;
end;}

procedure TJvThumbnail.SetShowShadow(AShow: Boolean);
begin
  FShadowObj.Visible := AShow;
  FShowShadow := AShow;
end;

procedure TJvThumbnail.SetShowTitle(const AState: Boolean);
begin
  if AState <> FShowTitle then
  begin
    FShowTitle := AState;
    FTitlePanel.Visible := AState;
  end
end;

procedure TJvThumbnail.SetStream(const AStream: TStream);
var
  Bmp: Graphics.TBitmap;
  Size: TPoint;
  Img2: TJPEGImage;
begin
  case StreamFileType of
    grBMP:
      Photo.Picture.Bitmap.LoadFromStream(AStream);
    (********* NOT CONVERTED ***
    grEMF, grWMF:
      Photo.Picture.Metafile.LoadFromStream(AStream);
      *************************)
    grJPG:
      begin
        Img2 := TJPEGImage.Create;
        Img2.LoadFromStream(AStream);
        Photo.Picture.Assign(Img2);
        FreeAndNil(Img2);
      end;
  end;

  if FMinimizeMemory then
  begin
    Bmp := Graphics.TBitmap.Create;
    if Parent is TJvThumbView then
      Size := ProportionalSize(Point(Photo.Picture.Width, Photo.Picture.Height),
        Point(TJvThumbView(Parent).MaxWidth, TJvThumbView(Parent).MaxHeight))
    else
      Size := ProportionalSize(Point(Photo.Picture.Width, Photo.Picture.Height),
        Point(Width, Height));
    Bmp.Width := Size.X;
    Bmp.Height := Size.Y;
    Bmp.handletype := bmDIB;
    Bmp.pixelformat := pf24bit;
    Bmp.Canvas.StretchDraw(rect(0, 0, Bmp.Width, Bmp.Height),
      Photo.Picture.Graphic);
    //Photo.Picture.Graphic.Free; // (rom) not needed
    //Photo.Picture.Graphic := nil;
    Photo.Picture.Assign(Bmp);
    Bmp.Free;
  end;
end;

procedure TJvThumbnail.THSizeChanged(var Msg: TLMessage);
begin
  CalculateImageSize;
end;

procedure TJvThumbnail.SetTitle(const Value: string);
begin
  if Value <> FTitle then
  begin
    FTitle := Value;
    FTitlePanel.Caption := Value;
  end;
end;

procedure TJvThumbnail.SetTitleBevelInner(const Value: TPanelBevel);
begin
  FTitlePanel.BevelInner := Value;
end;

procedure TJvThumbnail.SetTitleBevelOuter(const Value: TPanelBevel);
begin
  FTitlePanel.BevelOuter := Value;
end;

procedure TJvThumbnail.SetTitleBorderStyle(const Value: TBorderStyle);
begin
  FTitlePanel.BorderStyle := Value;
end;

procedure TJvThumbnail.SetTitleColor(const Value: TColor);
begin
  if Value <> FTitleColor then
  begin
    FTitleColor := Value;
    FTitlePanel.Color := Value;
  end;
end;

procedure TJvThumbnail.SetTitleFont(const Value: TFont);
begin
  FTitleFont.Assign(Value);
end;

procedure TJvThumbnail.SetTitlePanel(ATitle: string; AFont: TFont;
  AColor: TColor);
begin
  SetTitleFont(AFont);
  SetTitleColor(AColor);
  SetTitle(ATitle);
  FUpdated := True;
end;

procedure TJvThumbnail.SetTitlePlacement(const AState: TTitlePos);
begin
  if AState <> FTitlePlacement then
    case AState of
      tpUp:
        FTitlePanel.Align := alTop;
      tpDown:
        FTitlePanel.Align := alBottom;
      tpNone:
        FTitlePanel.Visible := False;
    end;
  if FTitlePlacement <> tpNone then
    FTitlePanel.Visible := True;
  FTitlePlacement := AState;
  CalculateImageSize;
end;

procedure TJvThumbnail.UpdateThumbHeight;
begin
  if Assigned(FTitlePanel) and FTitlePanel.Visible then
    FThumbHeight := ClientHeight - FTitlePanel.Height - FMargin
  else
    FThumbHeight := ClientHeight - FMargin;
end;

procedure TJvThumbnail.UpdateThumbWidth;
begin
  FThumbWidth := ClientWidth - 2 * FMargin;
end;

procedure TJvThumbnail.UpdateTitlePanelHeight;
var
  fd: TFontData;
begin
  fd := GetFontData(FTitleFont.Handle);
  Canvas.Font.Name := fd.Name;
  Canvas.Font.Style := fd.Style;
  Canvas.Font.Height := fd.Height;
  FTitlePanel.Height := Canvas.TextHeight('Tg') + 4;
  CalculateImageSize;
end;

procedure TJvThumbnail.WMPaint(var Msg: TLMPaint);
var
  ThumbnailTitle: string;
begin
  if not FUpdated then
  begin
    ThumbnailTitle := Title;
    if Assigned(FOnGetTitle) then
    begin
      FOnGetTitle(Self, FileName, ThumbnailTitle);
      SetTitle(ThumbnailTitle);
    end
    else
    begin
      if ThumbnailTitle = '' then
        SetTitle(ExtractFileName(FileName))
      else
        SetTitle(ThumbnailTitle);
    end;
    FUpdated := True;
  end;
  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.