terender.pas

delphi2007界面效果控件源码

    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;

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);
    ClientOrg :=
      Point(TTECustomForm(WinControl).BorderWidth,
            TTECustomForm(WinControl).BorderWidth);
  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;

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;

// Returns Windows version
function GetWinVersion: TTEWinVersion;
begin
  Result := teWinUnknown;
  case Win32Platform of
    VER_PLATFORM_WIN32s: Result := teWin32s;
    VER_PLATFORM_WIN32_WINDOWS: // Windows 9x/ME
    begin
      if(Win32MajorVersion = 4) and (Win32MinorVersion = 0)
      then Result := teWin95
      else
      begin
        if(Win32MajorVersion = 4) and (Win32MinorVersion = 10)
        then
        begin
          if Win32CSDVersion[1] = 'A'
          then Result := teWin98SE
          else Result := teWin98;
        end
        else
        begin
          if(Win32MajorVersion = 4) and (Win32MinorVersion = 90)
          then Result := teWinME
          else Result := teWinUnknown;
        end;
      end;
    end;
    VER_PLATFORM_WIN32_NT: // Windows NT/2000/XP/2003/Vista
    begin
      case Win32MajorVersion of
        4: Result := teWinNT;
        5:
        begin
          case Win32MinorVersion of
            0: Result := teWin2000;
            1: Result := teWinXP;
            2: Result := teWin2003;
          end;
        end;
        6: Result := teWinVista;
        else Result := teWinFuture;
      end;
    end;
  end;
end;

function ControlClientAreaHasRegion(Control: TWinControl): Boolean;
var
  ControlRgn,
  ClientRectRgn: HRgn;
  ControlR,
  R: TRect;
begin
  ControlRgn := CreateRectRgn(0, 0, 0, 0);
  try
    Result := GetWindowRgn(Control.Handle, ControlRgn) <> ERROR;
    if Result then
    begin
      GetRgnBox(ControlRgn, R);
      ControlR := Control.ClientRect;
      with ControlClientOffset(Control) do
        OffsetRect(ControlR, x, y);
      ClientRectRgn :=
        CreateRectRgn(ControlR.Left, ControlR.Top, ControlR.Right, ControlR.Bottom);
      try
        CombineRgn(ControlRgn, ControlRgn, ClientRectRgn, RGN_AND);
        Result := not EqualRgn(ControlRgn, ClientRectRgn);
      finally
        DeleteObject(ClientRectRgn);
      end;
    end;
  finally
    DeleteObject(ControlRgn);
  end;
end;

function WindowHasRegion(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
    (TEWinVersion >= teWinXP)                          and
    WindowHasRegion(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;

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;

procedure EraseAndPaintMessage(DC: HDC; WinControl: TWinControl; Window: HWND);
var
  SaveIndex: Integer;
  DoubleBuffered: Boolean;
begin
  DoubleBuffered := Assigned(WinControl) and (WinControl.DoubleBuffered);
  if DoubleBuffered then
    WinControl.DoubleBuffered := False;

  SaveIndex := SaveDC(DC);
  try
    SendMessage(Window, WM_ERASEBKGND, DC, 0);
  finally
    RestoreDC(DC, SaveIndex);
  end;
  SendMessage(Window, WM_PAINT, DC, BE_ID);

  if DoubleBuffered then
    WinControl.DoubleBuffered := True;
end;

// ****************************************************************
// Copyright (C) 1999 - 2006 www.madshi.net, All Rights Reserved
// This code has been donated by Mathias Rauen and can only be used
// here. You are not allowed to modify or use it in your own code.

type
  TModule = record
    handle   : dword;
    fileName : string;
  end;
  TDAModule = array of TModule;

  // directory structure for imported APIs
  TImageImportDirectory = packed record
    HintNameArray         : dword;
    TimeDateStamp         : dword;
    ForwarderChain        : dword;
    Name_                 : dword;
    ThunkArray            : dword;
  end;

  TPPointer = ^pointer;
  TPWord    = ^word; TAWord = array [0..maxInt shr 1-1] of word;

function GetImageNtHeaders(module: dword) : PImageNtHeaders;
const
  // PE header constants
  CENEWHDR = $003C;  // offset of new EXE header
  CEMAGIC  = $5A4D;  // old EXE magic id: