在加载到图像控件中后，与原始图像相比，图像质量变差

Question

在加载到图像控件中后，与原始图像相比，图像质量变差

delphi

4

我有一个将图像加载到 Zimage（graphcontrol）的应用程序。我遇到的问题是原始图像的质量比最终显示在组件中的图像要好得多。显示出来的那个看起来像是随机黑点。所以我做的是:

从文件夹中加载图像到TJpegimage
将jpg分配给位图
将位图保存到对象列表中
重复上述步骤，直到所有图像都加载到对象列表中
然后我创建了一个位图
将对象列表中的第一张图片分配给它
在画布上绘制位图。

但它看起来比原来的差得多。任何帮助或想法吗？

这是加载代码。

    procedure TForm1.LoadImages(const Dir: string);
var
  i: Integer;
  CurFileName: string;
  JpgIn: TJPEGImage;
  BmpOut: TBitmap;
begin

//set up progress bar
 progressbar1.Min := 0;
 progressbar1.Max := GetFilesCount(dir,'*.*');
 Label3.Visible := true;
 progressbar1.Visible := true;
//sets array for length
  SetLength(hwArray,GetFilesCount(dir,'*.*'));
//sets index for object list
  CurIdx := -1;
  i := 0;
  while True do
  begin
//gets file name out of current folder
    CurFileName := Format('%s%d.jpg',
                          [IncludeTrailingPathDelimiter(Dir), i]);
    if not FileExists(CurFileName) then
      Break;
//count files in folder for progress bar.
     progressbar1.StepBy(1);
//creates jpgin
    JpgIn := TJPEGImage.Create;
    try
//loads jpgin with file
      JpgIn.LoadFromFile(CurFileName);
//creates TBitmap and sets width to same as jpgs
      BmpOut := TBitmap.Create;
      bmpout.Width := jpgin.Width;
      bmpout.Height := jpgin.Height;
     try
         BmpOut.Assign(JpgIn);
//adds 1 to index for object list. thus starting at 0
         curIdx := curIdx+1;
//add bitmap to objectlist
         CurIdx:= mylist.Add(TBitmap(bmpout));
         hwArray[CurIdx][0]:=jpgin.Width;
         hwArray[CurIdx][1]:=jpgin.height;

      finally
      end;
    finally
      JpgIn.Free;
    end;
    Inc(i);
  end;
//makes sure cout is above 0 thus files added
  if mylist.Count > 0 then
  begin
      try
      CurIdx := 0;
      getBitmapfromList(CurIdx,bmpout);
      ZImage1.Bitmap.Assign(bmpout);
       //image1.Canvas.Assign(bmpout);
    finally
       BmpOut.Free;
    end;
  end;
  Label3.Visible := false;
  progressbar1.Visible := false;
  page:= '0';
  zimage1.DblClick;
end;

从列表中获取位图的函数

procedure Tform1.getBitmapfromList(index:integer;var Bitm:TBitmap);
begin
     Bitm.Assign(TBitmap(mylist[index]));
     if (Bitm.Width<>hwArray[index][0]) OR (Bitm.Height<>hwArray[index][1]) then begin
        ShowMessage('Size differs');
        Bitm.Width:=hwArray[index][0];
        Bitm.Height:=hwArray[index][1];
     end;
end;

下一步按钮，可查看下一张图片。

procedure TForm1.Button3Click(Sender: TObject);
var
  BmpOut: TBitmap;
begin
bmpout := TBitmap.Create;
CurIdx:= strtoint(page);
getBitmapfromList(CurIdx,bmpout);
ZImage1.Bitmap.Assign(bmpout);
//image1.Canvas.Assign(bmpout);
page := inttostr(strtoint(page) +1);      //this should show next item in ilst?
zimage1.Repaint;
end;

感谢任何帮助或建议。

以下是图片： http://s7.postimage.org/48mectvsp/image_Difference.png 编辑

