Speicher überfüllt sich! Aber wo?

[gee21]

Hallo zusammen.

Irgendwie frisst meine Anwendung ins unendliche Arbeitsspeicher.
Aber ich sehe oder finde nicht heraus wo?

Weiss es jemand von euch?

Gruess Robert

Delphi-Quellcode:

 private
    { Private-Deklarationen }
       CopyFrame: TRect;
     CopyMouseDown: Boolean;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  TimerONOFF:boolean;

implementation

uses Unit2, Unit3;

{$R *.dfm}
              type
   pRGBQuadArray = ^TRGBQuadArray;
   TRGBQuadArray = ARRAY[0..$effffff] OF TRGBQuad;


function GetScreenShot: TBitmap;
var
   Desktop: HDC;
begin
   Result  := TBitmap.Create;
   Desktop := GetDC(0);
   try
     try
       Result.PixelFormat := pf32bit;
       Result.Width := strtoint(form1.edit1.text);
       Result.Height := strtoint(form1.edit2.text);
       BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, Desktop, form1.SpinEdit1.Value, form1.SpinEdit2.Value, SRCCOPY);
       Result.Modified := True;
     finally
       ReleaseDC(0, Desktop);
     end;
   except
     Result.Free;
     Result := nil;
   end;
end;





Function FindBitmap(Container,Find:TBitmap):TPoint;
var
  SclS,SclF:pRGBQuadArray;
  xc,yc:Integer;
  x,y:Integer;
  Found:Boolean;
begin
    Container.PixelFormat := pf32Bit;
    Find.PixelFormat := pf32Bit;
    Result.X := -1;
    Result.Y := -1;

    yc:=0;
    while (yc < (Container.Height-Find.Height - 1)) and (Result.X=-1) do
        begin
          xc:= 0;
          while (xc < (Container.Width-Find.Width - 1)) and (Result.X=-1) do
             begin
                 y := 0;
                 Found := true;
                 while (y<Find.Height-1) and Found do
                   begin
                      x := 0;
                      SclF := Find.ScanLine[y];
                      SclS:= Container.ScanLine[yc+y];
                      while (x < Find.Width -1) and Found do
                         begin
                            Found := Integer(SclS[xc+x])=Integer(SclF[x]);
                         inc(x);
                         end;
                   inc(y);
                   end;
                 if Found then
                   begin
                      Result.X := xc;
                      Result.Y := yc;
                   end;
             inc(xc);
             end;
        inc(yc);
        end;

end;

procedure TForm1.Button1Click(Sender: TObject);
var
  p:TPoint;
begin

if listbox1.Items.Count<1 then begin
showmessage('Keine Such-Objekte angegeben');
abort;
end else button1.Enabled:=false;

if button2.Enabled=true then timeronoff:=true;


if form2.Visible=true then form2.Close;
if listbox1.itemindex=-1 then listbox1.itemindex:=0;
if listbox1.ItemIndex<listbox1.Items.Count-1 then  listbox1.ItemIndex:=listbox1.ItemIndex+1 else listbox1.ItemIndex:=0;

image1.Picture.Bitmap:= GetScreenShot;
image2.Picture.LoadFromFile(ExtractFilePath(Application.Exename)+'\'+listbox1.items[listbox1.ItemIndex]);

p:= FindBitmap(form1.Image1.Picture.Bitmap,Image2.Picture.Bitmap)  ;

if p.X=-1=false then
                  begin
                   SetCursorPos(form2.Left+ p.x , p.y+ form2.Top+ (image2.Picture.Height div 2));
                   if listbox1.ItemIndex>0 then listbox1.ItemIndex:=listbox1.ItemIndex-1 else listbox1.ItemIndex:=listbox1.Items.Count-1;

                   mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
                   mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);

                  end else begin
                   p.X:=-1;
                   p.Y:=-1;
                  end;


     timer1.Enabled:=true;

 end;


procedure TForm1.Button2Click(Sender: TObject);
begin
TimerOnOff:=false;
button2.Enabled:=false;
button1.Enabled:=true;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
form1.Close;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
if form2.Visible=true then form2.Close;

 image1.Picture.Bitmap:= GetScreenShot;
form1.Width:=707;

 // if savepicturedialog1.Execute=true  then  image1.Picture.SaveToFile(savepicturedialog1.filename);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin

form2.width:=strtoint(edit1.Text);
form2.Height:=strtoint(edit2.Text);

form2.Left:=spinedit1.Value;
form2.Top:=spinedit2.Value;

if form2.Visible=true  then form2.Close else form2.Show;

end;

procedure TForm1.Button6Click(Sender: TObject);
begin
form3.Show;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
form1.Width:=290;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
var
search: string;
begin

if checkbox1.Checked=true then listbox1.Items.Add(checkbox1.Caption+'.bmp')
else begin
search := checkbox1.Caption;

  if SendMessage(form1.ListBox1.Handle, lb_selectstring, - 1, Longint(PChar(search))) <> LB_ERR then listbox1.DeleteSelected;
end;

end;

procedure TForm1.CheckBox2Click(Sender: TObject);
var
search: string;
begin

if checkbox2.Checked=true then listbox1.Items.Add(checkbox2.Caption+'.bmp')
else begin
search := checkbox2.Caption;

  if SendMessage(form1.ListBox1.Handle, lb_selectstring, - 1, Longint(PChar(search))) <> LB_ERR then listbox1.DeleteSelected;
end;
end;

procedure TForm1.CheckBox3Click(Sender: TObject);
var
search: string;
begin

