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

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

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

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

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

EDIT : PARTS & STATES




// EDITSTYLE class parts and states
//
#define VSCLASS_EDITSTYLE L"EDITSTYLE"
#define VSCLASS_EDIT L"EDIT"
enum EDITPARTS {
EP_EDITTEXT = 1,
EP_CARET = 2,
EP_BACKGROUND = 3,
EP_PASSWORD = 4,
EP_BACKGROUNDWITHBORDER = 5,
EP_EDITBORDER_NOSCROLL = 6,
EP_EDITBORDER_HSCROLL = 7,
EP_EDITBORDER_VSCROLL = 8,
EP_EDITBORDER_HVSCROLL = 9,
};
#define EDITSTYLEPARTS EDITPARTS;
enum EDITTEXTSTATES {
ETS_NORMAL = 1,
ETS_HOT = 2,
ETS_SELECTED = 3,
ETS_DISABLED = 4,
ETS_FOCUSED = 5,
ETS_READONLY = 6,
ETS_ASSIST = 7,
ETS_CUEBANNER = 8,
};
enum BACKGROUNDSTATES {
EBS_NORMAL = 1,
EBS_HOT = 2,
EBS_DISABLED = 3,
EBS_FOCUSED = 4,
EBS_READONLY = 5,
EBS_ASSIST = 6,
};
enum BACKGROUNDWITHBORDERSTATES {
EBWBS_NORMAL = 1,
EBWBS_HOT = 2,
EBWBS_DISABLED = 3,
EBWBS_FOCUSED = 4,
};

استفاده در OpenThemaData و DrawThemBackground




عملگر واگذاری تفریق و جمع در C#









case WM_NCCALCSIZE

if wparam Then 
ncsp--> lparam 

GetWindowRect HWND,rc

rc.right -= rc.left
pnccs->rgrc[0].right-=rc.right
MoveWindow HWND,pnccs->rgrc[0].right, pnccs->rgrc[0].top,rc.right, pnccs->rgrc[0].bottom - pnccs->rgrc[0].top, TRUE
End if 
break 

case WM_NCHITTEST

if (lResult == HTNOWHERE) Then 

GetWindowRect HWND,rc) 

POINTSTOPOINT(pt, lParam)

  if(PtInRect(rc,pt)) Then 
   lResult = HTTRANSPARENT
End if 

   break --> Exit Function 

case WM_MOVE 

SetWindowPos hWnd, nullptr, 0, 0, 0, 0, SWP_NOMOVE | SWP_NOSIZE | SWP_NOZORDER | SWP_FRAMECHANGED
break --> Exit Function 


The button's width has to to be correct, the height gets adjusted afterwards. When handling WM_INITDIALOG, 

:call a single function



