寻求图形的缩放算法!

Question

效果：
    以某一点作为原点，来缩放。

Answer 1

不是很明白你要做什么，如果是在TImage中的话，只要设置Stretch属性为真，然后改变Image的大小。
如果是别的用途，看看下面的帖子，呵呵

Answer 2

Smoothly Resize a JPEG Image?
{   Before importing an image (jpg) into a database, 
  I would like to resize it (reduce its size) and 
  generate the corresponding smaller file. How can I do this? 
  Load the JPEG into a bitmap, create a new bitmap 
  of the size that you want and pass them both into 
  SmoothResize then save it again ... 
  there's a neat routine JPEGDimensions that 
  gets the JPEG dimensions without actually loading the JPEG into a bitmap, 
  saves loads of time if you only need to test its size before resizing. 
} uses 
  JPEG; type 
  TRGBArray = array[Word] of TRGBTriple; 
  pRGBArray = ^TRGBArray; {--------------------------------------------------------------------------- 
-----------------------} procedure SmoothResize(Src, Dst: TBitmap); 
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; {for} 
      Inc(yP, yP2); 
      DstLine := pRGBArray(Integer(DstLine) + DstGap); 
    end; {for} 
  end; {if} 
end; {SmoothResize} {--------------------------------------------------------------------------- 
-----------------------} function LoadJPEGPictureFile(Bitmap: TBitmap; FilePath, FileName: string): Boolean; 
var 
  JPEGImage: TJPEGImage; 
begin 
  if (FileName = '') then    // No FileName so nothing 
    Result := False  //to load - return False... 
  else 
  begin 
    try  // Start of try except 
      JPEGImage := TJPEGImage.Create;  // Create the JPEG image... try  // now 
      try  // to load the file but 
        JPEGImage.LoadFromFile(FilePath + FileName); 
        // might fail...with an Exception. 
        Bitmap.Assign(JPEGImage); 
        // Assign the image to our bitmap.Result := True; 
        // Got it so return True. 
      finally 
        JPEGImage.Free;  // ...must get rid of the JPEG image. finally 
      end; {try} 
    except 
      Result := False; // Oops...never Loaded, so return False. 
    end; {try} 
  end; {if} 
end; {LoadJPEGPictureFile} 
{--------------------------------------------------------------------------- 
-----------------------} 
function SaveJPEGPictureFile(Bitmap: TBitmap; FilePath, FileName: string; 
  Quality: Integer): Boolean; 
begin 
  Result := True; 
  try 
    if ForceDirectories(FilePath) then 
    begin 
      with TJPegImage.Create do 
      begin 
        try 
          Assign(Bitmap); 
          CompressionQuality := Quality; 
          SaveToFile(FilePath + FileName); 
        finally 
          Free; 
        end; {try} 
      end; {with} 
    end; {if} 
  except 
    raise; 
    Result := False; 
  end; {try} 
end; {SaveJPEGPictureFile} 
{--------------------------------------------------------------------------- 
-----------------------} 
procedure ResizeImage(FileName: string; MaxWidth: Integer); 
var 
  OldBitmap: TBitmap; 
  NewBitmap: TBitmap; 
  aWidth: Integer; 
begin 
  OldBitmap := TBitmap.Create; 
  try 
    if LoadJPEGPictureFile(OldBitmap, ExtractFilePath(FileName), 
      ExtractFileName(FileName)) then 
    begin 
      aWidth := OldBitmap.Width; 
      if (OldBitmap.Width > MaxWidth) then 
      begin 
        aWidth    := MaxWidth; 
        NewBitmap := TBitmap.Create; 
        try 
          NewBitmap.Width  := MaxWidth; 
          NewBitmap.Height := MulDiv(MaxWidth, OldBitmap.Height, OldBitmap.Width); 
          SmoothResize(OldBitmap, NewBitmap); 
          RenameFile(FileName, ChangeFileExt(FileName, '.$$$')); 
          if SaveJPEGPictureFile(NewBitmap, ExtractFilePath(FileName), 
            ExtractFileName(FileName), 75) then 
            DeleteFile(ChangeFileExt(FileName, '.$$$')) 
          else 
            RenameFile(ChangeFileExt(FileName, '.$$$'), FileName); 
        finally 
          NewBitmap.Free; 
        end; {try} 
      end; {if} 
    end; {if} 
  finally 
    OldBitmap.Free; 
  end; {try} 
end; 
{--------------------------------------------------------------------------- 
-----------------------} function JPEGDimensions(Filename : string; var X, Y : Word) : boolean; 
var 
  SegmentPos : Integer; 
  SOIcount : Integer; 
  b : byte; 
begin 
  Result  := False; 
  with TFileStream.Create(Filename, fmOpenRead or fmShareDenyNone) do 
  begin 
    try 
      Position := 0; 
      Read(X, 2); 
      if (X <> $D8FF) then 
        exit; 
      SOIcount  := 0; 
      Position  := 0; 
      while (Position + 7 < Size) do 
      begin 
        Read(b, 1); 
        if (b = $FF) then begin 
          Read(b, 1); 
          if (b = $D8) then 
            inc(SOIcount); 
          if (b = $DA) then 
            break; 
        end; {if} 
      end; {while} 
      if (b <> $DA) then 
        exit; 
      SegmentPos  := -1; 
      Position    := 0; 
      while (Position + 7 < Size) do 
      begin 
        Read(b, 1); 
        if (b = $FF) then 
        begin 
          Read(b, 1); 
          if (b in [$C0, $C1, $C2]) then 
          begin 
            SegmentPos  := Position; 
            dec(SOIcount); 
            if (SOIcount = 0) then 
              break; 
          end; {if} 
        end; {if} 
      end; {while} 
      if (SegmentPos = -1) then 
        exit; 
      if (Position + 7 > Size) then 
        exit; 
      Position := SegmentPos + 3; 
      Read(Y, 2); 
      Read(X, 2); 
      X := Swap(X); 
      Y := Swap(Y); 
      Result  := true; 
    finally 
      Free; 
    end; {try} 
  end; {with} 

Answer 3

procedure ZoomBmp(imagen: TBitmap; dWidth, dHeight: Integer; var des: TBitmap);
var
  ori: TBitmap;
  dispositivo_o, dispositivo_d: HDC;
  pepito: HBitmap;
begin
  ori := Tbitmap.Create;
  des := TBItmap.Create;
  ori.handle := imagen.handle;
  des.width := dWidth;
  des.height := dHeight;
  dispositivo_o := CreateCompatibleDC(0);
  dispositivo_d := CreateCompatibleDC(0);
  SelectObject(dispositivo_o, ori.handle);
  pepito := SelectObject(dispositivo_d, des.handle);
  SetStretchBltMode(dispositivo_d,  STRETCH_HALFTONE);
  StretchBlt(dispositivo_d, 0, 0, dWidth, dHeight, dispositivo_o, 0, 0, ori.width, ori.height, SRCCOPY);
  SelectObject(dispositivo_d, pepito);
  ori.Free;
  DeleteObject(pepito);
 DeleteDC(dispositivo_o);
 DeleteDC(dispositivo_d);
end;