* * *

Author Topic: Repaint of TListView either works, doesn't work, or produces error.  (Read 961 times)

R0b0t1

  • Jr. Member
  • **
  • Posts: 74
I have a TListView populated by strings representing TThreads handling a connection. In those threads I implemented callback functions for connection, disconnection, and miscellaneous errors. I would like to display the state of the connection in the list view for now, and possibly automatically remove dead connections - so I use the callbacks for this.

Sometimes it will work and the thread's name will go from "<name> (disconnected)" to "<name>" immediately. Other times it will not work and the name will not change until a new client is added. Other times this error will be produced:

Code: [Select]
(relgui:21868): Gtk-CRITICAL **: gtk_tree_view_unref_tree_helper: assertion 'node != NULL' failed
This has happened once:

Code: [Select]
**
Gdk:ERROR:/home/jmm/scratch/gtk/gtk+2.0-2.24.25/gdk/gdkwindow.c:2888:gdk_window_end_implicit_paint: assertion failed: (private->implicit_paint != NULL)
Aborted

This has happened once, and a dialog popped up:

Code: [Select]
(relgui:21897): Gtk-CRITICAL **: gtk_tree_view_unref_tree_helper: assertion 'node != NULL' failed
TApplication.HandleException List index (-1) out of bounds
  Stack trace:
  $0000000000477780
  $000000000045FC40 line 150 of form.pas
  $000000000065094E line 761 of include/customlistview.inc
  $000000000064BD4A line 840 of include/listitem.inc
  $000000000064BC74 line 817 of include/listitem.inc
  $000000000064E29F line 823 of include/listitems.inc
  $000000000074AE0C line 235 of gtk2listviewtreemodel.pas
  $00007F3469DE0ACA

And most recently I have had an element of the TListView disappear and have the GUI fail to respond to closing the window, but with the elements still responsive.

Code: Pascal  [Select]
  1. unit tcpclient;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, ssl_openssl, blcksock;
  9.  
  10. type
  11.   TErrorHook = procedure(Sender: TObject;
  12.                          const Value: Integer;
  13.                          const Desc: String) of object;
  14.   TConnectHook = procedure(Sender: TObject) of object;
  15.   TDisconnectHook = procedure(Sender: TObject) of object;
  16.  
  17.   PTCPClient = ^TTCPClient;
  18.  
  19.   TTCPClient = class(TThread)
  20.   private
  21.     FHost: String;
  22.     FPort: Integer;
  23.     FCertFile: String;
  24.     FConnected: Boolean;
  25.     FOnError: TErrorHook;
  26.     FOnConnect: TConnectHook;
  27.     FOnDisconnect: TDisconnectHook;
  28.   protected
  29.     procedure Execute; override;
  30.   public
  31.     Socket: TTCPBlockSocket;
  32.     constructor Create(CreateSuspended: Boolean;
  33.                        const StackSize: SizeUInt=DefaultStackSize);
  34.     property Host: String read FHost write FHost;
  35.     property Port: Integer read FPort write FPort;
  36.     property CertFile: String read FCertFile write FCertFile;
  37.     property Connected: Boolean read FConnected;
  38.     property OnError: TErrorHook read FOnError write FOnError;
  39.     property OnConnect: TConnectHook read FOnConnect write FOnConnect;
  40.     property OnDisconnect: TDisconnectHook read FOnDisconnect
  41.                                            write FOnDisconnect;
  42.   end;
  43.  
  44. implementation
  45.  
  46. { TTCPClient }
  47.  
  48. procedure TTCPClient.Execute;
  49. var
  50.   Line: String;
  51. begin
  52.   try
  53.     Socket.SSL.CertCAFile := FCertFile;
  54.     Socket.Connect(FHost, IntToStr(FPort));
  55.     Socket.SSLDoConnect;
  56.  
  57.     if Socket.LastError <> 0 then
  58.     begin
  59.       if FOnError <> nil then
  60.         FOnError(Self, Socket.LastError, Socket.LastErrorDesc);
  61.       Exit;
  62.     end
  63.     else
  64.     begin
  65.       if FOnConnect <> nil then
  66.         FOnConnect(Self);
  67.       FConnected := True;
  68.     end;
  69.  
  70.     repeat
  71.       while Socket.CanRead(1000) do
  72.       begin
  73.         Line := Socket.RecvString(1);
  74.         if Line = '' then
  75.            Exit;
  76.         WriteLn(Line);
  77.       end;
  78.     until False;
  79.   finally
  80.     if FOnDisconnect <> nil then
  81.       FOnDisconnect(Self);
  82.     Socket.Free;
  83.   end;
  84. end;
  85.  
  86. constructor TTCPClient.Create(CreateSuspended: Boolean;
  87.                               const StackSize: SizeUInt=DefaultStackSize);
  88. begin
  89.   inherited Create(CreateSuspended, StackSize);
  90.   Socket := TTCPBlockSocket.Create;
  91.   Socket.ConvertLineEnd := True;
  92. end;
  93.  
  94. end.

