تغير مظهر ادات المنزلقة - نسخة قابلة للطباعة

PHP كود :
unit uScrollBarSkin;

interface

uses
  System.Generics.Collections,
  WinApi.Windows,
  WinApi.UxTheme,
  Vcl.Graphics,
  Vcl.Styles,
  Vcl.Themes,
  DDetours;

var
  ScrollBarList: TObjectDictionary<HTHEME, String>;
  DrawThemeBackgroundOrgPointer: Pointer = nil;
  OpenThemeDataOrgPointer: Pointer = nil;

  TrampolineOpenThemeData: function(hwnd: hwnd; pszClassList: LPCWSTR): HTHEME; stdcall;

  TrampolineDrawThemeBackground: function(HTHEME: HTHEME; hdc: hdc; iPartId, iStateId: Integer; const pRect: TRect; pClipRect: pRect): HRESULT; stdcall;

function InterceptOpenThemeData(hwnd: hwnd; pszClassList: LPCWSTR): HTHEME; stdcall;
function InterceptDrawThemeBackground(THEME: HTHEME; dc: hdc; iPartId, iStateId: Integer; const pRect: TRect; pClipRect: pRect): HRESULT; stdcall;

implementation

function InterceptOpenThemeData(hwnd: hwnd; pszClassList: LPCWSTR): HTHEME; stdcall;
begin
  Result := TrampolineOpenThemeData(hwnd, pszClassList);
  if pszClassList = 'ScrollBar' then
  begin
    if ScrollBarList.ContainsKey(Result) then
      ScrollBarList.Remove(Result);
    ScrollBarList.Add(Result, pszClassList);
  end;
end;

procedure PaintRect(dc: hdc; R: TRect; Color: COLORREF);
var
  Brush: HBRUSH;
begin
  Brush := CreateSolidBrush(Color);
  FillRect(dc, R, Brush);
  DeleteObject(Brush);
end;

function InterceptDrawThemeBackground(THEME: HTHEME; dc: hdc; iPartId, iStateId: Integer; const pRect: TRect; pClipRect: pRect): HRESULT; stdcall;
var
  LStyle: TCustomStyleServices;
  LDetails: TThemedElementDetails;
begin
  if ScrollBarList.ContainsKey(THEME) then
  begin
    if iPartId = 1 then
      PaintRect(dc, pRect, $003783F1)
    else if iPartId = 3 { ThumbBtnVert } then
      PaintRect(dc, pRect, $00434343)
    else if iPartId = 6 then
      PaintRect(dc, pRect, $007D7D7D)
    else if iPartId = 7 then
      PaintRect(dc, pRect, $007D7D7D)
    else if iPartId = 8 then
      PaintRect(dc, pRect, clBlue)
    else
    begin
      TrampolineDrawThemeBackground(THEME, dc, iPartId, iStateId, pRect, pClipRect);
    end;
  end;
end;

initialization

ScrollBarList := TObjectDictionary<HTHEME, String>.Create();

OpenThemeDataOrgPointer := GetProcAddress(GetModuleHandle('UxTheme.dll'), 'OpenThemeData');
@TrampolineOpenThemeData := InterceptCreate(OpenThemeDataOrgPointer, @InterceptOpenThemeData);

DrawThemeBackgroundOrgPointer := GetProcAddress(GetModuleHandle('UxTheme.dll'), 'DrawThemeBackground');
@TrampolineDrawThemeBackground := InterceptCreate(DrawThemeBackgroundOrgPointer, @InterceptDrawThemeBackground);

finalization

if OpenThemeDataOrgPointer <> nil then
  InterceptRemove(@TrampolineOpenThemeData);

if DrawThemeBackgroundOrgPointer <> nil then
  InterceptRemove(@TrampolineDrawThemeBackground);

ScrollBarList.Free;

end.