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

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

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

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

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

WH_CBT ( قلاب یا گرفتن پنجره : برای ارسال پیام ازطریق پنجره به زیر پنجره ها Child Window:کنترل پیام های پنجره Window Message)


Tested SuccesFully..... 64 BIT


HOOK/SUBCLASS THE WINDOW







CustomMeSsageBox


(Public Const GWL_WNDPROC = (-4

Public Const HCBT_CREATEWND = 3

Public Const HCBT_DESTROYWND = 4

Public Const HCBT_ACTIVATE = 5


Public Const WM_INITDIALOG = &H110

Public Const WM_COMMAND = &H111

Public Const WM_SYSCOMMAND = &H112






case WM_PAINT
(hdc=BeginPaint(hWnd,ps
((whitebrush=CreateSolidBrush(RGB(0, 0, 0
' Erases the background 
SendMessage(hWnd,WM_ERASEBKGND,
(GetDC(hWnd),0,
(GetClientRect(hWnd,rc
(FillRect(GetDC(hWnd),rc,whitebrush
Can Use DrawEdge' 
 Draw the icon in the client area' 
DrawIcon hdc, 10,20,ByVal  hIcon1' 
(EndPaint(hWnd,ps



You need to handle WM_CTLCOLORDLG. You should return a brush handle. For example, to make the background white:

case WM_CTLCOLORDLG:
    return (INT_PTR)GetStockObject(WHITE_BRUSH);






' Not Tested In VBA Just Following
Code Copied Here

HDC hdcMem

LPDRAWITEMSTRUCT lpdis

Select Case message

case WM_INITDIALOG

'hbm1 and hbm2 are defined globally.

hbm1 = LoadBitmap((HANDLE) hinst, "OwnBit1")

hbm2 = LoadBitmap((HANDLE) hinst, "OwnBit2")

return TRUE

case WM_DRAWITEM

lpdis=(LPDRAWITEMSTRUCT) lParam

hdcMem = CreateCompatibleDC(lpdis.hDC)

if (lpdis->itemState & ODS_SELECTED)

'if selected

SelectObject(hdcMem,hbm2)

else

SelectObject(hdcMem,hbm1)

'Destination

StretchBlt lpdis.hDC,lpdis.rcItem.left,lpdis.rcItem.top,lpdis.rcItem.right-lpdis.rcItem.left,lpdis.rcItem.bottom-lpdis.rcItem.top,hdcMem,0,0,32,32,SRCCOPY

DeleteDC hdcMem

return TRUE

End If

case WM_COMMAND

if (wParam= IDOK Or wParam=IDCANCEL) Then

EndDialog hDlg, TRUE

return TRUE

End If

if (HIWORD(wParam)=BN_CLICKED) Then

Select Case  (LOWORD(wParam))

  case IDB_OWNERDRAW

End Select

End If

case WM_DESTROY

DeleteObject hbm1

DeleteObject hbm2

End Select

return FALSE
' Not Tested
case WM_CREATE
hdc = GetDC(hwnd)
'xPixel = GetDeviceCaps(hdc, ASPECTX) 'yPixel = GetDeviceCaps(hdc, ASPECTY) ReleaseDC hwnd, hdc
SetTimer hwnd,ID_TIMER,50,NULL return 0

case WM_SIZE

xCenter=(cxClient=LOWORD(lParam))/2 yCenter=(cyClient=HIWORD(lParam))/2

cxRadius=cyRadius=min(cxClient, cyClient)/16
cxMove=max(1, cxRadius/2)
cyMove = max(1, cyRadius / 2)

cxTotal=2 * (cxRadius + cxMove)
cyTotal=2 * (cyRadius + cyMove)



case WM_TIMER
hdc = GetDC(hwnd)
hdcMem = CreateCompatibleDC(hdc); SelectObject hdcMem, hBitmap)
BitBlt hdc,xCenter-cxTotal/2, yCenter -cyTotal/2,cxTotal,cyTotal,hdcMem,0,0, SRCCOPY)
ReleaseDC hwnd, hdc
DeleteDC hdcMem




Timers and Animation animation



BackGround Color question-146319

نظرات 0 + ارسال نظر
برای نمایش آواتار خود در این وبلاگ در سایت Gravatar.com ثبت نام کنید. (راهنما)
ایمیل شما بعد از ثبت نمایش داده نخواهد شد