Code: Pascal  [Select]
  1. unit form;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, DateTimePicker, Forms, Controls, Graphics,
  9.   Dialogs, StdCtrls, Buttons, ComCtrls, tcpclient;
  10.  
  11. type
  12.   { TClientItem }
  13.  
  14.   TClientItem = class(TCollectionItem)
  15.   private
  16.     FHost, FPort: String;
  17.     FConn: TTCPClient;
  18.   public
  19.     constructor Create(ACollection: TCollection); override;
  20.   published
  21.     property Host: String read FHost write FHost;
  22.     property Port: String read FPort write FPort;
  23.     property Conn: TTCPClient read FConn write FConn;
  24.   end;
  25.  
  26.   { TClientList }
  27.  
  28.   TClientList = class(TCollection)
  29.   private
  30.     function GetItem(Index: Integer): TClientItem;
  31.     procedure SetItem(Index: Integer; AValue: TClientItem);
  32.   protected
  33.   public
  34.     constructor Create;
  35.     function Add: TClientItem;
  36.     property Items[Index: Integer]: TClientItem
  37.       read GetItem write SetItem; default;
  38.   end;
  39.  
  40.   { TMainForm }
  41.  
  42.   TMainForm = class(TForm)
  43.     HostComboBox: TComboBox;
  44.     ConnectButton: TButton;
  45.     StartDateTimePicker: TDateTimePicker;
  46.     StartButton: TButton;
  47.     ConnectionListView: TListView;
  48.     procedure ConnectButtonClick(Sender: TObject);
  49.     procedure ConnectionListViewData(Sender: TObject;
  50.                                      Item: TListItem);
  51.     procedure FormCreate(Sender: TObject);
  52.   private
  53.     Clients: TClientList;
  54.     procedure ClientError(Sender: TObject;
  55.                           const Value: Integer;
  56.                           const Desc: String);
  57.     procedure ClientConnect(Sender: TObject);
  58.     procedure ClientDisconnect(Sender: TObject);
  59.   public
  60.   end;
  61.  
  62. var
  63.   MainForm: TMainForm;
  64.  
  65. implementation
  66.  
  67. {$R *.lfm}
  68.  
  69. { TClientItem }
  70.  
  71. constructor TClientItem.Create(ACollection: TCollection);
  72. begin
  73.   if Assigned(ACollection) then
  74.     inherited Create(ACollection);
  75. end;
  76.  
  77. { TClientList }
  78.  
  79. constructor TClientList.Create;
  80. begin
  81.   inherited Create(TClientItem);
  82. end;
  83.  
  84. function TClientList.GetItem(Index: Integer): TClientItem;
  85. begin
  86.   Result := TClientItem(inherited Items[Index]);
  87. end;
  88.  
  89. procedure TClientList.SetItem(Index: Integer; AValue: TClientItem);
  90. begin
  91.   Items[Index].Assign(AValue);
  92. end;
  93.  
  94. function TClientList.Add: TClientItem;
  95. begin
  96.   Result := inherited Add as TClientItem;
  97. end;
  98.  
  99. { TMainForm }
  100.  
  101. procedure TMainForm.ConnectButtonClick(Sender: TObject);
  102. var
  103.   HostLen, DelimPos: Integer;
  104.   NewHost, NewPort: String;
  105.   NewClient: TTCPClient;
  106. begin
  107.   // TODO: Insert unique hosts into the Items array.
  108.  
  109.   HostLen := Length(HostComboBox.Text);
  110.   DelimPos := Pos(':', HostComboBox.Text);
  111.   if (DelimPos = 0) or (DelimPos = HostLen) then
  112.     NewPort := '2200'
  113.   else
  114.     NewPort := Copy(HostComboBox.Text, DelimPos + 1, HostLen);
  115.  
  116.   if (DelimPos = 1) or (HostLen = 0) then
  117.     NewHost := 'localhost'
  118.   else
  119.   begin
  120.     if DelimPos = 0 then
  121.       DelimPos := HostLen + 1;
  122.     NewHost := Copy(HostComboBox.Text, 0, DelimPos - 1);
  123.   end;
  124.  
  125.   // TODO: Allow customization of certificate file.
  126.   NewClient := TTCPClient.Create(True);
  127.   with NewClient do
  128.   begin
  129.     Host := NewHost;
  130.     Port := StrToInt(NewPort);
  131.     CertFile := 'keys/id_rsa.crt';
  132.     OnError := @ClientError;
  133.     OnConnect := @ClientConnect;
  134.     OnDisconnect := @ClientDisconnect;
  135.     Start;
  136.   end;
  137.  
  138.   with Clients.Add do
  139.   begin
  140.     Host := NewHost;
  141.     Port := NewPort;
  142.     Conn := NewClient;
  143.   end;
  144.  
  145.   ConnectionListView.Items.Count := ConnectionListView.Items.Count + 1;
  146. end;
  147.  
  148. procedure TMainForm.ConnectionListViewData(Sender: TObject; Item: TListItem);
  149. begin
  150.   Item.Caption := Clients.Items[Item.Index].Host + ':' +
  151.                   Clients.Items[Item.Index].Port;
  152.   if not Clients.Items[Item.Index].Conn.Connected then
  153.     Item.Caption := Item.Caption + ' (disconnected)';
  154. end;
  155.  
  156. procedure TMainForm.FormCreate(Sender: TObject);
  157. begin
  158.   Clients := TClientList.Create;
  159. end;
  160.  
  161. procedure TMainForm.ClientError(Sender: TObject;
  162.                                 const Value: Integer;
  163.                                 const Desc: String);
  164. begin
  165. end;
  166.  
  167. procedure TMainForm.ClientConnect(Sender: TObject);
  168. begin
  169.   //ConnectionListView.Repaint;
  170.   //ConnectionListView.Invalidate;
  171.   //ConnectionListView.Update;
  172.   Repaint;
  173.   Invalidate;
  174. end;
  175.  
  176. procedure TMainForm.ClientDisconnect(Sender: TObject);
  177. begin
  178.   ConnectionListView.Repaint;
  179.   ConnectionListView.Invalidate;
  180. end;
  181.  
  182. end.

