【问题标题】:Realtime BMP to JPG conversion in Delphi 7 using ParadoxDelphi 7 中使用 Paradox 实时 BMP 到 JPG 转换
【发布时间】: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 连接到该字段。

【问题讨论】:

    标签: image delphi clipboard jpeg bmp


    【解决方案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有开源版本,搜索一下。
    猜你喜欢
    • 2012-04-03
    • 2011-10-16
    • 1970-01-01
    • 2012-12-26
    • 2012-01-24
    • 1970-01-01
    • 2015-05-10
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多