Delphi 7 中使用 Paradox 实时 BMP 到 JPG 转换

Posted 2023-02-16

【中文标题】Delphi 7 中使用 Paradox 实时 BMP 到 JPG 转换

【英文标题】：Realtime BMP to JPG conversion in Delphi 7 using Paradox

【发布时间】：2009-06-20 03:34:12

【问题描述】：

在这里和 Code News Fast 的研究中，我没有看到任何与我的问题有关的内容。我有一个应用程序，当用户单击我的应用程序中的按钮以加载它时，通过剪贴板从第三方拍照程序获取客户图片（JvDBImage）。 (PhotoImage.PasteFromClipboard)。这会将图像加载并保存为位图……有时是 BIG BMP。所以，我需要一些可以保存和加载 JPG 的东西。

我试过：.. 使用 JPeg

var
   jpg     : TJpegImage;
begin
  PhotoImage.PasteFromClipboard;
//  // convert to JPEG
//  jpg.Create;
//  jpg.Assign(PhotoImage.Picture);
//  PhotoImage.Picture := jpg;
//  freeAndNil(jpg);
end;

这不会编译，因为分配是两种不同的类型。我还花了一些时间处理剪贴板，试图将其放入 TMemoryStream 中，但没有成功。

我的下一个尝试是将其临时保存到一个文件中，然后将其检索为 JPG，但这会很慢，我不确定我正在尝试做的事情是否可行。所以，与其走另一条小巷，我想我会在这里发布问题。

有问题的数据库有一个名为 Photo 的 memo(1) 字段，PhotoImage 连接到该字段。

【参考方案1】：

This page至少展示了如何将剪贴板内容转换为JPEG：

uses
  Jpeg, ClipBrd;

procedure TfrmMain.ConvertBMP2JPEG;
  // converts a bitmap, the graphic of a TChart for example, to a jpeg
var 
  jpgImg: TJPEGImage;
begin
  // copy bitmap to clipboard
  chrtOutputSingle.CopyToClipboardBitmap;
  // get clipboard and load it to Image1
  Image1.Picture.Bitmap.LoadFromClipboardFormat(cf_BitMap,
    ClipBoard.GetAsHandle(cf_Bitmap), 0);
  // create the jpeg-graphic
  jpgImg := TJPEGImage.Create;
  // assign the bitmap to the jpeg, this converts the bitmap
  jpgImg.Assign(Image1.Picture.Bitmap);
  // and save it to file
  jpgImg.SaveToFile('TChartExample.jpg');
end;

这段代码很不完整，我不确定它是否正确，但使用的方法应该是正确的，而且应该不难纠正（例如，cf_BitMap 应该是 HBITMAP，你不会需要“CopyToClipboardBitmap”行，因为您似乎已经将数据存储在那里）。 您还应该查看 TJPEGImage 类以将图像质量和其他参数设置为适合您需要的值。

但是，如果您想实时为大图像执行此操作，则最好寻找一些可以使用的 JPG 库。可能有一些比 Delphi 例程执行得更好。

【讨论】：

这与我的 kludge 想法很接近。我对 Mike Shkolnik 基于想法的例程的尝试表明这是可行的，尽管速度很慢。我希望有一个快速、直接的 codelet 解决方案，但看起来越来越需要第三方专业库。谢谢你的努力。总经理

【参考方案2】：

这是我几年前编写的用于处理 JPEG 图像的一些代码的摘录。它演示了加载和保存 jpeg 文件，从 blob 字段存储和检索 jpeg 数据，以及 jpeg 和 bmp 之间的转换。

“_proper”程序演示了通过从 JPEG -> BMP -> JPEG 重新压缩图像。 '_update_display' 过程演示了如何在画布上绘制 TJpegImage 以便用户可以看到它。

//Take the supplied TJPEGImage file and load it with the correct
//data where _gas_check_key is pointing to.
//Return 'true' on success, 'false' on failure.
function TfrmGcImage._load_image(var image: TJPEGImage): Boolean;
var
    blob_stream: TStream;
begin
   //Get the current image into image_field
    _query_current_image();

    blob_stream := Query1.CreateBlobStream
        ( Query1.FieldByName('GcImage') as TBlobField, bmRead);
    try
        _load_image := False;
        if blob_stream.Size > 0 then
        begin
            image.LoadFromStream(blob_stream);
            _load_image := True;
        end;
    finally
        blob_stream.Free;
    end;
end;

   Extract Exif information representing the dots per inch of the physical
    image.

    Arguments:
        file_name: name of file to probe
        dpi_h: horizontal dpi or 0 on failure.
        dpi_v: vertical dpi or 0 on failure.

    Returns: True for successful extraction, False for failure

function TfrmGcImage._get_dpi
    (file_name: string; var dpi_h, dpi_v: Integer): Boolean;
var
    exif: TExif;
begin
    exif := TExif.Create;
    try
        exif.ReadFromFile(file_name);
        dpi_h := exif.XResolution;
        dpi_v := exif.YResolution;
    finally
        exif.Free;
    end;

    //Even though the file did have Exif info, run this check to be sure.
    _get_dpi := True;
    if (dpi_h = 0) or (dpi_v = 0) then
        _get_dpi := False;
end;

procedure TfrmGcImage._update_display();
var
    image_jpeg: TJPEGImage;
    thumbnail: TBitmap;
    dest_rect: TRect;
