0

我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.
4

1 回答 1

4

我非常怀疑双缓冲是否会对您有所帮助。事实上，作为一般规则，我总是建议避免它。现代操作系统会自动为您执行此操作，并且添加越来越多的缓冲层只会损害性能并且在视觉上没有任何改变。

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

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

在主线程上执行与缓冲区列表的所有交互以避免日期竞争。

于 2013-10-06T08:26:26.050 回答