terender.pas

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

// Detects is OS is Windows XP or above
function IsWinXPUp: Bool;
begin
  Result :=  GetWinVersion In [teWinXP,teWinFuture];  //V33
end;

function WindowHasRgn(Window: HWnd): Boolean;
var
  Rgn: HRgn;
begin
  Rgn := CreateRectRgn(0, 0, 0, 0);
  try
    Result := GetWindowRgn(Window, Rgn) <> ERROR;
  finally
    DeleteObject(Rgn);
  end;
end;

procedure NCPrintControl(DC: HDC; WinControl: TWinControl; Window: HWnd);
var
  Bmp: TBitmap;
begin
  if(WinControl <> nil)                                and
    (WinControl is TCustomForm)                        and
    (TTECustomForm(WinControl).FormStyle = fsMDIChild) and
    IsWinXPUp                                          and
    WindowHasRgn(Window)                               then
  begin // XP does something weird with the clipping region
    Bmp := TBitmap.Create;
    try
      AdjustBmpForTransition(Bmp, 0, WinControl.Width, WinControl.Height,
        pfDevice);
      SendMessage(Window, WM_PRINT, Bmp.Canvas.Handle, PRF_NONCLIENT);
      BitBlt(DC, 0, 0, WinControl.Width, WinControl.Height,
        Bmp.Canvas.Handle, 0, 0, SRCCOPY);
    finally
      Bmp.Free;
    end;
  end
  else SendMessage(Window, WM_PRINT, DC, PRF_NONCLIENT);
end;

{$ifndef CLX}
{$ifndef D3C3}
procedure WinControlNCPaint(WinControl: TWinControl; DC: HDC; Themed: Boolean);
  {$ifdef D7UP}
  procedure PaintThemeBorder(Control: TWinControl; DC: HDC; EraseLRCorner: Boolean);
  var
    EmptyRect,
    DrawRect: TRect;
    H, W: Integer;
    AStyle,
    ExStyle: Integer;
    Details: TThemedElementDetails;
  begin
    with Control do
    begin
      ExStyle := GetWindowLong(Handle, GWL_EXSTYLE);
      if (ExStyle and WS_EX_CLIENTEDGE) <> 0 then
      begin
        GetWindowRect(Handle, DrawRect);
        OffsetRect(DrawRect, -DrawRect.Left, -DrawRect.Top);
          EmptyRect := DrawRect;
          if EraseLRCorner then
          begin
            AStyle := GetWindowLong(Handle, GWL_STYLE);
            if ((AStyle and WS_HSCROLL) <> 0) and ((AStyle and WS_VSCROLL) <> 0) then
            begin
              W := GetSystemMetrics(SM_CXVSCROLL);
              H := GetSystemMetrics(SM_CYHSCROLL);
              InflateRect(EmptyRect, -2, -2);
              with EmptyRect do
                EmptyRect := Rect(Right - W, Bottom - H, Right, Bottom);
              FillRect(DC, EmptyRect, GetSysColorBrush(COLOR_BTNFACE));
            end;
          end;
          with DrawRect do
            ExcludeClipRect(DC, Left + 2, Top + 2, Right - 2, Bottom - 2);
          Details := ThemeServices.GetElementDetails(teEditTextNormal);
          ThemeServices.DrawElement(DC, Details, DrawRect);
      end;
    end;
  end;
  {$endif D7UP}
const
  InnerStyles: array[TBevelCut] of Integer = (0, BDR_SUNKENINNER, BDR_RAISEDINNER, 0);
  OuterStyles: array[TBevelCut] of Integer = (0, BDR_SUNKENOUTER, BDR_RAISEDOUTER, 0);
  EdgeStyles: array[TBevelKind] of Integer = (0, 0, BF_SOFT, BF_FLAT);
  Ctl3DStyles: array[Boolean] of Integer = (BF_MONO, 0);
var
  RC, RW, SaveRW: TRect;
  EdgeSize: Integer;
  WinStyle: Longint;
  SaveIndex,
  SaveIndex2: Integer;
