使用 Paradox 在 Delphi 7 中实时将 BMP 转换为 JPG

发布于 2024-07-24 23:43:47 字数 682 浏览 8 评论 0原文

在这里和 Code News Fast 进行研究,我没有看到任何与我的问题相关的内容。 我有一个应用程序,当用户单击我的应用程序中的按钮进行加载时,会通过剪贴板从第三方拍照程序获取客户图片(JvDBImage)。 (照片图像.PasteFromClipboard)。 这会将图像加载并保存为位图……有时是一个大 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 连接到该字段。

Researching here and at Code News Fast, I've seen nothing on point to my problem. I have an app where a customer picture (a JvDBImage) is acquired through the clipboard from a third-party picture-taking program when the user clicks a button in my app to load it. (PhotoImage.PasteFromClipboard). That loads and saves the image as a bitmap ... sometimes a BIG BMP. So, I need something that will make the saving and loading a JPG.

I tried: .. uses JPeg

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

Which won't compile, since the assignation is of two different types. I also spent some time working on the clipboard, trying to get it into a TMemoryStream without success.

My next try is to save it temporarily to a file and then retrieve it as a JPG, but that will be slow and I'm not sure what I'm trying to do is possible. So, rather than head down another alley, I thought I'd post the question here.

The database in question has a memo(1) field called Photo, which PhotoImage is connected to.

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(2

海之角 2024-07-31 23:43:47

此页面至少显示了如何将剪贴板内容转换为 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 例程更好。

This page at least shows how to convert the clipboard content to 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;

This code is quite incomplete and I'm not sure if it's correct, but the methods used should be right and it shouldn't be that hard to correct (cf_BitMap should be a HBITMAP, for example, and you won't need the "CopyToClipboardBitmap" line as you seem to already have the data stored there).
You should also have a look at the TJPEGImage class to set image quality and other parameters to values that suit your needs.

If you want to do this in realtime for big images, however, you should better look for some JPG library you can use. There could be some that perform better than the Delphi routines.

久随 2024-07-31 23:43:47

以下是我几年前编写的一些用于处理 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;

Here's an excerpt of some code I wrote a few years ago to handle JPEG images. It demonstrates loading and saving jpeg files, storing and retrieving jpeg data from a blob field, and converting between jpeg and bmp.

The '_proper' procedure demonstrates re-compressing an image by going from JPEG -> BMP -> JPEG. The '_update_display' procedure demonstrates how to draw a TJpegImage on a canvas so the user can see it.

//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;
~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文