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

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

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

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

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

رنگ کنترل رسمی ( Custom Control) در SubClaasing



ساب کلاس کردن کنترل ترسیمی  ( تنها یک کنترل ) 

Type  cz As SIZE

cx As Long ' Width

cy As Long  ' Height

End Type 


Type CustCtrl
'Foreground text colour
crForeGnd As Long 
'Background text colour
crBackGnd As Long 
'The font
hFont As Long 
'The control's window handle
hwnd As Long 
End Type 


Painting the control

Whenever windows wants us to update the contents of our window (the client area), a WM_PAINT message will be sent. So, whenever the WM_PAINT message is received, we need to call our control’s painting routine.


case WM_PAINT
 CustCtrl_OnPaint ccp,wParam, lParam

(CustCtrl_OnPaint(ccp As CustCtrl,wParam,lParam

Dim  hdc As Long
Dim ps As PAINTSTRUCTHANDLE
Dim hOldFont As Long
Dim szText As String*200
Dim rc As RECT
Get a device context for this window'
(hdc=BeginPaint(ccp.hwnd,ps
Set the font we are going to use'
(hOldFont=SelectObject(hdc,ccp.hFont
Set the text colours'
SetTextColor hdc,ccp.crForeGnd
SetBkColor  hdc,ccp.crBackGnd
Find the text to draw'
(GetWindowText ccp.hwnd,szText, Len(szText
Work out where to draw'
GetClientRect ccp.hwnd,rc
computes the width and height of the '
.specified string of text'
GetTextExtentPoint32 hdc,szText, len(szText),sz
Center the text'
x=(rc.right-sz.cx)/2
y=(rc.bottom-sz.cy)/2
Draw the text'
ETO_OPAQUE'
The current background color should be used to fill'
the rectangle'
ExtTextOut hdc,x,y,ETO_OPAQUE,rc,szText,len(szText),0
Restore the old font when we have finished'
SelectObject hdc,hOldFont
Release the device context'
EndPaint ccp.hwnd,ps
return 0



The GWL_USERDATA area

Every window in the system has a 32bit integer which can be set to any value. This 4 byte storage area is enough to store a pointer to a structure. We set this integer using SetWindowLong, and retrieve the integer using GetWindowLong. Using this technique, our function will look like this:

(GetCustCtrl(hwnd
return=GetWindowLong(hwnd,GWL_USERDATA



(SetCustCtrl(ByVal hwnd As Long,ByRef ccp As CustCtrl
SetWindowLong hwnd,GWL_USERDATA,ccp

This method is usually used when subclassing a control




Memory allocated by HeapAlloc is not movable. The address returned by HeapAlloc is valid until the memory block is freed or reallocated; the memory 
.block does not need to be locked

To free a block of memory allocated byHeapAlloc, use 
.the HeapFree function


Our custom control will change colour whenever the user clicks the mouse on it. Therefore the next message handler will be for the 
.WM_LBUTTONDOWNmessage

case WM_LBUTTONDOWN
CustCtrl_OnLButtonDown ccp, wParam, lParam


CustCtrl_OnLButtonDown(ByRef ccp As 
(CustCtrl,wParam,lParam
(col=RGB(rnd()*256,rnd()*256,rnd()*256 
Change the foreground colour'
ccp.crForeGnd=col
Use the inverse of the foreground colour'
(ccp.crBackGnd=((col) And &Hffffff
Now redraw the control'
InvalidateRect ccp.hwnd,0,0
UpdateWindow ccp.hwnd
return 0

WM_MOUSEACTIVATE=&H21

'Activates the window, and does not discard the mouse'
.message
MA_ACTIVATE =1

case WM_MOUSEACTIVATE
    SetFocus hwnd
    return MA_ACTIVATE