19/05/2020, 10:43
19/05/2020, 19:09
konusundaki örnekte kullanılmış kodları çalışmanıza ekleyebilirsiniz. Oradan modülü alıp en altta yer alan 2 değişikliği yapmanız yeterli
Önce bir Modül ekleyin
Modül Kodu:
saat24 foermundaki SeciliZaman fonksiyonu
Önce bir Modül ekleyin
Modül Kodu:
Option Compare Database
Option Explicit
'DEVELOPED AND TESTED UNDER MICROSOFT Access 97 and 2K VBA
'
'Copyright: Stephen Lebans - Lebans Holdings 1999 Ltd. www.lebans.com
' You may use this code in your own private or commercial applications
' without cost. Simply leave this copyright notice in the source code.
' You may not sell htis code by itself or as part of a collection.
'Name: PositionFormRelativeToControl
'Version: 1.5
'Purpose: To allow you to open a second form relative to a control on the parent form.
'Author: Stephen Lebans
'Email: [email protected]
'
'Web Site: www.lebans.com
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare PtrSafe Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetClientRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare PtrSafe Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare PtrSafe Function ClientToScreen Lib "user32" _
(ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function ScreenToClient Lib "user32" _
(ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As Long
Private Declare PtrSafe Function apiGetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare PtrSafe Function apiGetDeviceCaps Lib "gdi32" _
Alias "GetDeviceCaps" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function ReleaseDC Lib "user32" _
(ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare PtrSafe Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare PtrSafe Function apiGetWindow Lib "user32" _
Alias "GetWindow" _
(ByVal hwnd As Long, _
ByVal wCmd As Long) _
As Long
Private Declare PtrSafe Function apiGetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) _
As Long
Private Declare PtrSafe Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" (ByVal hwnd1 As Long, ByVal hwnd2 As Long, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare PtrSafe Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, _
ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
' Window Styles
Private Const WS_OVERLAPPED = &H0&
Private Const WS_POPUP = &H80000000
Private Const WS_CHILD = &H40000000
Private Const WS_MINIMIZE = &H20000000
Private Const WS_VISIBLE = &H10000000
Private Const WS_DISABLED = &H8000000
Private Const WS_CLIPSIBLINGS = &H4000000
Private Const WS_CLIPCHILDREN = &H2000000
Private Const WS_MAXIMIZE = &H1000000
Private Const WS_CAPTION = &HC00000 ' WS_BORDER Or WS_DLGFRAME
Private Const WS_BORDER = &H800000
Private Const WS_DLGFRAME = &H400000
Private Const WS_VSCROLL = &H200000
Private Const WS_HSCROLL = &H100000
Private Const WS_SYSMENU = &H80000
Private Const WS_THICKFRAME = &H40000
Private Const WS_GROUP = &H20000
Private Const WS_TABSTOP = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_TILED = WS_OVERLAPPED
Private Const WS_ICONIC = WS_MINIMIZE
Private Const WS_SIZEBOX = WS_THICKFRAME
Private Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
Private Const WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW
Private Const WS_POPUPWINDOW = (WS_POPUP Or WS_BORDER Or WS_SYSMENU)
Private Const WS_CHILDWINDOW = (WS_CHILD)
' Extended Window Styles
Private Const WS_EX_DLGMODALFRAME = &H1&
Private Const WS_EX_NOPARENTNOTIFY = &H4&
Private Const WS_EX_TOPMOST = &H8&
Private Const WS_EX_ACCEPTFILES = &H10&
Private Const WS_EX_TRANSPARENT = &H20&
' GetWindow() Constants
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDLAST = 1
Private Const GW_HWNDNEXT = 2
Private Const GW_HWNDPREV = 3
Private Const GW_OWNER = 4
Private Const GW_CHILD = 5
Private Const GW_MAX = 5
' App instance
Private Const GWL_HINSTANCE = (-6)
Private Const GWL_STYLE = (-16)
' Twips per inch
Private Const TWIPSPERINCH = 1440&
' Device Parameters for GetDeviceCaps()
Private Const LOGPIXELSX = 88 ' Logical pixels/inch in X
Private Const LOGPIXELSY = 90 ' Logical pixels/inch in Y
Private Const BITSPIXEL = 12 ' Number of bits per pixel
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Const SM_CXVSCROLL = 2
Private Const SM_CYHSCROLL = 3
Private Const SM_CXBORDER = 5
Private Const SM_CYBORDER = 6
' SetWindowPos Flags
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOREDRAW = &H8
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_FRAMECHANGED = &H20 ' The frame changed: send WM_NCCALCSIZE
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_NOCOPYBITS = &H100
Private Const SWP_NOOWNERZORDER = &H200 ' Don't do owner Z ordering
Private Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Private Const SWP_NOREPOSITION = SWP_NOOWNERZORDER
' SetWindowPos() hWndInsertAfter values
Private Const HWND_TOP = 0
Private Const HWND_BOTTOM = 1
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const TITLE = ""
' Horizontal and Vertical Screen resolution
Private m_ScreenXdpi As Long
Private m_ScreenYdpi As Long
' Junk return vars
Private lRet As Long
Public Function PositionFormRelativeToControl(frmName As String, ctl As Access.Control, Optional Position As Long = 0) As Boolean
Position:
' 0 = Underneath
' 1 = On Top
' 2 = Right side
' 3 = Left side
' 4 = Bottom Right Hand Corner
' Window handle to our Form's Detail Section
Dim m_hWndSection As Long
' Form we will position under the control
Dim frm As Access.Form
' Access MDI document window
Dim hWndMDI As Long
' MDI borders
Dim MDIborderX As Long
Dim MDIborderY As Long
' For positioning window
Dim rc As RECT
Dim rcWin As RECT
Dim pt As POINTAPI
Dim lOffsetX As Long, lOffsetY As Long
' Screen dimensions
Dim m_ScreenWidth As Long
Dim m_ScreenHeight As Long
' Window Style var
Dim lStyle As Long
' Since we are turning off screen redraw ignore all errors
On Error Resume Next
' Turn off redraw
' Leave this alone util you are done debugging
'Application.Echo False
' Open the Form
DoCmd.OpenForm frmName
' Does form exist?
Set frm = Forms.Item(frmName)
If Not frm Is Nothing Then
' Get the Window handle for the form Section containing this control
m_hWndSection = fFindSectionhWnd(ctl)
' Calculate the LEFT offset for this control from the edge of the Section
' First calc our screen resolution
GetScreenDPI
' Now get our screen dimensions
m_ScreenWidth = GetSystemMetrics(SM_CXSCREEN)
m_ScreenHeight = GetSystemMetrics(SM_CYSCREEN)
Select Case Position
Case 0
lOffsetX = ctl.Left / (TWIPSPERINCH / m_ScreenXdpi)
lOffsetY = (ctl.Top + ctl.Height) / (TWIPSPERINCH / m_ScreenYdpi)
Case 1
lOffsetX = ctl.Left / (TWIPSPERINCH / m_ScreenXdpi)
lOffsetY = (-frm.WindowHeight + ctl.Top) / (TWIPSPERINCH / m_ScreenYdpi)
Case 2
lOffsetX = (ctl.Left + ctl.Width) / (TWIPSPERINCH / m_ScreenXdpi)
lOffsetY = (ctl.Top) / (TWIPSPERINCH / m_ScreenYdpi)
Case 3
' Nov-2004 Logic error
' Must use Form's width NOT COntrol's width
'lOffsetX = (ctl.Left - ctl.Width) / (TWIPSPERINCH / m_ScreenXdpi)
lOffsetX = (ctl.Left - frm.WindowWidth) / (TWIPSPERINCH / m_ScreenXdpi)
lOffsetY = (ctl.Top) / (TWIPSPERINCH / m_ScreenYdpi)
Case 4
lOffsetX = (ctl.Left + ctl.Width) / (TWIPSPERINCH / m_ScreenXdpi)
lOffsetY = (ctl.Top + ctl.Height) / (TWIPSPERINCH / m_ScreenYdpi)
Case Else
' Default to Underneath
lOffsetX = ctl.Left / (TWIPSPERINCH / m_ScreenXdpi)
lOffsetY = (ctl.Top + ctl.Height) / (TWIPSPERINCH / m_ScreenYdpi)
End Select
' Get window rectangle of the Section
lRet = GetWindowRect(m_hWndSection, rc)
' Add in offsets for the calling control
pt.X = lOffsetX + rc.Left&
pt.Y = lOffsetY + rc.Top
' Bounds checking to ensure form will be completely visible on screen
lRet = GetWindowRect(frm.hwnd, rcWin)
With rcWin
If m_ScreenWidth - pt.X < .Right - .Left Then
pt.X = m_ScreenWidth - (.Right - .Left)
ElseIf pt.X < 2 Then 'm_S
pt.X = 2
End If
If m_ScreenHeight - pt.Y < .Bottom - .Top Then
pt.Y = m_ScreenHeight - (.Bottom - .Top)
ElseIf pt.Y < 2 Then
pt.Y = 2
End If
End With
' If the Form's POPUP property is True then skip the
' ScreenToClient stuff
If Not frm.PopUp = True Then
' find MDIClient window
hWndMDI = FindWindowEx(Application.hWndAccessApp, 0&, "MDIClient", TITLE)
' COnvert to Client coordinates of our MDI window
lRet = ScreenToClient(hWndMDI, pt)
' We have to subtract our MDI window's Border
lRet = GetWindowRect(hWndMDI, rcWin)
lRet = GetClientRect(hWndMDI, rc)
MDIborderX = ((rcWin.Right - rcWin.Left) - (rc.Right - rc.Left))
MDIborderY = ((rcWin.Bottom - rcWin.Top) - (rc.Bottom - rc.Top))
' See if ScrollBar is visible in the MDI window
lStyle = GetWindowLong(hWndMDI, GWL_STYLE)
If lStyle And WS_HSCROLL Then
MDIborderY = MDIborderY - GetSystemMetrics(SM_CYHSCROLL)
End If
If lStyle And WS_VSCROLL Then
MDIborderX = MDIborderX - GetSystemMetrics(SM_CXVSCROLL)
End If
' Remainder is our Border thickness
MDIborderX = MDIborderX / 2
MDIborderY = MDIborderY / 2
Else
' POPUP = True
' We need to subtract the Border thickness of the main Access Aplication Window
MDIborderX = GetSystemMetrics(SM_CXBORDER)
MDIborderY = GetSystemMetrics(SM_CYBORDER)
End If
' Position our Form underneath of the calling control
Call SetWindowPos(frm.hwnd, 0&, pt.X - MDIborderX, pt.Y - MDIborderY, 0, 0, SWP_NOSIZE)
End If
' Turn on redraw
'Application.Echo True
' Cleanup
Set frm = Nothing
' Return Success
PositionFormRelativeToControl = True
End Function
Private Sub GetScreenDPI()
Dim lngDC As Long
' Grab any DC
lngDC = GetDC(0)
'Horizontal
m_ScreenXdpi = apiGetDeviceCaps(lngDC, LOGPIXELSX)
'Vertical
m_ScreenYdpi = apiGetDeviceCaps(lngDC, LOGPIXELSY)
lngDC = ReleaseDC(0, lngDC)
End Sub
Private Function fFindSectionhWnd(ctl As Access.Control) As Long
On Error GoTo Err_fFindSectionhWnd
' Get ListBox's hWnd
Dim hWnd_LSB As Long
Dim hWnd_Temp As Long
' Window RECT vars
Dim rc As RECT
Dim pt As POINTAPI
' Loop Counters
Dim SectionCounter As Long
Dim ctr As Long
' Which Section contains the Control?
Select Case ctl.Section
Case acDetail '0
SectionCounter = 2
Case acHeader '1
SectionCounter = 1
Case acFooter '2
SectionCounter = 3
Case Else
' **** NEED ERROR HANDLING! ****
End Select
' Setup SectionCounter
' Form Header, Detail and then Footer
ctr = 1
' Nov -2004 - Modification by Onno Willems
' Let's get first Child Window of the FORM
If TypeOf ctl.Parent Is Access.Page Then
' If the control is on a page on a tab, we can't get a window handle
If TypeOf ctl.Parent.Parent Is Access.TabControl Then
' As expected, the page is on a tab
If TypeOf ctl.Parent.Parent.Parent Is Access.Form Then
' And the parent of the tab is the form we wanted
hWnd_LSB = apiGetWindow(ctl.Parent.Parent.Parent.hwnd, GW_CHILD)
End If
End If
Else
' Normal control directly on form
hWnd_LSB = apiGetWindow(ctl.Parent.hwnd, GW_CHILD)
End If
' Let's walk through every sibling window of the Form
Do
If fGetClassName(hWnd_LSB) = "OFormSub" Then
' First OFormSub is the Form's Header. We want the next next one
' which is the detail section
If ctr = SectionCounter Then
fFindSectionhWnd = hWnd_LSB
Exit Function
End If
' Increment our Section Counter
ctr = ctr + 1
End If
' Let's get the NEXT SIBLING Window
hWnd_LSB = apiGetWindow(hWnd_LSB, GW_HWNDNEXT)
' Let's Start the process from the Top again
' Really just an error check
Loop While hWnd_LSB <> 0
' SORRY - NO ListBox hWnd is available
fFindSectionhWnd = 0
Exit_fFindSectionhWnd:
Exit Function
Err_fFindSectionhWnd:
MsgBox Err.Description
Resume Exit_fFindSectionhWnd
End Function
' From Dev Ashish's Site
' The Access Web
' http://www.mvps.org/access/
Private Function fGetClassName(hwnd As Long)
Dim strBuffer As String
Dim lngLen As Long
Const MAX_LEN = 255
strBuffer = Space$(MAX_LEN)
lngLen = apiGetClassName(hwnd, strBuffer, MAX_LEN)
If lngLen > 0 Then fGetClassName = Left$(strBuffer, lngLen)
End Functionsaat24 foermundaki SeciliZaman fonksiyonu
Function SeciliZaman(Optional Target_Control As Object) As String
Set txtbox = Target_Control
End Function
Private Sub Metin0_DblClick(Cancel As Integer)
Dim blRet As Boolean '<--eklenen
blRet = PositionFormRelativeToControl("saat24", Me.ActiveControl) '<--eklenen
Call Form_Saat24.SeciliZaman(Me.ActiveControl)
End Sub20/05/2020, 01:08
Alıntı:ellerinze sağlık çok güel olmuşkeşke form metin kutusunun hemen altında açılsa idisizi ibretle izliyorum, bukadar zaman, bukadar konu ve mesaj..... pes.
Alıntı:Oradan modülü alıp en altta yer alan 2 değişikliği yapmanız yeterliÖnce bir Modül ekleyintahmin edeyim yapamayacak, sayin @berduş, @ozanakkaya ve @feraz bilginize, sabriniza ve emeginize hayranim, bence forumda sorusu cevap bekleyen, ogrenmeye ac uyelere yonelin. Bu kadar emeginize yazik bunlar nerede kullanılacak textbox a 22:18 yazmak bu kadar mi zor.
20/05/2020, 01:37
"22:18 yazmak bukadarmi zor" derken bu dediğiniz ölçü birimi nedir
Neye kıyasla zor veya kolay diye belirliyorsunuz
Benim için mouse u bırakıp tek harf için klavyeyi kullanmak zor mesela
Birilerine bir şeyler zor gelmeseydi hala taş devrinde olurduk
Birde burada paylaşılan çözülen soruların tek kişi için olduğunu zanneden birileri var
Zannediyorlar ki bu sadece soruyu soranın işine yarayacak
Çok ilginç anlamakta zorluk çekiyorum
Ama yinede zahmet edip ilgi duyup yazmışsınız teşekkürler
Neye kıyasla zor veya kolay diye belirliyorsunuz
Benim için mouse u bırakıp tek harf için klavyeyi kullanmak zor mesela
Birilerine bir şeyler zor gelmeseydi hala taş devrinde olurduk
Birde burada paylaşılan çözülen soruların tek kişi için olduğunu zanneden birileri var
Zannediyorlar ki bu sadece soruyu soranın işine yarayacak
Çok ilginç anlamakta zorluk çekiyorum
Ama yinede zahmet edip ilgi duyup yazmışsınız teşekkürler
20/05/2020, 02:11
Birisi şöyle demiş "bunlar nerede kullanılacak"
Bana Rutherford B. Hayes' in(ABD Başkanı). 1876 yılında ilk telefonu gördükten sonra yaptığı yorumu hatırlattı
Vizyon meselesi
Bana Rutherford B. Hayes' in(ABD Başkanı). 1876 yılında ilk telefonu gördükten sonra yaptığı yorumu hatırlattı
Vizyon meselesi
20/05/2020, 02:19
Ben daha bu saat be işe yarar anlamadım.Zaten içteki ve dıştaki rakamlar yer değişmeli sanki.
Accessman hocamız accessi yavaşlatmak için elinden geleni yapıyor bence.ilk önce heralde dünya saatleri uygulaması yapacak sandım
Accessman hocamız accessi yavaşlatmak için elinden geleni yapıyor bence.ilk önce heralde dünya saatleri uygulaması yapacak sandım