terender.pas

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

      teEmulate  : Flags := Flags or RCF_EMULNC;
      teCallback :
                 begin
                   NonClientCallback2 := NonClientCallback;
                   Flags := Flags or RCF_CALLBACKNC;
                 end;
      teHook     : Flags := Flags or RCF_HOOKNC;
    end;
  end;
  if RefreshNonClient then
    Flags := Flags or RCF_REFRESHNC;

  if ClientRenderMode <> teNoRender then
  begin
    Flags := Flags or RCF_RENDER;
    case ClientRenderMode of
      tePaint    : Flags := Flags or RCF_PAINT;
      tePrint    : Flags := Flags or RCF_PRINT;
      teEmulate  : Flags := Flags or RCF_EMUL;
      teCallback :
                 begin
                   ClientCallback2 := ClientCallback;
                   Flags := Flags or RCF_CALLBACK;
                 end;
      teHook     : Flags := Flags or RCF_HOOK;
    end;
  end;
  if RefreshClient then
    Flags := Flags or RCF_REFRESH;

  TERegControls.SaveRegControl(ControlClassName, Flags, NonClientCallback2,
    ClientCallback2);
end;

procedure SaveTERegControl(const WinControl: TWinControl;
  const TERegControl: TTERegControl);
var
  RefreshNonClient,
  RefreshClient: Boolean;
begin
  if(WinControl.HelpContext = 0) or (WinControl.Tag = 0) then
  begin
    RefreshNonClient := (TERegControl.Flags and RCF_REFRESHNC) <> 0;
    RefreshClient    := (TERegControl.Flags and RCF_REFRESH  ) <> 0;

    if WinControl.Focused then
    begin
      RefreshNonClient :=
        RefreshNonClient or
        ((TERegControl.Flags and RCF_REFRESHFOCUSEDNC) <> 0);
      RefreshClient    :=
        RefreshClient    or
        ((TERegControl.Flags and RCF_REFRESHFOCUSED  ) <> 0);
    end;

    if WinControl.HelpContext = 0
    then
    begin
      if RefreshNonClient
      then
        if RefreshClient
        then WinControl.HelpContext := THelpContext(RCF_SAVE_REFRESHALL)
        else WinControl.HelpContext := THelpContext(RCF_SAVE_REFRESHNC )
      else
        if RefreshClient
        then WinControl.HelpContext := THelpContext(RCF_SAVE_REFRESHC  )
        else WinControl.HelpContext := THelpContext(RCF_SAVE_NOREFRESH );
    end
    else
    begin
      if RefreshNonClient
      then
        if RefreshClient
        then WinControl.Tag := Longint(RCF_SAVE_REFRESHALL)
        else WinControl.Tag := Longint(RCF_SAVE_REFRESHNC )
      else
        if RefreshClient
        then WinControl.Tag := Longint(RCF_SAVE_REFRESHC  )
        else WinControl.Tag := Longint(RCF_SAVE_NOREFRESH );
    end;
  end;
end;

procedure GetTERegControl({$ifndef CLX}const Window: HWND;{$endif CLX}
  const WinControl: TWinControl; var TERegControl: TTERegControl);
begin
//  if IsWinXPUp
//  then TERegControl.Flags := 0
//  else
  begin
    if WinControl = nil
    then
      TERegControl.Flags := RCF_RENDERNC or RCF_PRINTNC or RCF_RENDER or RCF_PAINT
    else
    begin
      TERegControls.FindRegControl(WinControl, TControlClass(WinControl.ClassType),
        TERegControl);
      TERegControl.Flags := CompleteFlags(WinControl, TERegControl.Flags);
      SaveTERegControl(WinControl, TERegControl);
    end;
  end;
end;

procedure RefreshWindows(Window: HWND);
var
  ChildWnd: HWND;
  Control: TWinControl;
  TERegControl: TTERegControl;
  RefreshNonClient,
  RefreshClient: Boolean;
  SavedFlags: DWord;
