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