Delphi TMemo&x27；s滚动条双缓冲

我使用

TMemo

作为日志，并在每次调用事件时向其添加行。 在添加新行之前，我使用

BeginUpdate

，然后使用

EndUpdate

，并且启用了

双缓冲

。然而，滚动条似乎根本不是双缓冲的，而是一直在闪烁。是否有办法将滚动条设置为

DoubleBuffered:=True

编辑：

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

单位窗口；
接口
使用
Winapi.Windows、Winapi.Messages、System.SysUtils、System.Variants、System.Classes、Vcl.Graphics、，
Vcl.控件、Vcl.窗体、Vcl.对话框、Vcl.StdCtrls、Vcl.ExtCtrls、IdContext、，
IdBaseComponent、IDGlobal、IdComponent、IdCustomTCPServer、IdTCPServer、，
Vcl.ComCtrls，Winsock；
类型
TMainWindow=类（TForm）
TCPServer:TIdTCPServer；
状态栏：TStatusBar；
PageControl:TPageControl；
配置表：TTabSheet；
开始按钮：t按钮；
PortEdit:TLabeledEdit；
记录表：TTabSheet；
日志备忘录：TMemo；
日志编辑：TLabeledEdit；
TCPLogSheet:TTabSheet；
TCPLogEdit:TLabeledEdit；
TCPLogMemo:TMemo；
复选框1:t复选框；
程序开始按钮点击（发送方：TObject）；
私有的
公众的
结束；
//=====================================================================公共VAR===================================
变量
主窗口：TMainWindow；
hServer:TSocket；
sAddr:TSockAddrIn；
ListenerThread:TThread；
//========================================线程数=====================================
类型
TListenThread=class（TThread）
私有的
过程WriteToTCPLog（文本：字符串）；
公众的
形式：TMainWindow；
程序执行；推翻
结束；
类型
TReceiveThread=class（TThread）
私有的
过程WriteToTCPLog（文本：字符串）；
公众的
形式：TMainWindow；
hSocket:TSocket；
IP：字符串；
程序执行；推翻
结束；
实施
{$R*.dfm}
//===================================================用途======================================
使用
乌托尔，
UCO常数；
//==========================================================TListenThread============================
过程TListenThread.WriteToTCPLog（文本：字符串）；
变量
MaxLines：整数；
开始
如果没有（Form.CheckBox1.Checked），则退出；
如果GetCurrentThreadId=MainThreadID，则开始
Form.TCPLogMemo.Lines.BeginUpdate；
MaxLines:=stroint（Form.TCPLogEdit.Text）；
如果Form.TCPLogMemo.Lines.Count>=MaxLines，则开始
重复
Form.TCPLogMemo.Lines.Delete（0）；
直到Form.TCPLogMemo.Lines.Count=MaxLines，则开始
重复
Form.TCPLogMemo.Lines.Delete（0）；
直到Form.TCPLogMemo.Lines.Count0，则开始
WriteToTCPLog（IP+）-接收到的数据（“+inttostr（iRecv）+”字节）；
结束；
如果iRecv我非常怀疑双缓冲是否能在这里帮助您。事实上，作为一般规则，我总是建议避免它。现代操作系统会自动为您执行此操作，添加越来越多的缓冲层只会损害性能，而不会在视觉上改变任何东西

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

创建一个文本缓冲区，一个字符串列表，以保存新的日志消息
添加一个刷新率为5Hz的计时器。如果您愿意，请选择不同的费率
当您有新的日志信息时，将其添加到缓冲区字符串列表中
当计时器触发时，将缓冲区添加到GUI控件，并刷新缓冲区列表
在主线程上执行与缓冲区列表的所有交互，以避免日期争用。
我非常怀疑双缓冲是否能帮助您。事实上，作为一般规则，我总是建议避免它。现代操作系统会自动为您执行此操作，添加越来越多的缓冲层只会影响性能，而不会在视觉上改变任何东西。
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.