TMemo's Scrollbar DoubleBuffered

Question

I use TMemo as a Log and I add lines to it every time an event has been called. Before I add a new line I use BeginUpdate and then EndUpdate and also have DoubleBuffered enabled. However, it seems like that the scrollbar(s) are not double buffered at all an keep flickering. Is there a way I can also set the scrollbars to DoubleBuffered := True?

Edit:

It seems like that the boarder is flickering too. Not sure if that's associated with the scrollbar(s).

unit uMainWindow;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, IdContext,
  IdBaseComponent, IDGlobal, IdComponent, IdCustomTCPServer, IdTCPServer,
  Vcl.ComCtrls, Winsock;

type
  TMainWindow = class(TForm)
    TCPServer: TIdTCPServer;
    StatusBar: TStatusBar;
    PageControl: TPageControl;
    ConfigSheet: TTabSheet;
    StartButton: TButton;
    PortEdit: TLabeledEdit;
    LogSheet: TTabSheet;
    LogMemo: TMemo;
    LogEdit: TLabeledEdit;
    TCPLogSheet: TTabSheet;
    TCPLogEdit: TLabeledEdit;
    TCPLogMemo: TMemo;
    CheckBox1: TCheckBox;
    procedure StartButtonClick(Sender: TObject);
  private

  public

  end;

// ============================= Public Vars ===================================

var
  MainWindow          : TMainWindow;
  hServer             : TSocket;
  sAddr               : TSockAddrIn;
  ListenerThread      : TThread;

// =============================== Threads =====================================

type
  TListenThread = class (TThread)
  private
    procedure WriteToTCPLog (Text : String);
  public
    Form        : TMainWindow;
    procedure Execute; override;
end;

type
  TReceiveThread = class (TThread)
  private
    procedure WriteToTCPLog (Text : String);
  public
    Form          : TMainWindow;
    hSocket       : TSocket;
    IP            : String;
    procedure Execute; override;
end;

implementation

{$R *.dfm}

// ================================= Uses ======================================

uses
  uTools,
  uCommonConstants;

// ================================== TListenThread ============================

procedure TListenThread.WriteToTCPLog(Text: string);
var
  MaxLines : Integer;
begin
  if not(Form.CheckBox1.Checked) then exit;
  if GetCurrentThreadId = MainThreadID then begin
    Form.TCPLogMemo.Lines.BeginUpdate;
    MaxLines := StrToInt(Form.TCPLogEdit.Text);
    if Form.TCPLogMemo.Lines.Count >= MaxLines then begin
      repeat
        Form.TCPLogMemo.Lines.Delete(0);
      until Form.TCPLogMemo.Lines.Count < MaxLines;
    end;
    Form.TCPLogMemo.Lines.Add (Text);
    Form.TCPLogMemo.Lines.EndUpdate;
  end else begin
    Text := '[' + DateToStr (Now) + ' - ' + TimeToStr(Now) + '] ' + Text;
    Synchronize(procedure begin WriteToTCPLog(Text); end);
  end;
end;

procedure TListenThread.Execute;
var
  iSize               : Integer;
  hClient             : TSocket;
  cAddr               : TSockAddrIn;
  SynchIP             : String;
begin
  WriteToTCPLog ('Server started');
  while not (terminated) do begin
    iSize := SizeOf(cAddr);
    hClient := Accept(hServer, @cAddr, @iSize);
    if (hClient <> INVALID_SOCKET) then begin
      SynchIP  := inet_ntoa(cAddr.sin_addr);
      WriteToTCPLog(SynchIP + ' - connected.');
      with TReceiveThread.Create (TRUE) do begin
        FreeOnTerminate := TRUE;
        hSocket         := hClient;
        IP              := SynchIP;
        Form            := Self.Form;
        Resume;
      end;
    end else begin
      break;
    end;
  end;
  WriteToTCPLog('Server stopped.');
end;

// ==================================== TReceiveThread =========================

procedure TReceiveThread.WriteToTCPLog(Text: string);
var
  MaxLines : Integer;
begin
  if not(Form.CheckBox1.Checked) then exit;
  if GetCurrentThreadId = MainThreadID then begin
    Form.TCPLogMemo.Lines.BeginUpdate;
    MaxLines := StrToInt(Form.TCPLogEdit.Text);
    if Form.TCPLogMemo.Lines.Count >= MaxLines then begin
      repeat
        Form.TCPLogMemo.Lines.Delete(0);
      until Form.TCPLogMemo.Lines.Count < MaxLines;
    end;
    Form.TCPLogMemo.Lines.Add (Text);
    Form.TCPLogMemo.Lines.EndUpdate;
  end else begin
    Text := '[' + DateToStr (Now) + ' - ' + TimeToStr(Now) + '] ' + Text;
    Synchronize(procedure begin WriteToTCPLog(Text); end);
  end;
