TMemo的滚动条DoubleBuffered

Question

我将TMemo用作日志，并在每次调用事件时在其中添加行。 在添加新行之前，我先使用BeginUpdate ，然后使用EndUpdate并启用DoubleBuffered 。 但是，似乎滚动条根本没有被双重缓冲，从而保持闪烁。 有没有办法将滚动条设置为DoubleBuffered := True ？

编辑：

寄宿生似乎也在闪烁。 不确定是否与滚动条相关。

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

我非常怀疑双重缓冲是否会对您有所帮助。 实际上，通常来说，我总是建议您避免使用它。 现代操作系统会自动为您执行此操作，并且添加越来越多的缓冲层只会损害性能，并且在外观上不会发生任何变化。

您的问题听起来很像是您过于频繁地更新GUI。 而不是缓冲绘画，而是缓冲GUI控件的文本内容。

1. 创建一个文本缓冲区（一个字符串列表）来保存新的日志消息。
2. 添加一个刷新频率为5Hz的计时器。 如果您愿意，请选择其他汇率。
3. 当您有新的日志信息时，请将其添加到缓冲区字符串列表中。
4. 当计时器触发时，将缓冲区添加到GUI控件，然后刷新缓冲区列表。

与主线程上的缓冲区列表进行所有交互，以避免日期争用。