Anwendung ruckelt beim Vergrößern/Verkleinern

[Aviator]

Hallo zusammen,

mit folgendem Quellcode zeichne ich diverse Bilder in eine PaintBox:

Delphi-Quellcode:

procedure TfrmCardInfo.pbCardsPaint(Sender: TObject);
var
  i, col, row: Integer;
  BasePath, s: string;
  img: TJPEGImage;
  Start: Cardinal;
begin
  if (FBFCardInfoList.Count > 0) then begin
    img := TJPEGImage.Create;
    try
      col := 1;
      row := 0;
      i := 0;
      Start := GetTickCount;
      repeat
        FBFCardInfoList[i].Picture.Position := 0;
        img.LoadFromStream(FBFCardInfoList[i].Picture);
        pbCards.Canvas.Draw((col - 1) * img.Width + 5, row * img.Height + 10, img);

        if ((col mod FMaxCols) = 0) then begin
          col := 1;
          Inc(row);
        end else
          Inc(col);
        Inc(i);
      until (i >= FBFCardInfoList.Count);
      lblOrbs.Caption := IntToStr((GetTickCount - Start));
    finally
      img.Free;
    end;
  end;
end;

Die Bilder wurden zuvor in einem Thread von der Festplatte geladen und werden nun in einem Klassenobjekt in einer Objectlist aufbewahrt. Ich lade beim Zeichnen der Bilder auch immer nur noch aus einem Stream in ein TJPEGImage. Jedoch fängt die Anwendung an zu ruckeln, sobald ich das Fenster vergrößere und verkleinere. Die PaintBox in die gezeichnet wird, wird beim ändern der Formgröße immer durch die Anchor Property mit angepasst. Nehme ich die Zeile pbCards.Canvas.Draw((col - 1) * img.Width + 5, row * img.Height + 10, img); raus, dann läuft es flüssig(er). Getestet unter Windows 10 und Windows 7. Woran kann das liegen? Ist die Canvas.Draw Methode wirklich so langsam?

Wie kann ich das beschleunigen, da ich diese Ruckeleffekte nicht haben möchte?

PS: Das lblOrbs habe ich dazu verwendet, um die Zeit auszugeben wie lange gezeichnet wird. Das Ergebnis liegt immer irgendwo bei 300 - 370ms.

[Zacherl]

Was passiert, wenn du deine Grafiken zuerst auf ein internes Buffer Bitmap zeichnest und dann nur einmalig das Bitmap in der Paintbox ausgibst? Zudem könntest du schauen, ob die geänderte Größe im Vergleich zur letzten Größe überhaupt mehr Cols und Rows anzeigen kann. Falls nicht, nimmst du einfach wieder das alte Bitmap und sparst dir das interne Zeichnen komplett.

[Aviator]

Zitat von Zacherl:

Was passiert, wenn du deine Grafiken zuerst auf ein internes Buffer Bitmap zeichnest und dann nur einmalig das Bitmap in der Paintbox ausgibst? Zudem könntest du schauen, ob die geänderte Größe im Vergleich zur letzten Größe überhaupt mehr Cols und Rows anzeigen kann. Falls nicht, nimmst du einfach wieder das alte Bitmap und sparst dir das interne Zeichnen komplett.

Hi Zacherl,
das werde ich mal ausprobieren. Bin auch schon relativ weit gekommen, aber es funkioniert noch nicht ganz. Werde aber dementsprechend Rückmeldung geben wie und ob es (besser) funktioniert. Schonmal danke für den Tipp.

[Aviator]

Hallo zusammen,

habe es jetzt doch noch geschafft, dass auszuprobieren. Das interne Bild wird gemalt und dann erst mit PaintBox.Canvas.Draw(0, 0, InternalBmp); auf die Paintbox gemalt. Beim Vergrößern und Verkleinern der Form wird nur noch neu gezeichnet, wenn sich wirklich die Anzahl der Spalten (und u. U. dadurch auch die Anzahl der Zeilen) verändert. Solange sich die Anzahl Spalten nicht verändert, lässt sich die Form weitestgehend normal ohne ruckeln vergrößern bzw. verkleinern. Sobald aber nachgerechnet und auch neu gezeichnet wird, fängt das Spiel wieder von vorne an. Ich habe jetzt mal 60 Bilder geladen und das aufbauen bzw. neuzeichnen geht schon fast in den Sekundenbereich.

Woran kann das liegen? Ich bin für jeden Tipp dankbar.

Anbei mal noch die relevanten Zeilen, in denen ich das Bild aktuell male:

(Das ständige neu setzen der Größe des InternalBitmap hat übrigens keinen negativen Effekt auf die Dauer. Habe es testweise an eine andere Stelle verschoben und es hat sich nichts geändert.

Delphi-Quellcode:

procedure TfrmCardInfo.GetMaximumColumnsAndRows(const APaintBoxWidth: Integer);
const
  SPACE = 10;
var
  img: TJPEGImage;
  s: string;
begin
  try
    img := TJPEGImage.Create;
    try
      FBFCardInfoList[0].Picture.Position := 0;
      img.LoadFromStream(FBFCardInfoList[0].Picture);
      MaxCols := APaintBoxWidth div (img.Width + SPACE);
      MaxRows := Ceil(FBFCardInfoList.Count / MaxCols);
      PaintBoxHeight := MaxRows * (img.Height + SPACE);
      FInternalBitmap.Height := pbCards.Height;
      FInternalBitmap.Width := pbCards.Width;
    finally
      img.Free;
    end;
  except
    //
  end;
end;

procedure TfrmCardInfo.pbCardsPaint(Sender: TObject);
begin
  pbCards.Canvas.Draw(0, 0, FInternalBitmap);
end;

procedure TfrmCardInfo.RepaintInternalBitmap;
var
  i, col, row, xPos, yPos: Integer;
  img: TJPEGImage;
begin
  FInternalBitmap.Canvas.Brush.Color := clBlack;
  FInternalBitmap.Canvas.FillRect(FInternalBitmap.Canvas.ClipRect);

  Inc(Repaints);
  lblOrbs.Caption := IntToStr(Repaints);
  img := TJPEGImage.Create;
  try
    col := 1;
    row := 0;
    i := 0;
    repeat
      FBFCardInfoList[i].Picture.Position := 0;
      img.LoadFromStream(FBFCardInfoList[i].Picture);
      xPos := (col - 1) * img.Width + 5;
      yPos := row * img.Height + 10;
      FInternalBitmap.Canvas.Draw(xPos, yPos, img);

      if ((col mod FMaxCols) = 0) then begin
        col := 1;
        Inc(row);
      end else
        Inc(col);
      Inc(i);
    until (i >= FBFCardInfoList.Count);
  finally
    img.Free;
  end;
end;

procedure TfrmCardInfo.scbCardsResize(Sender: TObject);
begin
  GetMaximumColumnsAndRows(pbCards.Width);
end;

procedure TfrmCardInfo.SetMaxCols(const Value: Integer);
begin
  if (MaxCols <> Value) then begin
    FMaxCols := Value;
    RepaintInternalBitmap;  // InternalBitmap has to be drawn only once because the maximum number of rows depends on the number of columns
  end;
end;

procedure TfrmCardInfo.SetMaxRows(const Value: Integer);
begin
  if (FMaxRows <> Value) then begin
    FMaxRows := Value;
  end;
end;

procedure TfrmCardInfo.SetPaintBoxHeight(const Value: Integer);
begin
  if (FPaintBoxHeight <> Value) then begin
    FPaintBoxHeight := Value;
    pbCards.Height := Value;
  end;
end;

[Luckie]

Ich glaube BitBlt ist performanter.

[Sir Rufo]

Das ständige Laden eines JPEG aus dem Stream in GetMaximumColumnsAndRows kann man sich durch das Cachen der Werte (die werden sich zur Laufzeit nicht mehr verändern) schenken. Einmal reicht.

Das ständige Laden der Grafiken als JPEG ist auch langsamer, als wenn man sich die Bilder beim ersten Zugriff als Bitmap merkt und dann immer dieses gecachte Bitmap verwendet.

Erstelle dir ein Surrogate (Stellvertreter) für die Bilder. Der Konstruktor erhält z.B. den Dateinamen. Beim ersten Zugriff wird das Bild aus der datei geladen und intern als Bitmap gespeichert. Danach erfolgt jeder weitere Zugriff direkt auf das Bitmap.

Den Surrogate leitet man von TPersistent ab und überschreibt die virtuelle Methode AssignTo .

Zum Zeichnen braucht es dann nur noch

Delphi-Quellcode:

img := TBitmap.Create;

img.Assign( Surrogates[i] ); // temp. Bitmap mit dem Surrogate füllen
// Zeichnen von img

[Aviator]

Hallo Sir Rufo,

ich habe das mal so probiert wie du es gesagt hast. Ich hoffe mal, dass ich das richtig umgesetzt habe. Aber es ist auf jeden Fall schonmal ein gutes Stück schneller und bei normaler FullHD Auflösung ruckelt es auch eigentlich nicht mehr. Bei 4K allerdings merkt man es doch noch etwas. Wobei 4K ja eigentlich nicht so verbreitet ist und das Programm jetzt auch nicht zwingend darauf absolut perfekt laufen muss.

Danke für den Hinweis.

Und danke auch an @Lucky. Das werde ich mir mal ansehen. Kann man damit auch Grafiken verkleinert zeichnen wie man das mit StretchDraw machen kann

[Sir Rufo]

Du musst ja auch nicht jeden Vergrößerungsschritt mitmachen. Wenn du auf die Vergrößerung asynchron reagierst (z.B. per Timer mit Intervall 100/250 -> ausprobieren) dann sollte das auch reichen.

[EWeiss]

Zitat:

Kann man damit auch Grafiken verkleinert zeichnen wie man das mit StretchDraw machen kann

Das Äquivalent für StretchDraw wäre dann StretchBlt.

BitBlt zum Kopieren.
StretchBlt zum verändern.

gruss