terender.pas

Do your applications look a little boring? Would you like to get spectacular yet easy to use visual

  end;
end;
{$endif CLX}

{$ifndef CLX}
procedure PaintClient(DC: HDC; WinControl: TWinControl; Window: HWnd;
  TERegControl: TTERegControl);
var
  SaveIndex: Integer;
begin
  SaveIndex := SaveDC(DC);
  try
    if(TERegControl.Flags and RCF_PRINT) <> 0
    then SendMessage(Window, WM_PRINT, DC, PRF_ERASEBKGND or PRF_CLIENT)
    else if(TERegControl.Flags and RCF_PAINT) <> 0
    then EraseAndPaintMessage(DC, WinControl, Window)
    else if(TERegControl.Flags and RCF_CALLBACK) <> 0
    then
    begin
      if Assigned(TERegControl.ClientCallback) then
        TERegControl.ClientCallback(WinControl, DC);
    end
    else if(TERegControl.Flags and RCF_HOOK) <> 0
    then HookPaint(DC, WinControl)
    else EmulatePaint(DC, WinControl);
  finally
    RestoreDC(DC, SaveIndex);
  end;
end;
{$endif CLX}

{$ifndef CLX}
procedure RenderWindowToDCAux(
  Window, Limit, Parent: {$ifndef CLX}HWND{$else}TWidgetControl{$endif CLX};
  WinControl: TWinControl; DC: HDC; R: TRect;
  CheckVisibility, CheckRegion: Boolean); forward;
{$endif CLX}

{$ifndef CLX}
procedure RenderChildWindows(DC: HDC;
  Window, Limit: {$ifndef CLX}HWND{$else}TWidgetControl{$endif CLX};
  IsMaximizedMDIClient: Boolean; ClientOrg: TPoint; R: TRect);
var
  {$ifndef CLX}
  ChildWnd: HWND;
  {$else}
  ChildWnd: TWidgetControl;
  i,
  ChildIndex: Integer;
  {$endif CLX}
  ChildRect: TRect;
  P,
  ChildOrg: TPoint;
begin
  {$ifndef CLX}
  ChildWnd := GetWindow(Window, GW_CHILD);
  if ChildWnd <> 0 then
  begin
    if not IsMaximizedMDIClient
    then ChildWnd := GetWindow(ChildWnd, GW_HWNDLAST)
    else ChildWnd := GetWindow(ChildWnd, GW_HWNDFIRST);
  end;
  {$else}
  ChildIndex := -1;
  for i:=0 to Window.ControlCount-1 do
  begin
    if Window.Controls[i] is TWidgetControl then
    begin
      ChildIndex := i;
      break;
    end;
    if ChildIndex <> -1
    then
    begin
      if not IsMaximizedMDIClient
      then ChildWnd := Window.Controls[ChildIndex] as TWidgetControl
      else ChildWnd := Window.Controls[Window.ControlCount - 1] as TWidgetControl;
    end
    else ChildWnd := nil;
  end
  else ChildWnd := nil;
  {$endif CLX}

  while(ChildWnd <> {$ifndef CLX}0{$else}nil{$endif CLX}) and
       (ChildWnd <> Limit) do
  begin
    {$ifndef CLX}
    if IsWindowVisible(ChildWnd) then
    {$else}
    if QWidget_isVisible(Window.Handle) then
    {$endif CLX}
    begin
      if not IsMaximizedMDIClient
      then
      begin
        {$ifndef CLX}
        GetWindowRect(ChildWnd, ChildRect);
        ScreenToClient(Window, ChildRect.TopLeft);
        ScreenToClient(Window, ChildRect.BottomRight);
        OffsetRect(ChildRect, ClientOrg.x, ClientOrg.y);
        ChildOrg := ChildRect.TopLeft;
        IntersectRect(ChildRect, ChildRect, R);
        OffsetRect(ChildRect, -ChildOrg.x, -ChildOrg.y);
        {$else}
        GetWindowRect(QWidget_winId(Window.Handle), ChildRect);
        ControlScreenToClient(Window, ChildRect.TopLeft);
        ControlScreenToClient(Window, ChildRect.BottomRight);
        OffsetRect(ChildRect, ClientOrg.x, ClientOrg.y);
        ChildOrg := ChildRect.TopLeft;
        IntersectRect(ChildRect, ChildRect, R);
        OffsetRect(ChildRect, -ChildOrg.x, -ChildOrg.y);
        {$endif CLX}
      end
      else
      begin
        ChildRect := R;
        ChildOrg  := Point(0, 0);
      end;

      if not IsRectEmpty(ChildRect) then
      begin
        OffsetWindowOrgEx(DC, -ChildOrg.x, -ChildOrg.y, P);
        try
          RenderWindowToDCAux(ChildWnd, Limit, Window, nil, DC, ChildRect, True,
            True);
        finally
          SetWindowOrgEx(DC, P.x, P.y, nil);
        end;
      end;
    end;

    if IsMaximizedMDIClient
    then ChildWnd := {$ifndef CLX}0{$else}nil{$endif CLX}
    else
    begin
      {$ifndef CLX}
      ChildWnd := GetWindow(ChildWnd, GW_HWNDPREV);
      {$else}
      if ChildIndex < Window.ControlCount - 1
      then
      begin
        Inc(ChildIndex);
        ChildWnd := Window.Controls[ChildIndex] as TWidgetControl;
      end
      else ChildWnd := nil;
      {$endif CLX}
    end;
  end;
