تغير مظهر ادات المنزلقة

[Anew]

السلام عليكم

اخواني كيف يتم تغير مظهر ادات المنزلقة الى المظهر الي في الصورة

الصورة في المرفقات



و ان كانت ادات فما اسمها



بارك الله في الجميع

[SMP3]

الأداة اسمها ScrollBar و الجزء الأزرق يطلق عليه ThumbTrack ..
هناك طريقتين لتغيير شكل ال ScrollBar :
الاولى عن طريق اعادة رسمها بالكامل .. الأمر جد صعب و معقد لأنك ستضطر لعمل محاكاة تامة لل ScrollBar القياسية !!
لقد سبق لي و ان خذت هذه التجربة , يمكنك الاطلاع عليها من خلال مشروع
TThemedSysControls

الطريقة الأخرى أسهل عن طريق استحدام الهووك على الدوال OpenThemeData , DrawThemeBackground باستخدام
مكتبة DDetours

هذا مثال بسيط :

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. 


حتى يعمل الكود يجب أن تقوم باضافة مكون Scrollbar لأن النظام سيقوم بفتح ملف السكين الخاص به لرسم أجزاء ال ScrollBar , بعده يمكنك حذفه فيما بعد وقت التشغيل بعد حدث تحميل الفورم .


مرفق مثال كامل .
المثال يعمل مع اصدارات دلفي الحديثة فقط التي تدعم ال Generics ..يمكنك أن تستعمل المصفوفات بدلها حتى يمكنك أن تستخدمها مع نسخ دلفي القديمة ..

[Anew]

جميل جدا بارك الله بيك
و يجعله في ميزان حسناتك