TMemo的雙滾動滾動條

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控件，並刷新緩衝區列表。

執行與主線程上的緩衝區列表的所有交互以避免日期比賽。