2010-11-01 33 views
3

我在這段代碼有一個範圍檢查錯誤:範圍檢查錯誤畫布

{ This procedure is copied from RxLibrary VCLUtils } 
procedure CopyParentImage(Control: TControl; Dest: TCanvas); 
var 
    I, Count, X, Y, SaveIndex: Integer; 
    DC: HDC; 
    R, SelfR, CtlR: TRect; 
begin 
    if (Control = nil) OR (Control.Parent = nil) 
    then Exit; 

    Count := Control.Parent.ControlCount; 
    DC := Dest.Handle; 
    with Control.Parent 
    DO ControlState := ControlState + [csPaintCopy]; 

    TRY 
    with Control do 
    begin 
     SelfR := Bounds(Left, Top, Width, Height); 
     X := -Left; Y := -Top; 
    end; 

    { Copy parent control image } 
    SaveIndex := SaveDC(DC); 
    TRY 
     SetViewportOrgEx(DC, X, Y, nil); 
     IntersectClipRect(DC, 0, 0, Control.Parent.ClientWidth, Control.Parent.ClientHeight); 
     with TParentControl(Control.Parent) DO 
     begin 
     {$R-} 
     Perform(WM_ERASEBKGND, DC, 0); <--------------- HERE 
     {$R+}   
     PaintWindow(DC); 
     end; 
    FINALLY 
     RestoreDC(DC, SaveIndex); 
    END; 

    { Copy images of graphic controls } 
    for I := 0 to Count - 1 do begin 
     if Control.Parent.Controls[I] = Control then Break 
     else if (Control.Parent.Controls[I] <> nil) and 
     (Control.Parent.Controls[I] is TGraphicControl) then 
     begin 
     with TGraphicControl(Control.Parent.Controls[I]) do begin 
      CtlR := Bounds(Left, Top, Width, Height); 
      if Bool(IntersectRect(R, SelfR, CtlR)) and Visible then 
      begin 
      ControlState := ControlState + [csPaintCopy]; 
      SaveIndex := SaveDC(DC); 
      try 
       SetViewportOrgEx(DC, Left + X, Top + Y, nil); 
       IntersectClipRect(DC, 0, 0, Width, Height); 
       {$R-}    
       Perform(WM_PAINT, DC, 0); <--------------- HERE 
       {$R+} 
      finally 
       RestoreDC(DC, SaveIndex); 
       ControlState := ControlState - [csPaintCopy]; 
      end; 
      end; 
     end; 
     end; 
    end; 
    FINALLY 
    with Control.Parent DO 
    ControlState := ControlState - [csPaintCopy]; 
    end; 
end; 

有人發佈的代碼,而無需範圍檢查激活:(

我把{$ R - } {$ R +}周圍已產生的差錯,現在的代碼工作,但我不知道有什麼後果的線路,我不希望一些奇怪的錯誤後


德爾福,贏。 7 32bit

回答

9

Perform過程期望其第二個參數具有類型WParam,這是一個有符號的整數類型。從Delphi 3開始,實際參數的HDC類型是無符號的(與大多數其他句柄類型一樣)。在基於NT的系統上,處理的值高於MaxInt,這在WParam的範圍之外是很常見的。這是您的範圍檢查錯誤的來源。

類型轉換的參數,你將被罰款:

Perform(wm_EraseBkgnd, WParam(DC), 0); 

Perform方法簡單地解釋了高無符號值作爲一個大的負值來代替。它會將參數值發送到消息處理程序,並且消息處理程序將鍵入 - 將其返回到它想要的HDC類型。所有類型都是相同的大小,所以沒有危險。

+0

非常感謝。有效。我已經看到參數之間的差異,但我不知道我可以使用WParam進行類型轉換。它看起來像在Delphi 3中出現的變化,但代碼是用於Delphi 2005,我最初認爲是代碼錯誤。可能開發人員關閉了「範圍檢查」選項。 – Ampere 2010-11-02 13:06:34

2

它應該沒問題,它是通常的Cardinal/Integer類型轉換。 WM_ERASEBKGND在整個VCL中都是這樣使用的,例如在Controls.pas中使用{$ R-}指令。

+0

嗨。我已經嘗試過整數。它沒有奏效。 +1解釋。 – Ampere 2010-11-02 13:11:11

+0

我的意思是,無論是像Rob建議的那樣明確地進行類型轉換,還是像使用{$ R-}一樣,並且像在VCL中完成的那樣(特別是Controls.pas)。 – 2010-11-02 19:42:16