desktop changes

[kukuza]

its an alert for changes over the desktop.
and ok, it work.. but why it gradually fill the ram ?







function GetScreenShot: TBitmap;
var
Desktop: HDC;
begin
Result := TBitmap.Create;
Desktop := GetDC(0);
try
try
Result.PixelFormat := pf32bit;
Result.Width := Screen.Width;
Result.Height := Screen.Height;
BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, Desktop, 0, 0, SRCCOPY);
Result.Modified := True;
finally
ReleaseDC(0, Desktop);
end;
except
Result.Free;
Result := nil;
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
b1, b2: TBitmap;
c1, c2: PByte;
x, y, i, different: integer;
begin

Image2.Picture.Bitmap := GetScreenShot;
b1 := Image1.Picture.Bitmap;
b2 := Image2.Picture.Bitmap;
try
assert(b1.PixelFormat = b2.PixelFormat);
except
exit;
end;
different := 0;
for y := 0 to b1.Height - 1 do
begin
c1 := b1.Scanline[y];
c2 := b2.Scanline[y];
for x := 0 to b1.Width - 1 do
for i := 0 to 4 - 1 do
begin
inc(different, integer(c1^ <> c2^));
inc(c1);
inc(c2);
end;
end;
if different=0 then exit else
PlaySound(PChar('alarm.wav'), 0, SND_SYNC)
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
timer2.Enabled:=false;
Image1.Picture.Bitmap := GetScreenShot;
timer1.Enabled:=true;
end;

procedure TForm1.FormClick(Sender: TObject);
begin
close;
end;

end.

 

[DelphiAaron]

it's because you keep creating a bitmap for the result and its not being freed unless an exception occurs.

it bit be a while ago see thread

http://www.tek-tips.com/viewthread.cfm?qid=1301701&page=1

Aaron