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.