Board index » delphi » Newbie: Image Resizing

Newbie: Image Resizing

Hi,
    Ok I'm trying to get a program I'm writing to resize images...

The images are not actually used by the program in the sense they are
not loaded. Basically what I want to do is:

Select a file from a directory With a TOpenDialog etc.
then resize it to a set size (i.e.) Largest side 500 pixels
then save it back as a smaller image

so::
Point to file Original.jpg
Resize Image
Save as Original_thumb.jpg

any ideas would be most welcome

Thanks in Advance
Tracy

 

Re:Newbie: Image Resizing


This is how you resize an image

Lets say you hae an image 600X400 pixels

The pixture could be stored an an array like this
pic : array[0..ImageX,0..ImageY] of TColor;

ImageX is the actual size in X... 600.
ImageY is the actual size in Y... 400.

Example...
You want to show this picture in 300X200, exacty the half.

procedure showpicture(SizeX,SizeY);

var
    tx,ty    : word;
    Zx,Zy    : real,

begin
  // calc. scale factor.
  Zx:=ImageX/SizeX;
  Zy:=ImageY/SizeY;

  for ty:=0 to SizeY do
    for tx:=0 to SizeX do
     Putpixel( Tx,Ty,Pic[Tx*Zx,Ty*Zy] );
end;

Offcourse you cannot use 'putpixel' but you know can easily rewrite this to
your own code.

--
Regards
Ingolf

"Tracy The Tease" <nos...@myserver.tnx> wrote in message
news:7esmitc14b9ccmat8280246ubo2rht8okj@4ax.com...

Quote
> Hi,
>     Ok I'm trying to get a program I'm writing to resize images...

> The images are not actually used by the program in the sense they are
> not loaded. Basically what I want to do is:

> Select a file from a directory With a TOpenDialog etc.
> then resize it to a set size (i.e.) Largest side 500 pixels
> then save it back as a smaller image

> so::
> Point to file Original.jpg
> Resize Image
> Save as Original_thumb.jpg

> any ideas would be most welcome

> Thanks in Advance
> Tracy

Re:Newbie: Image Resizing


unit grafix;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics;

type
  TGrafixKind = (gkBMP, gkJPEG, gkMetaFile, gkICO, gkUnknown);

  function LoadGrafixFileBmp(const sFileName: string; bmp: TBitmap):
boolean;
  function SaveGrafixFileBmp(const sFileName: string; bmp: TBitmap):
boolean;

  procedure ResizeBmp(Bmp: TBitmap; NewWidth, NewHeight: integer;
                      MaintainAspect, Crop: boolean);

implementation
uses JPEG, ShellAPI;

function Grafix_Kind(const F: string): TGrafixKind;
var
  ext : string;
begin
  ext := LowerCase(ExtractFileExt(F));
  if ext = '.bmp' then result := gkBMP
    else if (ext = '.jpg') or (ext = '.jpeg') then result := gkJPEG
      else if (ext = '.wmf') or (ext = '.emf') then result := gkMetaFile
        else if (ext = '.ico') then result := gkICO
          else result := gkUnknown;
end;

function LoadGrafixFileBmp(const sFileName: string; bmp: TBitmap):
boolean;
var
  Icon     :  TIcon;
  JPEGImage:  TJPEGImage;
  Metafile :  TMetafile;
  bmpBuffer:  TBitmap;