There's so many different calls to what should be equivalent functions because I was seeing if they behaved differently under GTK. It seems like whether it works or not depends on the internal state of X and the GTK libraries. I was having rather good luck with Repaint over Update and Invalidate, but there's a good chance that doesn't mean anything.
« Last Edit: February 02, 2017, 10:01:32 pm by R0b0t1 »

GetMem

  • Hero Member
  • *****
  • Posts: 2044
Re: Repaint of TListView either works, doesn't work, or produces error.
« Reply #1 on: February 02, 2017, 11:14:07 pm »
Quote
And most recently I have had an element of the TListView disappear and have the GUI fail to respond to closing the window, but with the elements still responsive.
Because the whole design is not thread safe. By using a TCollection with each TCollectionItem containing a thread, basically you create an unsafe thread list. Whenever a TTCPClient(thread) is added or removed the list should be locked by using critical sections, but that's not happening. You should switch to a TThreadList instead. TThreadList already implements all the locking mechanism for you.
One more thing replace TListView with TVirtualStringTree. It's painful in the beginning, but you won't regret it in the long term.


R0b0t1

  • Jr. Member
  • **
  • Posts: 74
Re: Repaint of TListView either works, doesn't work, or produces error.
« Reply #2 on: February 03, 2017, 06:46:14 pm »
Quote
And most recently I have had an element of the TListView disappear and have the GUI fail to respond to closing the window, but with the elements still responsive.
Because the whole design is not thread safe. By using a TCollection with each TCollectionItem containing a thread, basically you create an unsafe thread list. Whenever a TTCPClient(thread) is added or removed the list should be locked by using critical sections, but that's not happening. You should switch to a TThreadList instead. TThreadList already implements all the locking mechanism for you.
One more thing replace TListView with TVirtualStringTree. It's painful in the beginning, but you won't regret it in the long term.

