⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 jvthumbnails.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 2 页
字号:

// 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.PhotoOnProgress(Sender: TObject; Stage: TProgressStage;
  PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
begin
  FImageReady := (Stage = psEnding);
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.SetShowShadow(Show: Boolean);
begin
  FShadowObj.Visible := Show;
  FShowShadow := Show;
end;

{procedure TJvThumbnail.SetShadowColor(aColor: TColor);
begin
  FShadowObj.Brush.Color := aColor;
  FShadowColor := aColor;
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;

procedure TJvThumbnail.GetFileInfo(AName: string);
var
  FileInfo: TWin32FindData;
  H: THandle;
  Dft: DWORD;
  Lft: TFileTime;
begin
  H := Windows.FindFirstFile(PChar(AName), FileInfo);
  if H <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(H);
    FileTimeToLocalFileTime(FileInfo.ftLastAccessTime, Lft);
    FileTimeToDosDateTime(Lft, LongRec(Dft).Hi, LongRec(Dft).Lo);
    try
      FDFileAccessed := DateTimeToStr(FileDateToDateTime(Dft));
    except
      FDFileAccessed := RsUnknown;
    end;
    FileTimeToLocalFileTime(FileInfo.ftLastwriteTime, Lft);
    FileTimeToDosDateTime(Lft, LongRec(Dft).Hi, LongRec(Dft).Lo);
    try
      FDFileChanged := DateTimeToStr(FileDateToDateTime(Dft));
    except
      FDFileChanged := RsUnknown;
    end;
    FileTimeToLocalFileTime(FileInfo.ftCreationTime, Lft);
    FileTimeToDosDateTime(Lft, LongRec(Dft).Hi, LongRec(Dft).Lo);
    try
      FDFileCreated := DateTimeToStr(FileDateToDateTime(Dft));
    except
      FDFileCreated := RsUnknown;
    end;
    FDFileSize := (FileInfo.nFileSizeHigh * MAXDWORD) + FileInfo.nFileSizeLow;
  end;
end;

function TJvThumbnail.GetFileName: string;
begin
  Result := FPhotoName.FileName;
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(Width, Height);
  end;
  Result := FName;
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.CalculateImageSize;
var
  Percent: Byte;
  TempX, TempY: Single;
begin
  SetClientHeight(15);
  SetClientWidth(15);
  if (Photo.Picture.Width > ClientWidth) or (Photo.Picture.Height > ClientHeight) then
  begin
    TempX := ((ClientWidth) / Photo.Picture.Width) * 100;
    TempY := ((ClientHeight) / 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.THSizeChanged(var Msg: TMessage);
begin
  CalculateImageSize;
end;

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

procedure TJvThumbnail.WMPaint(var Msg: TWMPaint);
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;

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.RefreshFont(Sender: TObject);
begin
  FTitlePanel.Font.Assign(FTitleFont);
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.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.Refresh;
begin
  CalculateImageSize;
  inherited Refresh;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -