Delphi-PRAXiS - Listbox.DoubleBuffered Anzeigeproblem

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