begin
  SaveIndex := SaveDC(DC);
  try
    with TTEWinControl(WinControl) do
    begin
      if (BevelKind <> bkNone) or (BorderWidth > 0) then
      begin
        Windows.GetClientRect(Handle, RC);
        GetWindowRect(Handle, RW);
        MapWindowPoints(0, Handle, RW, 2);
        OffsetRect(RC, -RW.Left, -RW.Top);
        ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom);
        { Draw borders in non-client area }
        SaveRW := RW;
        InflateRect(RC, BorderWidth, BorderWidth);
        RW := RC;
        if BevelKind <> bkNone then
        begin
          EdgeSize := 0;
          if BevelInner <> bvNone then Inc(EdgeSize, BevelWidth);
          if BevelOuter <> bvNone then Inc(EdgeSize, BevelWidth);
          with RW do
          begin
            WinStyle := GetWindowLong(Handle, GWL_STYLE);
            if beLeft in BevelEdges then Dec(Left, EdgeSize);
            if beTop in BevelEdges then Dec(Top, EdgeSize);
            if beRight in BevelEdges then Inc(Right, EdgeSize);
            if (WinStyle and WS_VSCROLL) <> 0 then Inc(Right, GetSystemMetrics(SM_CYVSCROLL));
            if beBottom in BevelEdges then Inc(Bottom, EdgeSize);
            if (WinStyle and WS_HSCROLL) <> 0 then Inc(Bottom, GetSystemMetrics(SM_CXHSCROLL));
          end;
          DrawEdge(DC, RW, InnerStyles[BevelInner] or OuterStyles[BevelOuter],
            Byte(BevelEdges) or EdgeStyles[BevelKind] or Ctl3DStyles[Ctl3D] or BF_ADJUST);
        end;
        IntersectClipRect(DC, RW.Left, RW.Top, RW.Right, RW.Bottom);
        RW := SaveRW;
        { Erase parts not drawn }
        OffsetRect(RW, -RW.Left, -RW.Top);
        Windows.FillRect(DC, RW, Brush.Handle);
      end;
    end;

    SaveIndex2 := SaveDC(DC);
    try
      NCPrintControl(DC, WinControl, WinControl.Handle);
    finally
      RestoreDC(DC, SaveIndex2);
    end;

    {$ifdef D7UP}
    if Themed or (csNeedsBorderPaint in WinControl.ControlStyle) then
      PaintThemeBorder(WinControl, DC, False);
    {$endif D7UP}
  finally
    RestoreDC(DC, SaveIndex);
  end;
end;
{$endif D3C3}
{$endif CLX}

procedure EraseAndPaintMessage(DC: HDC; WinControl: TWinControl; Window: HWND);
var
  SaveIndex: Integer;
//  UpdateRect,        //V33
//  ClientRect: TRect;
 {$ifndef D3C3}
  DoubleBuffered: Boolean;
 {$endif D3C3}
begin
{$ifndef D3C3}
  DoubleBuffered := Assigned(WinControl) and (WinControl.DoubleBuffered);
  if DoubleBuffered then
    WinControl.DoubleBuffered := False;
{$endif D3C3}

//  GetUpdateRect(Window, UpdateRect, False);   //V33
//  GetClientRect(Window, ClientRect);          //V33
//  InvalidateRect(Window, @ClientRect, False); //V33
  SaveIndex := SaveDC(DC);
  try
    SendMessage(Window, WM_ERASEBKGND, DC, 0);
  finally
    RestoreDC(DC, SaveIndex);
  end;
//  ValidateRect(Window, @ClientRect); //V33
//  InvalidateRect(Window, @UpdateRect, False);//V33
  SendMessage(Window, WM_PAINT, DC, 0);

{$ifndef D3C3}
  if DoubleBuffered then
    WinControl.DoubleBuffered := True;
{$endif D3C3}
end;

function HookedGetDC(hWnd: HWND): hDC; stdcall;
begin
  Result := HookDC;
end;

function HookedGetDCEx(hWnd: HWND; hrgnClip: HRGN; flags: DWORD): HDC; stdcall;
begin
  Result := HookDC;
end;

function HookedGetWindowDC(hWnd: HWND): hDC; stdcall;
begin
  Result := HookDC;
end;

function HookedReleaseDC(hWnd: HWND; DC: hDC): Integer; stdcall;
begin
  Result := 1;
end;

function HookedBeginPaint(hWnd: HWND; var lpPaint: TPaintStruct): HDC; stdcall;
begin
  lpPaint.hdc := HookDC;
  Result      := HookDC;
end;

function HookedEndPaint(hWnd: HWND; const lpPaint: TPaintStruct): BOOL; stdcall;
begin
  Result := True;
end;

