اداة من الفجوال لجعل برنامجك مناسبا للفستا واعطائه خاصيه رائعه

و هل الشفافية هى ما يعطى Vista Style ؟

أن كنت شغال على Vista ففى APIs لكده

بالنسبة لسؤالك فمش مفهوم , أن كنت عايز أداة الـ Slider نفسها تغيير من شفافيتها فده بيحصل فى مثالك أساسا.

-----------------------------

عندى سؤال كمان لأنها حاجة بشوفها كتير : ليه كتير من الأعضاء يرفعوا ملفات مسمينها ____________________ , ايه الهدف يعنى ؟!

انت ما فهمت قصدي انا عوز اداة Slider يمكن تغيير لونها Colorلان هذه الاداة لا يمكن تغيير لونها حسب ما انا جربت

ياريت لو في اداة يمكن تغيير لونها لكي يبقى شكل البرنامج جميلا

وارجو توضيح الــAPIs لا اعرفها

اما بخصوص سؤالك فالاسم ـــــــــــــــــــــــــ ليس متعمدا لكن يبدو عندما يكون الملف المرفوع مكتوبا بالعربيه يحدث هكذا والله اعلم

هل تقصد الــWindows API ايضا لا اعرفها هل تدخل في الجوال

فى لأداة Slider مفتوحة المصدر على vbAccelerator.com

ممكن تحضرلياها لاني حولت ولم استطع و اشكرك لقد افادني الموقع واتمنه منك ان تحضر لي الاداة رجاءا فأنا محتاج اليها جدااااا

مرحبا وجد هذا الكود ولكن للاسف ولاني جديد ام اعرف ان اكون الاداة في النهايه ولم اجد مثال جاهز ؟

VERSION 5.00
Begin VB.UserControl cSlider 
   ClientHeight	=   3600
   ClientLeft	  =   0
   ClientTop	   =   0
   ClientWidth	 =   4800
   ScaleHeight	 =   3600
   ScaleWidth	  =   4800
End
Attribute VB_Name = "cSlider"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' ======================================================================
' Class:	cSlider
' Filename: cSlider.Ctl
' Author:   SP McMahon
' Date:	 14 July 1998
'
' A (very!) simple implementation of the API Slider
' control.
' ======================================================================


'
 ===============================================================================
========
' API Declares:
'
 ===============================================================================
========
Private Const WM_VSCROLL = &H115
Private Const WM_HSCROLL = &H114
Private Const WM_COMMAND = &H111
Private Const WM_COMMNOTIFY = &H44

Private Type tagInitCommonControlsEx
	lngSize As Long
	lngICC As Long
End Type
Const ICC_BAR_CLASSES = &H20
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal
 hWndNewParent As Long) As Long
Private Declare Function InitCommonControlsEx Lib "Comctl32.dll" _
 (iccex As tagInitCommonControlsEx) As Boolean
Private Type RECT
	left As Long
	Top As Long
	Right As Long
	Bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect
 As RECT) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long,
 lpRect As RECT, ByVal bErase As Long) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As
 Long
'Private Const TB_ADDSTRINGA = (WM_USER + 28)
Private Declare Function LoadBitmap Lib "user32" Alias "LoadBitmapA" (ByVal
 hInstance As Long, ByVal lpBitmapName As String) As Long
'Public Const DI_MASK = 1 'VBC NR
'Public Const DI_IMAGE = 2 'VBC NR
Private Const DI_NORMAL = 3
'Public Const DI_COMPAT = 4 'VBC NR
 Const HWND_TOPMOST = -1
Const SW_HIDE = 0
Const SW_SHOWNORMAL = 1

Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOREDRAW = &H8
Const SWP_SHOWWINDOW = &H40

Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Const COLOR_BTNFACE = 15
Private Const COLOR_BTNTEXT = 18
' Window Style constants
Const WS_VISIBLE = &H10000000
Const WS_CHILD = &H40000000
Const WS_POPUP = &H80000000

' CreateWindow constants
Const CW_USEDEFAULT = &H80000000