end;
{$endif CLX}

{$ifndef CLX}

procedure DoRender(DC: HDC; WinControl: TWinControl; Window, Limit: HWnd;
  IsMaximizedMDIClient, IsMaximizedMDIChild: Boolean; Width, Height: Integer;
  R: TRect; TERegControl: TTERegControl; ClassType: TClass);
var
  AbsPos,
  BOrg,
  P: TPoint;
  WndDC: HDC;
  HasNonClientArea,
  RenderClient,
  RenderNonClient,
  CommonPainting: Boolean;
  ClientOrg: TPoint;
  ClientWidth,
  ClientHeight: Integer;
  SaveRgn: HRgn;
  Bmp: TBitmap;
begin
  if(((TERegControl.Flags and RCF_PAINTCOPYNC) <> 0)  or
     ((TERegControl.Flags and RCF_PAINTCOPY  ) <> 0)) then
  begin
    if((TERegControl.Flags and RCF_RENDERNCMASK) <> 0) and
      ((TERegControl.Flags and RCF_RENDERMASK  ) <> 0) and
       WinControl.Focused
    then TERegControl.Flags :=
           TERegControl.Flags and not(RCF_PAINTCOPYNC  or RCF_PAINTCOPY )
    else TERegControl.Flags :=
           TERegControl.Flags and not(RCF_RENDERNCMASK or RCF_RENDERMASK);
  end;

  RenderClient    := (TERegControl.Flags and RCF_RENDER  ) <> 0;
  RenderNonClient := (TERegControl.Flags and RCF_RENDERNC) <> 0;
  CommonPainting  :=
    RenderClient                                     and
    RenderNonClient                                  and
    (Assigned(TERegControl.ClientCallback   ) and
     Assigned(TERegControl.NonClientCallback) and
     (@TERegControl.ClientCallback =
      @TERegControl.NonClientCallback)) or
    (((TERegControl.Flags and RCF_PAINTCOPY  ) <> 0) or
     ((TERegControl.Flags and RCF_PAINTCOPYNC) <> 0));

  GetClientSize(WinControl, Window, IsMaximizedMDIClient, IsMaximizedMDIChild,
    ClientWidth, ClientHeight, ClientOrg);

  // Remember current clipping region
  SaveRgn := CreateRectRgn(0,0,0,0);
  GetClipRgn(DC, SaveRgn);
  try
    OffsetWindowOrgEx(DC, -ClientOrg.x, -ClientOrg.y, P);
    if(not CommonPainting)and RenderClient Then //V34
    try
    IntersectClipRect(DC, 0, 0, ClientWidth, ClientHeight);
      begin
        if(TERegControl.Flags and RCF_OWNCANVAS) = 0
        then
        begin
          // Adjust the brush origin
          AbsPos.x := 0;
          AbsPos.y := 0;
          LPtoDP(DC, AbsPos, 1);
          WndDC := GetDC(Window);
          try
            GetBrushOrgEx(WndDC, BOrg);
            SetBrushOrgEx(DC, BOrg.X + AbsPos.x, BOrg.Y + AbsPos.y, nil);
          finally
            ReleaseDC(Window, WndDC);
          end;
          try
            PaintClient(DC, WinControl, Window, TERegControl);
          finally
            SetBrushOrgEx(DC, BOrg.X, BOrg.Y, nil);
          end;
        end
        else
        begin
          Bmp := TBitmap.Create;
          try
            Bmp.Canvas.Lock;
            try
              AdjustBmpForTransition(Bmp, 0, ClientWidth, ClientHeight, pfDevice);
              PaintClient(Bmp.Canvas.Handle, WinControl, Window, TERegControl);
              BitBlt(DC, 0, 0, ClientWidth, ClientHeight, Bmp.Canvas.Handle, 0, 0,
                SRCCOPY);
            finally
              Bmp.Canvas.Unlock;
            end;
          finally
            Bmp.Free;
          end;
        end;
      end;
    finally
      SetWindowOrgEx(DC, P.x, P.y, nil);
    end;
    if(WinControl = nil) or (not(WinControl is TOleControl)) then
      RenderChildWindows(DC, Window, Limit, IsMaximizedMDIClient, ClientOrg, R);
  finally
    SelectClipRgn(DC, SaveRgn);
    DeleteObject(SaveRgn);
  end;

  // Some controls change the client area extent after its first painting
  GetClientSize(WinControl, Window, IsMaximizedMDIClient, IsMaximizedMDIChild,
    ClientWidth, ClientHeight, ClientOrg);
  HasNonClientArea := ((ClientWidth <> Width) or (ClientHeight <> Height));

  if not CommonPainting
  then
  begin
    if HasNonClientArea and RenderNonClient then
    begin
      // Remember current clipping region
      SaveRgn := CreateRectRgn(0,0,0,0);
      GetClipRgn(DC, SaveRgn);
      try
        ExcludeClipRect(DC, ClientOrg.x, ClientOrg.y,
          ClientOrg.x + ClientWidth, ClientOrg.y + ClientHeight);

        if IsMaximizedMDIChild then
          OffsetWindowOrgEx(DC, -WinControl.Left, -WinControl.Top, P);
        try
          if(TERegControl.Flags and RCF_OWNCANVASNC) = 0
          then
          begin
            // Adjust the brush origin
            AbsPos.x := 0;
            AbsPos.y := 0;
            LPtoDP(DC, AbsPos, 1);
            WndDC := GetDC(Window);
            try
              GetBrushOrgEx(WndDC, BOrg);
              SetBrushOrgEx(DC, BOrg.X + AbsPos.x, BOrg.Y + AbsPos.y, nil);
            finally
              ReleaseDC(Window, WndDC);
            end;
            try
              PaintNonClient(DC, WinControl, Window, TERegControl);
            finally
              SetBrushOrgEx(DC, BOrg.X, BOrg.Y, nil);
            end;
          end
          else
          begin
            Bmp := TBitmap.Create;
            try
              Bmp.Canvas.Lock;
              try
                AdjustBmpForTransition(Bmp, 0, ClientWidth, ClientHeight,
                  pfDevice);
                PaintNonClient(DC, WinControl, Window, TERegControl);
                BitBlt(DC, 0, 0, ClientWidth, ClientHeight, Bmp.Canvas.Handle,
                  0, 0, SRCCOPY);
              finally
                Bmp.Canvas.Unlock;
              end;
            finally
              Bmp.Free;
            end;
          end;
        finally
          if IsMaximizedMDIChild then
            SetWindowOrgEx(DC, P.x, P.y, nil);
        end;
      finally
        SelectClipRgn(DC, SaveRgn);
        DeleteObject(SaveRgn);
      end;
    end;
  end
  else
  begin
    if IsMaximizedMDIChild then
      OffsetWindowOrgEx(DC, -WinControl.Left, -WinControl.Top, P);
    try
      if(TERegControl.Flags and (RCF_OWNCANVASNC or RCF_OWNCANVAS)) = 0
      then
      begin
        // Adjust the brush origin
        AbsPos.x := 0;
        AbsPos.y := 0;
        LPtoDP(DC, AbsPos, 1);
        WndDC := GetDC(Window);
        try
          GetBrushOrgEx(WndDC, BOrg);
          SetBrushOrgEx(DC, BOrg.X + AbsPos.x, BOrg.Y + AbsPos.y, nil);
        finally
          ReleaseDC(Window, WndDC);
        end;
        try
          PaintNonClient(DC, WinControl, Window, TERegControl);
        finally
          SetBrushOrgEx(DC, BOrg.X, BOrg.Y, nil);
        end;
      end
      else
      begin
        Bmp := TBitmap.Create;
        try
          Bmp.Canvas.Lock;
          try
            AdjustBmpForTransition(Bmp, 0, ClientWidth, ClientHeight, pfDevice);
            PaintNonClient(DC, WinControl, Window, TERegControl);
            BitBlt(DC, 0, 0, Width, Height, Bmp.Canvas.Handle, 0, 0,
              SRCCOPY);
          finally
            Bmp.Canvas.Unlock;
          end;
        finally
          Bmp.Free;
        end;
      end;
    finally
      if IsMaximizedMDIChild then
        SetWindowOrgEx(DC, P.x, P.y, nil);
    end;
  end;
