كيف إظهر تلميح العنصر دون إيقاف الماوس فوقه

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

اذاكنت تقصد اظهار القيمة النصية لعنصر التلميح لأداة معينة فيمكنك قراءة قيمة الخاصية ToolTipText للأداة مثلا

MsgBox Command1.ToolTipText

ويمكنك استخدام المجموعة controls لقراءة قيم الخاصية لجميع عناصر النموذج..

 On Error Resume Next
 For Each ctrl In Me.Controls
  MsgBox ctrl.ToolTipText
 Next

أما إذا كنت تريد اظهار أداة التلميح في الزمان والمكان الذي تريده فيمكنك استخدام دوال API لانشاء أداة عنوان وتغيير شكلها لتصبح محاكية لأداة ToolTipText ثم تقوم بكتابة النص ويمكنك استخدام هذه الطريقة لإنشاء أداة تلميح ذات حواف ثلاثية الابعاد كما يمكنك أن تضيف لها ميزة تعدد الاسطر.. وقد قمت بعمل مثال لتوضيح الفكرة، ولربما يبدو للوهلة الاولى أن الكود طويلا بعض الشئ نظرا لأن انشاء اداة العنوان يتم وقت التشغيل، وعلى العموم أعتقد أن التعليقات المضافة على الكود ستسهل تتبعه، مع ملاحظة انني قمت بتفصيل شرح معظم الدوال الاساسية في وقت سابق ....

اضف اداة مؤقت وزر أمر مع اسناد أي قيمة للخاصية ToolTipText للأخير حتى يمككنا مشاهدتها وقت التشغيل.

Private Type RECT
 Left As Long
 Top As Long
 Right As Long
 Bottom As Long
End Type
Private Type POINTAPI
 X As Long
 Y As Long
End Type
Private Const WS_POPUP = &H80000000
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Const HWND_TOPMOST = -1
Private Const DT_LEFT = &H0
Private Const DT_CALCRECT = &H400
Private Const BF_LEFT = &H1
Private Const BF_TOP = &H2
Private Const BF_RIGHT = &H4
Private Const BF_BOTTOM = &H8
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 GetCursorPos Lib "user32" _
 (lpPoint As POINTAPI) 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 GetDC Lib "user32" (ByVal _
 hwnd As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal _
 hhDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal _
 hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" _
 (ByVal crctolor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal _
 hhDC As Long, lpRect As RECT, ByVal hBrush As Long) _
 As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal _
 hhDC As Long, ByVal crctolor As Long) As Long
Private Declare Function DrawText Lib "user32" Alias _
 "DrawTextA" (ByVal hhDC As Long, ByVal lpStr As _
 String, ByVal nCount As Long, lpRect As RECT, _
 ByVal wFormat As Long) As Long
Private Declare Function DrawEdge Lib "user32" (ByVal _
 hhDC As Long, Rct As RECT, ByVal edge As Long, ByVal _
 grfFlags As Long) As Boolean

Private lng_hWnd As Long

Sub GetToolTipText(txt As String)
 Dim hDC&, hBrush&, ClrInfo&
 Dim pt As POINTAPI, Rct As RECT
 ClrInfo = &HE1FFFF
 If Not lng_hWnd Then
  'انشاء أداة عنوان
  lng_hWnd = CreateWindowEx(0, "STATIC", "", WS_POPUP, _
   0, 0, 0, 0, hwnd, 0, App.hInstance, 0)
 End If
  '(الحصول على مقبض سياق الجهاز (منطقة الرسم
 hDC = GetDC(lng_hWnd)
 SetBkColor hDC, ClrInfo
  'الحصول على أبعاد النص
 DrawText hDC, txt, Len(txt), Rct, DT_CALCRECT
 ' الهوامش
 Rct.Bottom = Rct.Bottom + 6
 Rct.Right = Rct.Right + 6
 GetCursorPos pt
 'اظهار أداة العنوان في موقع المشيرة
 SetWindowPos lng_hWnd, HWND_TOPMOST, pt.X - 5, pt.Y + 20, _
  Rct.Right - Rct.Left, Rct.Bottom - Rct.Top, _
  SWP_SHOWWINDOW Or SWP_NOACTIVATE
 DoEvents
 'الحصول على مقبض الفرشاه للتلوين
 hBrush = CreateSolidBrush(ClrInfo)
 FillRect hDC, Rct, hBrush
 DeleteObject hBrush
 'رسم الحواف البارزة
 DrawEdge hDC, Rct, 1, BF_LEFT Or BF_RIGHT
 DrawEdge hDC, Rct, 1, BF_TOP Or BF_BOTTOM
 With Rct
  .Left = .Left + 3: .Right = .Right - 3
  .Top = .Top + 3: .Bottom = .Bottom - 3
 End With
 'رسم النص
 DrawText hDC, txt, Len(txt), Rct, DT_LEFT
End Sub

Private Sub Form_Load()
 Timer1.Interval = 50
End Sub

Private Sub Timer1_Timer()
 If lng_hWnd Then
  DestroyWindow lng_hWnd
 End If
 GetToolTipText Command1.ToolTipText
End Sub

الله يبارك فيك اخي Read Only

ننتظر المزيد من ابدعاتك

هل ممكن ان تراسلني علي بريدي Musatarek@hotmail.com

لك تحياتي

:D

يا شباب ترى ايميلي موجود بالتوقيع الفلاشي تحت :P

اوكيه يا طارق ;)

لوووووووووووووووووووووووووووووووووووووووووووووووووووووول

تحياتي

ويعطيك الف عافية يا استاذ / للقراء فقط :P Read Only

تحياتي

الدولار

بالتأكيد يشرفني ذلك يا أخي طارق .. yyasser75@hotmail.com

أشكرك على هذا الكود الجميل وقد جربته واشتغل وما اردته قريب جداً من هذا ويمكن التعديل على الكود ببساطة .

سؤال جانبي :

حاولت تشغيل الكود في الأكسس لكن لايوجد مقابل لـ :

App.hInstance

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

ولك تحياتي

الخاصية hInstance -التابعة لكائن النظام Application الذي يوفره فيجوال بيسك - تعيد قيمة مقبض التطبيق ... والحديث عن الخاصية السابقة يلزمني بالحديث عن فكرة المقابض بصورة عامة في أنظمة win32 والتي هي عبارة عدد صحيح طويل يعرف أحد كائنات النظام كالنوافذ و المؤشرات والأقلام وغيرها و(سأحاول) تفصيل الحديث عن مقابض كائنات النظام وطرق الحصول عليها وتوظيفها في موضوع لاحق باذن الله.

ويمكن الحصول على مقبض التطبيق من خلال دوال API بعدة اشكال ولعل أكثرها استخداما هو الاعتماد على احدى نوافذ البرنامج .. وذلك من خلال النمط GWL_HINSTANCE

Private Const GWL_HINSTANCE = (-6)
Private Declare Function GetWindowLong Lib "user32" _
 Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal _
 nIndex As Long) As Long

Private Sub Command1_Click()
 Dim hInstance&
 hInstance = GetWindowLong(hwnd, GWL_HINSTANCE)
 MsgBox hInstance
End Sub

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

www.vb4arab.com/vb

عزيزي Read Only

هل تمانع اذ اضفتك عندي على المسنجر :confused:

بالطبع لا أمانع :) ...

شكرا لك اخي الكريم (( ياسر ))

هذا من كرم اخلاقك

وانت يا استاذ طارق هل تسمح لي ان اضيفك عندي على المسنجر

لووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووول

:P :P :P :P

شباب ممكن أضيفكم عندي ولك واحد له حبة راس

;)

أوكي وإلا تزعلون ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