AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein GUI-Design mit VCL / FireMonkey / Common Controls Delphi TListBox.DrawItem blockiert komplette Anwendung dauerhaft

TListBox.DrawItem blockiert komplette Anwendung dauerhaft

Offene Frage von "HolgerX"
Ein Thema von berens · begonnen am 9. Mär 2016 · letzter Beitrag vom 9. Mär 2016
Antwort Antwort
berens

Registriert seit: 3. Sep 2004
426 Beiträge
 
Delphi 2010 Professional
 
#1

TListBox.DrawItem blockiert komplette Anwendung dauerhaft

  Alt 9. Mär 2016, 11:13
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.
  Mit Zitat antworten Zitat
Benutzerbild von Neutral General
Neutral General
Online

Registriert seit: 16. Jan 2004
Ort: Bendorf
5.188 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#2

AW: TListBox.DrawItem blockiert komplette Anwendung dauerhaft

  Alt 9. Mär 2016, 14:28
Also bei mir (Delphi 7, Windows 7) friert der Code (1:1 übernommen) den VCL Thread nicht ein.
Michael
"Programmers talk about software development on weekends, vacations, and over meals not because they lack imagination,
but because their imagination reveals worlds that others cannot see."
  Mit Zitat antworten Zitat
HolgerX

Registriert seit: 10. Apr 2006
Ort: Leverkusen
939 Beiträge
 
Delphi 6 Professional
 
#3

AW: TListBox.DrawItem blockiert komplette Anwendung dauerhaft

  Alt 9. Mär 2016, 15:18
Hmm..

Bei mir (Delphi6 Win7) ebenfalls nicht, flackert nur ein bisschen..
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 09:45 Uhr.
Powered by vBulletin® Copyright ©2000 - 2022, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf