磁性窗体 VBWord文档下载推荐.docx
《磁性窗体 VBWord文档下载推荐.docx》由会员分享，可在线阅读，更多相关《磁性窗体 VBWord文档下载推荐.docx（25页珍藏版）》请在冰豆网上搜索。
PrivateConstPATCH_05AsLong=93
PrivateConstPATCH_08AsLong=132
PrivateConstPATCH_09AsLong=137
PrivateTypetSubData
hwndAsLong
nAddrSubAsLong
nAddrOrigAsLong
nMsgCntAAsLong
nMsgCntBAsLong
aMsgTblA（）AsLong
aMsgTblB（）AsLong
EndType
Privatesc_aSubData（）AstSubData
Privatesc_aBuf（1ToCODE_LEN）AsByte
Privatesc_pCWPAsLong
Privatesc_pEbModeAsLong
Privatesc_pSWLAsLong
PrivateDeclareSubRtlMoveMemoryLib"
kernel32"
（DestinationAsAny,SourceAsAny,ByValLengthAsLong）
PrivateDeclareFunctionGetModuleHandleALib"
（ByVallpModuleNameAsString）AsLong
PrivateDeclareFunctionGetProcAddressLib"
（ByValhModuleAsLong,ByVallpProcNameAsString）AsLong
PrivateDeclareFunctionGlobalAllocLib"
（ByValwFlagsAsLong,ByValdwBytesAsLong）AsLong
PrivateDeclareFunctionGlobalFreeLib"
（ByValhmemAsLong）AsLong
PrivateDeclareFunctionSetWindowLongALib"
user32"
（ByValhwndAsLong,ByValnIndexAsLong,ByValdwNewLongAsLong）AsLong
PrivateDeclareFunctionVirtualProtectLib"
（lpAddressAsAny,ByValdwSizeAsLong,ByValflNewProtectAsLong,lpflOldProtectAsLong）AsLong
PrivateTypePOINTAPI
x1AsLong
Y1AsLong
PrivateTypeRECT2
x2AsLong
Y2AsLong
PrivateConstSPI_GETWORKAREAAsLong=48
PrivateConstWM_SIZINGAsLong=&
H214
PrivateConstWM_MOVINGAsLong=&
H216
PrivateConstWM_ENTERSIZEMOVEAsLong=&
H231
PrivateConstWM_EXITSIZEMOVEAsLong=&
H232
PrivateConstWM_SYSCOMMANDAsLong=&
H112
PrivateConstWM_COMMANDAsLong=&
H111
PrivateConstWMSZ_LEFTAsLong=1
PrivateConstWMSZ_RIGHTAsLong=2
PrivateConstWMSZ_TOPAsLong=3
PrivateConstWMSZ_TOPLEFTAsLong=4
PrivateConstWMSZ_TOPRIGHTAsLong=5
PrivateConstWMSZ_BOTTOMAsLong=6
PrivateConstWMSZ_BOTTOMLEFTAsLong=7
PrivateConstWMSZ_BOTTOMRIGHTAsLong=8
PrivateConstSC_MINIMIZEAsLong=&
HF020&
PrivateConstSC_RESTOREAsLong=&
HF120&
PrivateConstSWP_NOSIZEAsLong=&
H1
PrivateConstSWP_NOZORDERAsLong=&
H4
PrivateConstSWP_NOACTIVATEAsLong=&
H10
PrivateDeclareFunctionSystemParametersInfoLib"
Alias"
SystemParametersInfoA"
（ByValuActionAsLong,ByValuParamAsLong,lpvParamAsAny,ByValfuWinIniAsLong）AsLong
PrivateDeclareFunctionIsWindowLib"
（ByValhwndAsLong）AsLong
PrivateDeclareFunctionIsZoomedLib"
PrivateDeclareFunctionBeginDeferWindowPosLib"
（ByValnNumWindowsAsLong）AsLong
PrivateDeclareFunctionDeferWindowPosLib"
（ByValhWinPosInfoAsLong,ByValhwndAsLong,ByValhWndInsertAfterAsLong,ByValXAsLong,ByValYAsLong,ByValcxAsLong,ByValcyAsLong,ByValwFlagsAsLong）AsLong
PrivateDeclareFunctionEndDeferWindowPosLib"
（ByValhWinPosInfoAsLong）AsLong
PrivateDeclareFunctionGetCursorPosLib"
（lpPointAsPOINTAPI）AsLong
PrivateDeclareFunctionGetWindowRectLib"
（ByValhwndAsLong,lpRectAsRECT2）AsLong
PrivateDeclareFunctionOffsetRectLib"
（lpRectAsRECT2,ByValXAsLong,ByValYAsLong）AsLong
PrivateDeclareFunctionUnionRectLib"
（lpDestRectAsRECT2,lpSrc1RectAsRECT2,lpSrc2RectAsRECT2）AsLong
PrivateDeclareSubCopyMemoryLib"
RtlMoveMemory"
（pDestAsAny,pSrcAsAny,ByValByteLenAsLong）
PrivateTypeWND_INFO
hWndParentAsLong
GlueAsBoolean
PrivateConstLB_RECTAsLong=16
Privatem_uWndInfo（）AsWND_INFO
Privatem_lWndCountAsLong
Privatem_rcWnd（）AsRECT2
Privatem_ptAnchorAsPOINTAPI
Privatem_ptOffsetAsPOINTAPI
Privatem_ptCurrAsPOINTAPI
Privatem_ptLastAsPOINTAPI
Privatem_lSnapWidthAsLong
PrivateSubClass_Initialize（）
m_lSnapWidth=10'
默认吸引的宽度
ReDimm_uWndInfo（0）AsWND_INFO'
初始化包含窗口句柄的数组
m_lWndCount=0
EndSub
PrivateSubClass_Terminate（）
'
停止Subclass
If（m_lWndCount）Then
CallSubclass_StopAll
EndIf
PublicSubzSubclass_Proc（ByValbBeforeAsBoolean,ByRefbHandledAsBoolean,ByReflReturnAsLong,ByReflng_hWndAsLong,ByRefuMsgAsLong,ByRefwParamAsLong,ByReflParamAsLong）
DimrcWndAsRECT2
DimlcAsLong
SelectCaseuMsg
CaseWM_ENTERSIZEMOVE'
开始移动或改变大小
CallSystemParametersInfo（SPI_GETWORKAREA,0,m_rcWnd（0）,0）'
获得桌面区域
Forlc=1Tom_lWndCount'
获得窗体句柄
If（IsZoomed（m_uWndInfo（lc）.hwnd））Then'
如果窗体最大化
CallCopyMemory（m_rcWnd（lc）,m_rcWnd（0）,LB_RECT）'
获取工作区矩形
Else
CallGetWindowRect（m_uWndInfo（lc）.hwnd,m_rcWnd（lc））'
获取窗体矩形
If（m_uWndInfo（lc）.hwnd=lng_hWnd）Then'
如果是当前的窗体
获取偏移量
CallGetCursorPos（m_ptAnchor）
CallGetCursorPos（m_ptLast）
m_ptOffset.x1=m_rcWnd（lc）.x1-m_ptLast.x1
m_ptOffset.Y1=m_rcWnd（lc）.Y1-m_ptLast.Y1
Nextlc
改变大小
CaseWM_SIZING
CallCopyMemory（rcWnd,ByVallParam,LB_RECT）
CallpvSizeRect（lng_hWnd,rcWnd,wParam）
CallCopyMemory（ByVallParam,rcWnd,LB_RECT）
bHandled=True
lReturn=1
移动
CaseWM_MOVING
CallpvMoveRect（lng_hWnd,rcWnd）
改变或移动大小结束
CaseWM_EXITSIZEMOVE
CallpvCheckGlueing
特殊情况菜单调用
CaseWM_SYSCOMMAND
If（wParam=SC_MINIMIZEOrwParam=SC_RESTORE）Then
特殊情况控件调用
CaseWM_COMMAND
EndSelect
PublicFunctionAddWindow（ByValhwndAsLong,OptionalByValhWndParentAsLong=0）AsBoolean
Forlc=1Tom_lWndCount
If（hwnd=m_uWndInfo（lc）.hwnd）ThenExitFunction
If（IsWindow（hwnd）And（IsWindow（hWndParent）OrhWndParent=0））Then'
如果窗体有效
m_lWndCount=m_lWndCount+1'
增加数量
ReDimPreservem_uWndInfo（0Tom_lWndCount）'
调整数组大小
ReDimPreservem_rcWnd（0Tom_lWndCount）
Withm_uWndInfo（m_lWndCount）'
添加信息
.hwnd=hwnd
.hWndParent=hWndParent
EndWith
CallpvCheckGlueing'
粘合
执行Subclass
CallSubclass_Start（hwnd）
CallSubclass_AddMsg（hwnd,WM_ENTERSIZEMOVE）
CallSubclass_AddMsg（hwnd,WM_SIZING,[MSG_BEFORE]）
CallSubclass_AddMsg（hwnd,WM_MOVING,[MSG_BEFORE]）
CallSubclass_AddMsg（hwnd,WM_EXITSIZEMOVE）
CallSubclass_AddMsg（hwnd,WM_SYSCOMMAND）
CallSubclass_AddMsg（hwnd,WM_COMMAND）
执行成功
AddWindow=True
EndFunction
PublicFunctionRemoveWindow（ByValhwndAsLong）AsBoolean
Dimlc1AsLong
Dimlc2AsLong
Forlc1=1Tom_lWndCount
If（hwnd=m_uWndInfo（lc1）.hwnd）Then
移动到下面
Forlc2=lc1Tom_lWndCount-1
m_uWndInfo（lc2）=m_uWndInfo（lc2+1）
Nextlc2
m_lWndCount=m_lWndCount-1'
数量减一
ReDimPreservem_uWndInfo（m_lWndCount）
ReDimPreservem_rcWnd（m_lWndCount）
移动父
Forlc2=1Tom_lWndCount
If（m_uWndInfo（lc2）.hWndParent=hwnd）Then
m_uWndInfo（lc2）.hWndParent=0
CallSubclass_Stop（hwnd）'
停止Subclass
检查粘合
RemoveWindow=True
ExitFor
Nextlc1
PublicSubCheckGlueing（）
检查窗体所有可能的粘合
PublicPropertyGetSnapWidth（）AsLong
SnapWidth=m_lSnapWidth
EndProperty
PublicPropertyLetSnapWidth（ByValNew_SnapWidthAsLong）
m_lSnapWidth=New_SnapWidth
PrivateSubpvSizeRect（ByValhwndAsLong,rcWndAsRECT2,ByVallfEdgeAsLong）
DimrcTmpAsRECT2
CallCopyMemory（rcTmp,rcWnd,LB_RECT）
检查所有的窗体
Forlc=0Tom_lWndCount
Withm_rcWnd（lc）
If（m_uWndInfo（lc）.hwnd<
>
hwnd）Then'
如果不是当前窗体
X轴方向的粘合
If（rcWnd.Y1<
.Y2+m_lSnapWidthAndrcWnd.Y2>
.Y1-m_lSnapWidth）Then
SelectCaselfEdge
CaseWMSZ_LEFT,WMSZ_TOPLEFT,WMSZ_BOTTOMLEFT
SelectCaseTrue
CaseAbs（rcTmp.x1-.x1）<
m_lSnapWidth:
rcWnd.x1=.x1
CaseAbs（rcTmp.x1-.x2）<
rcWnd.x1=.x2
CaseWMSZ_RIGHT,WMSZ_TOPRIGHT,WMSZ_BOTTOMRIGHT
CaseAbs（rcTmp.x2-.x1）<
rcWnd.x2=.x1
CaseAbs（rcTmp.x2-.x2）<
rcWnd.x2=.x2
Y轴方向的粘合
If（rcWnd.x1<
.x2+m_lSnapWidthAndrcWnd.x2>
.x1-m_lSnapWidth）Then
CaseWMSZ_TOP,WMSZ_TOPLEFT,WMSZ_TOPRIGHT
CaseAbs（rcTmp.Y1-.Y1）<
rcWnd.Y1=.Y1
CaseAbs（rcTmp.Y1-.Y2）<
rcWnd.Y1=.Y2
CaseWMSZ_BOTTOM,WMSZ_BOTTOMLEFT,WMSZ_BOTTOMRIGHT
CaseAbs（rcTmp.Y2-.Y1）<
rcWnd.Y2=.Y1
CaseAbs（rcTmp.Y2-.Y2）<
rcWnd.Y2=.Y2
PrivateSubpvMoveRect（ByValhwndAsLong,rcWndAsRECT2）
DimlWIdAsLong
DimlOffxAsLong
DimlOffyAsLong
DimhDWPAsLong
CallGetCursorPos（m_ptCurr）'
获取当前鼠标位置
检查当前窗体的可粘合性
移动当前窗体
CallOffsetRect（rcWnd,（m_ptCurr.x1-rcWnd.x1）+m_ptOffset.x1,0）
CallOffsetRect（rcWnd,0,（m_ptCurr.Y1-rcWnd.Y1）+m_ptOffset.Y1）
Forlc1=0Tom_lWndCount'
If（m_uWndInfo（lc1）.hwnd<
如果不是当前的窗体
If（m_uWndInfo（lc1）.Glue=FalseOrm_uWndInfo（lc1）.hWn
升级会员 