begin
  if not IsWindowVisible(Window)
    then Exit;

  RefreshNonClient := False;
  RefreshClient    := False;

  Control := FindControl(Window);

  if Control <> nil then
  begin
    if Control.HelpContext and $FFFFFF0F = $FFFFFF0F
    then
    begin
      SavedFlags          := DWord(Control.HelpContext);
      Control.HelpContext := 0;
    end
    else if Control.Tag    and $FFFFFF0F = $FFFFFF0F
    then
    begin
      SavedFlags  := Control.Tag;
      Control.Tag := 0;
    end
    else SavedFlags := 0;

    if SavedFlags <> 0
    then
    begin
      case SavedFlags of
        RCF_SAVE_REFRESHALL:
          begin
            RefreshNonClient := True;
            RefreshClient    := True;
          end;
        RCF_SAVE_REFRESHC  :
          begin
            RefreshNonClient := False;
            RefreshClient    := True;
          end;
        RCF_SAVE_REFRESHNC :
          begin
            RefreshNonClient := True;
            RefreshClient    := False;
          end;
        RCF_SAVE_NOREFRESH :
          begin
            RefreshNonClient := False;
            RefreshClient    := False;
          end;
      end;
    end
    else
    begin
      TERegControl := TTERegControl.Create(0, nil, nil);
      try
        GetTERegControl(0, Control, TERegControl);

        RefreshNonClient := (TERegControl.Flags and RCF_REFRESHNC) <> 0;
        RefreshClient    := (TERegControl.Flags and RCF_REFRESH  ) <> 0;

        if Control.Focused then
        begin
          RefreshNonClient :=
            RefreshNonClient or
            ((TERegControl.Flags and RCF_REFRESHFOCUSEDNC) <> 0);
          RefreshClient    :=
            RefreshClient    or
            ((TERegControl.Flags and RCF_REFRESHFOCUSED  ) <> 0);
        end;
      finally
        TERegControl.Free;
      end;
    end;

    if RefreshNonClient then
      SendMessage(Window, WM_NCPAINT, 0, 0);

    if RefreshClient then
      if(Control <> nil) and (Control.ControlCount > 0)
      then RedrawWindow(Window, nil, 0, RDW_INVALIDATE or RDW_NOCHILDREN)
      else RedrawWindow(Window, nil, 0, RDW_INVALIDATE or RDW_ALLCHILDREN);
  end;
  
  ChildWnd := GetWindow(Window, GW_CHILD);
  while ChildWnd <> 0 do
  begin
    RefreshWindows(ChildWnd);
    ChildWnd := GetWindow(ChildWnd, GW_HWNDNEXT);
  end;
end;

procedure GetData(WinControl: TWinControl;
  {$ifndef CLX}Window: HWnd;{$endif CLX} var ClassType: TClass;
  var IsMaximizedMDIClient, IsMaximizedMDIChild, IsRenderWindow: Boolean);
var
  ClassName: array[0..63] of Char;
begin
  if WinControl <> nil
  then
  begin
    ClassType := WinControl.ClassType;
    StrPCopy(ClassName, WinControl.ClassName);

    {$ifndef CLX}
    {$ifndef D3C3}
    if GetMDIFormWithMaximizedMDIChild(WinControl) then
    begin // Edge changing
      SetWindowLong(Application.MainForm.ClientHandle, GWL_EXSTYLE,
        GetWindowLong(Application.MainForm.ClientHandle,
          GWL_EXSTYLE) and not WS_EX_CLIENTEDGE);
      SetWindowPos(Application.MainForm.ClientHandle, 0, 0, 0, 0, 0,
        SWP_FRAMECHANGED or SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or
        SWP_NOZORDER);
    end;
    {$endif D3C3}
    {$endif CLX}

    IsMaximizedMDIClient := False;
    IsMaximizedMDIChild  := GetMaximizedMDIChild(WinControl);
  end
  else
  begin
    {$ifndef CLX}
    GetClassName(Window, ClassName, Sizeof(ClassName));
    ClassType := GetClass(ClassName);
    IsMaximizedMDIClient := GetMaximizedMDIClient(ClassName);
    IsMaximizedMDIChild  := False;
    {$endif CLX}
  end;
  IsRenderWindow := StrIComp(ClassName, 'TTERenderWindow') = 0;
