2011-11-08 26 views
20
  • Vì vậy, tôi có một ứng dụng tải các plugin khác nhau và tạo một tab mới trên TPageControl cho mỗi một.
  • Mỗi DLL có một TForm liên kết với nó.
  • Các biểu mẫu được tạo với cha mẹ hWnd làm TTabSheet mới.
  • Vì TTabSheets không phải là cha mẹ của biểu mẫu theo VCL (không muốn sử dụng RTL động và plugin được tạo bằng các ngôn ngữ khác) Tôi phải xử lý thay đổi kích thước theo cách thủ công. Tôi làm điều này như dưới đây:Phụ đề TLabel và TGroupbox Nhấp nháy trên Resize

    var 
        ChildHandle : DWORD; 
    begin 
        If Assigned(pcMain.ActivePage) Then 
        begin 
        ChildHandle := FindWindowEx(pcMain.ActivePage.Handle, 0, 'TfrmPluginForm', nil); 
        If ChildHandle > 0 Then 
         begin 
         SetWindowPos(ChildHandle, 0, 0, 0, pcMain.ActivePage.Width, pcMain.ActivePage.Height, SWP_NOZORDER + SWP_NOACTIVATE + SWP_NOCOPYBITS); 
        end; 
        end; 
    

Bây giờ, vấn đề của tôi là khi ứng dụng được thay đổi kích cỡ, tất cả các TGroupBoxes và TLabels bên trong nhấp nháy TGroupBoxes. TLabels không nằm trong TGroupboxes là tốt và không nhấp nháy.

Những điều tôi đã cố gắng:

  • WM_SETREDRAW theo sau là một RedrawWindow
  • ParentBackground trên TGroupBoxes và TLabels thiết lập để False
  • DoubleBuffer: = True
  • LockWindowUpdate (Vâng, mặc dù tôi biết nó rất sai lầm)
  • Trong suốt: = False (thậm chí trọng tạo để chỉnh sửa ControlState)

Bất kỳ ý tưởng?

+0

Câu hỏi này có một vài ý tưởng bổ sung trong câu trả lời và nhận xét: http://stackoverflow.com/q uestions/4031147 – Argalatyr

Trả lời

25

Điều duy nhất tôi đã tìm thấy để làm việc tốt là sử dụng phong cách WS_EX_COMPOSITED cửa sổ. Đây là một hog hiệu suất vì vậy tôi chỉ kích hoạt nó khi trong một vòng lặp kích thước. Đó là kinh nghiệm của tôi rằng, với các điều khiển tích hợp, trong ứng dụng của tôi, nhấp nháy chỉ xảy ra khi thay đổi kích thước biểu mẫu.

Trước tiên, bạn nên thực hiện kiểm tra nhanh để xem liệu phương pháp này có giúp bạn không đơn giản bằng cách thêm kiểu cửa sổ WS_EX_COMPOSITED vào tất cả các điều khiển cửa sổ của bạn. Nếu thành công, bạn có thể xem xét các phương pháp tiên tiến hơn dưới đây: Hack

nhanh

procedure EnableComposited(WinControl: TWinControl); 
var 
    i: Integer; 
    NewExStyle: DWORD; 
begin 
    NewExStyle := GetWindowLong(WinControl.Handle, GWL_EXSTYLE) or WS_EX_COMPOSITED; 
    SetWindowLong(WinControl.Handle, GWL_EXSTYLE, NewExStyle); 

    for i := 0 to WinControl.ControlCount-1 do 
    if WinControl.Controls[i] is TWinControl then 
     EnableComposited(TWinControl(WinControl.Controls[i])); 
end; 

Gọi này, ví dụ, trong OnShow cho TForm của bạn, đi qua các ví dụ mẫu. Nếu điều đó giúp bạn thực sự nên thực hiện nó một cách sáng suốt hơn. Tôi cung cấp cho bạn các chất chiết xuất có liên quan từ mã của tôi để minh họa cách tôi đã làm điều đó.

Full đang

procedure TMyForm.WMEnterSizeMove(var Message: TMessage); 
begin 
    inherited; 
    BeginSizing; 
end; 

procedure TMyForm.WMExitSizeMove(var Message: TMessage); 
begin 
    EndSizing; 
    inherited; 
end; 

procedure SetComposited(WinControl: TWinControl; Value: Boolean); 
var 
    ExStyle, NewExStyle: DWORD; 
begin 
    ExStyle := GetWindowLong(WinControl.Handle, GWL_EXSTYLE); 
    if Value then begin 
    NewExStyle := ExStyle or WS_EX_COMPOSITED; 
    end else begin 
    NewExStyle := ExStyle and not WS_EX_COMPOSITED; 
    end; 
    if NewExStyle<>ExStyle then begin 
    SetWindowLong(WinControl.Handle, GWL_EXSTYLE, NewExStyle); 
    end; 