Private Declare Function CreateWindowEX Lib "user32" Alias "CreateWindowExA" _
 (ByVal dwExStyle As Long, _
 ByVal lpClassName As String, ByVal lpWindowName As String, _
 ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, _
 ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, _
 ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" _
 (ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
 (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)
  As Long
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" _
 (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As
  Long) As Long
Private Declare Function SendMessageString Lib "user32" Alias "SendMessageA" _
 (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As
  String) As Long
Private Declare Function ShowWindow Lib "user32" _
 (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Private Declare Function MoveWindow Lib "user32" _
 (ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _
 ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" _
 (ByVal hwnd As Long) As Long
Private Const WM_PAINT = &HF
Private Const WM_USER = &H400
Private Const GWL_HWNDPARENT = (-8)
Private Const GWL_STYLE = (-16)
 Private Const WS_BORDER = &H800000
Private Const WM_DRAWITEM = &H2B
Private Const WS_CLIPCHILDREN = &H2000000
Private Const WS_CLIPSIBLINGS = &H4000000
Private Const WM_SETREDRAW = &HB
'//Common Control Constants
Private Const CCS_TOP = &H1
Private Const CCS_NOMOVEY = &H2
Private Const CCS_BOTTOM = &H3
Private Const CCS_NORESIZE = &H4
Private Const CCS_NOPARENTALIGN = &H8
'Private Const CCS_ADJUSTABLE		  &H00020L
Private Const CCS_NODIVIDER = &H40
'Private Const CCS_VERT				&H00080L
'Private Const CCS_LEFT				(CCS_VERT | CCS_TOP)
'Private Const CCS_RIGHT			   (CCS_VERT | CCS_BOTTOM)
'Private Const CCS_NOMOVEX			 (CCS_VERT | CCS_NOMOVEY)


Private Declare Function SetWindowWord Lib "user32" (ByVal hwnd As Long, ByVal
 nIndex As Long, ByVal wNewWord As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA"
 (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA"
 (ByVal hwnd As Long, ByVal nIndex As Long) As Long
'Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal
 hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long,
 ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal
 hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long,
 ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const TRACKBAR_CLASSA = "msctls_trackbar32"

Private Const TBS_AUTOTICKS = &H1
Private Const TBS_VERT = &H2
Private Const TBS_HORZ = &H0
Private Const TBS_TOP = &H4
Private Const TBS_BOTTOM = &H0
Private Const TBS_LEFT = &H4
Private Const TBS_RIGHT = &H0
Private Const TBS_BOTH = &H8
Private Const TBS_NOTICKS = &H10
Private Const TBS_ENABLESELRANGE = &H20
Private Const TBS_FIXEDLENGTH = &H40
Private Const TBS_NOTHUMB = &H80
Private Const TBS_TOOLTIPS = &H100
'"TB_THUMPOSITION"
Private Const TBM_GETPOS = (WM_USER)
Private Const TBM_GETRANGEMIN = (WM_USER + 1)
Private Const TBM_GETRANGEMAX = (WM_USER + 2)
Private Const TBM_GETTIC = (WM_USER + 3)
Private Const TBM_SETTIC = (WM_USER + 4)
Private Const TBM_SETPOS = (WM_USER + 5)
Private Const TBM_SETRANGE = (WM_USER + 6)
Private Const TBM_SETRANGEMIN = (WM_USER + 7)
Private Const TBM_SETRANGEMAX = (WM_USER + 8)
Private Const TBM_CLEARTICS = (WM_USER + 9)
Private Const TBM_SETSEL = (WM_USER + 10)
Private Const TBM_SETSELSTART = (WM_USER + 11)
Private Const TBM_SETSELEND = (WM_USER + 12)
Private Const TBM_GETPTICS = (WM_USER + 14)
Private Const TBM_GETTICPOS = (WM_USER + 15)
Private Const TBM_GETNUMTICS = (WM_USER + 16)
Private Const TBM_GETSELSTART = (WM_USER + 17)
Private Const TBM_GETSELEND = (WM_USER + 18)
Private Const TBM_CLEARSEL = (WM_USER + 19)
Private Const TBM_SETTICFREQ = (WM_USER + 20)
Private Const TBM_SETPAGESIZE = (WM_USER + 21)
Private Const TBM_GETPAGESIZE = (WM_USER + 22)
Private Const TBM_SETLINESIZE = (WM_USER + 23)
Private Const TBM_GETLINESIZE = (WM_USER + 24)
Private Const TBM_GETTHUMBRECT = (WM_USER + 25)
Private Const TBM_GETCHANNELRECT = (WM_USER + 26)
Private Const TBM_SETTHUMBLENGTH = (WM_USER + 27)
Private Const TBM_GETTHUMBLENGTH = (WM_USER + 28)
Private Const TBM_SETTOOLTIPS = (WM_USER + 29)
Private Const TBM_GETTOOLTIPS = (WM_USER + 30)
Private Const TBM_SETTIPSIDE = (WM_USER + 31)
'// TrackBar Tip Side flags
Private Const TBTS_TOP = 0
Private Const TBTS_LEFT = 1
Private Const TBTS_BOTTOM = 2
Private Const TBTS_RIGHT = 3

Private Const TBM_SETBUDDY = (WM_USER + 32) ' // wparam = BOOL fLeft; (or right)
Private Const TBM_GETBUDDY = (WM_USER + 33) ' // wparam = BOOL fLeft; (or right)


Private Const TB_LINEUP = 0
Private Const TB_LINEDOWN = 1
Private Const TB_PAGEUP = 2
Private Const TB_PAGEDOWN = 3
Private Const TB_THUMBPOSITION = 4
Private Const TB_THUMBTRACK = 5
Private Const TB_TOP = 6
Private Const TB_BOTTOM = 7
Private Const TB_ENDTRACK = 8


'// custom draw item specs
Private Const TBCD_TICS = &H1
Private Const TBCD_THUMB = &H2
Private Const TBCD_CHANNEL = &H3


'
 ===============================================================================
========
' Implementation
'
 ===============================================================================
========
Public Enum ESliderOrientation
	eslHorizontal = TBS_HORZ
	eslVertical = TBS_VERT
End Enum
Private m_eOrientation As ESliderOrientation
Private m_hWNd As Long
Private m_bSubClass As Boolean
Private m_lMin As Long
Private m_lMax As Long
Private m_lValue As Long

Implements ISubclass
Private m_emr As EMsgResponse

Public Event Scroll(ByVal lPos As Long)

Public Property Get Min() As Long
	Min = m_lMin
End Property
Public Property Let Min(ByVal lMin As Long)
	If (m_lMin <> lMin) Then
		m_lMin = lMin
		If (m_lMax < m_lMin) Then
			m_lMax = m_lMin + 1
		End If
		SetRange m_lMin, m_lMax
	End If
End Property

Public Property Get Max() As Long
	Max = m_lMax
End Property
Public Property Let Max(ByVal lMax As Long)
	If (m_lMax <> lMax) Then
		m_lMax = lMax
		If (m_lMin > m_lMax) Then
			m_lMin = m_lMax - 1
		End If
		SetRange m_lMin, m_lMax
	End If
End Property
Public Property Get Value() As Long
	If (m_hWNd <> 0) Then
		Value = SendMessageLong(m_hWNd, TBM_GETPOS, 0, 0)
	Else
		Value = m_lValue
	End If
End Property
Public Property Let Value(ByVal lValue As Long)
	If (m_lValue <> lValue) Then
		m_lValue = lValue
		If (m_hWNd <> 0) Then
			SendMessageLong m_hWNd, TBM_SETPOS, 1, lValue
		End If
	End If
End Property
Public Sub SetRange(ByVal lMin As Long, ByVal lMax As Long)
	SendMessageLong m_hWNd, TBM_SETRANGEMIN, True, lMin
	SendMessageLong m_hWNd, TBM_SETRANGEMAX, True, lMax
End Sub
Public Property Get Orientation() As ESliderOrientation
	Orientation = m_eOrientation
End Property
Public Property Let Orientation(ByVal eOrientation As ESliderOrientation)
	m_eOrientation = eOrientation
End Property

Private Sub pInitialise()
Dim dwStyle As Long
Dim iccex As tagInitCommonControlsEx

	With iccex
		.lngSize = LenB(iccex)
		.lngICC = ICC_BAR_CLASSES
	End With
	InitCommonControlsEx iccex

	dwStyle = WS_CHILD Or WS_VISIBLE Or TBTS_LEFT Or TBS_RIGHT
	If (m_eOrientation = eslHorizontal) Then
		dwStyle = dwStyle Or TBS_HORZ
	Else
		dwStyle = dwStyle Or TBS_VERT
	End If

	m_hWNd = CreateWindowEX(0, TRACKBAR_CLASSA, "", _
				dwStyle, 0, 0, 0, 0, _
				UserControl.hwnd, 0&, App.hInstance, 0&)
	If (m_hWNd <> 0) Then
		SendMessageLong m_hWNd, TBM_SETTICFREQ, 10, 0
		' (Minimum range = low word, Maximum range = high word)
		SendMessageLong m_hWNd, TBM_SETRANGE, True, 100 * &H10000

		SetParent m_hWNd, UserControl.hwnd
		UserControl_Resize
		ShowWindow m_hWNd, SW_SHOWNORMAL

		If (UserControl.Ambient.UserMode) Then
			AttachMessage Me, UserControl.hwnd, WM_HSCROLL
			AttachMessage Me, UserControl.hwnd, WM_VSCROLL
			m_bSubClass = True
		End If
	End If
End Sub
Private Sub pTerminate()
	If (m_hWNd <> 0) Then
		ShowWindow m_hWNd, SW_HIDE
		SetParent m_hWNd, 0
		DestroyWindow m_hWNd
	End If
End Sub

Private Property Let ISubClass_MsgResponse(ByVal RHS As SSubTimer.EMsgResponse)
	m_emr = RHS
End Property

Private Property Get ISubClass_MsgResponse() As SSubTimer.EMsgResponse
	ISubClass_MsgResponse = emrPreprocess
End Property

Private Function ISubClass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long,
 ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lPos As Long
	lPos = Value
	RaiseEvent Scroll(lPos)
End Function

Private Sub UserControl_Initialize()
	m_lMin = 1
	m_lMax = 100
End Sub

Private Sub UserControl_InitProperties()
	pInitialise
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
	Orientation = PropBag.ReadProperty("Orientation", TBS_HORZ)
	pInitialise
	Min = PropBag.ReadProperty("Min", 1)
	Max = PropBag.ReadProperty("Max", 100)
	Value = PropBag.ReadProperty("Value", 1)
End Sub

Private Sub UserControl_Resize()
	If (m_hWNd <> 0) Then
		MoveWindow m_hWNd, 0, 0, UserControl.ScaleWidth \
		 Screen.TwipsPerPixelX, UserControl.ScaleHeight \
		 Screen.TwipsPerPixelY, 1
	End If
End Sub

Private Sub UserControl_Terminate()
	If (m_bSubClass) Then
		DetachMessage Me, UserControl.hwnd, WM_HSCROLL
		DetachMessage Me, UserControl.hwnd, WM_VSCROLL
	End If
	pTerminate
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
	PropBag.WriteProperty "Orientation", Orientation, eslHorizontal
	PropBag.WriteProperty "Min", Min, 1
	PropBag.WriteProperty "Max", Max, 100
	PropBag.WriteProperty "Value", Value, 1
End Sub

ومازلت منظرا الاداة

الأداة مرفقة , لاحظ أن Steve صاحبها لم يكملها , و مش هو اللى عملها فى مشروع لوحدها , لكن كـ Slider عادى هتشتغل , تقدر تضيف لها اللى أنت عايزة.

VB6_Slider__vbalSlider_.rar

شكرااااااااا مع انها ليست كما اطمح حسب النضره الاولى عند تغيير لونها بس إن شاء الله بس نتعمق شوي نحسنها

وشكراااااااااااا جزيلا والله اني لما اشوف اسمك بموضوعي اقول الحل وصل