[求助]处理图象中系统资源不足 ( 积分: 100 )

  • 主题发起人 主题发起人 doubeye
  • 开始时间 开始时间
D

doubeye

Unregistered / Unconfirmed
GUEST, unregistred user!
我写了一个程序,目的是将多个图象合成一个图象,但是处理一部分以后就会报系统资源不足,以下是代码,希望大哥们赐教:
Var
i,j,k : Integer;
JPEGImage,JPEGUnited : TJPEGImage;
bitmap : TBitMap;
item : TItem;
rWidthZoom,rHeightZoom : Real;
sMarkDetail : String;
sEncryptId,sStudentId : String;
sMarkTemp : String;
iMarkPosX,iMarkPosY : Integer;
rMark : Real;
iLeftPos,iRightPos,iPos : Integer;

bitmapRotated,bitmapRotate : TBitmap;
sRect,dRect : TRect;
x,y : Integer;
begin
ADOTableStudent.Active := True;
ADOTable1.Active := True;
ADOTableStudent.First;
for i := 0 to ADOTableStudent.RecordCount - 1 Do

Begin
Application.ProcessMessages;
sEncryptId := ADOTableStudent.FieldByName('encryptid').AsString;
sStudentId := ADOTableStudent.FieldByName('examcertid').AsString;

Label1.Caption := sStudentId;

For j := 0 to High(gPapers) Do
Begin
Application.ProcessMessages;

If FileExists('d:/pic/' + sStudentId + '_' + IntToStr(gPapers[j].iPaperId) + '.jpg') Then
Begin
Label1.Caption := sStudentId;
Continue;
End;

bitmap := TBitMap.Create;
bitmap.Width := gPapers[j].iWidth;
bitmap.Height := gPapers[j].iHeight;

For k := 0 To gPapers[j].iItemCount - 1 Do
Begin
Application.ProcessMessages;
rWidthZoom := 0;
rHeightZoom := 0;
item := gPapers[j].aItems[k];

If item.sPicName <> '@' Then
Begin
JPEGImage := TJPEGImage.Create;
JPEGImage.LoadFromFile('d:/' + ADOTableStudent.FieldByName('imagename').AsString + item.sPicName);


rWidthZoom := item.iWidth / JPEGImage.Width;
rHeightZoom := item.iHeight / JPEGImage.Height;


If item.irotate = 0 Then
Begin
bitmap.Canvas.StretchDraw(Rect(item.iTopx,item.iTopy,item.iTopx + item.iWidth,item.iTopy + item.iHeight),JPEGImage);
End
Else If item.irotate = 90 Then
Begin
bitmapRotated := TBitmap.Create;
bitmapRotate := TBitmap.Create;
bitmapRotate.Width := JPEGImage.Width;
bitmapRotate.Height := JPEGImage.Height;
bitmapRotate.Assign(JPEGImage);
bitmapRotated.Width := JPEGImage.Height;
bitmapRotated.Height := JPEGImage.Width;

sRect := rect(0,0,bitmapRotate.Width,bitmapRotate.Height);
dRect := rect(0,0,bitmapRotate.Height,bitmapRotate.Width);

for x := 0 to bitmapRotate.Width do
begin
for y:=0 to bitmapRotate.Height do
begin
bitmapRotated.Canvas.Pixels[-y + bitmapRotate.Height,x] := bitmapRotate.Canvas.Pixels[x,y];
end;
end;

JPEGImage.Assign(bitmapRotated);

bitmap.Canvas.StretchDraw(Rect(item.iTopx,item.iTopy,item.iTopx + item.iWidth,item.iTopy + item.iHeight),bitmapRotated);
bitmapRotate.Free;
bitmapRotated.Free;

End
Else if item.irotate = -90 Then
Begin
bitmapRotated := TBitmap.Create;
bitmapRotate := TBitmap.Create;
bitmapRotate.Width := JPEGImage.Width;
bitmapRotate.Height := JPEGImage.Height;
bitmapRotate.Assign(JPEGImage);
bitmapRotated.Width := JPEGImage.Height;
bitmapRotated.Height := JPEGImage.Width;

sRect := rect(0,0,bitmapRotate.Width,bitmapRotate.Height);
dRect := rect(0,0,bitmapRotate.Height,bitmapRotate.Width);

for x := 0 to bitmapRotate.Width do
begin
for y:=0 to bitmapRotate.Height do
begin
bitmapRotated.Canvas.Pixels[y, -x + bitmapRotate.Width] := bitmapRotate.Canvas.Pixels[x,y];
end;
end;

JPEGImage.Assign(bitmapRotated);
bitmap.Canvas.StretchDraw(Rect(item.iTopx,item.iTopy,item.iTopx + item.iWidth,item.iTopy + item.iHeight),bitmapRotated);
bitmapRotate.Free;
bitmapRotated.Free;
End;
End;

ADOTable1.Filtered := False;
ADOTable1.Filter := 'encryptid = ' + sEncryptId + ' And itemid = ' + IntToStr(item.iItemId);
ADOTable1.Filtered := True;
If ADOTable1.RecordCount = 0 Then Continue;
ADOTable1.First;
sMarkDetail := ADOTable1.FieldByName('markdetail1').AsString;
if sMarkDetail = '' Then Continue;

