Mega Code Archive
Optimise a dbimage fields and free space on the disk
<![CDATA[
Title: optimise a dbimage fields and free space on the disk
Question: how to reduce the size of dbimage and optimise the dbimage fields
or graphic field.
Answer:
we know that after scanning a photo and save it in a dataset the place assigned
on the disk depend of the size of the image and on the parametres of scanning way, so if we have to scan n photos we have to optimise and reduce the size of photos stored in the dataset.
this a unit of my project
{ this project is for optimise the blob fields as photos
after execute this project you will pack the table}
//***************************************************
// before you have to create a form
// dbnavigator1
// dbimage1 with the specified field to optimise
// image1
// datamodule2 unit
// gauge1
// SpeedButton1
//***************************************************
unit optimise;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Buttons, Mask,ComCtrls,DBCtrls,jpeg, Gauges;
type
TFoptimise = class(TForm)
SpeedButton1: TSpeedButton;
Gauge1: TGauge;
Image2: TImage;
DBImage1: TDBImage;
DBNavigator1: TDBNavigator;
procedure FormShow(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Foptimise: TFoptimise;
implementation
uses Unit2;
//unit2 is datamodule2 unit
{$R *.DFM}
function resizeImage(sInImage, sOutImage: string; iHeight, iWidth: integer): boolean;
var
JpgImg : TJpegImage;
BmpImg : TBitmap;
Rectangle: TRect;
begin
try
JpgImg := TJpegImage.Create;
BmpImg := TBitmap.Create;
JpgImg.LoadFromFile(sInImage);
Rectangle := Rect(0, 0, iWidth, iHeight);
with BmpImg do
begin
Width := iWidth;
Height := iHeight;
Canvas.StretchDraw(Rectangle, JpgImg);
end;
finally
JpgImg.Assign(BmpImg);
JpgImg.SaveToFile(sOutImage);
JpgImg.Free;
BmpImg.Free;
end;
Result := True;
end;
Function ConvertJpegToBmp(imgJpeg : TJPEGImage; Var imgBmp : TBitMap) : Boolean;
// Converti une image Jpeg en BMP
begin
Result:=True;
try
ImgBMP.Width := ImgJPEG.Width; // dtermination de la taille de ImgBmp
ImgBMP.Height := ImgJPEG.Height;
ImgBMP.Canvas.Draw(0,0,ImgJPEG); // On dessine de ImgJPEG dans ImgBmp
Except
On E:Exception do Result:=False;
end;
end;
Function FileConvertJpegToBmp(JpegFile,BmpFile : String) : Boolean;
// Converti un fichier Jpeg en fichier BMP
var
ImgJPEG : TJPEGImage;
ImgBmp : TBitmap;
begin
Result:=False;
try
try
ImgJPEG := TJPEGImage.Create;
ImgBmp := TBitmap.Create;
ImgJPEG.LoadFromFile(JpegFile); // chargement du JPEG partir d'un fichier
if ConvertJpegToBmp(ImgJPEG,ImgBmp) then
begin
ImgBmp.SaveToFile(BmpFile); // Sauvegarde de ImgBmp sous fichier
Result:=True;
end;
Except
On E:Exception do ;
end;
finally
ImgJPEG.Free;
ImgBmp.Free;
end;
end;
procedure TFoptimise.FormShow(Sender: TObject);
begin
datamodule2.Table1.open;
end;
procedure TFoptimise.SpeedButton1Click(Sender: TObject);
var
Imgbmp:TBitMap;
jpgImg2: TJPEGImage;
MyFormat:word;
Bitmap : TBitMap;
AData,APalette : THandle;
photo1,photo2,photo3,photo4:string;
begin
image2.Visible:=True;
gauge1.Visible:=True;
gauge1.MaxValue:=DataModule2.table1.RecordCount;
gauge1.Progress:=0;
DataModule2.table1.First;
photo1:=datamodule2.Session1.NetFileDir+'\constphoto.bmp';
photo2:=datamodule2.Session1.NetFileDir+'\constphoto.jpg';
photo3:=datamodule2.Session1.NetFileDir+'\constphoto3.jpg';
photo4:=datamodule2.Session1.NetFileDir+'\constphoto5.jpg';
while not (datamodule2.Table1.eof) do
begin
gauge1.Progress:=gauge1.Progress+1;
if not((Datamodule2.Table1photo.BlobSize=0) or (Datamodule2.Table1photo.isnull)) then
begin
dbimage1.Picture.SaveToFile(photo1);
image2.picture.LoadFromFile(photo1);
Image2.Refresh;
//conversion BMP -JPG
jpgImg2 := TJPEGImage.Create;
jpgImg2.Assign(Image2.Picture.Bitmap);
jpgImg2.SaveToFile(photo2);
//RESIZE
resizeImage(photo2,photo3,128,128);
image2.picture.LoadFromFile(photo3);
datamodule2.Table1.edit;
FileConvertJpegToBmp(photo3,photo4);
dbimage1.picture.Bitmap.LoadFromFile(photo4);
datamodule2.Table1.post;
deletefile(photo4);
end;
Datamodule2.table1.next;
end;
gauge1.Visible:=false;
image2.Visible:=False;
end;
procedure TFoptimise.FormClose(Sender: TObject; var Action: TCloseAction);
begin
datamodule2.Table1.close;
end;
end.
// after try to pack the dataset table.
]]>