ش | ی | د | س | چ | پ | ج |
1 | 2 | 3 | 4 | 5 | 6 | 7 |
8 | 9 | 10 | 11 | 12 | 13 | 14 |
15 | 16 | 17 | 18 | 19 | 20 | 21 |
22 | 23 | 24 | 25 | 26 | 27 | 28 |
29 | 30 |
کلاس پنجره 32770# است و آیدی های کنترل داخل آن با لوپ زدن و استفاده از تابع GetDlgCtrlID گرفته شده
SendMessageA(GetDlgItem(hhWnd, 2213), WM_GETTEXT, wparam,lparam use strptr
wParam تعداد کاراکتری است که به متغیر بافر تخصیص می دهد ( منظور داخل بافر کپی می کند ) و lParam خود متغیر بافر است مثل $Buff ، برای ارسال نوشته داخل کنترل RichEdit جایی که پسورد را تایپ کردیم به Caption پنجره والد از تابع SetWindowTextA بهره بردیم دقیقا مثل تصویر زیر
Function NewWindow1(ByVal hWnd As LongPtr,ByVal uMsg As Long,ByVal wParam As LongPtr,ByVal lParam As LongPtr) As LongPtr
Dim lRes As long
NewWindow1=CallWindowProc(oldWindow, hWnd, uMsg, wParam, lParam)
Select Case uMsg
Case &H133
Case &138
SetBkMode wParam,1
wParam, RGB(255, 0, 0)
NewWindow1=GetStockObject(8)
Case WM_NCHITTEST
lRes=DefWindowProc(hWnd,uMsg,wParam,lParam)
' 1 : Client
' 2 : Caption
' wm-nchittest
Case Else
End Select
End Function
منظور نوشته زیر این است که اگر شما از DefWindowProc استفاده کنید تغییر رنگ ناحیه Static امکانپذیر نیست و این تابع رنگ پیش فرض سیستم را انتخاب می کند پس سعی بیهوده نکنید!!!
By default, the DefWindowProc function selects the default system colors for the static control.
Declare PtrSafe Function SetWindowSubclass Lib "comctl32" (ByVal hWnd As LongPtr, ByVal pfnSubclass As LongPtr, _
ByVal uIdSubclass As LongPtr, ByVal dwRefData As LongPtr) As LongPtr
Declare PtrSafe Function RemoveWindowSubclass Lib "comctl32" (ByVal hWnd As LongPtr, ByVal pfnSubclass As LongPtr, _
ByVal uIdSubclass As LongPtr) As LongPtr
Declare PtrSafe Function DefSubclassProc Lib "comctl32" (ByVal hWnd As LongPtr, ByVal uMsg As Long, _
ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Dim hNotePad As Long
Dim hEdit As LonghNotePad = FindWindow("NotePad", vbNullString)hEdit = FindWindowEx(hNotePad, 0, "Edit", vbNullString)Call SendMessage(hEdit, WM_SETTEXT, 0, ByVal "abc")'StrPtr : Transfer Unicode'Const WM_SETTEXT = &HC
CopyMemory nml,ByVal lParam,,LenB(nml)
CopyMemory lParam,,ByVal nml,LenB(nml)
SubClassing ( Tested Successfully )
وقتی SubClass می کنید در واقع پنجره جدیدی ساخته شده و پنجره قدیمی میشود Default.لذا زمان خروج از New به Prev یا Default منتقل میشوید. اگر حذف بدرستی انجام نشود Crash حتمی است و در نهایت مجبور خواهید شد با Ctrl+Shift+Esc به Task Manager رفته و اپلیکیشن را End Process کنید !!! متاسفم چاره ای نیست برای همه پیش می آید حتی باتجربه ها
OnTimer :
Use FindWindowA To Get Handle For the Window Class "#32770"
if HandleWindow<>0 And hHook=0 Then
hHook=SetWindowsHookEx(WH_CBT,AddressOf NewHook,0&,GetCurrentThreadId)
Me.TimerInterval=0
Crash در این قبیل موارد طبیعی است و می بایست قبل از انجام همچین موارد غیر اصولی که آفیس هم توصیه نمی کند ، حتما یک بک آپ از فایل تهیه شود تا در صورت خرابی فایل فایل جایگزین داشته باشید!!!
Function NewHook(nCode,wParam,lParam)
NewHook=CallNextHookEx(hHook,nCode,wParam,lParam)
If nCode=5 Then
If GetClass(wParam)=""32770" Then
UnhookWindowsHookEx hHook
SetWindowSubclass wParam,AddressOf SubClass,1,0
End If
End If
End Function
Function SubClass(hWnd,uMsg,wParam,lParam)
Dim hBr As LongPtr
Dim WinR As RECT
Dim WinP1 As POINTAPI,WinP2 As POINTAPI
SubClass=DefSubClassProc(hWnd,uMsg,wParam,lParam)
Select Case uMsg
Case WM_CREATE
hBkColor=RGB(100,100,100)
hTxtColor=RGB(200,0,100)
hBr=hBkColor 'GetStockObject(8)
Case WM_ERASEBKGND
'البته مختصات صفحه باید با تابع ScreenToClient به مختصات کلایِنت تبدیل شود اگر این پیام توسط Parent یا والد Recieve شود رنگ بک گراند پنجره عوض خواهد شد. ( به رنگ دلخواه شما از پالت رنگ آمیزی ) RGB
Case WM_CTLCOLORSTATIC
'در اینجا رنگ داخل ناحیه استاتیک و نوشته هاش که Prompt است عوض می شود
SetBackColor wParam,hBkColor
SetTextColor wParam,hTxtColor
SubClass=hBr
Case WM_DESTROY,WM_NCDESTROY
'حذف ساب کلاس و هوک در زمان خروج
RemoveWindowSubclass
hWnd,SubClass,1
' DeleteObject (hBrush Or hFont)
hHook=False
End Select
End Function
free : subclassing-and-hooking-with-visual-basic
free : subclassing-and-hooking-with-visual basic_78aa.pdf
i can not figure out what to do what not to do
21 بهمن 1400 : ایرنا نوشت: جواد منصوری گفت: آمریکا ژنرال هایزر را فرستاده بود تا یک میلیون آدم بکشد تا محمدرضا پهلوی بر اوضاع مسلط شود ولی این اتفاق نیافتاد، خداوند نخواست و امام (ره) انقلاب را رهبری و فرماندهی کرد و نهایتا انقلاب پیروز شد.
21 بهمن 1400 : علیرغم انتقاد رهبر انقلاب از افزایش قیمت لوازم خانگی، متاسفانه هنوز شرکتهای بزرگ این حوزه از جمله اسنوا که سودهای غیرمتعارف بالای هزار میلیارد تومانی دریافت می کردند، اقدام به کاهش قیمت نکرده اند، بلکه برخی هنوز دنبال افزایش مجدد قیمت هستند.
22 بهمن 1400 : مدیر بیوتکنولوژی موسسه رازی با بیان اینکه بر اساس مطالعات انجام شده، اثربخشی واکسن کووپارس ۲.۵ تا سه برابر بیش از سینوفارم بوده است، گفت: تزریق دز استنشاقی واکسن رازی منجر به افزایش مقدار آنتی بادی در قسمتهای بینی و مخاطی شده و هم ورود ویروس به قسمت فوقانی دستگاه تنفسی کمتر شده و در نتیجه انتقال ویروس کمتر اتفاق میافتد.