function HookAPICall(const DllName, Name: String; ImportJump: PImportJump;
  var SaveImportJump: TImportJump; NewAPICall: Pointer): Pointer;
var
  SaveProtect: Integer;
begin
  SaveImportJump.JMP  := ImportJump^.JMP;
  SaveImportJump.Proc := ImportJump^.Proc^;
  Result := GetProcAddress(GetModuleHandle(PChar(DllName)), PChar(Name));
  if not VirtualProtect(ImportJump^.Proc, 4, PAGE_EXECUTE_READWRITE,
    @SaveProtect) then
    Halt;
  ImportJump.Proc^ := NewAPICall;
  if not VirtualProtect(ImportJump^.Proc, 4, SaveProtect, @SaveProtect) then
    Halt;
end;

procedure UnhookAPICall(ImportJump: PImportJump; SaveImportJump: TImportJump);
var
  SaveProtect: Integer;
begin
  if not VirtualProtect(ImportJump.Proc, 4, PAGE_EXECUTE_READWRITE,
    @SaveProtect) then
    Halt;
  ImportJump.Proc^ := SaveImportJump.Proc;
  if not VirtualProtect(ImportJump.Proc, 4, SaveProtect, @SaveProtect) then
    Halt;
end;

procedure HookPaint(DC: HDC; WinControl: TWinControl);
var
  SaveBeginPaintIJ,
  SaveEndPaintIJ,
  SaveGetDCIJ,
  SaveGetDCExIJ,
  SaveGetWindowDCIJ,
  SaveReleaseDCIJ: TImportJumP;
  BeginPaintIJ,
  EndPaintIJ,
  GetDCIJ,
  GetDCExIJ,
  GetWindowDCIJ,
  ReleaseDCIJ: PImportJump;
begin
  HookDC      := DC;
  HookControl := WinControl;

  GetDCIJ := @Windows.GetDC;
  HookAPICall('user32', 'GetDC', GetDCIJ, SaveGetDCIJ, @HookedGetDC);
  try
    GetDCExIJ := @Windows.GetDCEx;
    HookAPICall('user32', 'GetDCEx', GetDCExIJ, SaveGetDCExIJ, @HookedGetDCEx);
    try
      GetWindowDCIJ := @Windows.GetWindowDC;
      HookAPICall('user32', 'GetWindowDC', GetWindowDCIJ, SaveGetWindowDCIJ, @HookedGetWindowDC);
      Try
        ReleaseDCIJ := @Windows.ReleaseDC;
        HookAPICall('user32', 'ReleaseDC', ReleaseDCIJ, SaveReleaseDCIJ,
          @HookedReleaseDC);
        try
          BeginPaintIJ := @Windows.BeginPaint;
          HookAPICall('user32', 'BeginPaint', BeginPaintIJ, SaveBeginPaintIJ,
            @HookedBeginPaint);
          try
            EndPaintIJ := @Windows.EndPaint;
            HookAPICall('user32', 'EndPaint', EndPaintIJ, SaveEndPaintIJ,
              @HookedEndPaint);
            try
              EraseAndPaintMessage(DC, WinControl, WinControl.Handle);
            finally
              UnhookAPICall(EndPaintIJ, SaveEndPaintIJ);
            end;
          finally
            UnhookAPICall(BeginPaintIJ, SaveBeginPaintIJ);
          end;
        finally
          UnhookAPICall(ReleaseDCIJ, SaveReleaseDCIJ);
        end;
      finally
        UnhookAPICall(GetWindowDCIJ, SaveGetWindowDCIJ);
      end;
    finally
      UnhookAPICall(GetDCExIJ, SaveGetDCExIJ);
    end;
  finally
    UnhookAPICall(GetDCIJ, SaveGetDCIJ);
  end;
end;

procedure HookNCPaint(DC: HDC; Window: HWND);
var
  SaveGetWindowDCIJ,
  SaveGetDCExIJ,
  SaveReleaseDCIJ: TImportJumP;
  GetWindowDCIJ,
  GetDCExIJ,
  ReleaseDCIJ: PImportJump;
