کلینیک فوق تخصصی اکسس ( کاربرد vba در اکسس )

کلینیک فوق تخصصی اکسس ( کاربرد vba در اکسس )

به اشتراک گذاری اطلاعات کسب شده در اکسس از سایت آفیس و سایت های تخصصی خارجی
کلینیک فوق تخصصی اکسس ( کاربرد vba در اکسس )

کلینیک فوق تخصصی اکسس ( کاربرد vba در اکسس )

به اشتراک گذاری اطلاعات کسب شده در اکسس از سایت آفیس و سایت های تخصصی خارجی

کلاس پنجره ها در باکس ورودی پسورد اکسس ( دیتابیس با پسورد )


کلاس پنجره 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.


setwindowsubclass



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 Long
hNotePad = 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




sputniknews.


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 بهمن 1351؛ دلار سقوط کرد



21 بهمن 1400 : ایرنا نوشت: جواد منصوری گفت: آمریکا ژنرال هایزر را فرستاده بود تا یک میلیون آدم بکشد  تا محمدرضا پهلوی بر اوضاع مسلط شود ولی این اتفاق نیافتاد، خداوند نخواست و امام (ره) انقلاب را رهبری و فرماندهی کرد و نهایتا انقلاب پیروز شد.


21 بهمن 1400 : علیرغم انتقاد رهبر انقلاب از افزایش قیمت‌ لوازم خانگی، متاسفانه هنوز شرکتهای بزرگ این حوزه از جمله اسنوا که سودهای غیرمتعارف بالای هزار میلیارد تومانی دریافت می کردند، اقدام به کاهش قیمت نکرده اند، بلکه برخی هنوز دنبال افزایش مجدد قیمت هستند.



22 بهمن 1400 : مدیر بیوتکنولوژی موسسه رازی با بیان اینکه بر اساس مطالعات انجام شده، اثربخشی واکسن کووپارس ۲.۵ تا سه برابر بیش از سینوفارم بوده است، گفت: تزریق دز استنشاقی واکسن رازی منجر به افزایش مقدار آنتی بادی در قسمت‌های بینی و مخاطی شده و هم ورود ویروس به قسمت فوقانی دستگاه تنفسی کمتر شده و در نتیجه انتقال ویروس کمتر اتفاق می‌افتد.