Fehlermeldung:Für diesen Befehl ist nicht genügend Speicher

[meg91]

hi@all
ich hab ein Programm geschrieben, welches in regelmäßigen Abständen nen Screenshot macht und daraus die Durchschnitssfarbe berechnet
anschließend wird der eine Farbwert als RBG auf dem Com Port ausgegeben

am anfang funktioniert es auch wunderbar nur nach einiger Zeit kommt die Fehlermeldugn von Delphi:Für diesen Befehl ist nicht genügend Speicher verfügbar

hier mal mein Quelltext

Delphi-Quellcode:

procedure TForm1.ScreenToLine();
var
  Bitmap: TBitmap;
  Canvas: TCanvas;
  iFor, iFor2: LongInt;
  bRed, bGreen, bBlue: Byte;
  PixelColor: LongInt;
  bXgesRed, bXgesGreen, bXgesBlue: LongInt; //Duchschnittsfarben Horizontal
  bYgesRed, bYgesGreen, bYgesBlue: LongInt; //Duchschnittsfarben Vertikal
begin
  Canvas := TCanvas.Create;
  try
    Canvas.Handle := GetWindowDC(0);
    try
      Bitmap := TBitmap.Create;
      try
        Bitmap.Width := Screen.DesktopWidth;
        Bitmap.Height:= Screen.DesktopHeight;
        Bitmap.PixelFormat := pfDevice;

        BitBlt(Bitmap.Canvas.Handle, 0, 0, Pred(Screen.DesktopWidth), Pred(
            Screen.DesktopHeight), Canvas.Handle, Screen.DesktopLeft,
            Screen.DesktopTop, Bitmap.Canvas.CopyMode);   //Screenshot machen

        bXgesBlue := 0;
        bXgesGreen := 0;
        bXgesRed := 0;
        for iFor := 0 to 20 do
        begin
          bYgesBlue := 0;
          bYgesGreen := 0;
          bYgesRed := 0;

          for iFor2 := 0 to 16 do
          begin
            //jeden 64-ten Pixel in der hotizontalen addieren
            PixelColor := ColorToRGB(Bitmap.Canvas.Pixels[(iFor * 64), (iFor2 * 64)]);
            bBlue := PixelColor;
            bGreen := PixelColor shr 8;
            bRed := PixelColor shr 16;

            bYgesBlue := bYgesBlue + bBlue;
            bYgesGreen := bYgesGreen + bGreen;
            bYgesRed := bYgesRed + bRed;

          end;
          bYgesBlue := StrToInt(FloatToStr(Round(bYgesBlue / 16)));
          bYgesGreen := StrToInt(FloatToStr(Round(bYgesGreen / 16)));
          bYgesRed := StrToInt(FloatToStr(Round(bYgesRed / 16)));

          bXgesBlue := bXgesBlue + bYgesBlue;
          bXgesGreen := bXgesGreen + bYgesGreen;
          bXgesRed := bXgesRed + bYgesRed;

        end;

        bXgesBlue := StrToInt(FloatToStr(Round(bXgesBlue / 20)));
        bXgesGreen := StrToInt(FloatToStr(Round(bXgesGreen / 20)));
        bXgesRed := StrToInt(FloatToStr(Round(bXgesRed / 20)));

        //Werte ausgeben
        TrackBar1.Position := bXgesRed;
        TrackBar2.Position := bXgesGreen;
        TrackBar3.Position := bXgesBlue;

        Application.ProcessMessages;
      finally
        Bitmap.Free;
        iFor := 0;
        iFor2 := 0;
        bRed := 0;
        bGreen := 0;
        bBlue := 0;
        PixelColor := 0;
        bXgesRed := 0;
        bXgesGreen := 0;
        bXgesBlue := 0;
        bYgesRed := 0;
        bYgesGreen := 0;
        bYgesBlue := 0;
        end;
    finally
      ReleaseDC(0, Canvas.Handle);
    end;
  finally
    Canvas.Free;
  end;
end;

[mkinzler]

Ich würde die benötigten Objekte einmalig anlegen und dann wiederverwenden.

[meg91]

also die Bitmaps als globale variabelen?