if checkbox3.Checked=true then listbox1.Items.Add(checkbox3.Caption+'.bmp')
else begin
search := checkbox3.Caption;

  if SendMessage(form1.ListBox1.Handle, lb_selectstring, - 1, Longint(PChar(search))) <> LB_ERR then listbox1.DeleteSelected;
end;
end;

procedure TForm1.CheckBox4Click(Sender: TObject);

var
search: string;
begin

if checkbox4.Checked=true then listbox1.Items.Add(checkbox4.Caption+'.bmp')
else begin
search := checkbox4.Caption;

  if SendMessage(form1.ListBox1.Handle, lb_selectstring, - 1, Longint(PChar(search))) <> LB_ERR then listbox1.DeleteSelected;
end;
end;

procedure TForm1.CheckBox5Click(Sender: TObject);
var
search: string;
begin

if checkbox5.Checked=true then listbox1.Items.Add(checkbox5.Caption+'.bmp')
else begin
search := checkbox5.Caption;

  if SendMessage(form1.ListBox1.Handle, lb_selectstring, - 1, Longint(PChar(search))) <> LB_ERR then listbox1.DeleteSelected;
end;
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
form2.width:=strtoint(edit1.Text);
end;

procedure TForm1.Edit2Change(Sender: TObject);
begin
form2.Height:=strtoint(edit2.Text);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
 Perform(WM_SYSCOMMAND, $F012, 0);

end;

procedure TForm1.FormShow(Sender: TObject);
begin
form2.width:=strtoint(edit1.Text);
form2.Height:=strtoint(edit2.Text);
form2.Show;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 CopyFrame.Left := X;
   CopyFrame.Top := Y;
   CopyMouseDown := True;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if PtInRect(Image1.ClientRect, Point(X, Y)) then
   begin
     CopyFrame.Right := X;
     CopyFrame.Bottom := Y;
   end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
   Bmp: TBitmap;
begin
   Bmp := TBitmap.Create;
   try
     Bmp.PixelFormat := pf32Bit;
     Bmp.Width := CopyFrame.Right - CopyFrame.Left;
     Bmp.Height :=  CopyFrame.Bottom - CopyFrame.Top;
     Bmp.Canvas.CopyRect(Rect(0, 0, Bmp.Width, Bmp.Height), Image1.Picture.Bitmap.Canvas, CopyFrame);
     Image2.Picture.Bitmap.Assign(Bmp);
   finally
     Bmp.Free;
   end;
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
 Perform(WM_SYSCOMMAND, $F012, 0);

end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin

if timeronoff=false then begin
timer1.Enabled:=false;
timeronoff:=true;
button2.Enabled:=false;
button1.Enabled:=true;
abort;
end;


timer1.Enabled:=false;
button1.Click;

end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
form3.memo1.lines.loadfromfile(ExtractFilePath(Application.Exename)+'\Bilder.txt');
checkbox1.caption:=form3.memo1.lines[0];
form3.RadioGroup1.Items[0]:=form3.memo1.lines[0];
checkbox2.caption:=form3.memo1.lines[1];
form3.RadioGroup1.Items[1]:=form3.memo1.lines[1];
checkbox3.caption:=form3.memo1.lines[2];
form3.RadioGroup1.Items[2]:=form3.memo1.lines[2];
checkbox4.caption:=form3.memo1.lines[3];
form3.RadioGroup1.Items[3]:=form3.memo1.lines[3];
checkbox5.caption:=form3.memo1.lines[4];
form3.RadioGroup1.Items[4]:=form3.memo1.lines[4];

timer2.Enabled:=false;
end;

[jaenicke]

Du erzeugst mit GetScreenshot ständig neue TBitmap Objekte, gibst diese aber nie wieder frei. Bei

Delphi-Quellcode:

image1.Picture.Bitmap:= GetScreenShot

wird intern ein Assign ausgelöst (schau mal im VCL-Quelltext, wenn du den hast) und dein Objekt wird nie wieder benutzt oder freigegeben.

// EDIT:
Ach ja, mit FastMM kannst du so etwas auch selber finden, wenn du es (gerade bei größeren Projekten) nicht selbst siehst.

[gee21]

Ah jaa :lol:. ... Danke. Teste jetzt gleich mal FastMM ;-)

[Dalai]

Ich glaube, es wäre besser, wenn du das Bitmap mit Assign zuweisen würdest (in der Funktion GetScreenshot) und stattdessen einen Boolean zurückgibst, der den Erfolg widerspiegelt. So kann man die Bitmaps nämlich an der Stelle bzw. in derselben Ebene wieder freigeben, an/in der sie erzeugt wurden. Dadurch wird auch die Verantwortlichkeit für die Ressourcen eindeutig vergeben, was bei Erzeugen und Zurückgeben eines Objekts - wie in deinem Code - nicht so ganz klar ist.

MfG Dalai

[DeddyH]

Objektinstanzen als Funktionsrückgabe, und wo wir schon dabei sind:
Vergleichen Sie niemals mit Boolean-Konstanten

[p80286]

Zitat:

Zitat von jaenicke (Beitrag 1217014)

Du erzeugst mit GetScreenshot ständig neue TBitmap Objekte, gibst diese aber nie wieder frei. Bei

Delphi-Quellcode:

image1.Picture.Bitmap:= GetScreenShot

wird intern ein Assign ausgelöst (schau mal im VCL-Quelltext, wenn du den hast) und dein Objekt wird nie wieder benutzt oder freigegeben.

Hut ab, ich hab's nicht gefunden, obwohl ich danach gesucht habe.

Gruß
K-H