Realtime BMP to JPG conversion in Delphi 7 using Paradox

Question

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.

Answer 1

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.

Answer 2

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;