end;

procedure GetSize(Window: {$ifndef CLX}HWnd{$else}TWidgetControl{$endif CLX};
  IsMaximizedMDIChild: Boolean; var Width, Height: Integer);
var
  WndRect: TRect;
begin
  if IsMaximizedMDIChild
  {$ifndef CLX}
  then GetClientRect(GetParent(Window), WndRect)
  else GetWindowRect(Window, WndRect);
  {$else}
  then WndRect := Window.ClientRect
  else WndRect := Window.BoundsRect;
  {$endif CLX}
  Width  := WndRect.Right  - WndRect.Left;
  Height := WndRect.Bottom - WndRect.Top;
end;

{$ifndef CLX}
procedure CheckClipRegion(
  Window: {$ifndef CLX}HWnd{$else}TWidgetControl{$endif CLX}; DC: HDC;
  CheckRegion, IsMaximizedMDIChild: Boolean; Width, Height: Integer; R: TRect);
var
  WndRect: TRect;
  WndRgn,
  ClipRgn: HRGN;
  P: TPoint;
begin
  WndRect := Rect(0, 0, Width, Height);
  WndRgn  := CreateRectRgn(WndRect.Left, WndRect.Top, WndRect.Right,
    WndRect.Bottom);

  if CheckRegion and (not IsMaximizedMDIChild) then
    GetWindowRgn(Window, WndRgn);

  P := Point(0, 0);
  LPToDP(DC, P, 1);
  OffsetRgn(WndRgn, P.x, P.y);

  ClipRgn := CreateRectRgn(WndRect.Left, WndRect.Top, WndRect.Right,
    WndRect.Bottom);
  GetClipRgn(DC, ClipRgn);
  CombineRgn(ClipRgn, WndRgn, ClipRgn, RGN_AND);
  DeleteObject(WndRgn);
  SelectClipRgn(DC, ClipRgn);
  GetRgnBox(ClipRgn, R);
  DPToLP(DC, R, 2);
  DeleteObject(ClipRgn);
end;
{$endif CLX}

procedure GetClientSize(WinControl: TWinControl; Window: HWnd;
  IsMaximizedMDIClient, IsMaximizedMDIChild: Boolean;
  var ClientWidth, ClientHeight: Integer; var ClientOrg: TPoint);
var
  WndRect,
  ClientRect: TRect;
  aux: TPoint;
begin
  if IsMaximizedMDIChild
  then
  begin
    GetClientRect(Window, ClientRect);
    {$ifndef D3C3}
    ClientOrg :=
      Point(TTECustomForm(WinControl).BorderWidth,
            TTECustomForm(WinControl).BorderWidth);
    {$else}
    ClientOrg := Point(0, 0);
    {$endif D3C3}
  end
  else
  begin
    GetWindowRect(Window, WndRect);
    aux := Point(0, 0);
    ClientToScreen(Window, aux);
    ClientOrg.x := aux.x - WndRect.Left;
    ClientOrg.y := aux.y - WndRect.Top;
    ScreenToClient(Window, WndRect.TopLeft);
    ScreenToClient(Window, WndRect.BottomRight);
    GetClientRect(Window, ClientRect);
  end;
  ClientWidth  := ClientRect.Right  - ClientRect.Left;
  ClientHeight := ClientRect.Bottom - ClientRect.Top;
end;

function ClassInheritsFrom(const ClassType: TClass;
  const ClassName: String): Boolean;
var
  ParentClass: TClass;
begin
  Result := False;

  ParentClass := ClassType;
  while ParentClass <> TObject do
  begin
    if ParentClass.ClassNameIs(ClassName) then
    begin
      Result := True;
      break;
    end;
    ParentClass := ParentClass.ClassParent;
  end;