end; 

function TMyForm.SizingCompositionIsPerformed: Boolean; 
begin 
    //see The Old New Thing, Taxes: Remote Desktop Connection and painting 
    Result := not InRemoteSession; 
end; 
procedure TMyForm.BeginSizing; 
var 
    UseCompositedWindowStyleExclusively: Boolean; 
    Control: TControl; 
    WinControl: TWinControl; 
begin 
    if SizingCompositionIsPerformed then begin 
    UseCompositedWindowStyleExclusively := Win32MajorVersion>=6;//XP can't handle too many windows with WS_EX_COMPOSITED 
    for Control in ControlEnumerator(TWinControl) do begin 
     WinControl := TWinControl(Control); 
     if UseCompositedWindowStyleExclusively then begin 
     SetComposited(WinControl, True); 
     end else begin 
     if WinControl is TPanel then begin 
      TPanel(WinControl).FullRepaint := False; 
     end; 
     if (WinControl is TCustomGroupBox) or (WinControl is TCustomRadioGroup) or (WinControl is TCustomGrid) then begin 
      //can't find another way to make these awkward customers stop flickering 
      SetComposited(WinControl, True); 
     end else if ControlSupportsDoubleBuffered(WinControl) then begin 
      WinControl.DoubleBuffered := True; 
     end; 
     end; 
    end; 
    end; 
end; 

procedure TMyForm.EndSizing; 
var 
    Control: TControl; 
    WinControl: TWinControl; 
begin 
    if SizingCompositionIsPerformed then begin 
    for Control in ControlEnumerator(TWinControl) do begin 
     WinControl := TWinControl(Control); 
     if WinControl is TPanel then begin 
     TPanel(WinControl).FullRepaint := True; 
     end; 
     UpdateDoubleBuffered(WinControl); 
     SetComposited(WinControl, False); 
    end; 
    end; 
end; 

function TMyForm.ControlSupportsDoubleBuffered(Control: TWinControl): Boolean; 
const 
    NotSupportedClasses: array [0..1] of TControlClass = (
    TCustomForm,//general policy is not to double buffer forms 
    TCustomRichEdit//simply fails to draw if double buffered 
); 
var 
    i: Integer; 
begin 
    for i := low(NotSupportedClasses) to high(NotSupportedClasses) do begin 
    if Control is NotSupportedClasses[i] then begin 
     Result := False; 
     exit; 
    end; 
    end; 
    Result := True; 
end; 

procedure TMyForm.UpdateDoubleBuffered(Control: TWinControl); 

    function ControlIsDoubleBuffered: Boolean; 
    const 
    DoubleBufferedClasses: array [0..2] of TControlClass = (
     TMyCustomGrid,//flickers when updating 
     TCustomListView,//flickers when updating 
     TCustomStatusBar//drawing infidelities , e.g. my main form status bar during file loading 
    ); 
    var 
    i: Integer; 
    begin 
    if not InRemoteSession then begin 
     //see The Old New Thing, Taxes: Remote Desktop Connection and painting 
     for i := low(DoubleBufferedClasses) to high(DoubleBufferedClasses) do begin 
     if Control is DoubleBufferedClasses[i] then begin 
      Result := True; 
      exit; 
     end; 
     end; 
    end; 
    Result := False; 
    end; 

var 
    DoubleBuffered: Boolean; 

begin 
    if ControlSupportsDoubleBuffered(Control) then begin 
    DoubleBuffered := ControlIsDoubleBuffered; 
    end else begin 
    DoubleBuffered := False; 
    end; 
    Control.DoubleBuffered := DoubleBuffered; 
end; 

procedure TMyForm.UpdateDoubleBuffered; 
var 
    Control: TControl; 
begin 
    for Control in ControlEnumerator(TWinControl) do begin 
    UpdateDoubleBuffered(TWinControl(Control)); 
    end; 
end; 

này sẽ không biên dịch cho bạn, nhưng nó phải chứa một số ý tưởng hữu ích. ControlEnumerator là tiện ích của tôi để biến bước đi đệ quy của điều khiển con thành vòng lặp for phẳng. Lưu ý rằng tôi cũng sử dụng bộ tách tùy chỉnh gọi BeginSizing/EndSizing khi nó đang hoạt động.

Một mẹo hữu ích khác là sử dụng TStaticText thay vì TLabel mà đôi khi bạn cần phải thực hiện khi bạn có lồng sâu các bảng điều khiển và bảng điều khiển trang.

Tôi đã sử dụng mã này để làm cho ứng dụng của tôi không bị nhấp nháy 100% nhưng nó đã cho tôi độ tuổi và độ tuổi của thử nghiệm để làm cho nó tất cả tại chỗ. Hy vọng rằng những người khác có thể tìm thấy một cái gì đó sử dụng ở đây.

