Mehrere Hundert Images (Seitenminiaturen)

[Bjoerk]

Ich habe einen Ergebnislister, der ähnlich wie Adobe pdf Reader Seitenminiaturen anzeigt. Im Beispiel habe ich 316 Seiten, was 316 Images mit Bitmaps 210 x 279 (183 kB) bedeutet.
Das Problem ist, daß nach 188 Images Schluß ist und das Onklick nur bis Seite 94 funktioniert.

Ist das ein Speicherproblem und /oder kann eine Scrollbox nicht ca. 100.000 Pixel hoch sein?

Erzeugen tue ich folgendermaßen:

Delphi-Quellcode:

procedure TViewerForm.FormCreate(Sender: TObject);
var
  I, ATop: integer;
  AImage: TImage;
  ALabel: TLabel;
begin
  FFileName := TStrUtils.ExcludeQuotes(ParamStr(1));

  FViewer := TViewer.Create(FFileName);
  FPlot.CanvasStyle := csDefault;
  SetBounds(50, 50, Min(FPlot.CanvasWidth(210 + 10) + ScrollBox.Left, Screen.WorkAreaWidth - 100),
    Min(FPlot.CanvasHeight(297), Screen.WorkAreaHeight - 100));
  FStretch := FPlot.ppMM / FViewer.ppMM;
  FZoom := 100 * FStretch;
  PaintBox.Width := Round(FStretch * FViewer.Width);
  PaintBox.Height := Round(FStretch * FViewer.Height);

  ThumbPanel.Height := FViewer.Count * (297 + 20 + 30) + 20; // zzgl. je Rand oben/unten;
  ATop := 20;
  for I := 0 to FViewer.Count - 1 do
  begin
    AImage := TImage.Create(ThumbPanel);
    AImage.Name := Format('Image%d', [I]);
    AImage.Parent := ThumbPanel;
    AImage.Tag := I;
    AImage.Left := 10;
    AImage.Width := 210;
    AImage.Height := 297;
    AImage.Top := ATop;
    FViewer.LoadThumbFromFile(I);
    AImage.Picture.Assign(FViewer.Thumb);
    AImage.Cursor := crHandPoint;
    AImage.OnClick := LabelClick;

    ALabel := TLabel.Create(ThumbPanel);
    ALabel.Name := Format('Label%d', [I]);
    ALabel.Parent := ThumbPanel;
    ALabel.Tag := I;
    ALabel.Font.Name := 'Segoe UI';
    ALabel.Font.Size := 8;
    ALabel.Font.Color := clBlack;
    ALabel.Font.Style := [fsUnderline];
    ALabel.Caption := IntToStr(I + 1);
    ALabel.Top := AImage.Top + AImage.Height + 10;
    ALabel.Left := 10 + (AImage.Width - ALabel.Width) div 2;
    ALabel.Cursor := crHandPoint;
    ALabel.OnClick := LabelClick;

    Inc(ATop, 297 + 20 + 30);
  end;
end;

[Mavarik]

Eine Scrollbox hat eine Range... (Da bin ich auch mal drüber gestolpert)

Aber die eigentliche Frage ist... Warum willst Du eine Scrollbox mit fast 400 Images usw. belasten?

100.000 Punkte kannst Du sowieso nicht auf einmal darstellen...

LoadOnView?

Mavarik

[Luckie]

Hm. AImage: TImage; ist lokal deklariert. So bald die Methode verlassen wird, ist das Objekt ungültig. Du hst dir damit also ein riesen großen Spicherleck gebaut. Das ist das eine. Und das andere, da blicke ich aber noch nicht so ganz durch, warum es überhaupt funktioniert, du überschreibst das Objekt immer wieder bis du die Schleife verlässt....

Ich würde die Images auch dynamisch erstellen, abe rin einer Objektliste verwalten.

[Bjoerk]

Versteh ich nicht? AImage ist TImage.Create. Der Owner bzw. das Parent geben es wieder frei.

[DeddyH]