end; //EROC itnA
{$endif CLX}

{$ifndef CLX}
procedure RenderWindowToDCAux(
  Window, Limit, Parent: {$ifndef CLX}HWND{$else}TWidgetControl{$endif CLX};
  WinControl: TWinControl; DC: HDC; R: TRect;
  CheckVisibility, CheckRegion: Boolean);
var
  SaveRgn: HRgn;
  ClassType: TClass;
  IsMaximizedMDIClient,
  IsMaximizedMDIChild,
  IsRenderWindow: Boolean;
  Width,
  Height: Integer;
  TERegControl: TTERegControl;
begin
  {$ifndef CLX}
  if WinControl = nil then
    WinControl := FindControl(Window);
  {$endif CLX}

  GetData(WinControl, {$ifndef CLX}Window, {$endif CLX}ClassType,
    IsMaximizedMDIClient, IsMaximizedMDIChild, IsRenderWindow);

  if IsRenderWindow then
    Exit;

  TERegControl := TTERegControl.Create(0, nil, nil);
  try
    GetTERegControl({$ifndef CLX}Window, {$endif CLX}WinControl, TERegControl);

    if((not CheckVisibility) or
      {$ifndef CLX}
      IsWindowVisible(Window)) then
      {$else}
      QWidget_isVisible(Window.Handle)) then
      {$endif CLX}
    begin
      // Remember current clipping region
      SaveRgn := CreateRectRgn(0,0,0,0);
      GetClipRgn(DC, SaveRgn);
      try
        GetSize(Window, IsMaximizedMDIChild, Width, Height);
        {$ifndef CLX}
        CheckClipRegion(Window, DC, CheckRegion, IsMaximizedMDIChild, Width,
          Height, R);
        {$endif CLX}
        if not IsRectEmpty(R) then
        begin
            DoRender(DC, WinControl, Window, Limit, IsMaximizedMDIClient,
              IsMaximizedMDIChild, Width, Height, R, TERegControl, ClassType);
        end;
      finally
        SelectClipRgn(DC, SaveRgn);
        DeleteObject(SaveRgn);
      end;
    end;
  finally
    TERegControl.Free;
  end;
end;
{$endif CLX}



procedure RenderWindowToDC(
  Window, Limit: {$ifndef CLX}HWND{$else}TWidgetControl{$endif CLX};
  WinContr