delphi Android 创建缩略图,delphi实现批量缩略图生成工具开发代码

以下是Delphi实现批量缩略图生成工具开发代码的示例：

unit MainForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.Imaging.jpeg,
  Vcl.Imaging.pngimage, Vcl.Imaging.GIFImg;

type
  TfrmMain = class(TForm)
    btnOpenFolder: TButton;
    lvImages: TListView;
    btnGenerateThumbnails: TButton;
    imgThumbnail: TImage;
    chkMaintainAspectRatio: TCheckBox;
    edtWidth: TEdit;
    edtHeight: TEdit;
    lblWidth: TLabel;
    lblHeight: TLabel;
    lblPixels: TLabel;
    lblStatus: TLabel;
    pbProgress: TProgressBar;
    procedure btnOpenFolderClick(Sender: TObject);
    procedure lvImagesSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
    procedure btnGenerateThumbnailsClick(Sender: TObject);
    procedure chkMaintainAspectRatioClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FImageList: TImageList;
    FImageFiles: TStringList;
    FCurrentImage: TGraphic;
    procedure LoadImageFiles(const AFolder: string);
    procedure GenerateThumbnail(const AFileName: string);
    procedure UpdateThumbnailPreview;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.btnOpenFolderClick(Sender: TObject);
var
  FolderDlg: TFileOpenDialog;
begin
  FolderDlg := TFileOpenDialog.Create(nil);
  try
    FolderDlg.Options := FolderDlg.Options + [fdoPickFolders];
    if FolderDlg.Execute then
    begin
      LoadImageFiles(FolderDlg.FileName);
    end;
  finally
    FolderDlg.Free;
  end;
end;

procedure TfrmMain.btnGenerateThumbnailsClick(Sender: TObject);
var
  I: Integer;
begin
  pbProgress.Max := lvImages.Items.Count;
  pbProgress.Position := 0;

  for I := 0 to FImageFiles.Count - 1 do
  begin
    GenerateThumbnail(FImageFiles[I]);
    pbProgress.Position := I + 1;
  end;

  pbProgress.Position := 0;
  lblStatus.Caption := 'Thumbnails generated successfully.';
end;

procedure TfrmMain.chkMaintainAspectRatioClick(Sender: TObject);
begin
  if chkMaintainAspectRatio.Checked then
  begin
    edtHeight.Enabled := False;
    edtHeight.Text := '0';
  end
  else
  begin
    edtHeight.Enabled := True;
  end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FImageList := TImageList.Create(nil);
  FImageFiles := TStringList.Create;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  FImageList.Free;
  FImageFiles.Free;
end;

procedure TfrmMain.GenerateThumbnail(const AFileName: string);
var
  Image: TGraphic;
  Thumbnail: TBitmap;
  Width, Height: Integer;
begin
  // Load the image
  Image := nil;
  try
    Image := TGraphic.Create;
    Image.LoadFromFile(AFileName);

    // Calculate the dimensions of the thumbnail
    if chkMaintainAspectRatio.Checked then
    begin
      if Image.Width > Image.Height then
      begin
        Width := StrToInt(edtWidth.Text);
        Height := MulDiv(Image.Height, Width, Image.Width);
      end
      else
      begin
        Height := StrToInt(edtHeight.Text);
        Width := MulDiv(Image.Width, Height, Image.Height);
      end;
    end
    else
    begin
      Width := StrToInt(edtWidth.Text);
      Height := StrToInt(edtHeight.Text);
    end;

    // Generate the thumbnail
    Thumbnail := TBitmap.Create;
    try
      Thumbnail.Width := Width;
      Thumbnail.Height := Height;
      Thumbnail.Canvas.StretchDraw(Rect(0, 0, Width, Height), Image);
      FImageList.Add(Thumbnail, nil);
    finally
      Thumbnail.Free;
    end;
  finally
    Image.Free;
  end;
end;

procedure TfrmMain.LoadImageFiles(const AFolder: string);
var
  SearchRec: TSearchRec;
  Image: TGraphic;
  ListItem: TListItem;
begin
  FImageList.Clear;
  FImageFiles.Clear;
  lvImages.Items.Clear;

  if FindFirst(AFolder + '\*.*', faAnyFile, SearchRec) = 0 then
  begin
    repeat
      if (SearchRec.Attr and faDirectory) <> 0 then
        Continue;

      Image := nil;
      try
        Image := TGraphic.Create;
        Image.LoadFromFile(AFolder + '\' + SearchRec.Name);
        FImageFiles.Add(AFolder + '\' + SearchRec.Name);

        ListItem := lvImages.Items.Add;
        ListItem.Caption := SearchRec.Name;
        ListItem.SubItems.Add(IntToStr(Image.Width));
        ListItem.SubItems.Add(IntToStr(Image.Height));
        ListItem.ImageIndex := FImageList.Count;
      finally
        Image.Free;
      end;
    until FindNext(SearchRec) <> 0;
    FindClose(SearchRec);
  end;

  FImageList.SetSize(FImageFiles.Count, FImageFiles.Count);

  lvImages.LargeImages := FImageList;
  lvImages.SmallImages := FImageList;

  lblStatus.Caption := IntToStr(FImageFiles.Count) + ' images loaded successfully.';
end;

procedure TfrmMain.lvImagesSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
begin
  if Selected then
  begin
    FCurrentImage := TGraphic.Create;
    FCurrentImage.LoadFromFile(FImageFiles[Item.Index]);
    UpdateThumbnailPreview;
  end
  else
  begin
    FCurrentImage.Free;
    FCurrentImage := nil;
    imgThumbnail.Picture.Assign(nil);
  end;
end;

procedure TfrmMain.UpdateThumbnailPreview;
var
  Thumbnail: TBitmap;
  Width, Height: Integer;
begin
  if FCurrentImage = nil then
  begin
    imgThumbnail.Picture.Assign(nil);
    Exit;
  end;

  if chkMaintainAspectRatio.Checked then
  begin
    if FCurrentImage.Width > FCurrentImage.Height then
    begin
      Width := StrToInt(edtWidth.Text);
      Height := MulDiv(FCurrentImage.Height, Width, FCurrentImage.Width);
    end
    else
    begin
      Height := StrToInt(edtHeight.Text);
      Width := MulDiv(FCurrentImage.Width, Height, FCurrentImage.Height);
    end;
  end
  else
  begin
    Width := StrToInt(edtWidth.Text);
    Height := StrToInt(edtHeight.Text);
  end;

  Thumbnail := TBitmap.Create;
  try
    Thumbnail.Width := Width;
    Thumbnail.Height := Height;
    Thumbnail.Canvas.StretchDraw(Rect(0, 0, Width, Height), FCurrentImage);
    imgThumbnail.Picture.Assign(Thumbnail);
  finally
    Thumbnail.Free;
  end;
end;

end.

这个示例代码使用了Delphi的TListView、TImageList和TGraphic控件来加载图片文件，生成缩略图，并在屏幕上显示。可以通过选择文件夹、选择图片、调整缩略图大小等功能来实现批量生成缩略图的需求。