Fix drawing of TElTree with "square between scrollbars"

Quanos Service Solutions GmbH

With this fixed Version of the Paint-Methode the problems of not correctly drawn "right bottom" square if both scrollbars are shown


procedure TElTreeView.WMPaint(var Msg : TWMPaint);  { private }
var
  ADC,
  DCOwner, DC, MemDC, MemDCOwner: HDC;
  MemBitmapOwner,
  MemBitmap, OldBitmap, OldBitmapOwner: HBITMAP;
  PS, PSOwner: TPaintStruct;
  R, ROwner: TRect;
  ARgn : HRGN;
  DoDoubleBuffer : boolean;
begin
  DoDoubleBuffer := (FOwner.DoubleBuffered and not Fowner.InSizeMove) or (FOwner.InSizeMove and FOwner.DoubleBufferedOnResize);

  if not FOwner.IsUpdating then
  begin
    if (Msg.DC <> 0) then
      PaintHandler(Msg)
    else
    begin
      DC := BeginPaint(Handle, PS);
      DCOwner := BeginPaint(FOwner.Handle, PSOwner);

      try
        if DoDoubleBuffer then
        begin
          //DC := GetDC(0);
          MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
          MemBitmapOwner := CreateCompatibleBitmap(DCOwner, ClientRect.Right, ClientRect.Bottom);
          //ReleaseDC(0, DC);
          MemDC := CreateCompatibleDC(0);
          MemDCOwner := CreateCompatibleDC(0);
          OldBitmap := SelectObject(MemDC, MemBitmap);
          OldBitmapOwner := SelectObject(MemDCOwner, MemBitmapOwner);
          ADC := MemDC;
        end
        else
          ADC := 0;

        try
          if not DoDoubleBuffer then
            ADC := DC;
            
          GetClipBox(DC, R);
          GetClipBox(DCOwner, ROwner);          

          if IsRectEmpty(ROwner) then
            ROwner := FOwner.ClientRect;

          if IsRectEmpty(R) then
            R := ClientRect
          else
          begin
            inc(R.Right);
            inc(R.Bottom);
          end;
          //with R do
          //  BitBlt(MemDC, Left, Top, Right - Left, Bottom - Top, DC, Left, Top, SRCCOPY);

          if DoDoubleBuffer then
          begin
            with R do
              ARgn := CreateRectRgn(Left, Top, Right, Bottom);
            {$IFDEF DEBUG_TREE_DRAW}
              SelectClipRgn({A$$}DC, ARgn);
            {$ELSE}
              SelectClipRgn(ADC, ARgn);
            {$ENDIF}

            Self.FOwner.PaintWindow(DCOwner);
          end;

          {$IFDEF DEBUG_TREE_DRAW}
            DoPaintBkgnd({A$$}DC, R);
            Msg.DC := {A$$}DC;
          {$ELSE}
            DoPaintBkgnd(ADC, R);
            Msg.DC := ADC;
          {$ENDIF}

          PaintHandler(Msg);

          if DoDoubleBuffer then
          begin
          {$IFDEF DEBUG_TREE_DRAW}
            SelectClipRgn({Mem$$}DC, 0);
          {$ELSE}
            SelectClipRgn(MemDC, 0);
            SelectClipRgn(MemDCOwner, 0);
          {$ENDIF}
            DeleteObject(ARgn);
          end;
          Msg.DC := 0;
          if DoDoubleBuffer then
          begin
            with ROwner do
              BitBlt(DCOwner, FOwner.Left, FOwner.Top, FOwner.Width, FOwner.Height, MemDC, FOwner.Left, FOwner.Top, SRCCOPY);

            with R do
              {$IFDEF DEBUG_TREE_DRAW}
                BitBlt(DC, Left, Top, Right - Left, Bottom - Top, {Mem$$}DC, Left, Top, SRCCOPY);
              {$ELSE}
                BitBlt(DC, Left, Top, Right - Left, Bottom - Top, MemDC, Left, Top, SRCCOPY);
              {$ENDIF}
          end;
        finally
          if DoDoubleBuffer then
          begin
            SelectObject(MemDCOwner, OldBitmapOwner);
            DeleteDC(MemDCOwner);
            DeleteObject(MemBitmapOwner);

            SelectObject(MemDC, OldBitmap);
            DeleteDC(MemDC);
            DeleteObject(MemBitmap);
          end;
        end;
      finally
        EndPaint(Handle, PS);
        EndPaint(FOwner.Handle, PSOwner);
      end;
    end;
  end
  else
  begin
    DefWindowProc(Handle, WM_PAINT, TMessage(Msg).wParam, TMessage(Msg).lParam);
    FClearAll := true;
  end;
end;

balabuev

Done.