Anwendung ruckelt beim Vergrößern/Verkleinern

[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;