begin
  result := false;
  if (bmp = nil) then exit;

  if   FileExists(sFilename)
  then begin
    case Grafix_Kind(sFilename) of
      gkBMP:      begin
                    bmpBuffer := TBitmap.Create;
                    try
                      bmpBuffer.LoadFromFile(sFileName);
                      bmp.Height      := bmpBuffer.Height;
                      bmp.Width       := bmpBuffer.Width;
                      bmp.PixelFormat := pf24bit;
                      bmp.Canvas.Draw(0,0, bmpBuffer);
                      result := true;
                    finally
                      bmpBuffer.Free;
                    end;
                  end;

      gkJPEG:     begin
                    JPEGImage := TJPEGImage.Create;
                    try
                      JPEGImage.LoadFromFile(sFilename);
                      bmp.Height      := JPEGImage.Height;
                      bmp.Width       := JPEGImage.Width;
                      bmp.PixelFormat := pf24bit;
                      bmp.Canvas.Draw(0,0, JPEGImage);
                      result := true;
                    finally
                      JPEGImage.Free
                    end;
                  end;

      gkMetaFile: begin
                    Metafile := TMetafile.Create;
                    try
                      Metafile.LoadFromFile(sFilename);
                      bmp.Height      := Metafile.Height;
                      bmp.Width       := Metafile.Width;
                      bmp.PixelFormat := pf24bit;
                      bmp.Canvas.Draw(0,0, Metafile);
                      result := true;
                    finally
                      Metafile.Free
                    end;
                  end;

      gkICO:      begin
                    Icon := TIcon.Create;
                    try
                      Icon.LoadFromFile(sFilename);
                      bmp.Height      := Icon.Height;
                      bmp.Width       := Icon.Width;
                      bmp.PixelFormat := pf24bit;
                      bmp.Canvas.Draw(0,0, Icon);
                      result := true;
                    finally
                      Icon.Free
                    end;
                  end;
      gkUnknown: ;
    end;
  end;
end;

function TempPathStr(Backslash: boolean): string;
var
  d : array[0..MAX_PATH]of char;
