05/10/2016, 13:53
(04/10/2016, 19:35)İlginize tşk ederim kodları yerlerine kopyaladım ama tools-preferences olayı yapamadım. daha doğrusu bulamadım. atoz112 yazdı: [ -> ]Sayın ykucur,
Sayın life_exciting Bey’in hoşgörüsüne ve iznine sığınarak,
32 bit / 64 bit kullanımına göre yeniden ve SADECE ilgili kod satırlarında düzenlemeleri yapılmak sureti ile,
basMouseHook adlı modülün kodlarını komple olmak üzere,aşağıdaki kodlar ile değiştiriniz.
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function VirtualAlloc Lib "kernel32" (ByVal Address As Longptr, ByVal Size As Longptr, ByVal AllocationType As Longptr, ByVal Protect As Longptr) As Longptr
Private Declare PtrSafe Function GetModuleHandleA Lib "kernel32" (ByVal ProcName As String) As Longptr
Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal Module As Longptr, ByVal ProcName As String) As Longptr
Private Declare PtrSafe Sub CopyMemoryAnsi Lib "kernel32" Alias "RtlMoveMemory" (ByVal Dest As Longptr, ByVal Source As String, ByVal Size As Longptr)
Private Declare PtrSafe Sub CastToObject Lib "kernel32" Alias "RtlMoveMemory" (ByRef Dest As Object, ByRef Source As Longptr, ByVal Size As Longptr)
Private Const SIZEOF_PTR32 As Longptr = &H4
Private Const PAGE_EXECUTE_RW As Longptr = &H40
Private Const MEM_RESERVE_AND_COMMIT As Longptr = &H3000
Private Const ERR_OUT_OF_MEMORY As Longptr = &H7
Private Type IDispatchVTable
QueryInterface As Longptr
AddRef As Longptr
Release As Longptr
GetTypeInfoCount As Longptr
GetTypeInfo As Longptr
GetIDsOfNames As Longptr
Invoke As Longptr
End Type
#Else
Private Declare Function VirtualAlloc Lib "kernel32" (ByVal Address As Long, ByVal Size As Long, ByVal AllocationType As Long, ByVal Protect As Long) As Long
Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal ProcName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal Module As Long, ByVal ProcName As String) As Long
Private Declare Sub CopyMemoryAnsi Lib "kernel32" Alias "RtlMoveMemory" (ByVal Dest As Long, ByVal Source As String, ByVal Size As Long)
Private Declare Sub CastToObject Lib "kernel32" Alias "RtlMoveMemory" (ByRef Dest As Object, ByRef Source As Long, ByVal Size As Long)
Private Const SIZEOF_PTR32 As Long = &H4
Private Const PAGE_EXECUTE_RW As Long = &H40
Private Const MEM_RESERVE_AND_COMMIT As Long = &H3000
Private Const ERR_OUT_OF_MEMORY As Long = &H7
Private Type IDispatchVTable
QueryInterface As Long
AddRef As Long
Release As Long
GetTypeInfoCount As Long
GetTypeInfo As Long
GetIDsOfNames As Long
Invoke As Long
End Type
#End If
Public Function NewMouseHook(ByRef Form As Access.Form) As Object
Dim NativeCode As String
Dim Kernel32Handle As Long
Dim GetProcAddressPtr As Long
Dim MouseHookAddr As Long
Dim MouseHookLoader As Object
Dim LoaderVTable As IDispatchVTable
NativeCode = _
"XYQPSWQ[T_S\\[S\XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX- %uUPXX-%ueeT[PXX-E%%ePXX-uu0E-uu0EPXX-eeE%PXX-%e%uPXX-eeE PXX-%eE PXXX@@fX<0tF4+&4+2'&,V/PCp@-''2V/5+1''3V/ys 1S CCCuRfI>_ltcDPC@KCQcBnIAGBqcDPO@GBE@KCqc@YMQHUqp@dQ^AAAAGBUBISExD]MQQ=OYHAQ@\EAA@eiQDeiQHMIqFeiQLMIqHeiQPMIqHeiQTMIqHeiQXucOAAAAMcY^AAAAIsEHDEQCAeE@AeEC?GGCPCXM@BeqDAAoAAEA@KMC@azC@IAaBB@Ax[AABAiqXAqa<QCC@UFLwREHTIAA@AA\jmIPdqpaxBA\\mITdQqcRmiEMKX^AAAAf\MAIAQcP TKKp>RPQM@JMH@azA@IAaBRCAHAAA@qbE@AA>JAAAxnAA@qCB@AADMAAAtuAA@QTB@AAONAAAhAAA@UtclNIpt^]P<[VPXKpcEp>bPpQcU ?bM ? ypCAuPqM@n_LKWDBCkoAtTPajbaA@AQ\MmYRxBY_tAQ\DMBqkbp>uPp>u@p>upq>u pcU ??rpscM ??QPucevdqPAAePWtclNIppbG<AAAAhR<K@AQWIWE>sA]cE ?bU ?bMpnpDEpU?WE?KWE?KWD>FRaAU<_PxnYRxnYP<[M@Hmy>E ?bU ?bMpnpDE@z?WE?KWE?KWD>FRaAS<_PxnYRxnYP<[M@HMy>E ?bU ?bMpnpDEP^?WE?KWE?KWD>FRaAT=_PxnYRxnYP<[M@HAq>E ?bU ?bMpnpDEP\?WE?KWE?KWD>FRaAK=_PxnYRxnYP<[M@Haz>E ?bU ?bMpnpDE @?WE?KWE?KWD>FRaA@<_PxnYRxnYP<[M@HAq>E ?bU ?bMpnpDE@a?WE?KWE?KWD>FRaAY<_PxnYRxnYP<[M@Hut>E ?b" & _
"U ?bMpnpDEpW?WE?KWE?KWD>FRaAB>_PxnYRxnYP<[M@Hqq>E ?bU ?bMpnpDE@A?WE?KWE?KWD>FRaAK?_PxnYRxnYP<[M@HUt>E ?bU ?bMpnpDE@B?WE?KWE?KWD>FRaAC?_PxnYRxnYP<[M@HI=?E ?bU ?bMpnpDE@@?WE?KWE?KWD>FRaAK?_PxnYRxnYP<[M@HIp>E ?bU ?bMpnpDEPc?WE?KWE?KWD>FRaAU<_PxnYRxnYP<[M@Hq>?E ?bU ?bMpnpDEpa?WE?KWE?KWD>FRaAz<_PxnYRxnYP<[M@HQq>E ?bU ?bMpnpDE@A?WE?KWE?KWD>FRaAu<_PxnYRxnYP<[M@Hip>E ?bU ?bMpnpDEPo?WE?KWE?KWD>FRaAC=_PxnYRxnYP<[M@HAq>E ?bU ?bMpnpDE@A?WE?KWE?KWD>FRaA@=_PxnYRxnYP<[M@Hmy>E ?bU ?bMpnpDEPP?WE?KWE?KWD>FRaAL=_PxnYRxnYP<[M@hey>E ?bU ?bMpnpDEpq?WE?KWE?KWD>FRaAC?_PxnYRxnYP<[M@HA=?E ?bU ?bMpnpDE@B?WE?KWE?KWD>FRaAy=_PxnYRxnYP<[M@Hiu>E ?bU ?bMpnpDE@C?WE?KWE?KWD>FRaAt<_PxnYRxnYP<[M@Haq>E ?bU ?bMpnpDEPA?WE?KWE?KWD>FRaAX=_PxnYRxnYP<[M@HMy>E ?bU ?bMpnpDE@q?WE?KWE?KWD>FRaAD=_PxnYRxnYP<[M@HEu>E ?bU ?bMpnpDEp;?WE?KWE?KWD>FRaAs>_PxnYRxnYP<[M@HMy>E ?bU ?bMpnpDE ^?WE?KWE?KWD>FRaAD=_PxnYRxnYP<[M@HAq>E ?bU ?bMpnpDEP\?WE?KWE?KWD>FRaAF=_PxnYRxnYP<[M@Hmy>E ?bU ?bMpnpDEPR?WE?KWE?KWD>FRaAL=_PxnYRxnYP<[M@" & _
"Hey>E ?bU ?bMpnpDE R?WE?KWE?KWD>FRaAD=_PxNRsIwE<ifL@@Aq[EPNFACM]r^EAIWE=KWD?KwE>FRQEK?_PxnYPxnYT<[M@Buu>E ?bM ?bEpnpDaAE?WE?KWD?KwE>FRQEA?_PxnYPxnYT<[M@Bev>E ?bM ?bEpnpDaAA?WE?KWD=JkAaa>?bE ?bUpNcLIq>E ?bM@>bAEM;HQs>KWD?KwE>HSQE?WE?KWE=KCPqjB@ab>?bM ?bEpNcTaq>E ?bU@>bJE];XAYy?oYPxnYT<cIBB=_PxnYRxnYP<[M@HUv>E ?bU ?bMpnpDEpN?WE?KWE?KWD>FRaAA?_PxnYRxnYP<[M@Hev>E ?bU ?bMpnpDE@@?WE?KWE=JCD@@K??KwE?KWE>HS@C?WE?KWD=KkE@AfOC@G??KWE?KWD>HsaA?WE?KwE=KGE@AbOEd=?bU ?bMpNcDEp>E ?bE@>bPPQqjb@ab>?bM ?bEpNcTaq>E ?bU ?bMpnpDEP\?WE?KWE?KWD>FRaAv=_PxnYRxnYP<[M@hey>E ?bU ?bMpnpDEP_?WE?KWE?KWD>FRaAH=_PxnYRpjYQHQs>KWD?KwE>HSQE?WE?KWE=KCDCAjOC@K??KwE?KWE>HS@C?WE?KWD=KkECAfOE@G??KWE?KWD>HsaA?WE?KwE=KGECAbOGd=?bU ?bMpNcDEp>E ?bE ?bUpnpDIQ\?WE?KwE?KWE>FRACm=_PxnYTxnYR<[M@QEy>E ?bE ?bUpnpDIQ_?WE?KwE?KWE>FRACL=_PxnYTpjiSLAYy?oYPxnYT<cIBB=_PxnYRpnYQLEM;HQs>KWD?KwE>HSQE?WE?KWE=KCDBAjOE@K??KwE?KWE>HS@C?WE?KWD=KkEBAfOG@G??KWE?KWD>HsaA?WE?KwE?KWE>FRACu<_PxnYTxnYR<[M@QQs>E ?bE ?bUpnpDIqc?WE?KwE?KWE>" & _
"FRACE<_PxnYTxnYR<[M@Qq>?E ?bE ?bUpnpDIqc?WE?KwE?KWE>FRACP<_PxnYTxnYR<[M@qqq>E ?bE ?bUpnpDIQa?WE?KwE?KWE>FRACB>_PxnYTtnisAJ?@kElcDUHar^EAABoAd=?bU ?bMpNcDEp>E ?bEP>bPFMyCmcqKsQ @K>Q@E]yBE]?HAYy?oYPxnYT<cIBB=_PxnYRtnYqAF?@ka=bTuIar^EAAJoAAjNE@K??KwE?KWE>HS@C?WE?KWD<Kk]qbNqKQnI@UCi=G@Qq KQqxb@H?oYTxnYR<cI@Q=_PxnYPxnYT<[M@bmy>E ?bM ?bEpnpDaQR?WE?KWD?KwE>FRQET=_PxnYPxnYT<[M@BEY>E ?bM ?bEpnpDaQE?WE?KWD?KwE>FRQEK?_PxnYPxnYT<[M@BUu>E ?bM ?bEpnpDaAD?WE?KWD?KwE>FRQEK?_PxnYPxnYT<[M@BAp>E ?bM ?bEpnpDaaU?WE?KWD?KwE>FRQEK?_PxnYPxnYT<[M@Biq>E ?bM ?bEpnpDaq>?WE?KWD?KwE>FRQEQ<_PxnYPxnYT<[M@BQq>E ?bM ?bEpnpDaqM?WE?KWD?KwE>FRQE@>_PxnYPxnYT<[M@bet>E ?bM ?bEpnpDaQV?WE?KWD?KwE>FRQE[<_PxnYPxnYT<[M@BI=?E ?bM ?bEpnpDaAB?WE?KWD?KwE>FRQE@=_Px>_PtnYPtnR@XG?Q@= aXm>??oYTxnYR<[M@Qmy>E ?bE ?bUpnpDIQR?WE?KwE?KWE>FRACT=_PxnYTxnYR<[M@Q]=?E ?bE ?bUpnpDIQA?WE?KwE?KWE>FRAC@=_PxnYTxnYR<[M@QAq>E ?bE ?bUpnpDIAA?WE?KwE?KWE>FRAC@=_PxnYTxnYR<[M@qaz>E ?bE ?bUpnpDIaA?WE?KwE?KWE>FRAC@<_PxnYTxnYR<[M@QAq>E ?bE ?b" & _
"UpnpDIAa?WE?KwE?KWE>FRACK?_PxnYTxnYR<[M@QA=?E ?bE ?bUpnpDIqc?WE?KwE?KWE>FRAC@>_PxnYTxnYR<[M@Qet>E ?bE ?bUpnpDIQV?WE?KwE?KWE>FRAC[<_PxnYTxnYR<[M@QI=?E ?bE ?bUpnpDIAB?WE?KwE?KWE>FRAC@=_PxnYTxnYR<[M@QAx>E ?bEp>bevtqUlIzQlYPHMIqDmIEIWD>KwE>CgF@@UVCKWECKWD>IKE@KC=b@nYR<oYA?GQW]HM@@AHePOTTKs?TCwFD@UvCxKAQ@AYW]ldqLAqcUpqaBRqcReYT<Oi_DAQ\ZezA@AAAKWEBIO= @rQOJ @\HEAGCCM@Al?<CkF@@Uf@KwEBIkE@KwEEAgFA@AAA@UvNAgF@@AAA@UfLAgFC@BAA@UVJAgFB@AAAFTFHKWE>KCD@AKMA@AAAKwEDIGpcEPpcPItcJ=_UDMBqYttWBrAAKwEEAgFA@QaA@UvNAgF@@AAA@UfLAgFC@BAA@UVJAgFB@AAAFTFHKWE>KCD@AKMA@AAAKwEDIGpcEPpcPItcJ=_UDMBqYttWBrAAKwEDGFAA@AAAxKAQ@Ayc@nIqYttWBrAAPWtclFtcE pa@RqcPeYT<oYR<OY_DAQ\ImYPHmYT<giQDmIqKC=bMp>bA=_AYtdqDAAePCXTKs? DR>TKWECCCM@KCPcUp>bMp> yPAAudqcE pcUp^cBPqcMp>?ImYP<OIO@=P aCAA@myt<Oi_LAqBDSHA@AqcMp>bApqaxpCAt rcUp>bJpq>qpc[<oYP<oIUL=o]pmYR<oYQL=OUHlYT<oiSLMBqIGEJKWD>KkEBCgBAtxqcEp>bPpqcJEtcA=OUHmYT<oiSLmYQ@dYPxnYT<oiSDEY;DFAA@eYRtnYP<?O]LmYT<oiSLmYAPlIE?KDDKWE?KwE<Is_V[LIpDaGA@CAAj@QUS<OyKC=b@nYR" & _
"<oYA[lYx]HM@@AHeUlIzQlYPHMIqDmIEIWD>KC=b@bZA@@AaYtdqHAAePCXTKs_UKWECCCM@KCPcUp>b@nIqxGAQ@AYW]HME@AHePWtclFtcE pa@RqcPeYT<OY^TEA\JaZA@@AaizJA@AqcU@pcJYwayeU\=lYPPmIEfLi_ByW\qmYRPmYAfLI_DeW\emYTPmiCfLY_FQV\YmYPPmIEfLi_HAQ\MmYR\]]AAAAA@MBqkZvcU@pcJYwayMT\UlYPPmIEfLi_BMW\IlYRPmYAfLI_DIV\=lYTPmiCfLY_F=V\qmYPPmIEfLi_HqW\emYRPmYAfLI_JqW\YmYTPmiCfLY_LAQ\MmYP\]MABAAA@MBqkZpcUpppB=????OoFAaA@oo@KC=b@NBqYtdqXAAePWtclNIpHnYPHMIqDmIEIWD>CwFBA=P HKAA@mYR\MY_HMA\JajB@IAai><@@Aqa=ACAt pcU@cXGJQA@mYR\mYAvBUI@PvBKWDFKkqcA rcPeYTxn?BKwEFKGqcP RcU ?bMppcAYNQQAE\OmYT\miCKGEGKCPcUP>zKmYR\mYAKCDGIWD<KwE>CGmZQ<_\x>_TtfYPpnYP<OIq?At>U@^cEp?bUp^aBVIA@AaU?WD=IWE;KwE>AGmb@AAAQ<_\l>_TtfYPdvYP Cd[A=_TdjGUKWDyRliC?GDBKWD>IKEBKWE>EiHA@AAU?WD=KwE>KGDBIKEHKWE>EEKA@AAUKwE>KGEB?CFH?WD<KWD>KkEBIGEPKWE>EEJA@AAUKWD>KkEB?GFH?WD<KWD>KkEBIGESKWE>KCEBsI\cP rMIfYR\nYP\mIEIWDwKwEwO]ZA=HAQ@Aq^QQVQCcoAt@BStTpahzA\BloWmMAQ@AA\RMI;NQVQkrucU =bJ PcMp<zAlYPXnIUHmiCIwEvkRrcE =C?BDCIWDvkbscM =bA pB?BPcUp<zZmYRXNBqJGEC" & _
"IWEvkvqcU =bJ pM@jYAIWEvKWD>KkEBKWEvIGEMKWD>KkEBFFELAmYP<WAq@AAAP<_\x>_TtnYT<oiSLeYQ@lYP<oIULmYR giCKWE>KCDBKwE=IkENKWE>KCDBKwE<IkEOKWE>KCDBKwE?IkEGKWE>KCDBKwEzIkEFKWE>KCDBKwE;IkEIKWE>KCDBKwECIkEKKWECKCpcJpPcMP<L@fYPPnYTTNQTPFiOvTEgRUvCKwEtCuEuKWE>IGq>E@\a=ALs@aaa<m<?uPl[<oYT<oiSL=_]pmYP<oIUL=oUHlYR<oYULeiQlMBqi>UA@AQ;MDAA@MY^LIqBEOUA@AaXCwFGBQfBfLY^XMA\GYwa=aPAuxucMppay @AthAoNAaA@gOKAAAACwFI@QFHKWDIf\mAKAqcMp>bApAaxPBAtTqaJ>?zBMbuKWEIfdIUHmoCx;@ABAY;tBAA@MBqivOA@AaXCwFGD=P UBAA@myt\Mi_HEA\JajB@IAai>LA@AqMRfYTLnYR\mYAIWEsKWDsO]jCAgnA@@AA?Y@\LLY;BQvOIPFICgOCtdwaiZA\Hlo_Ag?@@@AAt\paibA\aLY;FQVQkZwcE <bP PcUp=z[lYRHnYQHmIEIWDrkzucM <C?FECIWErkJucU <bJ pB?FQcEp=ztmYTHNRsJkECIwErk^scE <bP pMIjiCIwErkbpcE <C?BDCIWDrkrqcM <bA pB?BPcUp= =qMAOUXqCG_AKWE>KCDBHkELsA=zMazA@IAakZqc@nIqsA=bevdqdAAe@AAA@AAA@AaC@AAA@AAA@MEAo@A]@eFAr@Q[@]GAh@A\@ACAW@QY@eFAn@QX@ACAP@A[@eGAl@AZ@eGAp@q]@ACAoAAI@eGAT@QX@MGAh@AI@uEAa@q]@QFAe@a]@MFA @aM@ABApAAO@AAA@AqPePVRoPW\lTGSaxGXlTWQ@=DRELbM@=DREDU\" & _
"tLbM@MuZGTG\MDGZl<vY@UtUEHtMrAqQapGZWdgZd<v\PHvZcDEASTG\WdgZd<v\L<fZgDEAVdg]tTVYlXe]eTGA0"
MouseHookAddr = VirtualAlloc(0, Len(NativeCode), MEM_RESERVE_AND_COMMIT, PAGE_EXECUTE_RW)
If MouseHookAddr <> 0 Then
Call CopyMemoryAnsi(MouseHookAddr, NativeCode, Len(NativeCode))
LoaderVTable.QueryInterface = MouseHookAddr
Call CastToObject(MouseHookLoader, VarPtr(VarPtr(LoaderVTable)), SIZEOF_PTR32)
If Not TypeOf MouseHookLoader Is VBA.Collection Then
Set NewMouseHook = (MouseHookLoader)
Set MouseHookLoader = Nothing
End If
Kernel32Handle = GetModuleHandleA("kernel32")
GetProcAddressPtr = GetProcAddress(Kernel32Handle, "GetProcAddress")
Call NewMouseHook.Init(Kernel32Handle, GetProcAddressPtr, Form.hwnd)
NewMouseHook.Scroll = False
Else
Err.Raise ERR_OUT_OF_MEMORY
End If
End Function
pencere_gizle adlı modülün kodlarını komple olmak üzere,aşağıdaki kodlar ile değiştiriniz.
Option Compare Database
Option Explicit
#If VBA7 Then
Public Declare PtrSafe Function CreateRectRgn Lib "gdi32" (ByVal X1 As Longptr, _
ByVal Y1 As Longptr, ByVal X2 As Longptr, ByVal Y2 As Longptr) As Longptr
Public Declare PtrSafe Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Longptr, _
ByVal Y1 As Longptr, ByVal X2 As Longptr, ByVal Y2 As Longptr, ByVal X3 As Longptr, _
ByVal Y3 As Longptr) As Longptr
Declare PtrSafe Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Longptr, _
ByVal hSrcRgn1 As Longptr, ByVal hSrcRgn2 As Longptr, _
ByVal nCombineMode As Longptr) As Longptr
Public Declare PtrSafe Function SetWindowRgn Lib "user32" (ByVal hwnd As Longptr, _
ByVal hRgn As Longptr, ByVal bRedraw As Boolean) As Longptr
Public Const RGN_AND = 1
Public Const RGN_COPY = 5
Public Const RGN_DIFF = 4
Public Const RGN_OR = 2
Public Const RGN_XOR = 3
#Else
Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, _
ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, _
ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, _
ByVal Y3 As Long) As Long
Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, _
ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, _
ByVal nCombineMode As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, _
ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Const RGN_AND = 1
Public Const RGN_COPY = 5
Public Const RGN_DIFF = 4
Public Const RGN_OR = 2
Public Const RGN_XOR = 3
#End If
Public Function degistir()
Dim rgn1 As Long, rgn2 As Long
rgn1 = CreateRectRgn(0, 0, 1, 1)
CombineRgn rgn1, rgn1, rgn2, RGN_OR
SetWindowRgn Application.hWndAccessApp, rgn1, True
End Function
Public Function degistir2()
Dim rgn1 As Long, rgn2 As Long
rgn1 = CreateRectRgn(0, 0, 1500, 1500)
CombineRgn rgn1, rgn1, rgn2, RGN_OR
SetWindowRgn Application.hWndAccessApp, rgn1, True
End Function
bilginize...iyi çalışmalar,saygılar.