TListBox.DrawItem blockiert komplette Anwendung dauerhaft

[berens]

Hallo zusammen,
für ein Projekt benötige ich letztendlich eine Listbox, bei der in jedem Eintrag eine Menge unterschiedlicher Informationen stehen. Dies habe ich als "Bild" umgesetzt, im Sinne von: ich verwende Style := lbOwnerDrawFixed und OnDrawItem, um alles zu Zeichnen. Soweit kein Problem.

Um die Listbox nicht zu überfrachten sind logischerweise bestimmte Angaben als Icon/Symbol auf dem Eintrag dargestellt. Wenn ein (neuer) Benutzer wissen will, was dieses Symbol bedeutet, geht er mit der Maus drüber, und ein Tooltip soll anzeigen, worum es sich bei dem Symbol handelt. Anhand von OnMouseMove und den X/Y Koordinaten kann ich also passend zum Symbol den Tooltip anzeigen. Soweit kein Problem.

Jetzt spuckt mir allerdings wieder Windows in die Suppe: Durch OwnerDraw habe ich das Problem, dass z.B. unter dem letzten Eintrag (wenn schon runter gescrollt wurde) alles Schwarz ist, oder dass wenn ein anderer Eintrag selektiert wird, bei dem -vorher- selektierten Eintrag die farbliche Hervorhebung bestehen bleibt. Also muss ich -soweit ich das verstanden habe- zwischendrin entweder Repaint, Update oder Invalidate aufrufen. Hier also konkret nachdem gescrollt wurde (Schwarzer Kasten), ein neuer Eintrag selektiert wurde (damit der alte deselektiert wird) oder die Maus bewegt wurde, damit der "eingebrannte" Tooltip wieder entfernt wird.

An dieser Stelle wird es merkwürdig, vielleicht müsst Ihr das nachfolgende Programm selbst testen und könnt es hoffentlich nachvollziehen:

Wenn das Programm gestartet ist, und sich die Maus über der Listbox befindet (auch wenn Sie NICHT bewegt wird!), werden vom kompletten Programm keinerlei Messages mehr verarbeitet. Der VCL-Thread steht still. Erst mit verlassen der Maus aus der TListbox läuft das Programm weiter.

Das Ganze ist schön zu beobachten, wenn man sich einen Timer einbaut, der jede Sekunde die aktuelle Uhrzeit in der Titelleiste des Fensters anzeigen lässt - sobald die Maus über der ListBox ist, steht die Uhr.

Mich würde zunächst die Ursache für das Problem interessieren.

Wahrscheinlich läuft es auf einen Zirkelbezug hinaus. Wo ich das hier gerade schreibe fällt mir ein zu kontrollieren, was der Prozessor macht: Maus über ListBox: kontinuierlich ~12,5% Prozessorauslastung, was bei 8 CPU-Kernen einer Auslastung von 100% entspricht. Das dürfe es wohl sein.

Die Frage ist, welches Ereignis nun was auslöst. Denn wenn die Maus stillsteht, solle er ja nicht mehr zeichnen?

Als nächstes die Frage nach der Lösung.
-Ist die Funktion mit den Tooltips überhaupt praktikabel oder eine programmiertechnische Todsünde?
-Ist das Zeichnen auf ein temporäres Bitmap für OnDrawItem überhaupt zulässig? Hier scheinen die akuten Probleme zu hängen, aber wo bekomme ich sonst ein TCanvas her? Wenn ich ein TCanvas direkt instanziere und drauf zeichen will, kommt:

Zitat:

---------------------------
Benachrichtigung über Debugger-Exception
---------------------------
Im Projekt Project1.exe ist eine Exception der Klasse EInvalidOperation mit der Meldung 'Leinwand/Bild erlaubt kein Zeichnen' aufgetreten.
---------------------------
Anhalten Fortsetzen Hilfe
---------------------------

-Wie löst man das sauber?
-Was genau löst den scheinbaren Zirkelbezug aus?

Delphi 2010, Windows 10 x64

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TTestListBox = class(TListBox)
  private
    procedure TestListBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure TestListBoxDrawItem(Control: TWinControl; Index: Integer; _Rect: TRect; State: TOwnerDrawState);  virtual;
  public
    constructor Create(Owner: TComponent); override;

  end;

  TForm1 = class(TForm)
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    timer1:TTimer;
    tlb: TTestListBox;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  tlb := TTestListBox.Create(Self);
  with tlb do begin
    Parent := Self;
    left := 100;
    top := 100;
    width := 300;
    height := 300;
    Items.Add('x');
    Items.Add('x');
    Items.Add('x');
  end;

  timer1 := TTimer.Create(Self);
  timer1.OnTimer := Timer1Timer;
  timer1.Interval := 100;
  timer1.Enabled := True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Caption := FormatDateTime('HH:nn:ss zzz', Now);
end;

{ TTestListBox }

constructor TTestListBox.Create(Owner: TComponent);
begin
  inherited;
  Style := lbOwnerDrawFixed;
  OnDrawItem := TestListBoxDrawItem;
  OnMouseMove := TestListBoxMouseMove;
end;

procedure TTestListBox.TestListBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  Repaint;
end;

procedure TTestListBox.TestListBoxDrawItem(Control: TWinControl; Index: Integer; _Rect: TRect; State: TOwnerDrawState);
var
  bmp: Graphics.TBitmap;
begin
    bmp := Graphics.TBitmap.Create;
    bmp.Width := 300;
    bmp.Height := 300;

//    bmp.Width := Control.ClientWidth;
//    bmp.Height := Control.ClientHeight;

    if not Control.InheritsFrom(TCustomListBox) then begin
      ShowMessage('Control <> TListBox!');
    end;

    bmp.Canvas.Brush.Assign((Control as TCustomListBox).Canvas.Brush);
    bmp.Canvas.Pen.Assign((Control as TCustomListBox).Canvas.Pen);


    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);
end;


end.

[Neutral General]

Also bei mir (Delphi 7, Windows 7) friert der Code (1:1 übernommen) den VCL Thread nicht ein.

[HolgerX]

Hmm..

Bei mir (Delphi6 Win7) ebenfalls nicht, flackert nur ein bisschen..