end;

procedure TReceiveThread.Execute;
var
  iRecv   : Integer;
  bytBuf  : Array[0..1023] of byte;
begin
  iRecv := 0;
  while true do begin
    ZeroMemory(@bytBuf[0], Length(bytBuf));
    iRecv := Recv(hSocket, bytBuf, SizeOf(bytBuf), 0);
    if iRecv > 0 then begin
      WriteToTCPLog(IP + ' - data received (' + inttostr(iRecv) + ' bytes).');
    end;
    if iRecv <= 0 then break;
  end;
  WriteToTCPLog(IP + ' - disconnected.');
  closesocket(hSocket);
end;

// ================================= TMainWindow ===============================

procedure TMainWindow.StartButtonClick(Sender: TObject);
begin
  if StartButton.Caption = 'Start' then begin
    try
      hServer                             := Socket(AF_INET, SOCK_STREAM, 0);
      sAddr.sin_family                    := AF_INET;
      sAddr.sin_port                      := htons(StrToInt(PortEdit.Text));
      sAddr.sin_addr.S_addr               := INADDR_ANY;
      if Bind(hServer, sAddr, SizeOf(sAddr)) <> 0 then raise Exception.Create('');
      if Listen(hServer, 3)                  <> 0 then raise Exception.Create('');
    except
      OutputError   (Self.Handle, 'Error','Port is already in use or blocked by a firewall.' + #13#10 +
                                  'Please use another port.');
      exit;
    end;
    ListenerThread                        := TListenThread.Create (TRUE);
    TListenThread(ListenerThread).Form    := Self;
    TListenThread(ListenerThread).Resume;
    StartButton.Caption := 'Stop';
  end else begin
    closesocket(hServer);
    ListenerThread.Free;
    StartButton.Caption := 'Start';
  end;
end;

end.

Can you show some code or explain what you're trying to solve? I use a TMemo as a log similarly in multiple apps, don't use Begin/EndUpdate or DoubleBuffered, and I don't have any issues. Are you using `Lines.Add()`? — Marcus Adams, Oct 06 '13 at 13:54
@MarcusAdams Yes I use `Lines.Add`. There is no code just a lot of tthreads that synchronize with the GUI. If I don't use Begin/EndUpdate nor DoubleBuffered it flickers. — Ben, Oct 06 '13 at 16:21
@MarcusAdams I added code. You need a client that connects and sends data in an infinite loop. — Ben, Oct 07 '13 at 18:37
The only way I could get it to "flicker" was by removing the begin/endupdate because the delete moves the scroll button up and the add moves it down. I think this uses GDI. Perhaps your machine has GDI issues (is slow)? Maybe you could describe the flickering. — Marcus Adams, Oct 07 '13 at 20:21
If the worker threads are putting the log information into a `TThreadedQueue`, and this queue is drained in the main thread inside a timer event, the strain of the GUI will ease and likely the flicker will not be of any problem anymore. All in all, this is what David is proposing. — LU RD, Oct 07 '13 at 20:23

score 4 · Accepted Answer · answered Oct 06 '13 at 08:26

4

I doubt very much if double buffering will help you here. In fact, as a general rule I always recommend avoiding it. Modern operating systems do it automatically for you and adding more and more layers of buffering just hurts performance and changes nothing visually.

Your problem sounds very much as though you are updating the GUI too frequently. Instead of buffering the painting, buffer the text content of the GUI control.

Create a text buffer, a string list, to hold new log messages.
Add a timer with a refresh rate of, say 5Hz. Choose a different rate if you prefer.
When you have new log information, add this to the buffer string list.
When the timer fires, add the buffer to the GUI control, and flush the buffer list.

Perform all interaction with the buffer list on the main thread to avoid date races.

answered Oct 06 '13 at 08:26

David Heffernan

601,492
42
1,072
1,490

The text content of the Memo does not flicker. Just the boarder and the scrollbar. Thanks for your answer tho. – Ben Oct 06 '13 at 16:21
1

I guess you need to give us a repro then. Because if the issue is not the update frequency then something else is the problem. How can we reproduce the problem? – David Heffernan Oct 06 '13 at 16:32
I added some code. You will need a TCP Client that sends constantly data – Ben Oct 07 '13 at 18:38
1

The behaviour cannot be reproduced without TCP comms? – David Heffernan Oct 07 '13 at 20:02
1

How about you make an SSCCE. With one of those, I'd investigate and solve the problem. – David Heffernan Oct 07 '13 at 21:36

TMemo's Scrollbar DoubleBuffered

1 Answers1