Richtig, da Du sowohl Owner als auch Parent setzt, ist das Image in dessen/deren Components- bzw. Controls-Array abgelegt, also nix Speicherleck.

[Luckie]

Hm. OK. Dann behaupte ich das Gegenteil. :mrgreen:

[Bjoerk]

Ich glaub, es reicht sogar nur der Parent.

Die Idee mit dem LoadOnView von Mavarik gefällt mir. Man könnte so 20 Seitenminiaturen vorhalten. Der Pdf Reader wird es wohl ähnlich machen. Hat jemand eine Idee, wie man so was realisieren könnte?

[DeddyH]

Nur so als Gedankenspiel: Du kannst ja errechnen, wie viele Images gleichzeitig sichtbar sein können. Nehmen wir noch 2 in jede Richtung als Puffer dazu, dann merkst Du beim Scrollen, wann es Zeit wird, neue Images in Scrollrichtung zu erzeugen und zu befüllen. In der anderen Richtung kannst Du dann diejenigen, die weder in den sichtbaren noch im Puffer enthalten sind, wieder freigeben.

[Uwe Raabe]

Kannst du nicht einfach ein Standard TDrawGrid nehmen, ColCount auf 1, RowCount auf Anzahl der Bilder, DefaultRowHeight und DefaultColWidth auf die Bildgröße. Im OnDrawCell-Event dann einfach das Bild auf den TDrawGrid.Canvas malen, in etwa so (angenommen FViewer.Thumb ist ein TGraphic):

Delphi-Quellcode:

procedure TForm137.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
  FViewer.LoadThumbFromFile(ARow);
  (Sender as TDrawGrid).Canvas.Draw(Rect.Left, rect.Top, FViewer.Thumb);
end;

[Medium]

Zitat:

Zitat von Bjoerk (Beitrag 1353413)

Ich glaub, es reicht sogar nur der Parent.

Zwar leicht OT, aber:
Parent = Darstellung (auf wessen Canvas habe ich mich zu zeichnen)
Owner = kaskadierte Freigabe

[Bjoerk]

Nein, das stimmt nicht so einfach. Der Owner kann bei vielen Controls ja auch auch nil sein.

D2007 Hilfe: "Die in TControl deklarierte Eigenschaft Parent ähnelt der Eigenschaft Owner von TComponent darin, dass die hier angegebenen Objekte für das Freigeben des Steuerelements zuständig sind. Jedoch ist das in Parent enthaltene Objekt immer eine fensterorientierte Komponente, die das Steuerelement visuell enthält und beim Speichern des Formulars für das Schreiben des Steuerelements in einen Stream verantwortlich ist. Owner enthält das Objekt, das beim Instantiieren des Steuerelements als Parameter an den Konstruktor übergeben wurde. Dieser Eigentümer veranlasst das Speichern aller Objekte (einschließlich des Steuerelements und seiner übergeordneten Komponente), wenn das Formular gespeichert wird."

[Bjoerk]

Zitat:

Zitat von DeddyH (Beitrag 1353415)

Nur so als Gedankenspiel: Du kannst ja errechnen, wie viele Images gleichzeitig sichtbar sein können. Nehmen wir noch 2 in jede Richtung als Puffer dazu, dann merkst Du beim Scrollen, wann es Zeit wird, neue Images in Scrollrichtung zu erzeugen und zu befüllen. In der anderen Richtung kannst Du dann diejenigen, die weder in den sichtbaren noch im Puffer enthalten sind, wieder freigeben.

So (ähnlich) hab ich's nun gemacht. Ein Panel und eine Scrollbar (sbVertical, alRight) drauf. Für die Scrollbar Min und Max Position setzen. Dann nur noch die aktuelle Position weiterleiten. Position blättert ThumbImage.Height weise.

Delphi-Quellcode:

procedure TViewerForm.FormCreate(Sender: TObject);
const
  cThumbHeight = 198;
var
  I, ATop, ThumbImagesCount: integer;