[mkinzler]

Und den Canvas auch.

[meg91]

ich hab das ganze mal getestet, aber dann geht gar nix mehr
warum auch immer

[KrasserChecker]

Lass doch mal das Canvas-Objekt weg. Das brauchst du doch gar nicht. Da dort auch das Handle verwendet wird, könnte ich mi gut vorstellen, dass dort auch (irgendwo) der Fehler liegt.

Delphi-Quellcode:

var TempDC: THandle;
...
TempDC := GetWindowDC(0);
try
  BitBlt(Bitmap.Canvas.Handle, 0, 0, Pred(Screen.DesktopWidth), Pred(
    Screen.DesktopHeight), TempDC, Screen.DesktopLeft,
    Screen.DesktopTop, SRCCOPY);   //Screenshot machen 
finally
  ReleaseDC(TempDC);
end;
...

Ach ja, und du brauchst im "finally"-Abschnitt nicht alle lokalen Variablen wieder auf 0 zu setzen. Freigeben lokal erzeugter Objekte (hier die Bitmap) reicht.

[meg91]

ohne dem Canvas bekomm ich genau die gleiche Fehlermeldung wie am anfang
und das mit den Variabelen auf null war mein Lösungansatz zu den Abstürtzen

[xaromz]

Hallo,

verwende mal folgende Routine. Hier wird kein Bitmap verwendet, sondern direkt vom Desktop gelesen. Außerdem habe ich diesen Blödsinn mit der Umwandlung in String und wieder zurück rausgeschmissen.

Delphi-Quellcode:

procedure TForm1.ScreenToLine;
var
  Handle: THandle;
  iFor, iFor2: Integer;
  bRed, bGreen, bBlue: Byte;
  PixelColor: Integer;
  bXgesRed, bXgesGreen, bXgesBlue: Integer; //Duchschnittsfarben Horizontal
  bYgesRed, bYgesGreen, bYgesBlue: Integer; //Duchschnittsfarben Vertikal
begin
  Handle := GetDC(0);
  try
    bXgesBlue := 0;
    bXgesGreen := 0;
    bXgesRed := 0;

    for iFor := 0 to 20 do
    begin
      bYgesBlue := 0;
      bYgesGreen := 0;
      bYgesRed := 0;

      for iFor2 := 0 to 16 do
      begin
        //jeden 64-ten Pixel in der Horizontalen addieren
        PixelColor := GetPixel(Handle, (iFor * 64), (iFor2 * 64));
        bBlue := PixelColor;
        bGreen := PixelColor shr 8;
        bRed := PixelColor shr 16;

        bYgesBlue := bYgesBlue + bBlue;
        bYgesGreen := bYgesGreen + bGreen;
        bYgesRed := bYgesRed + bRed;
      end;

      bYgesBlue := Round(bYgesBlue / 16);
      bYgesGreen := Round(bYgesGreen / 16);
      bYgesRed := Round(bYgesRed / 16);

      bXgesBlue := bXgesBlue + bYgesBlue;
      bXgesGreen := bXgesGreen + bYgesGreen;
      bXgesRed := bXgesRed + bYgesRed;
    end;

    bXgesBlue := Round(bXgesBlue / 20);
    bXgesGreen := Round(bXgesGreen / 20);
    bXgesRed := Round(bXgesRed / 20);

    //Werte ausgeben
    TrackBar1.Position := bXgesRed;
    TrackBar2.Position := bXgesGreen;
    TrackBar3.Position := bXgesBlue;

    Application.ProcessMessages;
  finally
    ReleaseDC(0, Handle);
  end;
end;

Das läuft bei mir ohne die geringsten Ressourcenlecks.

Übrigens: Mit Deinen Berechnungen (jeden 64. Pixel nehmen und daraus den Durchschnitt berechnen) bekommst Du keine wirkliche Durchschnittsfarbe des Desktops, sondern nur eine sehr grobe Näherung, die auch komplett falsch sein kann. Außerdem funktioniert Deine Methode nur bei der Auflösung von 1280x1024 (20 * 64 x 16 * 64).

Gruß
xaromz

[meg91]

vielen Dank
endlich gehts super