Fehler beim Parent setzen eines Labels

[Jumpy]

Wenn ich Chat lese, denke ich, wurden auch irgendwelche TCP/Socket/Irgendwas-Komponenten verwendet, oder? Wenn dann an einer solchen Komponente eine Nachricht ankommt, das Event, ist das dann nicht in dem Fall immer als eigener Thread implementiert? Muss daher die Darstellung (e.g. die Panels usw.) nicht threadsafe gemacht werden?

[CreativeMD]

so
ich habe es jetzt in eine Klass geschrieben:

Delphi-Quellcode:

unit ChatSystem_Class;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdContext, Vcl.ComCtrls, Vcl.StdCtrls,
  IdCustomTCPServer, IdTCPServer, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, Vcl.Menus, Vcl.ExtCtrls, mmSystem, ClipBrd, User, Contnrs,
  Data.DB, Datasnap.DBClient, Datasnap.Win.MConnect, Datasnap.Win.SConnect,
  Vcl.OleCtrls, SHDocVw, JvExStdCtrls, JvRichEdit, ShellApi;

type
  TChatSystem = class
  private
    current_Height: Integer;
    Panel: TPanel;
    ScrollBar: TScrollBar;
    Objekte: TObjectList;
    PopupMenu: TPopupMenu;
  public
    Constructor Create(Panel_Need: TPanel; Scrollbar_Need: TScrollBar;
      PopupMenu_Need: TPopupMenu);
    Destructor Free;
    procedure onMouseOver(Sender: TObject);
    procedure onMouseOut(Sender: TObject);
    procedure onMouseClick(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure renderLabels;
    procedure addButton(id: Integer; Text: String);
    procedure addProgessbar(id: Integer);
    procedure addImage(Text: String);
    procedure addText(Text: String);
    procedure addUserText(Text: String);
    procedure newMessage;

  end;

implementation

Constructor TChatSystem.Create(Panel_Need: TPanel; Scrollbar_Need: TScrollBar;
  PopupMenu_Need: TPopupMenu);
begin
  Panel := Panel_Need;
  ScrollBar := Scrollbar_Need;
  PopupMenu := PopupMenu_Need;
  Objekte := TObjectList.Create;
end;

Destructor TChatSystem.Free;
begin
  Objekte.Clear;
  Panel.Free;
  ScrollBar.Free;
  PopupMenu.Free;
end;

procedure TChatSystem.newMessage;
begin
  renderLabels;
  ScrollBar.Position := current_Height - ScrollBar.PageSize;
  renderLabels;
end;

procedure TChatSystem.renderLabels;
var
  zahl: Integer;
begin

  current_Height := 0;

  for zahl := 0 to Objekte.count - 1 do
  begin
    // Label
    if Objekte[zahl] is TLabel then
    begin
      (Objekte[zahl] as TLabel).Top := current_Height - ScrollBar.Position;
      current_Height := current_Height + (Objekte[zahl] as TLabel).Height;
    end;

    // Bild
    if Objekte[zahl] is TImage then
    begin
      // Ausrechnen der Größe
      (Objekte[zahl] as TImage).Height := Panel.Height div 3;

      (Objekte[zahl] as TImage).Width := (Objekte[zahl] as TImage)
        .Picture.Width div ((Objekte[zahl] as TImage)
        .Picture.Height div (Objekte[zahl] as TImage).Height);

      // Ausrechen der Position
      (Objekte[zahl] as TImage).Top := current_Height - ScrollBar.Position;
      current_Height := current_Height + (Objekte[zahl] as TImage).Height;
    end;

    // Progressbar
    if Objekte[zahl] is TProgressBar then
    begin
      (Objekte[zahl] as TProgressBar).Top := current_Height -
        ScrollBar.Position;
      current_Height := current_Height + (Objekte[zahl] as TProgressBar).Height;
    end;

    // Button
    if Objekte[zahl] is TButton then
    begin

      (Objekte[zahl] as TButton).Top := current_Height - ScrollBar.Position;
      current_Height := current_Height + (Objekte[zahl] as TButton).Height;
    end;
  end;

  current_Height := current_Height + 10;

  if Panel.Height < current_Height then
  begin
    ScrollBar.Max := current_Height;
    ScrollBar.PageSize := Panel.Height;
    ScrollBar.Enabled := true;

  end
  else
  begin
    ScrollBar.Enabled := false;
  end;

  Application.ProcessMessages;
end;

procedure TChatSystem.addUserText(Text: String);
var
  Label_Create: TLabel;
begin
  Label_Create := TLabel.Create(Panel);
  Label_Create.Parent := Panel;

  Label_Create.Caption := Text;
  Label_Create.Top := 0;
  Label_Create.Left := 0;
  Label_Create.Autosize := false;
  Label_Create.Font.size := 13;

  Label_Create.Width := Panel.Width;
  Label_Create.Height := 20;

  Label_Create.Font.Color := clHotLight;

  Label_Create.Tag := Objekte.count;

  Label_Create.OnMouseDown := onMouseClick;
  Label_Create.Cursor := crHandPoint;

  Objekte.Add(Label_Create);

  // newMessage;
end;

procedure TChatSystem.addText(Text: String);
var
  Label_Create: TLabel;
begin
  Label_Create := TLabel.Create(Panel);
  Label_Create.Parent := Panel;

  Label_Create.Caption := Text;
  Label_Create.Top := 0;
  Label_Create.Left := 10;
  Label_Create.Autosize := true;
  Label_Create.Tag := Objekte.count;
  Label_Create.OnMouseEnter := onMouseOver;
  Label_Create.OnMouseLeave := onMouseOut;

  Objekte.Add(Label_Create);

  newMessage;

end;

procedure TChatSystem.onMouseOver(Sender: TObject);
begin
  case (Sender as TComponent).Tag of
    0:
      (Sender as TLabel).Font.Style := (Sender as TLabel).Font.Style + [fsBold];
end;

renderLabels;
end;

procedure TChatSystem.onMouseOut(Sender: TObject);
begin
  case (Sender as TComponent).Tag of
    0:
      (Sender as TLabel).Font.Style := (Sender as TLabel).Font.Style - [fsBold];
end;
renderLabels;
end;

procedure TChatSystem.onMouseClick(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if ssRight in Shift then
  begin
    PopupMenu.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
  end;
end;

procedure TChatSystem.addImage(Text: String);
var
  Image_Create: TImage;
begin
  Image_Create := TImage.Create(Panel);
  Image_Create.Parent := Panel;
  Image_Create.Picture.LoadFromFile(Text);
  Image_Create.Height := 150;
  Image_Create.Width := Image_Create.Picture.Width div
    (Image_Create.Picture.Height div Image_Create.Height);
  Image_Create.Stretch := true;
  Image_Create.Top := 0;
  Image_Create.Left := 10;
  Image_Create.Tag := Objekte.count;
  Image_Create.OnMouseDown := onMouseClick;
  Image_Create.DragMode := dmAutomatic;

  Objekte.Add(Image_Create);

  newMessage;
end;

procedure TChatSystem.addProgessbar(id: Integer);
var
  Progressbar_Create: TProgressBar;
begin
  Progressbar_Create := TProgressBar.Create(Panel);
  Progressbar_Create.Parent := Panel;
  Progressbar_Create.Left := 10;
  Progressbar_Create.Top := 0;

  Progressbar_Create.Max := 100;
  Progressbar_Create.Position := 0;
  Progressbar_Create.Height := 20;
  Progressbar_Create.Width := 100;

  Progressbar_Create.Tag := Objekte.count;
  Progressbar_Create.MarqueeInterval := id;

  Objekte.Add(Progressbar_Create);

  newMessage;

end;

procedure TChatSystem.addButton(id: Integer; Text: String);
var
  Button_Create: TButton;
begin
  Button_Create := TButton.Create(Panel);
  Button_Create.Parent := Panel;
  Button_Create.Caption := Text;
  Button_Create.Left := 10;
  Button_Create.Top := 0;
  // Button_Create.Height := Form1.Canvas.TextHeight(Text) + 10;
  // Button_Create.Width := Form1.Canvas.TextWidth(Text) + 10;
  Button_Create.Tag := Objekte.count;
  // Button_Create.TBDockHeight := id;

  Objekte.Add(Button_Create);

  newMessage;
end;

end.

In der Form1 sieht das dann so aus

Delphi-Quellcode:

unit Main;

interface

uses
  Winapi.Windows, Winapi.Messages ...

type

  TForm1 = class(TForm)
    IdTCPClient1: TIdTCPClient;
    IdTCPServer1: TIdTCPServer;
    ...
    procedure Netzwerkbeitreten1Click(Sender: TObject);
    procedure Netzwerkerstellen1Click(Sender: TObject);
    ...

var
  //Ich habe alles nicht relevante rausgelassen da die Unit fast 700 Zeilen hat

  ChatSystem : TChatSystem;

implementation

uses Erstellen, Beitreten...
{$R *.dfm}



procedure TForm1.IdTCPClient1Disconnected(Sender: TObject);
begin
  ChatSystem.addUserText('server');
  ChatSystem.addText('Die Verbindung zum Server wurde getrennt');
  ClientThread.Terminate;
end;


procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
  Name: String;
begin
  Name := Form1.removeUser(AContext.Binding.IP);

  sendServerMessage(Name + ' verließ den Server');
  Server.updateUser;
  Form1.updateListView;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

  ChatSystem := TChatsystem.Create(Panel1, ScrollBar1, Bild);

end;



end.

Das ist lange nicht alles aber ich hoffe das reicht um einen Eindruck zu bekommen wie ich versuche die
Klasse zu nutzen.

Es wird immer komischer, wenn ich das Programm debugge funktioniert es einwandfrei,
wenn nicht dann nicht.

Ich versteh das einfach nicht.

[CreativeMD]

hm,
soweit ich das verstanden habe liegt es also am Thread.
Gibt es wirklich keine Möglichkeit diesen Fehler zu beheben?

und müsste nicht bei dem RichEdit derselbe Fehler kommen?

[himitsu]

Die VCL ist nunmal nicht threadsicher und daher darf man diese einfach grundsätzlich nicht unsynchronisiert in Threads verwenden *punkt*

Ein TLabel ist keine eigenständige Komponente, sondern sie hängt sich "brutal" in dessen Parent, um sich auf dessen Canvas zu zeichnen.

Beim RichEdit gibt es vielleicht an dieser Stelle zufällig grade kein Problem, aber daß heißt nicht, daß es nicht wo anders knallen könnte.

PS: Die Owner- und Parentbeziehungen werden auch noch in mehreren TList verwaltet, welche nicht threadsicher sind und hierbei bearbeitet werden,
außerdem gibt es viele weitere gemeinsam genutze Komponenten, wie Fonts, Brushs, Pens usw., welche ebenfalls nicht threadsicher sind.


Fazit: Man macht das einfach nicht, selbst wenn es zufällig dennoch scheinbar mal keine Probleme zu geben scheint.


Und dazu wird das Messagehandling mit dem Thread verlinkt, wo eine Komponente erstellt wird, also da wo z.B. das CreateWindow aufgerufen wird.
Delphi hat von sich aus nur im Hauptthread eine Messagebehandlung integriert. In allen anderen Threads müsste man dieses selber erledigen.
Das merkt man sehr gut, denn wenn man den Haupttread auslastet und der VCL keine Möglichkeit bietet diese Messages zu verarbeiten, dann hängen alle Fenster.

[CreativeMD]

Zitat von himitsu:

Und dazu wird das Messagehandling mit dem Thread verlinkt, wo eine Komponente erstellt wird, also da wo z.B. das CreateWindow aufgerufen wird.
In allen anderen Threads müsste man dieses selber erledigen.

Wie?

Application.ProcessMessages; ?

[himitsu]

Nein, denn dieses ist nur für den Hauptthread, da darin ebenfalls auf globale VCL-Dinge zugegriffen wird.

Also praktisch alles nur NonVCL.
PeekMessage, TranslateMessage und DispatchMessage

[CreativeMD]

ok,
soweit so gut.

Ich hab mich mal eine kurze Zeit mit C++ beschäftigt und da stand im Buch
das jede Anwendung dem Windows eine Existenz nachricht schicken muss.

Ich hab mich jetzt ein bisschen Umgeschaut aber ich habe nirgends ein Beispiel dafür gefunden
wie ich diese drei Funktionen anwenden könnte.(Kann auch sein, dass ich das falsche Wort gegoogelt habe.)

[CreativeMD]

Was wirklich niemand wie man diese Funktionen anwendenden kann?

[himitsu]

Was nun genau?



Wenn du auf die VCL zugreifst, dann einfach immer nur synchronisiert und schon gibt es keinerlei Probleme.

Existenznachicht?
Nee, Windows guckt nur, ob Messages verarbeitet werden, wenn welche in der MessageQueue rumgammeln, und wenn sich da eine Weile lang nix tut, dann hängt für Windows diese Anwendung.

[CreativeMD]

Zitat von himitsu:

Was nun genau?



Wenn du auf die VCL zugreifst, dann einfach immer nur synchronisiert und schon gibt es keinerlei Probleme.

Existenznachicht?
Nee, Windows guckt nur, ob Messages verarbeitet werden, wenn welche in der MessageQueue rumgammeln, und wenn sich da eine Weile lang nix tut, dann hängt für Windows diese Anwendung.

Du hast mich gerade etwas verwirrt, wie und was soll ich synchronisieren?

Zitat von CreativeMD:

Zitat von himitsu:

Und dazu wird das Messagehandling mit dem Thread verlinkt, wo eine Komponente erstellt wird, also da wo z.B. das CreateWindow aufgerufen wird.
In allen anderen Threads müsste man dieses selber erledigen.

Du hast doch vorhin von den drei Funktionen geredet.

Was muss ich mit denen denn machen?

Wie?

Application.ProcessMessages; ?