Listbox.DoubleBuffered Anzeigeproblem

[berens]

*Staub wegpust* *Hüstel*

Hallo und sorry für das Ausgraben dieses uralten Threads, aber ich habe das gleiche Problem.

Eine lbOwnerDrawFixed TListBox zeigt das beschriebene Problem, sobald gescrollt werden muss:

Alles Items haben eine Höhe von 100px, die Box selbst eine Höhe von sagen wir als Beispiel 250px. Wenn man nun nach unten scrollt (und den ItemIndex _nicht_ verändert: Mausrad, klick auf die Dreieck-Buttons), wird ja immer automatisch soweit gescrollt, dass der oberste sichbare Eintrag bündig mit der Oberkante der kompletten Listbox ist. Wurde nun komplett heruntergescrollt, ist nun auch entsprechend der 5. Eintrag ganz oben (0-100 px), der 6. Eintrag bei 101-200 px, und der Rest der Listbox (201-250 px) ist schwarz.

Dieses Problem taucht nicht auf, wenn mit der Tastatur (Pfeil-Tasten) gescrollt wird, da hier auch der ItemIndex geändert wird, was somit auch ein (korrektes) Neuzeichnen der kompletten Listbox aufruft.

Das Problem tritt nur bei DoubleBuffered auf! Sobald die Listbox das nächste Mal neu gezeichnet wird, ist alles wieder korrekt - bis zum nächsten scrollen.

Die Frage ist nun:
-Berechnet Windows die Listbox falsch und eigentlich sollte beim kompletten Nach-Unten-Scrollen der unterste Eintrag bündig mit der Unterkante der Listbox abschließen? Scheinbar nicht, wenn bei Style lbStandard ist das Scrollverhalten identisch (also sichtbarer Freiraum nach dem letzten Eintrag).
-Wie kann/muss ich diesen Bereich nach dem letzten Eintrag zeichnen? Auch das setzen von Canvas.Brush.Color etc. haben keine Auswirkung.
-BeginUpdate / Endupdate haben hiermit nichts zu tun.
-Muss/sollte ich die Scroll-Windows-Message abfangen und dann ein Repaint aufrufen, oder gibt es eine elegantere Methode?

Delphi-Quellcode:

constructor TMeineListBox.Create(_Owner: TComponent);
begin
    inherited;

    ParentCtl3D := False;
    Ctl3D := False;

    Anchors := [akLeft, akTop, akRight, akBottom];
    BorderStyle := bsNone;

    Color := $00E6E6E6;
    ParentDoubleBuffered := False;
    DoubleBuffered := True;

    ItemHeight := 100;

    Style := lbOwnerDrawFixed;

    OnDrawItem := MeineListBoxDrawItem;
    DragMode := dmAutomatic;
end;

procedure TMeineListBox.MeineListBoxDrawItem(Control: TWinControl; Index: Integer; _Rect: TRect; State: TOwnerDrawState);
var
  re: TRect;
  bmp: Graphics.TBitmap;
begin
    if (Index < 0) or (Index >= Count) then begin
      inherited;
      Exit;
    end;
    if not Self.InheritsFrom(TCustomListBox) then Exit;

    bmp := Graphics.TBitmap.Create;
    bmp.Width := Control.ClientWidth;
    bmp.Height := Control.ClientHeight;
    bmp.Canvas.Brush.Assign((Control as TCustomListBox).Canvas.Brush);
    bmp.Canvas.Pen.Assign((Control as TCustomListBox).Canvas.Pen);

    with bmp.Canvas do begin
      re := _Rect;
      if (odSelected in State) then begin
        Brush.Color := clWhite;
        Pen.Color := clWhite;
        Brush.Color := $00F4F4F4;
        Pen.Color := $00F4F4F4;
      end else begin
        Brush.Color := Self.Color;
        Pen.Color := Self.Color;
      end;

      Brush.Color := clred;
      Pen.Color := clLime;

      Rectangle(re);

      re.Left := re.Left + 5;
      re.Top := re.Top + 5;
      re.Bottom := re.Bottom - 5;
      re.Right := re.Right - 5;

      --> Hier wird meine eigentliche Zeichenprozedur aufgerufen; Problem ist aber unabhängig davon 
    end;

    BitBlt((Control as TCustomListBox).Canvas.Handle, _Rect.Left, _Rect.Top, _Rect.Right - _Rect.Left, _Rect.Bottom - _Rect.Top, bmp.Canvas.Handle, _Rect.Left, _Rect.Top, SRCCOPY);
    FreeAndNil(bmp);

    if (odSelected in State) then begin
      (Control as TCustomListBox).Canvas.DrawFocusRect(_Rect);
    end;

    (Control as TCustomListBox).Canvas.Brush.Color := clLime;
    (Control as TCustomListBox).Canvas.Pen.Color := clRed;
end;

Wie immer vielen Dank im voraus!



Edit1:
Also damit funktioniert es zwar, aber beim Scrollen flackert es nun (logischerweise wegen x-fachen Repaints) so stark, dass man DoubleBuffered auch gleich weglassen kann:

Delphi-Quellcode:

  protected
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
    procedure WMMOUSEWHEEL(var Msg: TMessage); message WM_MOUSEWHEEL;
  ...
procedure TMeineListBox.WMMOUSEWHEEL(var Msg: TMessage);
begin
  inherited;
  Repaint;
end;

procedure TMeineListBox.WMVScroll(var Message: TWMVScroll);
begin
  inherited;
  Repaint;
end;

Edit 2:
[STRIKEOUT]Mit Invalidate anstelle von Repaint scheint es halbwegs ordentlich dargestellt zu werden. Es bleibt trotzdem die Frage, ob dieser Lösungsweg der "richtige" bzw. "elegante" ist.[/STRIKEOUT] Nö, klappt im tatsächlichen Programm dann doch nicht.


Edit 3:
Wer es nachvollziehen will: Neues Projekt mit einer Listbox:

Delphi-Quellcode:

procedure TForm2.FormCreate(Sender: TObject);
var
  i: integer;
begin
  ClientWidth := 500;
  ClientHeight := 250;
  ListBox1.Align := alClient;
  ListBox1.Style := lbOwnerDrawFixed;
  ListBox1.OnDrawItem := MyDrawItem;
  ListBox1.Font.Name := 'Arial';
  ListBox1.Font.Size := 67;
  ParentDoubleBuffered := False;
  DoubleBuffered := True;
  for i := 0 to 5 do begin
    ListBox1.Items.Add(IntToStr(i))
  end;
end;

procedure TForm2.MyDrawItem(Control: TWinControl; Index: Integer; _Rect: TRect; State: TOwnerDrawState);
var
  re: TRect;
  bmp: Graphics.TBitmap;
begin
  with Control as TListBox do
  begin
    Canvas.FillRect(_Rect);
    Canvas.TextOut(_Rect.Left + 2, _Rect.Top, Items[Index]);
  end;
end;