[DUG] Image manipulation

[John Bird]

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
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://listserver.123.net.nz/pipermail/delphi/attachments/20091013/dee00300/attachment.html