Conversion BMP en JPG en temps réel dans Delphi 7 en utilisant Paradox

Question

Recherche ici et chez Code News Rapide, je n'ai rien vu sur mon problème. J'ai une application où une image du client (un JvDBImage) est acquise à travers le presse-papiers à partir d'un programme de prise de vue tiers lorsque l'utilisateur clique sur un bouton dans mon application pour le charger. (PhotoImage.PasteFromClipboard). Cela charge et enregistre l'image sous forme de bitmap ... parfois un gros BMP. Donc, j'ai besoin de quelque chose qui fera l'économie et le chargement d'un fichier JPG.

J'ai essayé: .. utilise Jpeg

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

qui ne compile pas, puisque l'attribution est de deux types différents. J'ai aussi passé du temps à travailler sur le presse-papiers, essayant de l'intégrer dans un TMemoryStream sans succès. Mon prochain essai est de l'enregistrer temporairement dans un fichier, puis de le récupérer au format JPG, mais ce sera lent et je ne suis pas sûr que ce que j'essaie de faire soit possible. Donc, plutôt que de descendre une autre allée, j'ai pensé que je posterais la question ici.

La base de données en question possède un champ mémo (1) appelé Photo, auquel PhotoImage est connecté.

Answer 1

This page au moins montre comment convertir le contenu du presse-papiers au format 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; 

Ce code est tout à fait incomplet et je ne suis pas sûr que ce soit correct, mais les méthodes utilisées doivent être juste et shouldn » t être si difficile à corriger (cf_BitMap devrait être un HBITMAP, par exemple, et vous n'aurez pas besoin de la ligne "CopyToClipboardBitmap" car vous semblez y avoir déjà stocké les données). Vous devriez également jeter un oeil à la classe TJPEGImage pour définir la qualité d'image et d'autres paramètres à des valeurs qui répondent à vos besoins.

Si vous voulez faire cela en temps réel pour les grandes images, cependant, vous devriez mieux chercher une bibliothèque JPG que vous pouvez utiliser. Il pourrait y en avoir qui fonctionnent mieux que les routines Delphi.

Answer 2

Voici un extrait d'un code que j'ai écrit il y a quelques années pour gérer des images JPEG. Il démontre le chargement et l'enregistrement des fichiers jpeg, le stockage et la récupération des données jpeg à partir d'un champ blob, et la conversion entre jpeg et bmp.

La procédure '_proper' illustre la recompression d'une image en passant de JPEG -> BMP -> JPEG. La procédure '_update_display' montre comment dessiner un TJpegImage sur une toile afin que l'utilisateur puisse le voir.

//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;