begin
  HookDC := DC;

  GetWindowDCIJ := @Windows.GetWindowDC;
  HookAPICall('user32', 'GetWindowDC', GetWindowDCIJ, SaveGetWindowDCIJ,
    @HookedGetWindowDC);
  try
    GetDCExIJ := @Windows.GetDCEx;
    HookAPICall('user32', 'GetDCEx', GetDCExIJ, SaveGetDCExIJ, @HookedGetDCEx);
    try
      ReleaseDCIJ   := @Windows.ReleaseDC;
      HookAPICall('user32', 'ReleaseDC', ReleaseDCIJ, SaveReleaseDCIJ,
        @HookedReleaseDC);
      try
        SendMessage(Window, WM_NCPAINT, 0, 0);
      finally
        UnhookAPICall(ReleaseDCIJ, SaveReleaseDCIJ);
      end;
    finally
      UnhookAPICall(GetDCExIJ, SaveGetDCExIJ);
    end;
  finally
    UnhookAPICall(GetWindowDCIJ, SaveGetWindowDCIJ);
  end;
end;

procedure PaintCopy(DC: HDC; WinControl: TWinControl);
begin
  if WinControl = nil then
    Exit;

  WinControl.ControlState := WinControl.ControlState + [csPaintCopy];
  try
    SendMessage(WinControl.Handle, WM_PAINT, DC, 0);
  finally
    WinControl.ControlState := WinControl.ControlState - [csPaintCopy];
  end;
end;

{$ifndef CLX}
procedure EmulatePaint(DC: HDC; WinControl: TWinControl);
begin
  if WinControl = nil then
    Exit;

  if WinControl is TOleControl
  then
  begin
    WinControl.HandleNeeded;
    OleDraw(IUnknown(TOleControl(WinControl).OleObject), DVASPECT_CONTENT,
      DC, ControlClientRect(WinControl));
  end;
end;
{$endif CLX}

{$ifndef CLX}
procedure EmulateNCPaint(DC: HDC; WinControl: TWinControl; Window: HWnd;
  Themed: Boolean);
begin
  if WinControl = nil then
    exit;

  {$ifdef D7UP}
  Themed := Themed and IsWinXPUp;
  {$endif D7UP}

  if ClassInheritsFrom(WinControl.ClassType, 'TToolWindow')
  then ToolWindowNCPaint(WinControl, DC)
  else
  {$ifndef D3C3}
  begin
    WinControlNCPaint(TWinControl(WinControl), DC, Themed);
  end;
  {$else}
  NCPrintControl(DC, WinControl, Window);
  {$endif D3C3}
end;
{$endif CLX}

{$ifndef CLX}
procedure PaintNonClient(DC: HDC; WinControl: TWinControl; Window: HWnd;
  TERegControl: TTERegControl);
var
  SaveIndex: Integer;
begin
  {$ifndef D3C3}
  if(WinControl <> nil) and (WinControl is TScrollingWinControl) then
    with TScrollingWinControl(WinControl) do
    begin
      if((HorzScrollBar.Visible and (HorzScrollBar.Style = ssRegular)) and
         not(VertScrollBar.Visible and (VertScrollBar.Style <> ssRegular))) or
        ((VertScrollBar.Visible and (VertScrollBar.Style = ssRegular)) and
         not(HorzScrollBar.Visible and (HorzScrollBar.Style <> ssRegular))) then
        UninitializeFlatSB(Window);
    end;
  {$endif D3C3}

  SaveIndex := SaveDC(DC);
  try
    if(TERegControl.Flags and RCF_PRINTNC) <> 0
    then NCPrintControl(DC, WinControl, Window)
    else if(TERegControl.Flags and RCF_PAINTNC) <> 0
    then
    begin
      NCPrintControl(DC, WinControl, Window);
      SendMessage(Window, WM_NCPAINT, 0, DC);
    end
    else if(TERegControl.Flags and RCF_CALLBACKNC) <> 0
    then
    begin
      if WinControl <> nil then
        if Assigned(TERegControl.NonClientCallback) then
          TERegControl.NonClientCallback(WinControl, DC);
    end
    else if(TERegControl.Flags and RCF_HOOKNC) <> 0
    then
    begin
      NCPrintControl(DC, WinControl, Window);
      HookNCPaint(DC, Window)
    end
    else if(TERegControl.Flags and (RCF_PAINTCOPY or RCF_PAINTCOPYNC)) <> 0
    then PaintCopy(DC, WinControl)
    else EmulateNCPaint(DC, WinControl, Window,
          (TERegControl.Flags and (RCF_THEMEDNC)) <> 0);
  finally
    RestoreDC(DC, SaveIndex);