begin
    thumbnail := TBitmap.Create;
    try
        image_jpeg := TJpegImage.Create;
        try
            if (not _load_image(image_jpeg)) or (not _initialized) then
                _load_no_image_placeholder(image_jpeg);
            thumbnail.Width := Image1.Width;
            thumbnail.Height := Image1.Height;
            dest_rect := _scale_to_fit
                ( Rect(0, 0, image_jpeg.Width, image_jpeg.Height)
                , Rect(0, 0, thumbnail.Width, thumbnail.Height));
            thumbnail.Canvas.StretchDraw(dest_rect, image_jpeg);
        finally
            image_jpeg.Free;
        end;
        Image1.Picture.Assign(thumbnail);
    finally
        thumbnail.Free;
    end;
end;


    Calculate a TRect of the same aspect ratio as src scaled down to
    fit inside dest and properly centered

function TfrmGcImage._scale_to_fit(src, dest: TRect): TRect;
var
    dest_width, dest_height: Integer;
    src_width, src_height: Integer;
    margin_lr, margin_tb: Integer;
begin
    dest_width := dest.Right - dest.Left;
    dest_height := dest.Bottom - dest.Top;
    src_width := src.Right - src.Left;
    src_height := src.Bottom - src.Top;


    //Must not allow either to be larger than the page
    if src_width > dest_width then
    begin
        src_height := Trunc(src_height * dest_width / src_width);
        src_width := dest_width;
    end;
    if src_height > dest_height then
    begin
        src_width := Trunc(src_width * dest_height / src_height);
        src_height := dest_height;
    end;

    margin_lr := Trunc( (dest_width - src_width) / 2);
    margin_tb := Trunc( (dest_height - src_height) / 2);

    _scale_to_fit.Left := margin_lr + dest.Left;
    _scale_to_fit.Right := dest.Right - margin_lr;
    _scale_to_fit.Top := margin_tb + dest.Top;
    _scale_to_fit.Bottom := dest.Bottom - margin_tb;
end;


    Take a Jpeg image and resize + compress

procedure TfrmGcImage._proper(var image: TJpegImage; dpi_h, dpi_v: Integer);
var
    scale_h, scale_v: Single;
    bitmap: TBitmap;
begin
    scale_h := dpi / dpi_h;
    scale_v := dpi / dpi_v;

    bitmap := TBitmap.Create;
    try
        bitmap.Width := Trunc(image.Width * scale_h);
        bitmap.Height := Trunc(image.Height * scale_v);
        bitmap.Canvas.StretchDraw
            ( Rect
                ( 0, 0
                , bitmap.Width
                , bitmap.Height)
            , image);
        with image do
        begin
            Assign(bitmap);
            JPEGNeeded();
            CompressionQuality := 75;
            GrayScale := True;
            DIBNeeded();
            Compress();
        end;
    finally
        bitmap.Free;
    end;

end;

procedure TfrmGcImage.Import1Click(Sender: TObject);
var
    blob_stream: TStream;
    image: TJPEGImage;
    dpi_h, dpi_v: Integer;
    open_dialog: TOpenPictureDialog;
    file_name: string;
begin
    if not _initialized then Exit;

    //locate file to import.
    open_dialog := TOpenPictureDialog.Create(Self);
    try
        open_dialog.Filter := GraphicFilter(TJpegImage);
        open_dialog.Title := 'Import';
        if not open_dialog.Execute() then Exit;
        file_name := open_dialog.FileName;
    finally
        open_dialog.Free;
    end;

    image := TJpegImage.Create();
    try
        try
            image.LoadFromFile(file_name);
        except
            ShowMessage(file_name + ' could not be imported.');
            Exit;
        end;
        if not _get_dpi(file_name, dpi_h, dpi_v) then
        begin
            if not _get_dpi_from_user
                ( image.Width, image.Height, dpi_h, dpi_v) then Exit
            else if (dpi_h = 0) or (dpi_v = 0) then Exit;
        end;

        _proper(image, dpi_h, dpi_v);

        //Create a TBlobStream to send image data into the DB
        _query_current_image();
        Query1.Edit;
        blob_stream := Query1.CreateBlobStream
            (Query1.FieldByName('Gcimage') as TBlobField, bmWrite);
        try
            image.SaveToStream(blob_stream);
        finally
            Query1.Post;
            blob_stream.Free;
        end;
    finally
        image.Free;
    end;

    _update_display();
end;

procedure TfrmGcImage.Export1Click(Sender: TObject);
var
    save_dialog: TSavePictureDialog;
    blob_stream: TStream;
    image: TJpegImage;
    file_name: string;
begin
    if not _initialized then Exit;

    //decide where to save the image
    save_dialog := TSavePictureDialog.Create(Self);
    try
        save_dialog.DefaultExt := GraphicExtension(TJpegImage);
        save_dialog.Filter := GraphicFilter(TJpegImage);
        if not save_dialog.Execute() then Exit;
        file_name := save_dialog.FileName;
    finally
        save_dialog.Free;
    end;

    //locate the appropriete image data
    _query_current_image();

    //Create a TBlobStream to send image data into the DB
    Query1.Edit;
    blob_stream := Query1.CreateBlobStream
        ( Query1.FieldByName('Gcimage') as TBlobField
        , bmRead);
    image := TJpegImage.Create();
    try
        image.LoadFromStream(blob_stream);
        image.SaveToFile(file_name);
    finally
        Query1.Post;
        blob_stream.Free;
        image.Free;
    end;
end;

【讨论】：

感谢 Michael 的回复和这么多代码的贡献。最终，我决定采用商业解决方案。 ImageEn 解决了这个问题。

@GMMugford：ImageEn有开源版本，搜索一下。