procedure BitmapZoomIn(filepath:string;img:TImage);
const Zoom = 300;
var Bmp,ZBmp:TBitmap;
    ZW,ZH:integer;
begin
  Bmp:=TBitmap.Create;
  Bmp.loadfromfile(filepath);
 
  if Bmp.Width>Bmp.Height then
  begin
    ZW:=Zoom;
    ZH:=Round(Bmp.Height*Zoom/Bmp.Width);
  end
  else
  begin
    ZW:=Round(Bmp.Width*Zoom/Bmp.Height);
    ZH:=Zoom;
  end;
  ZBmp:=TBitmap.Create;
  ZBmp.Height:=ZH;
  Zbmp.Width:=ZW;
 
  //用CopyRect 顏色會怪怪的
  //ZBmp.Canvas.CopyRect(Rect(0,0,ZW,ZH),Bmp.Canvas,Rect(0,0,Bmp.Width,Bmp.Height));
 
  ZBmp.Canvas.StretchDraw(Rect(0, 0, ZW, ZH), Bmp);
 
  img.picture.bitmap.Assign(ZBmp);
 
  ZBmp.Free;
  Bmp.Free;
end;
arrow
arrow
    文章標籤
    Delphi 圖片處理 副程式
    全站熱搜
    創作者介紹
    創作者 抓狂小白 的頭像
    抓狂小白

    抓狂小白的程式筆記

    抓狂小白 發表在 痞客邦 留言(0) 人氣()

    E-mail轉寄