begin
  result := '';
  if GetTempPath(MAX_PATH, @d[0]) > 0 then begin
    result := d;
    if BackSlash and (result[Length(result)] <> '\') then
      result := result +'\';
  end;
end;

function tmpBmpFilename: string;
var
  i, iMax : integer;
  sPath, f : string;
begin
  result := '';

  sPath := TempPathStr(true);
  if sPath = '' then begin
    sPath := ExtractFilePath(ParamStr(0));
    if sPath[Length(sPath)] <> '\' then sPath := sPath +'\';
  end;

  iMax := 50;

  i := 1;
  f := IntToHex(i *iMax,8);
  while (i <= iMax) and FileExists(sPath +f +'.bmp') do begin
    Inc(i); //!
    f := IntToHex(i *iMax,8);
  end;

  if not FileExists(sPath +f +'.bmp') then
    result := sPath +f +'.bmp';
end;

function SaveGrafixFileBmp(const sFileName: string; bmp: TBitmap):
boolean;
var
  Icon     :  TIcon;
  JPEGImage:  TJPEGImage;
  Metafile :  TMetafile;
  tmpF     :  string;
begin
  result := false;
  if (bmp = nil) then exit;

  case Grafix_Kind(sFilename) of
    gkBMP:      begin
                  bmp.SaveToFile(sFilename);
                  result := true;
                end;

    gkJPEG:     begin
                  JPEGImage := TJPEGImage.Create;
                  try
                    JPEGImage.Assign(bmp);
                    JPEGImage.SaveToFile(sFilename);
                    result := true;
                  finally
                    JPEGImage.Free
                  end;
                end;

    gkMetaFile: begin
                  Metafile := TMetafile.Create;
                  try
                    MetaFile.Width := bmp.Width;
                    MetaFile.Height := bmp.Height;
                    with TMetaFileCanvas.Create(MetaFile,0) do begin
                      Draw(0,0,bmp);
                      Free;
                    end;
                    Metafile.SaveToFile(sFilename);
                    result := true;
                  finally
                    Metafile.Free
                  end;
                end;

    gkICO:      begin
                  tmpF := tmpBmpFilename;
                  if tmpF <> '' then begin
                    bmp.SaveToFile(tmpF);
                    try
                      Icon := TIcon.Create;
                      try
                        Icon.Handle := ExtractIcon(hInstance,
PChar(tmpF), 0);
                        if Icon.Handle > 1 then begin
                          Icon.SaveToFile(sFilename);
                          result := true;
                        end;
                      finally
                        Icon.Free
                      end;
                    finally
                      DeleteFile(tmpF);
                    end;
                  end;
                end;
    gkUnknown: ;
  end;
end;

procedure ResizeBmp(Bmp: TBitmap; NewWidth, NewHeight: integer;
                    MaintainAspect, Crop: boolean);
var
  iHalf,
  iHeight,
  iWidth     :  integer;
  bmpBuffer :  TBitmap;
  Rct       :  TRect;
begin
  if (Bmp = nil) or (NewWidth < 1) or (NewHeight < 1) then exit;

  bmpBuffer := TBitmap.Create;
  try
    bmpBuffer.Width  := NewWidth;
    bmpBuffer.Height := NewHeight;
    bmpBuffer.PixelFormat := Bmp.PixelFormat;
    bmpBuffer.Canvas.Brush.Color := clWhite;
    bmpBuffer.Canvas.FillRect(bmpBuffer.Canvas.ClipRect);

    Rct := Rect(0,0,NewWidth,NewHeight);

    if MaintainAspect then begin
      // adapted from EFGs Computer Lab
      //          http://homepages.borland.com/efg2lab/index.html

      // "equality" (=) case can go either way in this comparison

      IF   Bmp.Width / Bmp.Height  <  NewWidth / NewHeight THEN BEGIN

        // Stretch Height to match.
        Rct.Top    := 0;
        Rct.Bottom := NewHeight;

        // Adjust and center Width.
        iWidth := MulDiv(NewHeight, Bmp.Width, Bmp.Height);
        iHalf := (NewWidth - iWidth) DIV 2;

        Rct.Left  := iHalf;
        Rct.Right := Rct.Left + iWidth;
      END ELSE BEGIN
        // Stretch Width to match.
        Rct.Left    := 0;
        Rct.Right   := NewWidth;

        // Adjust and center Height.
        iHeight := MulDiv(NewWidth, Bmp.Height, Bmp.Width);
        iHalf := (NewHeight - iHeight) DIV 2;

        Rct.Top    := iHalf;
        Rct.Bottom := Rct.Top + iHeight
      END;
    end;

    if Crop then begin
      iWidth := Rct.Right -Rct.Left;
      iHeight := Rct.Bottom -Rct.Top;

      if iWidth < bmpBuffer.Width then bmpBuffer.Width := iWidth;
      if iHeight < bmpBuffer.Height then bmpBuffer.Height := iHeight;
      Rct := Rect(0,0,bmpBuffer.Width,bmpBuffer.Height);
    end;

    bmpBuffer.Canvas.StretchDraw(Rct, Bmp);
    Bmp.Assign(bmpBuffer);
  finally
    bmpBuffer.Free
  end;
end;

end. {grafix unit}

// Example...

uses
  Grafix; // add to forms uses

var
  bmp : TBitmap;
begin
  bmp := TBitmap.Create;
  try
    if LoadGrafixFileBmp('C:\Original.jpg', bmp) then begin
      ResizeBmp(bmp, 500, 500, true, true);
      SaveGrafixFileBmp('C:\Original_thumb.jpg', bmp);
    end;
  finally
    bmp.Free;
  end;
end;

Quote
Tracy The Tease wrote:

> Hi,
>     Ok I'm trying to get a program I'm writing to resize images...

> The images are not actually used by the program in the sense they are
> not loaded. Basically what I want to do is:

> Select a file from a directory With a TOpenDialog etc.
> then resize it to a set size (i.e.) Largest side 500 pixels
> then save it back as a smaller image

> so::
> Point to file Original.jpg
> Resize Image
> Save as Original_thumb.jpg

> any ideas would be most welcome

> Thanks in Advance
> Tracy

Re:Newbie: Image Resizing


Thank you very much Chris

Other Threads