I have a neat program that can picks a JPG file, converts JPG to BMP and back and resize it at will too. The trick is that you can resize as a BMP, but save back as a JPG
Can email the rest of the project, but here is the main unit to show its not hard to do... This program zooms a bevel in and out to show the size of the image will be when resized, but does not actually resize until you click resize now, as the image would lose quality by being continuously resized. Its all done by about 4 lines in the ResizeNow procedure John Code unit TestJpeg1; //ideas from //http://www.delphi3000.com/articles/article_4399.asp?SK= //(compression) //and //http://www/efg2.com/Lab/Library/UseNet/200/0803a.txt //re using Stretchdraw and Rect //#### BMPIn and JPGIn need to be Free'd 30/10/2008 interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, FindFile, ExtCtrls, JPEG; type TForm1 = class(TForm) FindFile1: TFindFile; ListBox1: TListBox; edtPath: TEdit; Label1: TLabel; Label2: TLabel; lblFilename: TLabel; Label4: TLabel; edtFileOut: TEdit; ImageIn: TImage; btnFind: TButton; Label5: TLabel; lblWidthHeight: TLabel; Label3: TLabel; Label6: TLabel; edtWidthOut: TEdit; edtHeightOut: TEdit; ImageOut: TImage; btnMinus20: TButton; btnPlus20: TButton; btnResize: TButton; btnSave: TButton; lblStatus: TLabel; Label7: TLabel; Label8: TLabel; Bevel1: TBevel; procedure btnFindClick(Sender: TObject); procedure ListBox1DblClick(Sender: TObject); procedure btnMinus20Click(Sender: TObject); procedure btnPlus20Click(Sender: TObject); procedure btnResizeClick(Sender: TObject); procedure btnSaveClick(Sender: TObject); private procedure SetJPGCompression(ACompression: integer; const AInFile, AOutFile: string); procedure ShowSizeOut; procedure ResizeNow; { Private declarations } public { Public declarations } end; var Form1: TForm1; FileList:TStringList; FileIn,FileOut:String; JPGIn : TJPegImage; BMPIn : TBitMap; JPGOut : TJPegImage; BMPOut : TBitMap; WidthOut,HeightOut:Integer; ZoomUpDown:integer; //counter number times zoomed up (+) or down (-) implementation {$R *.dfm} procedure TForm1.btnMinus20Click(Sender: TObject); begin HeightOut:=(HeightOut * 100) div 120; WidthOut:=(WidthOut * 100) div 120; ZoomUpDown:=ZoomUpDown-1; if(Zoomupdown=0) then begin WidthOut:=JPGIn.Width; //original sizes - avoid rounding errors HeightOut:=JPGIn.Height; //original sizes - avoid rounding errors end; ShowSizeOut; // ResizeNow; //this slows down clicking of course... end; procedure TForm1.ShowSizeOut; begin edtWidthOut.text:=inttostr(WidthOut); edtHeightOut.text:=inttostr(HeightOut); bevel1.top:=ImageOut.top; bevel1.Left:=ImageOut.left; bevel1.width:=WidthOut; bevel1.Height:=HeightOut; Application.ProcessMessages; end; procedure TForm1.btnPlus20Click(Sender: TObject); begin HeightOut:=(HeightOut * 120) div 100; WidthOut:=(WidthOut * 120) div 100; ZoomUpDown:=ZoomUpDown+1; if(Zoomupdown=0) then begin WidthOut:=JPGIn.Width; //original sizes - avoid rounding errors HeightOut:=JPGIn.Height; //original sizes - avoid rounding errors end; ShowSizeOut; // ResizeNow; //this slows down clicking of course... end; procedure TForm1.btnResizeClick(Sender: TObject); begin ResizeNow; end; procedure TForm1.ResizeNow; begin //have to do from BMP //Get fresh from original JPG each time to prevent degrading JPGOut:=JPGIn; BMPOut.Width:=WidthOut; BMPOut.Height:=HeightOut; BMPOut.Canvas.Stretchdraw(Rect(0,0,WidthOut,HeightOut),JPGOut); //reshow image now lblStatus.Caption:='intermediate BMP - wait...'; ImageOut.Picture.Assign(BMPOut); ShowSizeOut; sleep(1000); JPGOut.Free; JPGOut := TJPEGImage.Create; JPGOut.Assign(BMPOut); lblStatus.Caption:='Final JPG:'+inttostr(JPGOut.Width)+'x'+inttostr(JPGOut.Height); BMPOut.Assign(JPGOut); ImageOut.Picture.Assign(BMPOut); ShowSizeOut; end; procedure TForm1.btnSaveClick(Sender: TObject); begin JPGOut.SavetoFile(FileOut); ShowMessage('File Saved - Click Find again to see in list'); end; procedure TForm1.btnFindClick(Sender: TObject); begin FindFile1.InSubFolders:=true; Findfile1.Path:=edtPath.text; FindFile1.FileMask:='*.JP*'; FileList:=FindFile1.SearchForFiles; ListBox1.items:=FileList; Application.ProcessMessages; end; procedure TForm1.ListBox1DblClick(Sender: TObject); var dotpos:integer; rszpos:Integer; begin FileIn:=listbox1.Items[Listbox1.ItemIndex]; lblFilename.caption:=FileIn; dotpos:=ansipos('.',FileIn); rszpos:=ansipos('Rsz.',FileIn); if RszPos>0 then FileOut:=FileIn; //keep same name if (dotpos>0) and (RszPos<=0) then FileOut:= copy(FileIn,1,dotpos-1)+'Rsz'+copy(FileIn,DotPos,5); // Create Jpeg and Bmp work classes JPGIn := TJPegImage.Create; JPGIn.LoadFromFile(FileIn); BMPIn := TBitMap.Create; BMPIn.Assign(JPGIn); ImageIn.Picture.Assign(BMPIn); lblWidthHeight.Caption:=inttostr(JPGin.Width)+'x'+inttostr(JPGIn.Height); JPGOut := TJPegImage.Create; JPGOut:=JPGIn; BMPOut := TBitMap.Create; BMPOut.Assign(JPGOut); ImageOut.Picture.Assign(BMPOut); edtFileOut.text:=FileOut; WidthOut:=JPGOut.Width; HeightOut:=JPGOut.Height; ShowSizeOut; ZoomUpDown:=0; label7.Caption:='(frame='+inttostr(ImageIn.Width)+'x'+inttostr(ImageIn.Height)+')'; label8.Caption:='(frame='+inttostr(ImageOut.Width)+'x'+inttostr(ImageOut.Height)+')'; end; //http://www.delphi3000.com/articles/article_4399.asp?SK= // ==================================================== // Set the compression quality of a JPEG image // This will alter the quality vs size ratio // ==================================================== //(Note this code is not used for resize) procedure TForm1.SetJPGCompression(ACompression : integer; const AInFile : string; const AOutFile : string); var iCompression : integer; oJPG : TJPegImage; oBMP : TBitMap; begin // Force Compression to range 1..100 iCompression := abs(ACompression); if iCompression = 0 then iCompression := 1; if iCompression > 100 then iCompression := 100; // Create Jpeg and Bmp work classes oJPG := TJPegImage.Create; oJPG.LoadFromFile(AInFile); oBMP := TBitMap.Create; oBMP.Assign(oJPG); // Do the Compression and Save New File oJPG.CompressionQuality := iCompression; oJPG.Compress; oJPG.SaveToFile(AOutFile); // Clean Up oJPG.Free; oBMP.Free; end; end. 1) open and dipslay Gif, jpg, and png image formats. 2) Resize the above file format 3) Save file back in resized format. Does anyone have or recommend any code for doing such? I have seen GraphixEx but it states it does not support saving of images. Cheers Rob _______________________________________________ NZ Borland Developers Group - Delphi mailing list
_______________________________________________ NZ Borland Developers Group - Delphi mailing list Post: delphi@delphi.org.nz Admin: http://delphi.org.nz/mailman/listinfo/delphi Unsubscribe: send an email to delphi-requ...@delphi.org.nz with Subject: unsubscribe
