Полоса прокрутки TMemo DoubleBuffered

Question

Я использую TMemo как журнал, и я добавляю строки к нему каждый раз, когда событие вызывается. Прежде чем добавить новую строку, я использую BeginUpdate, а затем EndUpdate, а также включил DoubleBuffered. Однако похоже, что полоса прокрутки (-ов) не является двойной буферизацией во всех случаях мерцания. Есть ли способ, которым я также могу установить полосы прокрутки на DoubleBuffered := True?

Edit:

Похоже, что граница мерцает тоже. Не уверен, что это связано с полосой прокрутки.

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 слишком часто. Вместо буферизации картины буферизируйте текстовое содержимое элемента управления графическим интерфейсом.

1. Создайте текстовый буфер, список строк, чтобы сохранить новые сообщения журнала.
2. Добавить таймер с частотой обновления, скажем, 5 Гц. Если хотите, выберите другую ставку.
3. Когда у вас есть новая информация о журнале, добавьте ее в список строк буфера.
4. Когда таймер срабатывает, добавьте буфер в элемент управления GUI и сбросьте список буферов.

Выполните все взаимодействие с списком буферов основного потока, чтобы избежать гонок на дате.