• 0

Delphi help - Resize BMP


Question

Hello, I'm having a bit of trouble trying to resize an image (BMP) in borland delphi 7.

The program I'm working on is part of our ID Card system where people can have their photographs taken and placed on an ID card.

When this program was created, people were meant to use one of our webcams, but now we let people upload theirt images from remote locations for processing.

Because of this, a problem has arisen where people are using their megapixel digital cameras and our software cant deal with images that are outside of a certain spec size (depending on the company and ID card).

I've managed to scale the image preview on screen, but now our selection rectangle is too small to grab their faces from the images sent to us. This means that I have to resize the image in a program such as Paint Shop Pro or Photoshop.

Now, this is causing headfaches, because alot of calculations are required to make sure the person's face isnt stretched or skewed.

My plan is to somehow resize the bitmap image in the code, or even take the scaled image and save it to a temporary bitmap which then will be imported to the program.

I've searched the net, and found some controls and libraries, but these are expensive for what they are

Any ideas?

I'm not sure if I'm being too vague in this descriprtion, so feel free to ask for any more details. All I'm looking for is a few ideas or to be pointed in the right direction.

Regards.

Edited by ElectricDemon
Link to comment
Share on other sites

1 answer to this question

Recommended Posts

  • 0

what you could do is when the image is imported, show a window with the image on and you then tell the app where the face is. so basicly do an onMouseDown on the TImage and take the coordinates. then onMouseUp and take the coordinates. then copyrect to a new image and use the following code to give a nice resize.

uses Windows, SysUtils, Graphics;

procedure ResizeImage(Src, Dst: TBitmap);
type
  TRGBArray = array[Word] of TRGBTriple;
  pRGBArray = ^TRGBArray;

var
  x, y: Integer;
  xP, yP: Integer;
  xP2, yP2: Integer;
  SrcLine1, SrcLine2: pRGBArray;
  t3: Integer;
  z, z2, iz2: Integer;
  DstLine: pRGBArray;
  DstGap: Integer;
  w1, w2, w3, w4: Integer;
begin
  Src.PixelFormat := pf24Bit;
  Dst.PixelFormat := pf24Bit;

  if (Src.Width = Dst.Width) and (Src.Height = Dst.Height) then
    Dst.Assign(Src)
  else
  begin
    DstLine := Dst.ScanLine[0];
    DstGap  := Integer(Dst.ScanLine[1]) - Integer(DstLine);

    xP2 := MulDiv(pred(Src.Width), $10000, Dst.Width);
    yP2 := MulDiv(pred(Src.Height), $10000, Dst.Height);
    yP  := 0;

    for y := 0 to pred(Dst.Height) do
    begin
      xP := 0;

      SrcLine1 := Src.ScanLine[yP shr 16];

      if (yP shr 16 < pred(Src.Height)) then
        SrcLine2 := Src.ScanLine[succ(yP shr 16)]
      else
        SrcLine2 := Src.ScanLine[yP shr 16];

      z2  := succ(yP and $FFFF);
      iz2 := succ((not yp) and $FFFF);
      for x := 0 to pred(Dst.Width) do
      begin
        t3 := xP shr 16;
        z  := xP and $FFFF;
        w2 := MulDiv(z, iz2, $10000);
        w1 := iz2 - w2;
        w4 := MulDiv(z, z2, $10000);
        w3 := z2 - w4;
        DstLine[x].rgbtRed := (SrcLine1[t3].rgbtRed * w1 +
          SrcLine1[t3 + 1].rgbtRed * w2 +
          SrcLine2[t3].rgbtRed * w3 + SrcLine2[t3 + 1].rgbtRed * w4) shr 16;
        DstLine[x].rgbtGreen :=
          (SrcLine1[t3].rgbtGreen * w1 + SrcLine1[t3 + 1].rgbtGreen * w2 +

          SrcLine2[t3].rgbtGreen * w3 + SrcLine2[t3 + 1].rgbtGreen * w4) shr 16;
        DstLine[x].rgbtBlue := (SrcLine1[t3].rgbtBlue * w1 +
          SrcLine1[t3 + 1].rgbtBlue * w2 +
          SrcLine2[t3].rgbtBlue * w3 +
          SrcLine2[t3 + 1].rgbtBlue * w4) shr 16;
        Inc(xP, xP2);
      end;
      Inc(yP, yP2);
      DstLine := pRGBArray(Integer(DstLine) + DstGap);
    end;
  end;
end;

hope that helped :)

Link to comment
Share on other sites

This topic is now closed to further replies.
  • Recently Browsing   0 members

    • No registered users viewing this page.