Delphi 与原始图像相比,加载到图像控件后的图像质量较差
我有一个应用程序可以将图像加载到Zimage(graphcontrol)。我遇到的一个问题是,原始图像的质量要比最终显示在组件中的图像好得多。显示的那个看起来有随机的黑色标记。所以我要做的是:Delphi 与原始图像相比,加载到图像控件后的图像质量较差,delphi,Delphi,我有一个应用程序可以将图像加载到Zimage(graphcontrol)。我遇到的一个问题是,原始图像的质量要比最终显示在组件中的图像好得多。显示的那个看起来有随机的黑色标记。所以我要做的是: 将图像从文件夹加载到TJpegimage 将jpg分配给位图 将位图保存到对象列表 重复上述步骤,直到所有图像都加载到对象列表中 然后我创建一个位图 将对象列表中的第一个图像指定给它 在画布上绘制位图 但它只是看起来比原来的糟糕多了。有什么帮助或想法吗 这是加载代码 procedure TFo
- 将图像从文件夹加载到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;
谢谢你的帮助和建议
以下是图片:
编辑
似乎一旦我放大一幅图像,它就会变得更好。最糟糕的是当它的全屏/全屏放大时。。原始尺寸。- a) 我假设所有图像都有不同的大小。如果显示的图像“ZImage1”应始终具有相同的高度或宽度(两件事之一,或对于拉伸配合==低质量),必须确定比率(原始高度/原始宽度)。然后必须在新关系中计算“ZImage1”(高度或宽度)
- b) 设置ZImage1.AutoSize:=false李>
- c) 设置ZImage1.Stretch:=false
- d) bmpout.Width和Height必须设置为当前的
sizemylist[CurIdx]
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;
编辑:创建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,'*.*'));
....
您可以将原始和加载的图像附加到问题plz吗?我没有使用TBitmap类,因此可能是错误的,但是,您似乎正在重用插入到集合中的最后一个TBitmap实例,该实例已经分配了一个图像,以重新分配和显示一个新图像。在那之前你不需要使用FreeImage吗?如果只有一个图像,这难道不是一个问题吗?@Guillem,将图像添加到集合中,在TBitmap
实例之间分配,并在画布上渲染,都不会降低图像质量。Glen,我想你的问题是在渲染图像时出现了错误的纵横比(如果我是对的,那么你使用的是StretchDraw
)。当然,你需要考虑到,当你拉伸图像(缩放)时,它自然会失去质量(你必须以某种方式重新采样以减少质量损失)。@TLama,很高兴知道。谢谢你的解释!这是一个链接,指向相邻的两个图像。我没有使用过stretchdraw,如果你看一下图片的链接,它显然不是一个缩放问题,因为图片是保存大小为旁边的图片。当时我还没有缩放,不需要设置位图大小,也不需要使用数组来存储图像尺寸。此伪代码SecondBitmap.Assign(FirstBitmap)
将通过FirstBitmap
设置SecondBitmap
的大小。这个问题更多的是关于纵横比或缩放质量。它现在运行,但图像看起来仍然不好,但我确实注意到了一些东西。如果我放大图像,图像会变得更清晰。当它缩小到全屏时,它的质量似乎很差。我使用的是XE,但我也看不到缩放。至于把它放在Timage上,我试图更改zimage1.bitmap.assign(bmpout);但它给出了Timage无法分配位图的错误信息。我已经更新了代码,以显示到目前为止我所做的事情。。还有,当它第一次加载时,会显示大约1/4的图像,其余部分隐藏起来,只能通过滚动条查看。不确定这是否有帮助?在使用此代码重做所有操作后,我可以确定代码是否正确并执行所有请求。我的zimage似乎有一些计算问题。我的TZImage.Paint方法中存在问题。我认为我没有正确地保留纵横比。屏幕上的图像总是填充控件的客户端区域,而不管窗体的形状或源图像如何,因此无法保留纵横比。TZImage.Paint中的计算不正确。我通过简单地将绘制方法更改为Canvas.Draw(0,0,FBitmap)进行测试;它产生了一个高质量的图像,与原始图像一样。因此,TZImage.Paint中的计算肯定是错误的。只是纵横比的计算是错误的。因此,我将批准这个答案,因为它确实回答了最初的问题。但我可能会发布另一篇关于如何修复我的绘画方法的文章。。。谢谢你,格伦
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);
....
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,'*.*'));
....