begin
  [..]

  ThumbScrollBar.Max := FViewer.Count;
  FThumbImages := TThumbImages.Create(false, ThumbPanel, FViewer.Thumbs);

  if Screen.WorkAreaHeight mod cThumbHeight = 0 then
    ThumbImagesCount := Min(FViewer.Count, Screen.WorkAreaHeight div cThumbHeight)
  else
    ThumbImagesCount := Min(FViewer.Count, Screen.WorkAreaHeight div cThumbHeight + 1);

  ATop := 0;
  for I := 0 to ThumbImagesCount - 1 do
  begin
    FThumbImages.ItemsAdd;
    FThumbImages[I].Name := Format('ThumbImage%d', [I]);
    FThumbImages[I].Tag := I + 1;
    FThumbImages[I].Left := 10;
    FThumbImages[I].Top := ATop;
    FThumbImages[I].Graphic := FViewer.Thumb[I];
    FThumbImages[I].OnClick := ThumbImageClick;
    FThumbImages[I].OnMouseEnter := ThumbImageMouseEnter;
    FThumbImages[I].OnMouseLeave := ThumbImageMouseLeave;
    Inc(ATop, FThumbImages[I].Height);
  end;
end;

procedure TViewerForm.ThumbScrollBarChange(Sender: TObject);
begin
  FThumbImages.ScrollBarPosition := ThumbScrollBar.Position;
end;

procedure TViewerForm.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  ThumbScrollBar.Position :=
    RangeValue(ThumbScrollBar.Position - Sign(WheelDelta), 1, ThumbScrollBar.Max);
end;

Delphi-Quellcode:

unit uThumbImage;

interface

uses
  Classes, SysUtils, Dialogs, Controls, Graphics, Contnrs;

type
  TThumbImage = class(TGraphicControl)
  private
    FPicture: TPicture;
    FSelected: boolean;
    function GetGraphic: TGraphic;
    procedure SetGraphic(const Value: TGraphic);
    procedure SetSelected(const Value: boolean);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Align;
    property Anchors;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Constraints;
    property ParentShowHint;
    property ShowHint;
    property Visible;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
    property Color;
    property ParentColor;
    property ParentFont;
    property OnClick;
    property Graphic: TGraphic read GetGraphic write SetGraphic; // Seitenminiatur
    property Selected: boolean read FSelected write SetSelected;
    property Tag; // *** Seite = Tag
  end;

  TThumbs = class // Alle Seitenminiaturen
  private
    FItems: TObjectList;
    function GetItems(Index: integer): TBitmap;
    function GetCount: integer;
  public
    function ItemsAdd: integer;
    property Items[Index: integer]: TBitmap read GetItems; default;
    property Count: integer read GetCount;
    constructor Create;
    destructor Destroy; override;
  end;

  TThumbImages = class // MaxVisibleCount Seitenminiaturen
  private
    FItems: TObjectList;
    FParent: TWinControl;
    FThumbs: TThumbs;
    function GetItems(Index: integer): TThumbImage;
    function GetCount: integer;
    procedure SetScrollBarPosition(const Value: integer);
  public
    function ItemsAdd: integer;
    property ScrollBarPosition: integer write SetScrollBarPosition;
    property Items[Index: integer]: TThumbImage read GetItems; default;
    property Count: integer read GetCount;
    constructor Create(OwnsObjects: boolean; Parent: TWinControl; Thumbs: TThumbs);
    destructor Destroy; override;
  end;

procedure Register;

implementation

{ TThumbImage }

procedure Register;
begin
  RegisterComponents('Samples', [TThumbImage]);
end;

constructor TThumbImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  Cursor := crHandPoint;
  FPicture := TPicture.Create;
  Width := 140 + 10 + 10; // GraphicWidth + MarginLeft + MarginRight
  Height := 198 + 20 + 30; // GraphicHeight + MarginTop + MarginBottom
  Font.Name := 'Segoe UI';
  Font.Size := 8;
  Font.Color := clBlack;
  Font.Style := [fsUnderline];
  Color := clInactiveBorder;
end;

