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.

Answer 1

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.

1. Create a text buffer, a string list, to hold new log messages.
2. Add a timer with a refresh rate of, say 5Hz. Choose a different rate if you prefer.
3. When you have new log information, add this to the buffer string list.
4. 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.