似乎一旦我放大图像，它就会变得更好。最差的质量是当它处于全屏幕/缩小到最小的状态时...原始大小。

- Glen Morse

1

请问您能否将原始图片和加载后的图片附加到问题中吗？ - Kromster

我没有使用过TBitmap类，所以我可能错了，但是看起来你正在重复使用插入到集合中的最后一个TBitmap实例，该实例已经有一个图像分配，以重新分配并显示新图像。在此之前，难道不需要使用FreeImage吗？如果您只有一个图像，这会成为问题吗？ - Guillem Vicens

@Guillem，将图像添加到集合中，将其分配给TBitmap实例并在画布上呈现不会降低图像质量。Glen，我猜你的问题在于当你渲染图像时宽高比不正确（如果我没错的话，你正在使用StretchDraw）。当然，你需要考虑到当你拉伸图像（缩放）时，它自然会失去质量（你需要以某种方式重新采样来减少质量损失）。 - TLama

将 Image1.Bitmap.Assign(bmpout); 更改为 Image1.Picture.Bitmap.Assign(bmpout);。 - moskito-x

似乎在缩放到某个点之前都没问题。这可能是像素设置的问题吗？添加zimage1.height并没有帮助图像。 - Glen Morse

显示剩余3条评论

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- moskito-x · Accepted Answer

a) 我假设所有图像都有不同的大小。如果显示的图像“ZImage1”应该始终具有相同的高度或宽度（两者之一，否则它将以拉伸适合方式制作==低质量），则必须确定比率（orginal.height / original.width）。然后，“ZImage1”（高度或宽度）必须在新关系中计算。
b) 设置ZImage1.AutoSize：=false;
c) 设置ZImage1.Stretch：=false;
d) bmpout.Width和Height必须设置为当前的mylist[CurIdx]大小。

bmpout.Assign(TBitmap(mylist[CurIdx]));
Zimage1.Bitmap.Width := bmpout.Width;
Zimage1.Bitmap.Height := bmpout.Height;
ZImage1.Bitmap.Assign(bmpout);

注意：

你没有将 mylist 分配给 *assign*，而是将其存储在 CurIdx:= mylist.Add(TBitmap(bmpout)) 中。

我看不出你是如何创建“mylist”的。

也许这就是原因，如果你想用 bmpout.Assign(TBitmap(mylist[CurIdx])) 将其取回，可能没有自动设置 bmpout.Width 和 bmpout.Height。

提示：

创建一个额外的数组来存储高度和宽度。

....
JpgIn.LoadFromFile(CurFileName);
BmpOut := TBitmap.Create;
bmpout.Width := jpgin.Width;
bmpout.Height := jpgin.Height;
....
CurIdx:= mylist.Add(TBitmap(bmpout));
hwArray[CurIdx][0]:=jpgin.Width;
hwArray[CurIdx][1]:=jpgin.height;
....

制作一个过程编辑: 在其中添加一个测试;

procedure getBitmapfromList(index:integer;var Bitm:TBitmap);
begin
     Bitm.Assign(TBitmap(mylist[index]));
     if (Bitm.Width<>hwArray[index][0]) OR (Bitm.Height<>hwArray[index][1]) then begin
        ShowMessage('Size differs');
        Bitm.Width:=hwArray[index][0];
        Bitm.Height:=hwArray[index][1];
     end;
end;

使用以下方式进行调用：

....
getBitmapfromList(CurIdx,bmpout);
....
ZImage1.Bitmap.Assign(bmpout);
....

编辑：创建 hwArray

type
  Tarray2size = Array[0..1] of integer;
.... 

var
  hwArray : Array of Tarray2size;
....

procedure TForm1.LoadImages(const Dir: string);
....
begin
 //set up progress bar
 progressbar1.Min := 0;
 showmessage(inttostr(GetFilesCount(dir,'*.*')));
 SetLength(hwArray,GetFilesCount(dir,'*.*'));
....