destructor TThumbImage.Destroy;
begin
  FPicture.Free;
  inherited;
end;

function TThumbImage.GetGraphic: TGraphic;
begin
  Result := FPicture.Graphic;
end;

procedure TThumbImage.SetGraphic(const Value: TGraphic);
begin
  FPicture.Assign(Value);
  Invalidate;
end;

procedure TThumbImage.SetSelected(const Value: boolean);
begin
  FSelected := Value;
  Invalidate;
end;

procedure TThumbImage.Paint;
var
  ATop, ALeft, ABottom, ARight, SumMarginsY, X, Y: integer;
  S: string;
begin
  Canvas.Brush.Color := Color;
  Canvas.FillRect(Rect(0, 0, Width, Height));

  if Tag > 0 then
  begin
    SumMarginsY := Height - FPicture.Height;
    ALeft := (Width - FPicture.Width) div 2;
    ATop := Round(0.4 * SumMarginsY);
    Canvas.Draw(ALeft, ATop, FPicture.Graphic);

    Canvas.Font.Assign(Font);
    S := IntToStr(Tag);
    X := ALeft + (FPicture.Width - Canvas.TextWidth(S)) div 2;
    Y := Round(0.6 * SumMarginsY) + FPicture.Height;
    Canvas.TextOut(X, Y, S);

    ARight := ALeft + FPicture.Width;
    ABottom := ATop + FPicture.Height;
    if FSelected then
      Canvas.Pen.Color := clHighlight
    else // Lowered;
      Canvas.Pen.Color := clBtnShadow;
    Canvas.MoveTo(ALeft, ABottom);
    Canvas.LineTo(ALeft, ATop);
    Canvas.LineTo(ARight, ATop);
    if not FSelected then
      Canvas.Pen.Color := clBtnHighlight;
    Canvas.MoveTo(ARight, ATop);
    Canvas.LineTo(ARight, ABottom);
    Canvas.LineTo(ALeft, ABottom);
  end;
end;

{ TThumbs }

constructor TThumbs.Create;
begin
  FItems := TObjectList.Create;
end;

destructor TThumbs.Destroy;
begin
  FItems.Free;
  inherited;
end;

function TThumbs.GetCount: integer;
begin
  Result := FItems.Count;
end;

function TThumbs.GetItems(Index: integer): TBitmap;
begin
  Result := TBitmap(FItems[Index]);
end;

function TThumbs.ItemsAdd: integer;
begin
  Result := FItems.Add(TBitmap.Create);
end;

{ TThumbImages }

constructor TThumbImages.Create(OwnsObjects: boolean; Parent: TWinControl; Thumbs: TThumbs);
begin
  FItems := TObjectList.Create(OwnsObjects);
  FParent := Parent;
  FThumbs := Thumbs; // Kopplung;
end;

destructor TThumbImages.Destroy;
begin
  FItems.Free;
  inherited;
end;

function TThumbImages.GetCount: integer;
begin
  Result := FItems.Count;
end;

function TThumbImages.GetItems(Index: integer): TThumbImage;
begin
  Result := TThumbImage(FItems[Index]);
end;

function TThumbImages.ItemsAdd: integer;
begin
  Result := FItems.Add(TThumbImage.Create(FParent));
  Items[Result].Parent := FParent;
end;

procedure TThumbImages.SetScrollBarPosition(const Value: integer);
var
  I, Index, Tag: integer;
begin
  if FThumbs.Count > Count then // else nothing to do
    if (Value >= 1) and (Value <= FThumbs.Count) then // = ScrollBarPosition.Min .. ScrollBarPosition.Max
      for I := 0 to Count - 1 do
      begin
        Index := I + Value - 1; // Null basiert (Items);
        Tag := Index + 1; // Eins basiert (Seitennummer);
        if Index < FThumbs.Count then
        begin
          Items[I].Tag := Tag;
          Items[I].Graphic := FThumbs[Index];
        end
        else
        begin
          Items[I].Tag := 0;
          Items[I].Invalidate;
        end;
      end;
end;

end.