I don't mind implementing thread safety if it is necessary but I'm extremely confused as to why it is necessary. What I have done should be thread safe, as the various asynchronous elements only read and the elements are only written on initialization. Nothing is being manipulated by the threads in the list, the threads don't even access the list. They simply exist in a list managed by the GUI thread. Is interrupting the GUI with a call to Repaint enough to cause the erroneous behavior? If it is, then the problem isn't really in the data structure, it's in the expectations of the windowing library.

I have seen many references to virtual tree views, so I will look into those at your recommendation.

GetMem

  • Hero Member
  • *****
  • Posts: 2044
Re: Repaint of TListView either works, doesn't work, or produces error.
« Reply #3 on: February 03, 2017, 07:44:21 pm »
Quote
Is interrupting the GUI with a call to Repaint enough to cause the erroneous behavior?
Every GUI update, even a repaint must be done through the synchronize/queue method otherwise is not thread safe.

I suppose in the future you wish to display some data received through the socket(thread) in the GUI. What if multiple clients try to update the same GUI, for example you wish to display all the clients status/data at server side. In this case you must lock the list.

Quote
I have seen many references to virtual tree views, so I will look into those at your recommendation.
Please take a look at this basic example: http://forum.lazarus.freepascal.org/index.php/topic,35545.msg235381.html#msg235381
Download virtual tree from here: https://github.com/blikblum/VirtualTreeView-Lazarus/releases/tag/lazarus-4.8.7-R4 , you must install lcl-extensions first.

 

R0b0t1

  • Jr. Member
  • **
  • Posts: 74
Re: Repaint of TListView either works, doesn't work, or produces error.
« Reply #4 on: February 03, 2017, 09:44:27 pm »
Quote
I have seen many references to virtual tree views, so I will look into those at your recommendation.
Please take a look at this basic example: http://forum.lazarus.freepascal.org/index.php/topic,35545.msg235381.html#msg235381
Download virtual tree from here: https://github.com/blikblum/VirtualTreeView-Lazarus/releases/tag/lazarus-4.8.7-R4 , you must install lcl-extensions first.

I'm running into an issue I have before and had to abandon research on. Attempting to build lcl-extensions gives the error:

Code: [Select]
Compile package bgracontrols 4.3.1.2: Exit code 256, Errors: 1
bclistbox.pas(155,1) Error: resource compiler "windres" not found, switching to external mode

I had run into this before when attempting to install that package explicitly. I've found a few threads mentioning it but all of them simply ask the OP to check if the executable exists. On my  installation it seems not to. A program called `fpcres` is. Can you point me toward anything that might fix it? Should I open a new thread in a different location?

Cyrax

  • Sr. Member
  • ****
  • Posts: 495
Re: Repaint of TListView either works, doesn't work, or produces error.
« Reply #5 on: February 03, 2017, 09:48:58 pm »
Grap needed files (windres.zip) from this bug report : http://bugs.freepascal.org/view.php?id=29698

EDIT: Ah, sorry. It seems that you are developing under Linux OS. Then you need to install mingw package from your OS package repository.
« Last Edit: February 03, 2017, 09:53:14 pm by Cyrax »

R0b0t1

  • Jr. Member
  • **
  • Posts: 74
Re: Repaint of TListView either works, doesn't work, or produces error.
« Reply #6 on: February 03, 2017, 10:27:41 pm »
Grap needed files (windres.zip) from this bug report : http://bugs.freepascal.org/view.php?id=29698

EDIT: Ah, sorry. It seems that you are developing under Linux OS. Then you need to install mingw package from your OS package repository.

Predictably, I found this thread just after asking which pointed me towards the mingw32 package which contains the executable I needed. I had to create a symlink to the proper file as the name isn't "windres." I believe the other issue I had was related to not using the 4.8 release. Switched to that and it installed. Thanks!


 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus