Delphi 7 图片处理问题

[roclegned]

用D7做图片拉伸的，拉伸前后图片上文字失真

QQ截图如下：
拉伸前


拉伸后


问题四周出现像素丢失和阴影
拉伸代码如下：

var
  bmpSrc, bmpDes: TBitmap;
  i: Integer;
  sPic, sPicSava, sTmpPath, ExFileName, sEx: string;
  pf: TPixelFormat;
begin
  if FFileListSrc.Count = 0 then
  begin
    ShowMessage('重新载入源图片');
    Exit;
  end;
  bmpSrc := TBitmap.Create;
  bmpDes := TBitmap.Create;
//  pf := bmpSrc.PixelFormat;
  try
    sTmpPath :=  ExcludeTrailingPathDelimiter(edt2.Text);
    for i:= 0 to FFileListSrc.Count - 1 do
    begin
      sPic := FFileListSrc.Strings[i];
      ExFileName := ExtractFileName(sPic);
      sEx := ExtractFileExt(ExFileName);
      if (sEx <> '.BMP') and (sEx <> '.JPG') then Continue;
      sPicSava := sTmpPath;
      sPicSava := sPicSava + '\' + ExFileName;
      bmpSrc.LoadFromFile(sPic);
      bmpDes.Width := Round(bmpSrc.Width * (StrToInt(edt3.Text)/100));
      bmpDes.Height := Round(bmpSrc.Height * (StrToInt(edt4.Text)/100));
//      bmpDes.PixelFormat := pf;
//      bmpSrc.PixelFormat := pf;
      SetStretchBltMode(bmpDes.Canvas.Handle, HALFTONE);
      StretchBlt(bmpDes.Canvas.Handle, 0, 0, bmpDes.Width, bmpDes.Height,
                 bmpSrc.Canvas.Handle, 0, 0, bmpSrc.Width, bmpSrc.Height, SRCCOPY);
      bmpDes.SaveToFile(sPicSava);
    end;
    mmo1.Lines.Add('图片转换完成！')
  finally
    bmpSrc.Free;
    bmpDes.Free;
    FFileListSrc.Clear;
  end;

[lyhoo163]

这是你的原图分辨率低的原因。拉伸不会提高分辨率，要让原图提高分辨率才能获得好的效果。

[roclegned]

问题已解决： 我的图片是BMP单色位图，改用下面的拉伸模式搞定了 SetStretchBltMode(bmpDes.Canvas.Handle, BLACKONWHITE); BLACKONWHITE：使用消除和现在的像素颜色值进行逻辑AND（与）操作运算。如果该位图是单色位图，那么该模式以牺牲白色像素为代价，保留黑色像素点。