在Delphi 7中使用Paradox實時BMP到JPG轉換

Question

在這裏和代碼新聞快速研究，我沒有看到任何關於我的問題。我有一個應用程序，當用戶點擊我的應用程序中的按鈕加載它時，通過剪貼板從第三方圖片獲取程序獲取客戶圖片（JvDBImage）。 （PhotoImage.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的備忘錄（1）字段，該PhotoImage已連接到該字段。

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

此代碼是相當不完整的，我不知道這是否是正確的，但使用的方法應該是正確的，它不該」 t很難糾正（例如，cf_BitMap應該是HBITMAP，並且您不需要「CopyToClipboardBitmap」這一行，因爲您似乎已經將數據存儲在那裏）。 您還應該查看TJPEGImage類，以將圖像質量和其他參數設置爲適合您需要的值。

但是，如果您想對大圖像實時進行此操作，最好還是尋找一些可以使用的JPG庫。可能有一些比Delphi例程執行得更好。

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