;(EmbedButton(hWndEdit, hWndButton

BOOL EmbedButton(HWND hWndEdit, HWND hWndButton) noexcept
}
if(!SetWindowSubclass(hWndEdit, EmbedButton_SubclassProc, 

,reinterpret_cast<UINT_PTR>(hWndButton)

((((reinterpret_cast<DWORD_PTR>(hWndButton

return(FALSE); // Enforce WM_NCCALCSIZE

return(SetWindowPos(hWndEdit, nullptr, 0, 0, 0, 0

| SWP_NOMOVE | SWP_NOSIZE | SWP_NOZORDER, 

;((SWP_FRAMECHANGED

{



Change Size?



Public Type Margins 
cyTopHeight As Long 
cxLeftWidth As Long 
cyBottomHeight As Long 
cxRightWidth As Long 
End Type

Private dwmMargins As  MARGINS

' Adjust (shrink) the client rectangle to accommodate' 
the border'

'about rgrc --> 0 new 1 old 2 window 'client rectangle '
'before moved or resized '
       
nccsp.rgrc0.Top=0
nccsp.rgrc0.Bottom= 0
nccsp.rgrc0.Left=0
nccsp.rgrc0.Right=0
       

dwmMargins.cyTopHeight=nccsp.rgrc0.Top-nccsp.rgrc0.Top

dwmMargins.cxLeftWidth=nccsp.rgrc0.Left-nccsp.rgrc0.Left

dwmMargins.cyBottomHeight=nccsp.rgrc0.Bottom-nccsp.rgrc0.Bottom

dwmMargins.cxRightWidth=nccsp.rgrc0.Right-nccsp.rgrc0.Right




WVR_VALIDRECTS0x0400


This value indicates that, upon return from WM_NCCALCSIZE, the rectangles specified by the rgrc[1] and rgrc[2] members of the NCCALCSIZE_PARAMSstructure contain valid destination and source area rectangles
    

(cxfr=GetSystemMetrics(SM_CXSIZEFRAME

(cyfr= GetSystemMetrics(SM_CYSIZEFRAME
InflateRect lpncsp.rgrc,cxfr-1,cyfr-1

The InflateRect function increases or decreases the 
.width and height of the specified rectangle





کلاس Combo در api



Dim items() As String
 
"FreeBSD", "OpenBSD", "NetBSD", "Solaris", "Arch" }; 



Case WM_CREATE,WM_SHOWWINDOW

for i = 0 To 4 

SendMessageW hwndCombo,CB_ADDSTRING, 0,(LPARAM) items(i)

Next


case WM_COMMAND

if  HIWORD(wParam)=BN_CLICKED Then 

SendMessage(hwndCombo, CB_SHOWDROPDOWN,(WPARAM)TRUE, 0)

End If 

if  HIWORD(wParam)=CBN_SELCHANGE)

sel=SendMessage hwndCombo,CB_GETCURSEL,0, 0 

(SetWindowTextW hwndStatic,items(sel

End if 






MIN/MAX IN FORM





hwnd = GetActiveWindow

SetWindowLong hwnd,GWL_STYLE,GetWindowLong(hwnd,GWL_STYLE) Or p_str_Minimize_Maximize_Box

SetWindowPos hwnd, 0, 0, 0, 0,0,SWP_FRAMECHANGED Or SWP_NOMOVE Or
SWP_NOSIZE






EM_SETMARGINS پیامی برای تنظیم حاشیه در EDIT BOX



تنظیم حاشیه در کنترل EDIT


 : wparam

EC_LEFTMARGIN=&H1

EC_RIGHTMARGIN=&H2

:  Msg

    EM_SETMARGINS=211 '&HD3

 

دسیمال 211 تبدیل به هگزا - ->> عدد دسیمال تقسیم بر 16 میشود 13 معادل آن D و حاصل تفریق عدد211 و حاصلضرب 13 در 16 میشود 3 .... نهایتا از کنار هم گذاشتن آنها D3 بدست می آید ، در  تابع زیر پارامتر هندل Et ذکر شده و منظور گرفتن هندل Edit است که با FindWindowEx انجام شده.


SendMessageA Et, 211, &H1, ByVal  25

       SendMessageA Et, 211, &H2, ByVal 65536 * 50



تست شده طبق شکل زیر که تمام تکست داخل EDIT BOX با Ctrl+A انتخاب شده در نتیجه مارجین یا حاشیه مشخص است . البته باید دید تغییر فونت چه تاثیری خواهد گذاشت .





SWP_FRAMECHANGED  0x0020


Applies new frame styles set using the SetWindowLongfunction. Sends a WM_NCCALCSIZE message to the window, even if the window's size is not being changed. If this flag is not specified, WM_NCCALCSIZEis sent only when the window's size is being changed.


SWP_FRAMECHANGED = &H20

Fully redraw the window in its new 

.position


SWP_FRAMECHANGED   Sends a WM_NCCALCSIZEmessage to the window, even if the window's size is not being changed. If this flag is not specified, WM_NCCALCSIZE is sent only when the window's size is being changed.



ارسال آیکون به باتن با پیام BM_SETIMAGE و تابع ارسال پیام به دیالوگ باکس و آیدی باتن که یک است.  image_icon=1 , un1=1 

GWL_USERDATA/GWL_ID



hIcon2=CreateWindow('Static', nil, WS_VISIBLE or WS_CHILD or SS_ICON or WS_CLIPSIBLINGS, 507,2,3,120,hForm1,0,hInstance,nil)

I put WS_CLIPSIBLINGS in these 2 Icons to prevent them from drawing on each other, remove the WS_CLIPSIBLINGS and resize the form making it wider or narrow and see what the Icons do} 

SendMessage(hIcon2, STM_SETIMAGE, IMAGE_ICON,LoadIcon(0,IDI_QUESTION)); 
to put a NON-Resource Icon in a Static Icon you SendMessage,STM_SETIMAGE} 


hIcon3=CreateWindow('Static', '', WS_VISIBLE or WS_CHILD or SS_ICON or WS_CLIPSIBLINGS,475,2,7,11,hForm1,0,hInstance,nil) 

SendMessage(hIcon3,STM_SETIMAGE,IMAGE_ICON,LoadIcon(0,IDI_QUESTION))

hLabel2=CreateWindow('Static', 'Enter the Folder you want to list the File Names for below', WS_VISIBLE or WS_CHILD or SS_LEFT,10,40,290,16,hForm1,0,hInstance,nil)

SendMessage(hLabel2,WM_SETFONT,Font1,0)

if possible leave some extra room on controls, width and heigth, in case the font mapper picks a different font than the one you named}

hExitBut=CreateWindow('Button','Exit', WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_TEXT or BS_BOTTOM or WS_TABSTOP, 285, 108, 64, 28, hForm1, 0, hInstance,nil)

SendMessage(hExitBut, WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT),0)

because the IsDialogMessage( ) is in the GetMessage loop below, you can put WS_TABSTOP in a control's style to have that control be a Tab Stop. Tab Stop Order is set by the creation order of the Tab Stop controls Since this is the first control with a WS_TABSTOP it is FIRST in the Tab Stop Order, hEdit1 will be next}


SetWindowLong(hExitBut, GWL_USERDATA, 1)

Every window has 4 bytes (integer) of "User Data", which you can set and read with SetWindowLong and GetWindowLong, you might think of this user data integer like the "Tag" property of controls in the VCL. Here I will use the Exit buttons user data as a boolean to signify if the button is visible, see the ChangeStyle procedure above


SetWindowLong(hExitBut, GWL_ID, ID_ExitBut)

control ID numbers are sometimes used in system messages, like the WM_DRAWITEM message, ID can also be used in the WM_COMMAND. . Normaly you would just put this ID number in the hMenu parameter of the CreateWindow function, I do this here to show methods for the SetWindowLong



WS_CLIPSIBLINGS 
0x04000000L






ترسیم خط با Polyline




Const NUM =1000
(Const TWOPI = (2 * 3.14159


WndProc 

static int cxClient,cyClient
Dim apt(NUM) As POINTAPI

WM_PAINT 

(MoveToEx hdc, 0, cyClient / 2, NULL
(LineTo  hdc,cxClient,cyClient / 2

i=0
Do
apt(i).x = i * cxClient / NUM
(((apt(i).y =(cyClient / 2 * (1 - sin (TWOPI * i / NUM
i=i+1
Loop Until I<NUM

Polyline  hdc, apt, NUM

SETMARGINS IN EDIT CONTROL




EC_LEFTMARGIN =&H1
            EC_RIGHTMARGIN =&H2

EM_SETMARGINS=&HD3


  :  lParam


The HIWORD specifies the new width of the right margin, in pixels. This value is ignoredif wParam does 

.notinclude EC_RIGHTMARGIN






EM-SETMARGINS







ExcludeClipRect



ExcludeClipRect(aMessage.WParam, fButton.Left,
                                                              top + 1,
                                                              fButton.Left + fButton.Width,
                                                              fButton.Height);
       

زاویه


عدد پی تقسیم بر سینوس یک درجه 


3.141592/0.01745240643?

 180.009101472661 



?2*(3.141592)/0.01745240643
 360.018202945323 
 180.009101472661 

ترسیم خط LineTo




تمام منابع خارجی 









Dim px As POINTAPI

           GetCursorPos px

           'ClientToScreen hwnd, px

        

         MoveToEx hdc, 120, 30, px

         LineTo hdc, 140, 30

          

         MoveToEx hdc, 120, 30, px

         LineTo hdc, 135, 15

         ' Quarter

         MoveToEx hdc, 120, 30, px

         LineTo hdc, 134, 44

         

         

         MoveToEx hdc, 120, 30, px

         LineTo hdc, 120, 50

         

         ' Quarter

         MoveToEx hdc, 120, 30, px

         LineTo hdc, 105, 44

         

               

         MoveToEx hdc, 120, 30, px

         LineTo hdc, 120, 10

         

          ' Quarter

         MoveToEx hdc, 120, 30, px

         LineTo hdc, 105, 14

         

         

         MoveToEx hdc, 120, 30, px

         LineTo hdc, 100, 30






Rotate

using WM_TIMER

Dim tt As RECT

Static Deg

       Deg = Deg + 5

         If Deg > 360 Then Deg = 0

         Dim xl, yt

        xl = 120: yt = 30

  

          tt.Left = 99: tt.Top = 5: tt.right = 141: tt.bottom = 55

   (FillRect hdc, tt, GetSysColorBrush(15

طول خط 20 

                 

   در ربع اول            If 0 < Deg < 90 Then ' Quarter 

                      Newx = xl + Sin(Deg * Sin1) * 20

                      Newy = yt - Cos(Deg * Sin1) * 20

                 End If

                  

  در ربع دوم                  If 90 < Deg < 180 Then

                      Newx = xl + Cos(Deg * Sin1) * 20

                      Newy = yt + Sin(Deg * Sin1) * 20

                End If

                

در ربع سوم                   If 180 < Deg < 270 Then

                      Newx = xl - Sin(Deg * Sin1) * 20

                      Newy = yt + Cos(Deg * Sin1) * 20

                 End If

                 

در ربع چهارم                 If 270 < Deg < 360 Then

                      Newx = xl - Cos(Deg * Sin1) * 20

                      Newy = yt - Sin(Deg * Sin1) * 20

               End If

                     

              MoveToEx hdc, 120, 30, px

              LineTo hdc, Newx, Newy

                      

                   






 xl = 120: yt = 30

       

          tt.Left = 100: tt.Top = 5: tt.right = 140: tt.bottom = 55

          (FillRect hdc, tt, GetSysColorBrush(15

                      

                      Arc hdc, 100, 10, 140, 50, 0, 0, 0, 0

                      SelectObject hdc, HoldPen

                      Arc hdc, 115, 25, 125, 35, 0, 0, 0, 0

                      SelectObject hdc, HoldPen1

                      Newx = xl + Sin(Deg * Sin1) * 16

                      Newy = yt - Cos(Deg * Sin1) * 16

                      

                      MoveToEx hdc, 120, 30, px

                      LineTo hdc, Newx, Newy

                      

                      Deg = Deg + 10

       

       

       DeleteObject HoldPen

       DeleteObject HoldPen1







       


CreatePen ساخت قلم برای ترسیم



HPEN CreatePen( int iStyle, int cWidth, COLORREF color );


()Edit::OnNcPaint

pDC=GetDC( ) ? GetWindowDC
GetWindowRect Edithwnd,Crect 
OffsetRect Crect,-rect.left,-rect.top
'Draw a single line around the outside
(brush=RGB( 255, 0, 0
FrameRect pDC,Crect,brush ReleaseDC hwnd,pDC


Const PS_SOLID = 0
Const PS_DASH = 1
Const PS_DOT = 2
Const PS_DASHDOT = 3
Const PS_DASHDOTDOT = 4
Const PS_NULL = 5
Const PS_INSIDEFRAME = 6



((hPen=CreatePen(PS_DASH,0,RGB(0,255, 0
(hOldPen=SelectObject(hDC,hPen
Ellipse hDC, 100, 150, 350, 300
SelectObject hDC, hOldPen
DeleteObject hPen




مورد زیر طبق شکل تست شده 


حتما در WndProc در پیام SHOWWINDOW تابع زیر اعمال گردد
SetWindowPos hwnd,0,0,0,0,0,SWP_FRAMECHANGED 

ساب کلاس کردن  کنترل  Edit 

Public Function SubClassEdit(ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, _
                            ByVal lParam As LongPtr, ByVal uId As LongPtr, ByVal dwData As LongPtr) As Long
Dim nccsp As NCCALCSIZE_PARAMS
Select Case Msg

Case WM_NCPAINT
     (hdc = GetDC(hwnd
     Dim rClient As RECT
     GetClientRect hwnd, rClient
    ( hpen = CreatePen(ps_solid, 2, vbRed
    ( holdpen = SelectObject(hdc, hpen
     RoundRect hdc, rClient.Left - 2, rClient.Top - 2, rClient.right + 2, rClient.bottom + 2, 6, 6
     ReleaseDC hwnd, hdc
     DeleteObject holdpen
Case WM_DESTROY
      RemoveWindowSubclass hwnd, SubClassEdit, 0
      End Select
      
(SubClassEdit = DefSubclassProc(hwnd, Msg, wParam, ByVal lParam
                            
End Function


SWP_FRAMECHANGED 0x0020

Applies new frame styles set using the SetWindowLongfunction. Sends a WM_NCCALCSIZE message to the window, even if the window's size is not being changed. If this flag is not specified, WM_NCCALCSIZEis sent only when the window's size 
.is being changed







Paint InputBox



موارد پایین تست شده ... البته اینها موارد ساده ای هستند و پیش پا افتاده


Public Function CallWindProc(ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

Dim hdc As LongPtr


Select Case Msg

   Case WM_PAINT

    

     Dim cc As RECT

     GetClientRect hwnd, cc

     (hdc = GetDC(hwnd

     ((FillRect hdc, cc, CreateSolidBrush(RGB(255, 0, 255

     

   Case WM_DESTROY

   SetWindowLongPtr hwnd, GWL_WNDPROC, OldWindow

      

   End Select


CallWindProc = CallWindowProc(OldWindow, hwnd,

(Msg, wParam, lParam,


End Function



(FillRect hdc, cc, GetSysColorBrush(5


(FillRect hdc, cc, GetSysColorBrush(16




TIMER

 Case WM_TIMER

GetClientRect hwnd, rcClient

hdc

(GetDC(hwnd=

      DrawText hdc, x, 2, rcClient, DT_CENTER

      SetWindowTextA hwnd, x

    x = x + 1


ترسیم مستطیل در InputBox


Case WM_TIMER

               Dim Et As LongPtr

        Dim WinRect As RECT

     Et:Edit Handle,WinRect For Edit Control'

        GetWindowRect Et, WinRect

       ( hdc = GetDC(hwnd

             

      

        rc.Left = 10

        rc.Top = 68

        rc.right = 70

        rc.bottom = 88


rcClear.Left = rc.Left: rcClear.right = GetUpdateRight

        rcClear.Top = rc.Top - 3: rcClear.bottom = rc.bottom

       

       

         rc.Left = rc.Left + x: rc.right = rc.right + x

        Fill Rectangle' 

( FillRect hdc, rcClear, GetSysColorBrush(15

           Draw Rectangle'

           Rectangle hdc, rc.Left, rc.Top, rc.right, rc.bottom

FillRect Again GetSysColorBrush(18) ' Black'

Use Offset And FillRect rc With Another Brush'

GetUpdateRight = rc.right + x

        If rc.right > WinRect.right - WinRect.Left Then x = 0








Timers and Animation




Dim ps As PAINTSTRUCT
Dim hdc As Long
(hdc=BeginPaint(hWnd,ps
((hbrOld=SelectObject(hdc,GetStockObject(HOLLOW_BRUSH
draw your ellipses here'
Ellipse hdc, 300, 300, 500, 510
EndPaint hwnd,ps 


 : Animation 

const  BALL_MOVE=2
 
Type BALLINFO
width
height
x
y
dx
dy
End Type 

dim g_ballInfo As BALLINFO


const int ID_TIMER = 1
در زمان ساخت یا نمایش پنجره 
(ret =SetTimer(hwnd,ID_TIMER, 50,0
if(ret= 0) Then
"MsgBox "Zzzz

در WinProc

case WM_TIMER
 Dim rcClient As RECT
(hdc=GetDC(hwnd
GetClientRect hwnd,rcClient
UpdateBall rcClient
DrawBall hdc,rcClient
ReleaseDC hwnd, hdc

تابع آپدیت کردن : 

(UpdateBall(ByRef prc As RECT


g_ballInfo.x=g_ballInfo.x+g_ballInfo.dx
g_ballInfo.y= g_ballInfo.y+g_ballInfo.dy 

if g_ballInfo.x < 0 Then 
 g_ballInfo.x=0
 g_ballInfo.dx=BALL_MOVE
 else if(g_ballInfo.x+g_ballInfo.width>prc.right)  Then
g_ballInfo.x=prc.right-g_ballInfo.width g_ballInfo.dx=g_ballInfo.dx-BALL_MOVE
End If 

 if(g_ballInfo.y<0)Then 
     g_ballInfo.y = 0
     g_ballInfo.dy = BALL_MOVE
else if(g_ballInfo.y+g_ballInfo.height>prc.bottom) Then
g_ballInfo.y=prc.bottom-g_ballInfo.height
g_ballInfo.dy=g_ballInfo.dy-BALL_MOVE
End If 

در تابع زیر میتوان ترسیم موردنظر را انجام داد یا بیتمپ داخل آن لود نمود

(DrawBall(ByVal hdc As Long,ByRef prc As RECT
(FillRect hdc,prc,GetStockObject(WHITE_BRUSH


 : Finally 

KillTimer hwnd, ID_TIMER

MOVECURSOR رسم مستطیل



WM_MOUSEMOVE 

       Dim p As POINTAPI

       GetCursorPos p

       ScreenToClient hwnd, p

    

    

      Dim ff As RECT

      Dim ff1 As RECT

       SetRect ff, p.x, p.y, p.x, p.y

       ff.Left = p.x - 15

       ff.Top = p.y - 15

       ff.right = p.x + 35

       ff.bottom = p.y + 30

              

 DrawFrameControl GetDC(hwnd), ff, DFC_BUTTON, DFCS_BUTTONPUSH

       RoundRect GetDC(hwnd), ff.Left, ff.Top, ff.right, ff.bottom, 16, 16

      ( FillRect GetDC(hwnd), ff, GetSysColorBrush(16

            

        Sleep 100

       InvalidateRect hwnd, ff, 1

       UpdateWindow hwnd

       

      

         (ReleaseDC hwnd, GetDC(hwnd

     

     

       

   






UINT SetBoundsRect( HDC hdc, const RECT *lprect, 
(UINT flags : DCB_RESET ( Clear Bounding Rectangle 


(BOOL ValidateRect( HWND hWnd, const RECT *lpRect 

validates the client area within a rectangle by removing the rectangle from the update region of the specified window.

BOOL InvalidateRect( HWND hWnd, const RECT 
(*lpRect, BOOL bErase 

The InvalidateRect function adds a rectangle to the specified window's update region. The update region represents the portion of the window's client area that must be redrawn.

(BOOL UpdateWindow( HWND hWnd 

The UpdateWindow function updates the client area of the specified window by sending a WM_PAINT message to the window if the window's update region is not empty


(HDC GetDC( HWND hWnd 

The GetDC function retrieves a handle to a device context (DC) for the client area of a specified window or for the entire screen







SetCursorPos



انتقال کرسر به مختصات صفحه ی مشخص شده.


Moves the cursor to the specified screen coordinates. If the new coordinates are not within the screen rectangle set by the most recent ClipCursor function call, the system automatically adjusts the coordinates 

.so that the cursor stays within the rectangle










BUTTON_CLICK ( ترسیم لبه در پنجره کلاس 32770# )



در BS_OWNERDRAW یا خود Button  کار نمی کند نتیجتا ترسیم شد ( منظور ناحیه ای که در تصویر پایین داخلش  تکست Inside ترسیم شده) .   DrawEdge و DrawTextA


dim rr as RECT

If wMsg = WM_PAINT Then


        z1.Left = 285 + GetSystemMetrics(SM_CYFRAME) * 3 ' 296

        z1.right = 348 + GetSystemMetrics(SM_CYFRAME) * 2 ' 355

        z1.Top = 63 + GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME) * 2 ' 95

        z1.bottom = 86 + GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME) + 2 ' 115

     

    (WindProc = DrawEdge(GetWindowDC(hwnd), z1, EDGE_RAISED, BF_RECT + BF_ADJUST

End If


If wMsg = WM_LBUTTONDOWN Then 'WM_MOUSEMOVE

       

       Dim cp As POINTAPI

SetRect rr, 285, 63, 348, 86

      

      GetCursorPos cp

      ScreenToClient hwnd, cp


rr.Left = rr.Left + 2

       rr.right = rr.right - 2

       rr.Top = rr.Top - cp.y + 2

       rr.bottom = rr.bottom - cp.y - 2



If PtInRect(rr, cp.x, cp.y) Then


End If 



اگر شکل را مشاهده کنید زمان فشردن باتن سمت چپ ماوس در مستطیل موردنظر با مختصات صفحه در قسمت کپشن ویندو هم IN ارسال میشود 

















MOUSEMOVE


کدام درست و منطقی تر است ؟


WM_MOUSEMOVE

   Dim rc As RECT
   Din pt As POINT

   SetRect rc, 0,0,5,5
   (Pt.x=LOWORD(LParam
   (Pt.y=HIWORD(LParam

   if PtInRect(rc,pt.x,pt.y)  Then 
      Msgbox "in"
  Else 
     Msgbox "Out"
  End If 



For x = rc.Left To rc.Right
For y = rc.Top To rc.Bottom

If PtInRect(rc, x, y) Then 
Msgbox "in"
Else
Msgbox "Out"
End If 

Next y
Next x




Dim mousept As POINTAPI
Dim winrect As RECT 
with winrect
left=5.
top=0.
right=5.
bottom=5.
End With 


GetCursorPos mousept
GetWindowRect hWnd, winrect'
SetRect 5,0,5,5?'
ScreenToClient ?'

(isinside=PtInRect(winrect, mousept.x, mousept.y

If isinside = 1 Then
  Debug.Print "The mouse cursor is currently inside 
".of Form1
Else
  Debug.Print "The mouse cursor is currently outside 
".of Form1
End If



Dim pt As POINTAPI
Dim BtnRect As RECT



WM_MOUSEMOVE

GetWindowRect BtnHwnd,BtnRect
(pt.x=loword(lparam
(pt.y=hiword(lparam
ClientToScreen BtnHwnd,pt

If PtInRect(BtnRect,pt.x,pt.y) Then 


Timer




Private sTitle As String
Private TitleHandle As Long 


On Load Or After (Msgbox,Inputbox) : TitleHandle=0


in Hook Window Or Timer : 
If TitleHandle = 0 Then TitleHandle 
(FindWindow("#32770", sTitle=

If TitleHandle <> 0 Then
.
End if 

CustomButton_MouseMove



WM_MOUSEMOVE
Dim pt As POINTAPI
Dim cursorPoint As Longptr 
Dim rc As RECT
(pt.x=loword(lparam
(pt.y=hiword(lparam
(cursorPoint=ScreenToClient (hwnd,pt???
rc.left=0
rc.right=0
rc.right=rc.left+5
rc.bottom=rc.top+5
(If PtInRect(rc, cursorPoint
"SetWindowTextA hwnd,"in
End if 


wParam  : virtual keys like MK_LBUTTON(Mouse Key 
(Left 

lParam
loword از lparam یا (Clng(lparam And 65535 نشاندهنده ی مختصات x کرسر 
The low-order word specifies the x-coordinate of the cursor. The coordinate is relative to the upper-left 
.corner of the client area
Hiword از lparam یا (Clng(lparam \ 65535 نشاندهنده ی مختصات y کرسر 
The high-order word specifies the y-coordinate of the cursor. The coordinate is relative to the upper-left corner of the client area.


Return value

If an application processes this message, it should 
.return zero




Private oldUserData As LongPtr
Private oldWinProc As LongPtr


=oldUserData 
(GetWindowLongPtr(hwnd,GWLP_USERDATA
oldWinProc=SetWindowLongPtr(hwnd,GWL_WNDPROC,Addressof 
(WinProc


WinProc
Select Case uMsge


Case WM_MOUSMOVE
.
End Select

=userDataToRestore
(SetWindowLongPtr(GWL_USERDATA,oldUserData
)WinProc=CallWindowProc
(oldWinProc,hWnd,uMsg,wParam,lParam
SetWindowLongPtr(GWL_USERDATA,userDataToRestore
End Function



()OnNcPaint

static BOOL before=FALSE
 
if  not before Then 'If first time, the OnNcCalcSize function will be called

SetWindowPos 0(hwnd),0,0,0,0, SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOSIZE before=TRUE
DrawBorders

End if



prect
oldrect

NCCALCSIZE
Static p As RECT


Dim nccsp As NCCALCSIZE_PARAMS
(CopyMemory nccsp,ByVal lParam,Len(lParam
(prect=nccsp.rgrc(0
oldrect=prect

CallWindowProc hWnd, wMsg, wParam, lParam


p.left=prect.left - oldrect.left
p.right=oldrect.right - prect.right
p.Top=prect.top-oldrect.top
p.Bottom=oldrect.bottom-prect.bottom

(p.right=p.right-GetSystemMetrics(SM_CXVSCROLL

ret 
WinProc=WVR_VALIDRECTS


WMNCPAINT : GetButtonRect
Static btnrect

CallWindowProc hWnd, wMsg, wParam, lParam

GetWindowRect hwnd,Winrect
OffsetRect Winrect, -Winrect.left, -Winrect.top

btnrect.right=btnrect.right-p.Right
btnrect.top=btnrect.top+p.Top
btnrect.bottom=btnrect.bottom-p.Bottom
btnrect.left=btnrect.right 
(GetSystemMetrics(SM_CXVSCROLL-


(hdc=GetWindowDC(hwnd

FillRect hdc,btnrect
(GetSysColorBrush(COLOR_BTNFACE,
 

WM_NCPAINT=&H85
WM_NCCALCSIZE=&H83

 * WM_NCCALCSIZE  flags

WVR_ALIGNTOP=&H10
WVR_ALIGNLEFT=&H20
WVR_ALIGNBOTTOM=&H40
WVR_ALIGNRIGHT=&H80
WVR_HREDRAW=&H100
WVR_VREDRAW=&H200
(WVR_REDRAW=(WVR_HREDRAW+ WVR_VREDRAW
WVR_VALIDRECTS=&H400 

SETWINDOWPOS




SWP_FRAMECHANGED  &H20

Applies new frame styles set using the SetWindowLongfunction. Sends a WM_NCCALCSIZE message to the window, even if the window's size is not being changed. If this flag is not specified, WM_NCCALCSIZEis sent only when the window's size is being changed


If you have changed certain window data using SetWindowLong, you must call SetWindowPos for the changes to take effect. Use the following combination for uFlagsSWP_NOMOVE | SWP_NOSIZE | SWP_NOZORDER | SWP_FRAMECHANGED.



(GWL_USERDATA  (-21

Sets the user data associated with the window. This data is intended for use by the application that created the window. Its value is initially zero.



(SetWindowLong(hWnd,GWL_USERDATA,Value

(Value=GetWindowLong(hWnd, GWL_USERDATA