如何使用TBitmap创建正确的缩略图?

时间:2017-09-24 07:04:48

标签: delphi bitmap delphi-xe5

我有一个奇怪的问题,我无法解决它。我有很多图像,我想创建它们的缩略图。我将我的应用程序指向一个目录,它创建了每个目录的缩略图(64 * 64)。问题是前一个位图持续存在于我不理解的新位图中。以下是导致错误的过程的代码:

procedure TMain.import_image_resize (source, destination: string);
var
   Input_Bitmap: TBitmap;
begin
   Input_Bitmap := TBitmap.CreateFromFile (source);
   Input_Bitmap.ReSize (iSize, iSize); // iSize = 64
   Input_Bitmap.SaveToFile (destination);
   Input_Bitmap.Free;
end; // import_image_resize //

下面的import_process_images将其称为参数。

procedure TMain.import_process_images (sub: string; process: TConverter);
var
   i, n: int32;
   dir_input: string;
   dir_new: string;
   temp: string;
   file_path: string;
   file_name: string;
   file_ext: string;
   new_file: string;
   source_dirs: TStringDynArray;
   destination_dirs: TStringDynArray;
   files: TStringDynArray;

begin
   // get list of directories from selected directory
   source_dirs := TDirectory.GetDirectories (Dir_Selected);
   SetLength (destination_dirs, Length (source_dirs));

   // create these directories in the destination directory
   n := 0;
   for dir_input in source_dirs do
   begin
      i := LastDelimiter ('\', dir_input) - 1;
      temp := dir_input.Substring (i + 1);
      dir_new := TPath.Combine (Project_Root, Project_Selected);
      dir_new := TPath.Combine (dir_new, sub);
      dir_new := TPath.Combine (dir_new, temp);
      TDirectory.CreateDirectory (dir_new);
      destination_dirs [n] := dir_new;
      n := n + 1;
   end; // for

   // for each directory in the selected directory
   // - get each image
   // - convert it
   // - and copy it to the destination directory
   n := 0;
   Stop_Conversion := False;
   for dir_new in source_dirs do
   begin
      files := TDirectory.GetFiles (dir_new);
      for file_path in files do
      begin
         file_name := TPath.GetFileName (file_path);
         file_ext := LowerCase (TPath.GetExtension (file_name));
         if (file_ext = '.bmp') or (file_ext = '.jpg') or
            (file_ext = '.png') or (file_ext = '.jpeg') then
         begin
            new_file := TPath.Combine (destination_dirs [n], file_name);
            process (file_path, new_file);
            Label_Progress.Text := new_file;
            Application.ProcessMessages;
            if Stop_Conversion then Exit;
         end; // if
      end; // for
      n := n + 1;
   end; // for
   Label_Progress.Text := 'Ready';
end; (*** import_process_images ***)

从事件处理程序调用这两个函数,如下所示:

procedure TMain.Button_SelectClick (Sender: TObject);
var
   tree_item: TTreeViewItem;
begin
   iSize := StrToInt (edit_XSize.Text);
   tree_item := Directory_Tree.Selected;
   Dir_Selected := tree_item.Text;

   import_process_images ('rs', import_image_resize);
end; // Button_SelectClick //

可以预期新的Input_Bitmap应该只填充从文件加载的位图。但是,调整大小的位图显示先前位图的所有图像(由以前的import_image_resize调用加载)覆盖当前位图。我不明白这种行为,有人得到解释,最好是解决方法吗?

谢谢你的时间。

修改1 我将展示两张照片连续转换的示例:第一张是风景照片,第二张是肖像照片。您会在第二张照片的边缘看到第一张照片。第二张照片刚刚覆盖了第一张照片(第三张照片覆盖了前两张照片的组合等)

编辑2 有人建议某些未显示的代码可能会对procedure import_image_resize产生影响。至于完整性,我添加了这段代码,但我看不出自己到底做错了什么。

enter image description here enter image description here

0 个答案:

没有答案