end;

{$ifndef CLX}
procedure ToolWindowNCPaint(WinControl: TWinControl; DC: HDC);
type
  TEdgeStyle   = (esNone, esRaised, esLowered);
  TEdgeBorder  = (ebLeft, ebTop, ebRight, ebBottom);
  TEdgeBorders = set of TEdgeBorder;
const
  InnerStyles: array[TEdgeStyle] of Integer = (0, BDR_RAISEDINNER, BDR_SUNKENINNER);
  OuterStyles: array[TEdgeStyle] of Integer = (0, BDR_RAISEDOUTER, BDR_SUNKENOUTER);
  Ctl3DStyles: array[Boolean] of Integer = (BF_MONO, 0);
var
  RC, RW: TRect;
  EdgeInner,
  EdgeOuter: TEdgeStyle;
  EdgeBorders: TEdgeBorders;
  PropInfo: PPropInfo;
  aux: Longint;
begin
  GetClientRect(WinControl.Handle, RC);
  GetWindowRect(WinControl.Handle, RW);
  MapWindowPoints(0, WinControl.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
  OffsetRect(RW, -RW.Left, -RW.Top);

  PropInfo    := GetPropInfo(WinControl.ClassInfo, 'EdgeInner');
  EdgeInner   := TEdgeStyle(GetOrdProp(WinControl, PropInfo));
  PropInfo    := GetPropInfo(WinControl.ClassInfo, 'EdgeOuter');
  EdgeOuter   := TEdgeStyle(GetOrdProp(WinControl, PropInfo));
  PropInfo    := GetPropInfo(WinControl.ClassInfo, 'EdgeBorders');
  aux         := GetOrdProp(WinControl, PropInfo);
  EdgeBorders := [];
  if(aux and $00000001) <> 0 then
    EdgeBorders := EdgeBorders + [ebLeft];
  if(aux and $00000002) <> 0 then
    EdgeBorders := EdgeBorders + [ebTop];
  if(aux and $00000004) <> 0 then
    EdgeBorders := EdgeBorders + [ebRight];
  if(aux and $00000008) <> 0 then
    EdgeBorders := EdgeBorders + [ebBottom];

  DrawEdge(DC, RW,
    InnerStyles[EdgeInner] or OuterStyles[EdgeOuter],
    Byte(EdgeBorders) or Ctl3DStyles[TTEWinControl(WinControl).Ctl3D] or BF_ADJUST);
  // Erase parts not drawn
  IntersectClipRect(DC, RW.Left, RW.Top, RW.Right, RW.Bottom);
  Windows.FillRect(DC, RW, WinControl.Brush.Handle);
end;
{$endif CLX}
//V33
function GetWinVersion: TTEWinVersion;
Begin
  Result:=teWinUnknown;
  Case Win32Platform Of
   0: Begin
        Result:=teWin32s;
        Exit;
      End;
   2: Begin
        If Win32MajorVersion<=4 Then
          Result:=teWinNT
        Else
        If (Win32MajorVersion>5)Or(Win32MajorVersion=5)And(Win32MinorVersion>1) Then
            Result:=teWinFuture
          Else
           If  (Win32MajorVersion=5)And(Win32MinorVersion=0) Then
              Result:=teWin2000
          Else
           If  (Win32MajorVersion=5)And(Win32MinorVersion=1) Then
              Result:=teWinXP
           Else
              Result:=teWinUnknown;
        Exit;
      End;
    1: Begin
         If (Win32MajorVersion=4)And(Win32MinorVersion=0) Then
           Result:=teWin95
         Else
         If (Win32MajorVersion=4)And(Win32MinorVersion=10) Then
         Begin
           If Win32CSDVersion[1] = Chr(65) Then
             Result:=teWin98SE
           Else
             Result:=teWin98;
         End
         Else
           If (Win32MajorVersion=4)And(Win32MinorVersion=90) Then
             Result:=teWinME
         Else
           Result:=teWinUnknown;
       End;
   End;//Case
end;