bitmap.Canvas.Font.Color := clRed;
bitmap.Canvas.Font.Size := 30;
bitmap.Canvas.Brush.Style := bsClear;

While sMarkDetail <> '' Do
Begin
Application.ProcessMessages;
iLeftPos := Pos('{',sMarkDetail);
iRightPos := Pos('}',sMarkDetail);
sMarkTemp := Copy(sMarkDetail,iLeftPos + 1,iRightPos - iLeftPos - 1);
sMarkDetail := Copy(sMarkDetail,iRightPos + 1,Length(sMarkDetail));
If Copy(sMarkTemp,1,1) <> '0' Then Continue;
iPos := Pos(',',sMarkTemp);
sMarkTemp := Copy(sMarkTemp,iPos + 1,Length(sMarkTemp));

iPos := Pos(',',sMarkTemp);
rMark := StrToFloat(Copy(sMarkTemp,1,iPos - 1));
sMarkTemp := Copy(sMarkTemp,iPos + 1,Length(sMarkTemp));

iPos := Pos(',',sMarkTemp);
iMarkPosX := StrToInt(Copy(sMarkTemp,1,iPos - 1));
sMarkTemp := Copy(sMarkTemp,iPos + 1,Length(sMarkTemp));

iPos := Pos(',',sMarkTemp);
iMarkPosY := StrToInt(Copy(sMarkTemp,1,iPos - 1));
sMarkTemp := Copy(sMarkTemp,iPos + 1,Length(sMarkTemp));



iMarkPosX := Ceil(iMarkPosX * rWidthZoom);
iMarkPosY := Ceil(iMarkPosY * rHeightZoom);

bitmap.Canvas.TextOut(iMarkPosX + item.iTopx,IMarkPosY + item.iTopy,FloatToStr(rMark));
End;

sMarkDetail := ADOTable1.FieldByName('markdetail2').AsString;
if sMarkDetail = '' Then Continue;

bitmap.Canvas.Pen.Mode := pmNOTXOR;
bitmap.Canvas.Font.Color := clBlue;
bitmap.Canvas.Font.Size := 18;
bitmap.Canvas.Font.Style := [fsBold];

While sMarkDetail <> '' Do
Begin
Application.ProcessMessages;

iLeftPos := Pos('{',sMarkDetail);
iRightPos := Pos('}',sMarkDetail);
sMarkTemp := Copy(sMarkDetail,iLeftPos + 1,iRightPos - iLeftPos - 1);
sMarkDetail := Copy(sMarkDetail,iRightPos + 1,Length(sMarkDetail));
If Copy(sMarkTemp,1,1) <> '0' Then Continue;
iPos := Pos(',',sMarkTemp);
sMarkTemp := Copy(sMarkTemp,iPos + 1,Length(sMarkTemp));

iPos := Pos(',',sMarkTemp);
rMark := StrToFloat(Copy(sMarkTemp,1,iPos - 1));
sMarkTemp := Copy(sMarkTemp,iPos + 1,Length(sMarkTemp));

iPos := Pos(',',sMarkTemp);
iMarkPosX := StrToInt(Copy(sMarkTemp,1,iPos - 1));
sMarkTemp := Copy(sMarkTemp,iPos + 1,Length(sMarkTemp));

iPos := Pos(',',sMarkTemp);
iMarkPosY := StrToInt(Copy(sMarkTemp,1,iPos - 1));
sMarkTemp := Copy(sMarkTemp,iPos + 1,Length(sMarkTemp));



iMarkPosX := Ceil(iMarkPosX * rWidthZoom);
iMarkPosY := Ceil(iMarkPosY * rHeightZoom);

bitmap.Canvas.TextOut(iMarkPosX + item.iTopx,IMarkPosY + item.iTopy,FloatToStr(rMark));

End;

JPEGImage.Free;
End;

JPEGUnited := TJPEGImage.Create;
JPEGUnited.Assign(bitmap);
JPEGUnited.SaveToFile('d:/pic/' + sStudentid + '_' + IntToStr(gPapers[j].iPaperId) + '.jpg');
JPEGUnited.Free;
bitmap.Free;
End;
ProgressBar1.Position := Ceil(i * 100 / ADOTableStudent.RecordCount);
ADOTableStudent.Next;
End;
end;
 
Tbitmap有大小限制的,听说是不能超过120M,具体没试过。注意,同一过程内创建多个tbitmap,其所能用的资源是互相影响的,也就是说,你同时创建的tbitmap越多,单个bitmap的大小就只能越小(大了报存储空间不足错误)。
 
我的图象其实不大,最大就6M多,用完了马上就释放了
 
你的代码中至少有3个bitmap同时存在,看看能否优化一下,减掉一个tbitmap
 
好的,我试一下.
不过对象我都有释放啊
按照你的意思我去掉一个对象充其只能推迟这个问题的出现,我一次大约要合成几十万张图像:(
还请高手从根本上帮我解决一下
 
加个EurekaLog 6.0.1.3,看看泄露的代码行到底是哪里。EurekaLog能检测内存泄露。
 
这个不是内存泄露的问题,应该是操作系统的限制。具体如何突破限制,我也没有好办法。以前我遇到这个问题的时候是减少同时开启的tbitmap数量来解决的。

另外,不要在循环内频繁的创建和释放tbitmap。
 
后退
顶部