サムネイル画像の作成(2001/9/2)

　MiViewやHTMLCatで使用しているサムネイル画像作成処理です。より多くの画像ファイルに対応するため実際の処理はもっと複雑ですが、サムネイルへの画像縮小方法はわかると思います。
　サンプルプロジェクトではTListBoxへのOwnerDraw処理で簡単なサムネイル一覧表示を行なっています。
　

const
  THUMBHT = 120; //サムネイル画像の高さ
  THUMBWD = 120; //サムネイル画像の幅

// サムネイル画像を作成する
procedure TForm1.MakeThumb(Fname: string);
var
  Thumbnl, bmp: TBitmap;
  jpg: TJpegImage;  // UsesにJpegを追加
  ext, fn: string;
  sr, dr: TRect;
  srt, sc: double;
  x, y: integer;
begin
  Thumbnl := TBitmap.Create;
  try
    // サムネイル画像の大きさをセット
    Thumbnl.Width := THUMBWD;
    Thumbnl.Height:= THUMBHT;
    // サムネイル画像の背景を白で塗りつぶす
    Thumbnl.Canvas.Brush.Color := clWhite;
    Thumbnl.Canvas.FillRect(Rect(0, 0, THUMBWD, THUMBHT));
    // ファイル拡張子を取得
    ext := AnsiUpperCase(ExtractFileExt(Fname));
    // 元画像を読込むBitmapを準備
    bmp := TBitmap.Create;
    try
      // ビットマップ
      if ext = '.BMP' then
      begin
        bmp  := TBitmap.Create;
        bmp.LoadFromFile(fname);
      // Jpeg
      end else if (ext = '.JPG') or (ext = '.JPEG') then
      begin
        jpg := TJpegImage.Create;
        try
          jpg.LoadFromFile(fname);
          bmp.Assign(jpg);
        finally
          Jpg.Free;
        end;
      end;
      x := bmp.Width;
      y := bmp.Height;
      try
        // サムネイル描画スケールを計算
        sc := x / y;
        // 縦横どちらが大きいかをチェックする
        // THUMBHTから16引いているのはファイル名を描画する部分を確保するため
        srt := (THUMBWD / (THUMBHT - 16)) / sc;
        if srt < 1.0 then
        begin
          x := THUMBWD;
          y := Trunc((THUMBHT - 16) * srt) - 1;
        end else begin
          x := Trunc(THUMBWD / srt) - 1;
          y := (THUMBHT - 16);
        end;
      except
        x := THUMBWD;
        y := (THUMBHT - 16);
      end;
      // コピー元の大きさをセット
      sr.Top := 0;
      sr.Left := 0;
      sr.Right := bmp.Width;
      sr.Bottom := bmp.Height;
      dr.Right := x;
      dr.Bottom := y;
      // コピー先（サムネイル）の大きさをセット
      if x < THUMBWD then
      begin
        dr.Left := (THUMBWD - x) div 2;
        dr.Right := dr.Right + dr.Left;
      end else
        dr.Left := 0;
      if y < (THUMBHT - 16) then
      begin
        dr.Top := ((THUMBHT - 16) - y) div 2;
        dr.Bottom := dr.Bottom + dr.Top;
      end else
        dr.Top := 0;
      // サムネイル画像へ書込み
      Thumbnl.Canvas.CopyMode := cmSrcCopy;
      Thumbnl.Canvas.StretchDraw(dr, bmp);
      // サムネイルに書込むファイル名を作成
      fn := ExtractFileName(fname);
      // ファイル名が長い場合には省略する
      if Length(fn) > 18 then
        fn := Copy(ExtractFileName(fn), 1, 12) + '...' + ExtractFileExt(fn);
      // ファイル名書込み
      SetTextAlign(Thumbnl.Canvas.Handle, TA_CENTER);
      TextOut(Thumbnl.Canvas.Handle, THUMBWD div 2, (THUMBHT - 14), PChar(fn), Length(fn));
    finally
      bmp.Free;
    end;
    // Image1.Picture.Bitmap.Assign(Thumbnl);
    // ここに作成したサムネイル画像を使用する処理を記述する
  finally
    Thumbnl.Free;
  end;
end;

サンプルプロジェクトのダウンロード(3,065byte)

サンプルプロジェクトにはFindFile, FolderDlg, ShfOperationの三つのコンポーネントが必要です。Delphi小技のページからダウンロードして下さい。

戻る