+3

+1, TStaticText lưu ngày của bạn khi sử dụng bảng điều khiển và điều khiển trang thay vì TLabel. –

+0

Ồ vâng, tôi chắc chắn có thể tìm thấy một cái gì đó hữu ích ở đây :-) Cảm ơn và +1 –

+2

Thông tin rất tốt và đã giải quyết được sự cố của tôi – ThievingSix

10

Sử dụng VCL Fix Pack từ Andreas Hausladen.

Ngoài ra: không chỉ định SWP_NOCOPYBITS cờ, và thiết lập DoubleBuffered của PageControl:

uses 
    VCLFixPack; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
    PageControl1.DoubleBuffered := True; 

    //Setup test conditions: 
    FForm2 := TForm2.Create(Self); 
    FForm2.BorderStyle := bsNone; 
    FForm2.BoundsRect := TabSheet1.ClientRect; 
    Windows.SetParent(FForm2.Handle, TabSheet1.Handle); 
    FForm2.Show; 
    PageControl1.Anchors := [akLeft, akTop, akRight, akBottom]; 
    PageControl1.OnResize := PageControl1Resize; 
end; 

procedure TForm1.PageControl1Resize(Sender: TObject); 
begin 
    SetWindowPos(FForm2.Handle, 0, 0, 0, TabSheet1.ClientWidth, 
    TabSheet1.ClientHeight, SWP_NOZORDER + SWP_NOACTIVATE); 
end; 
+1

Tôi chưa từng nghe về Gói Sửa lỗi VCL, tôi sẽ dùng thử. – ThievingSix

1

Đây là giải pháp tôi sử dụng với thành công trong dự án của tôi trong một số biểu mẫu. Nó hơi bẩn vì nó sử dụng các hàm winapi. So với David trả lời nó không bao gồm hình phạt hiệu suất. Vấn đề là ghi đè lên trình xử lý tin nhắn cho thông báo WM_ERASEBKGND cho biểu mẫu và tất cả các cửa sổ con của nó.

typedef LRESULT CALLBACK(*PWndProc)(HWND, UINT, WPARAM, LPARAM); 

void SetNonFlickeringWndProc(TWinControl &control, std::map<HWND,PWndProc> &list, PWndProc new_proc) 
{ 
    if (control.Handle == 0) 
    { 
     return; 
    } 

    PWndProc oldWndProc = (PWndProc)SetWindowLong(control.Handle, GWL_WNDPROC, (LONG)new_proc); 
    list[control.Handle] = oldWndProc; 

    int count = control.ControlCount; 
    for (int i = 0; i < count; i++) 
    { 
     TControl *child_control = control.Controls[i]; 
     TWinControl *child_wnd_control = dynamic_cast<TWinControl*>(child_control); 
     if (child_wnd_control == NULL) 
     { 
     continue; 
     } 

     SetNonFlickeringWndProc(*child_wnd_control, list, new_proc); 
    } 
} 

void RestoreWndProc(std::map<HWND,PWndProc> &old_wnd_proc) 
{ 
    std::map<HWND,PWndProc>::iterator it; 
    for (it = old_wnd_proc.begin(); it != old_wnd_proc.end(); it++) 
    { 
     LONG res = SetWindowLong(it->first, GWL_WNDPROC, (LONG)it->second); 
    } 
    old_wnd_proc.clear(); 
} 

std::map<HWND,PWndProc> oldwndproc; // addresses for window procedures for all components in form 

LRESULT CALLBACK NonFlickeringWndProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) 
{ 
    if (uMsg == WM_ERASEBKGND) 
    { 
     return 1; 
    } 
    return ((PWndProc)oldwndproc[hwnd])(hwnd, uMsg, wParam, lParam); 
} 

void __fastcall TForm1::FormShow(TObject *Sender) 
{ 
    oldwndproc.clear(); 
    SetNonFlickeringWndProc(*this, oldwndproc, &NonFlickeringWndProc); 
} 

void __fastcall TForm1::FormClose(TObject* Sender, TCloseAction& Action) 
{ 
    RestoreWndProc(oldwndproc_etype); 
} 

Lưu ý quan trọng: Thuộc tính DoubleBufferd cho biểu mẫu phải được đặt nếu bạn không muốn thấy sọc đen ở hai bên!

0

Đặt trên mẫu của bạn (giao diện) hoặc đặt nó tất cả trong một đơn vị cuối cùng mới bao gồm:

TLabel = class(stdCtrls.TLabel) 
    protected 
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND; 
    end; 

Đặt này trong thực hiện phần

procedure TLabel.WMEraseBkgnd(var Message: TWmEraseBkgnd); 
begin 
Message.Result:=1; // Fake erase 
end; 

lặp lại bước này cho TGroupBox

Các vấn đề liên quan