Вот фрагмент кода, который я написал несколько лет назад для обработки изображений JPEG. Он демонстрирует загрузку и сохранение файлов JPEG, хранение и извлечение данных JPEG из поля BLOB-объектов, а также преобразование между 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;