[es] - Kako da smanjim Mem Usage?

IvanBeograd
Kladza
Beograd

Član broj: 83376
Poruke: 379
*.adsl.sezampro.yu.

Sajt: www.dza-bu-drz-ne-daj.com

Profil

^{01.03.2006. u 01:59 - pre 220 meseci}

Pa ovako imam jedan problem namestio sam jedan programcic koji slika kameru ,tj slikau sa kamere,to sam sve odradio na OnTimer event,svake sekunde i sacuva sliku u neki folder,jedni problem je taj sto posle par minuta
njegov mem Usage u task manager-u je 300 a bio je na pocetku 2 :(
Pa onda zabaguje :(
Ako moze mala pomoc kako da resim ovaj moj problem!

SERVIA NOSTRUM REGNUM!

Odgovor na temu

ntojzan
Sandor II Tojzan
Becej

Član broj: 36657
Poruke: 168
*.171.244.43.ap.yournet.ne.jp.

Profil

Re: Kako da smanjim Mem Usage?

^{01.03.2006. u 03:43 - pre 220 meseci}

Verovatno si zaboravio da oslobodis memoriju. Proveri da li svaki TObject.Create ima i Object.Free kad zavrsis sa objektom.

Odgovor na temu

IvanBeograd
Kladza
Beograd

Član broj: 83376
Poruke: 379
*.smin.sezampro.yu.

Sajt: www.dza-bu-drz-ne-daj.com

Profil

Re: Kako da smanjim Mem Usage?

^{01.03.2006. u 10:59 - pre 220 meseci}

Da,da to sam i ja gledao ali imam ovako 2 funkcije u kojim kad oslobodim stvoreni objekat,onda funkcije neodrade posao!

evo koda :

Code:

function CaptureScreenRect(ARect:TRect):TBitmap;
var
ScreenDC:HDC;
begin
Result:=TBitmap.Create;
with Result,ARect do
begin
  Width:=Right-Left;
  Height:=Bottom-Top;
  ScreenDC:=GetDC(0);
try
  BitBlt(Canvas.Handle,0,0,Width,Height,ScreenDC,Left,Top,SRCCOPY);
finally
ReleaseDC(0,ScreenDC);
end;
end;
end;

function CaptureScreen(x,y : integer):TBitmap;
begin
with Screen do
Result:=CaptureScreenRect(Rect(x,0,Width,y));
end;

SERVIA NOSTRUM REGNUM!

Odgovor na temu

Srki_82
Srdjan Tot
Me @ My Home
Ljubljana

Član broj: 28226
Poruke: 1403
82.208.201.*

ICQ: 246436949

+10 Profil

Re: Kako da smanjim Mem Usage?

^{01.03.2006. u 11:38 - pre 220 meseci}

CaptureScreenRect kreira TBitmap objekat... trebalo bi da ga negde kasnije oslobodis... npr:

Code:
var
  B: TBitmap;
begin
  B := CaptureScreen(10, 10);
  // uradis nesto sa slikom... snimis, obradis, itd...
  B.Free;
end;

Play Store

Odgovor na temu

johnnie
somewhere in Serbia

Član broj: 40975
Poruke: 299
*.041net.co.yu.

+4 Profil

Re: Kako da smanjim Mem Usage?

^{01.03.2006. u 14:03 - pre 220 meseci}

Citat:

Srki_82: CaptureScreenRect kreira TBitmap objekat... trebalo bi da ga negde kasnije oslobodis... npr:

Code:
var
  B: TBitmap;
begin
  B := CaptureScreen(10, 10);
  // uradis nesto sa slikom... snimis, obradis, itd...
  B.Free;
end;

ili dodaj pre svega ostalog

Code:
If assigned(b) then b.free;

i posto koristis OnTimer event ubaci negde

Code:
Application.ProcessMessages...

Still going strong...

Odgovor na temu

IvanBeograd
Kladza
Beograd

Član broj: 83376
Poruke: 379
*.smin.sezampro.yu.

Sajt: www.dza-bu-drz-ne-daj.com

Profil

Re: Kako da smanjim Mem Usage?

^{22.03.2006. u 13:49 - pre 220 meseci}

Ja se izvinjavam sto ovoliko kasnim sa ovom temom,ali nisam imao vremena za to!
evo code :

Code:

procedure brisi(Dir: string; var i : integer);
var
  SR: TSearchRec;
begin
  i:=0;
  Dir:=Dir+'slike\';
  Dir := IncludeTrailingPathDelimiter(Dir);
  if  FindFirst(dir+'*',faAnyFile,SR) = 0
  then
   begin
    repeat

      if (ExtractFileExt(SR.Name)='.jpg')
      then
       begin
        DeleteFile(Dir+SR.Name);
        i:=i+1;
       end;

    until FindNext(SR) <> 0;
   end;
end;

procedure Prebroj(Dir: string; var i : integer; var FS: DWord);
var
  SR: TSearchRec;
begin
  i:=0;
  FS:=0;
  Dir:=Dir+'slike\';
  Dir := IncludeTrailingPathDelimiter(Dir);
  if  FindFirst(dir+'*',faAnyFile,SR) = 0
  then
   begin
    repeat
      if (ExtractFileExt(SR.Name)='.jpg')
      then
       begin
        FS:=FS+Sr.Size;
        i:=i+1;
       end;

    until FindNext(SR) <> 0;
   end;
end;

function BMPtoJPG(var BMPpic, JPGpic: string):boolean;
var
Bitmap: TBitmap;
JpegImg: TJpegImage;
begin
Result:=False;
Bitmap := TBitmap.Create;
try
Bitmap.LoadFromFile(BMPpic) ;
JpegImg := TJpegImage.Create;
try
  JpegImg.Assign(Bitmap) ;
  JpegImg.SaveToFile(JPGpic) ;
  Result:=True;
finally
  JpegImg.Free
end;
finally
Bitmap.Free
end;
end;

procedure Capture(ARect : TRect);
var
ScreenDC:HDC;
Slika:TBitmap;
Image : TImage;
s1,s2:string;
BrSlika : integer;
FS:DWord;
path : string;
begin
path:=ExtractFilePath(Application.ExeName);
prebroj(path,BrSlika,FS);
Slika:=TBitmap.Create;
Image:=TImage.Create(Image);
begin
try
  ScreenDC:=GetWindowDC(GetDeskTopWindow);
  Slika.Width:=ARect.Right-ARect.Left;
  Slika.Height:=ARect.Bottom-ARect.Top;
  BitBlt(Slika.Canvas.Handle,0,0,Slika.Width,Slika.Height,ScreenDC,ARect.Left,Arect.Top,SRCCOPY);
  Slika.SaveToFile(ExtractFilePath(Application.ExeName)+'slike\'+IntToStr(BrSlika+1)+'.bmp');
  Image.Picture.Bitmap:=Slika;
  Image.Picture.SaveToFile(ExtractFilePath(Application.ExeName)+'slike\'+IntToStr(BrSlika+1)+'.bmp');
  s1:=(ExtractFilePath(Application.ExeName)+'slike\'+IntToStr(BrSlika+1)+'.bmp');
  s2:=(ExtractFilePath(Application.ExeName)+'slike\'+IntToStr(BrSlika+1)+'.jpg');
  BmpToJpg(s1,s2);
  DeleteFile(ExtractFilePath(Application.ExeName)+'slike\'+IntToStr(BrSlika+1)+'.bmp');
finally
  ReleaseDC(GetDeskTopWindow,ScreenDC);
  Slika.Free;
  Image.Free;
end;
end;
end;

E sad ja na timer1 upisem :

Code:

Capture(Rect(500,0,Screen.Width,500));

Ne vidim gde je greska??Probao sam i sam i da upisem application.processmessage ??
Moze mala pomoc!Hvala,poz!

SERVIA NOSTRUM REGNUM!

Odgovor na temu