กระทู้เก่าบอร์ด อ.Yeadram
4,259 23
URL.หัวข้อ /
URL
สอบถาม set focus แล้ว Key ไม่ได้
ผมได้ออกแบบฟอร์ม login ได้ design ตามรูป เมื่อเปิดฟอร์มขึ้นมา Cursor focus ที่ตำแหน่งชื่อ login ถูกต้อง แต่ Key ไม่ได้ ต้องเอา mouse คลิกที่ ชื่อ login 1ครั้งก่อนจึง key ได้ แก้ปัญหานี้อย่างไรครับ อยากให้เปิดฟอร์มแล้ว key ได้เลยทันที ขอบคุณครับ
23 Reply in this Topic. Dispaly 2 pages and you are on page number 1
1 @R18628
2 @R18629
เท่าที่อ่าน ปัญหาของคุณน่าเกิดจากฟอร์มคุณที่เป็น Pop up มันไม่ได้ Active ปัญหาน่าจะคล้ายกับกระทู้นี้ ลองศึกษาดูครับ
http://www.thai-access.com/yeadram_view.php?topic_id=3316
http://www.thai-access.com/yeadram_view.php?topic_id=3316
3 @R18633
คุณ TTT ผมลองทำดูแล้วครับ
1.สร้าง module ชื่อ module3 แล้ว copy code ดังข้อ 1 ใส่
Option Explicit
Private Declare 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
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Public Sub On_Top(ByVal lhWnd As Long)
SetWindowPos lhWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub
Public Sub NotOn_Top(ByVal lhWnd As Long)
SetWindowPos lhWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub
2.ทำตามข้อ 2
Private Sub Form_Open(Cancel As Integer)
DoCmd.RunCommand acCmdAppMinimize ' โค๊ดที่คุณใช้อยู่
On_Top (Application.hWndAccessApp)
End Sub
3.ทำตามข้อ 3
Private Sub Detail_Paint()
NotOn_Top (Application.hWndAccessApp)
End Sub
พอเปิดฟอร์ม คราวนี้ cursor ไม่ focus เลยครับ ผมทำผิดขั้นตอนไหนหรือเปล่าครับ
1.สร้าง module ชื่อ module3 แล้ว copy code ดังข้อ 1 ใส่
Option Explicit
Private Declare 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
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Public Sub On_Top(ByVal lhWnd As Long)
SetWindowPos lhWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub
Public Sub NotOn_Top(ByVal lhWnd As Long)
SetWindowPos lhWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub
2.ทำตามข้อ 2
Private Sub Form_Open(Cancel As Integer)
DoCmd.RunCommand acCmdAppMinimize ' โค๊ดที่คุณใช้อยู่
On_Top (Application.hWndAccessApp)
End Sub
3.ทำตามข้อ 3
Private Sub Detail_Paint()
NotOn_Top (Application.hWndAccessApp)
End Sub
พอเปิดฟอร์ม คราวนี้ cursor ไม่ focus เลยครับ ผมทำผิดขั้นตอนไหนหรือเปล่าครับ
4 @R18640
ถ้าใช้มาโคร Gotocontrol แทน SetFocus จะได้หรือเปล่าครับ
5 @R18641
ยังไม่เคยเจอปัญหาแบบนี้ครับ
แต่ลองแก้ Modal เป็น Yes ดูครับ จะให้ดีเอา code ต่างๆ ออกก่อนนะครับ แล้วค่อยใส่เฉพาะ code ที่จำเป็นเข้าไป
แต่ลองแก้ Modal เป็น Yes ดูครับ จะให้ดีเอา code ต่างๆ ออกก่อนนะครับ แล้วค่อยใส่เฉพาะ code ที่จำเป็นเข้าไป
6 @R18642
อื่ม ถ้าคุณอยากแสดงฟอร์มแบบ Popup เหมือนกับ MS Access 2003 แต่ใช้กับ เวอร์ชั่น 2007 ขึ้นไป โดยใช้ทริคแบบกระทู้ที่ คุณมาลี คือใช้ทริคประมาณนี้
Other > Pop Up = Yes
Event > On Open: DoCmd.RunCommand acCmdAppMinimize
สร้าง Macros สำหรับเปิดฟอร์มอัตโนมัติเมื่อเรียกไฟล์ ชื่อ Autoexec
Add New Action: OpenForm
Form Name: Form1
View: Form
Window Mode: Normal
และเมื่อเรียกไฟล์ขึ้นมาก็จะแสดงหน้าต่างเฉพาะของฟอร์มที่เป็น Popup ส่วนหน้าต่างของโปรแกรม MS Access ก็จะย่อลงไปที่ Task bar ทำให้เหมือนมี MS Access หน้าต่างเดียวประมาณนี้ใช่หรือป่าวครับ
ซึ่งจริงๆแล้วทริคนี้ก็เป็นทริคที่ดีนะครับ แต่ก็มีปัญหาคือ หน้าต่างที่ Active จะอยู่ที่หน้าต่าง MS Access ไม่ใช่หน้าต่างฟอร์ม ทำให้เมื่อคุณเรียกโปรแกรมแล้วไม่สามารถพิมพ์ได้เลยเพราะหน้าต่างฟอร์มยังไม่ได้ Active ต้องใช้เมาท์คลิ๊กที่หน้าต่างนั้นก่อนทุกครั้งให้มัน Active ถึงจะใช้งานได้
ซึ่งเท่าที่ผมลองก็เป็นอย่างนั้นจริงๆ แก้ไม่ได้ครับ คิดว่านะครับ
จริงๆแล้วส่วนใหญ่หากผมต้องการทำฟอร์มในลักษณะแบบมีผมจะเขียนโค๊ดแทนซึ่งมันค่อนข้างยุ่งยากโดยใช้ API ของ Windows เข้ามาช่วย แต่หากคุณยังสนใจอยู่ก็ช่วยตอบกลับมาด้วยนะครับ หากไม่ตอบผมขออนุญาติข้ามนะครับ เพราะช่วงนี้ผมก็ยุ่งๆเหมือนกัน
Other > Pop Up = Yes
Event > On Open: DoCmd.RunCommand acCmdAppMinimize
สร้าง Macros สำหรับเปิดฟอร์มอัตโนมัติเมื่อเรียกไฟล์ ชื่อ Autoexec
Add New Action: OpenForm
Form Name: Form1
View: Form
Window Mode: Normal
และเมื่อเรียกไฟล์ขึ้นมาก็จะแสดงหน้าต่างเฉพาะของฟอร์มที่เป็น Popup ส่วนหน้าต่างของโปรแกรม MS Access ก็จะย่อลงไปที่ Task bar ทำให้เหมือนมี MS Access หน้าต่างเดียวประมาณนี้ใช่หรือป่าวครับ
ซึ่งจริงๆแล้วทริคนี้ก็เป็นทริคที่ดีนะครับ แต่ก็มีปัญหาคือ หน้าต่างที่ Active จะอยู่ที่หน้าต่าง MS Access ไม่ใช่หน้าต่างฟอร์ม ทำให้เมื่อคุณเรียกโปรแกรมแล้วไม่สามารถพิมพ์ได้เลยเพราะหน้าต่างฟอร์มยังไม่ได้ Active ต้องใช้เมาท์คลิ๊กที่หน้าต่างนั้นก่อนทุกครั้งให้มัน Active ถึงจะใช้งานได้
ซึ่งเท่าที่ผมลองก็เป็นอย่างนั้นจริงๆ แก้ไม่ได้ครับ คิดว่านะครับ
จริงๆแล้วส่วนใหญ่หากผมต้องการทำฟอร์มในลักษณะแบบมีผมจะเขียนโค๊ดแทนซึ่งมันค่อนข้างยุ่งยากโดยใช้ API ของ Windows เข้ามาช่วย แต่หากคุณยังสนใจอยู่ก็ช่วยตอบกลับมาด้วยนะครับ หากไม่ตอบผมขออนุญาติข้ามนะครับ เพราะช่วงนี้ผมก็ยุ่งๆเหมือนกัน
7 @R18643
ขออภัยคุณ TTT ผมสนใจอยู่ครับ ผมไม่ได้เก่งเรื่องการเขียนโปรแกรมด้วย code ที่ซับซ้อนมากนัก ไม่ได้จบด้าน Programmer มาเลย (จริงๆแล้วไม่ได้จบด้านคอมพิวเตอร์มาเลย อาศัยเรียนรู้ด้วยตนเอง) ถ้าคุณจะกรุณาอธิบายวิธีการ จักขอบคุณเป็นอย่างยิ่ง ไว้เพิ่มพูลความรู้ หรืออย่างน้อยก็อาจจะมีประโยชน์ต่อคนอื่นที่อ่านกระทู้นี้ครับ ขอบคุณครับ
8 @R18644
E-mail:weerachai079@yahoo.com ครับ
9 @R18645
ผมให้เป็นตัวอย่างไปลองสร้างกันดูในนี้ก็แล้วกันนะครับ พอดีลองเขียนดูตอนเที่ยง ผมปรับย่อโค๊ดให้มันกระชับมากเท่าที่จะทำได้นะครับเพราะถ้าเอาแบบตามหลักการเขียนมันจะยาวมาก แต่ก็ยังคงความยืดหยุ่นของคำสั่งไว้ประมาณนึงครับ
1. สร้างฟอร์มที่ต้องการทำเป็นฟอร์ม Pop Up ขึ้นมาโดยสมมุติใช้ชื่อว่า Form1
- ฟอร์มต้องกำหนดเป็น Overlapping Windows:
Options > Current Database > Document Windows Options: [O] Overlapping Windows
- กำหนดให้เปิดฟอร์มอัตโนมัติเมื่อเปิดไฟล์
Options > Current Database > Display Form: [Form1]
* หรือ สร้าง Macros สำหรับเปิดฟอร์มอัตโนมัติเมื่อเรียกไฟล์ ชื่อ Autoexec
Add New Action: OpenForm
Form Name: Form1
View: Form
Window Mode: Normal
- ภายในฟอร์มจะออกแบบอย่างได้ก็ได้ ตามที่ต้องการไม่มีผล
- ไม่ต้องกำหนด Property ของฟอร์มเป็น Pop Up: Other > Pop Up: No
1. สร้างฟอร์มที่ต้องการทำเป็นฟอร์ม Pop Up ขึ้นมาโดยสมมุติใช้ชื่อว่า Form1
- ฟอร์มต้องกำหนดเป็น Overlapping Windows:
Options > Current Database > Document Windows Options: [O] Overlapping Windows
- กำหนดให้เปิดฟอร์มอัตโนมัติเมื่อเปิดไฟล์
Options > Current Database > Display Form: [Form1]
* หรือ สร้าง Macros สำหรับเปิดฟอร์มอัตโนมัติเมื่อเรียกไฟล์ ชื่อ Autoexec
Add New Action: OpenForm
Form Name: Form1
View: Form
Window Mode: Normal
- ภายในฟอร์มจะออกแบบอย่างได้ก็ได้ ตามที่ต้องการไม่มีผล
- ไม่ต้องกำหนด Property ของฟอร์มเป็น Pop Up: Other > Pop Up: No
10 @R18646
2. สร้าง Module ใหม่ ใส่โค๊ดดังนี้:
Option Explicit
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
Declare Function WM_apiSetWindowPos Lib "User32" Alias "SetWindowPos" (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
Declare Function WM_apiGetSystemMetrics Lib "User32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
Declare Function WM_apiShowWindow Lib "User32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Function xg_GetAccesshWnd() As Long
xg_GetAccesshWnd = Application.hWndAccessApp
End Function
Sub xg_SizeWindow(sWindow As String, x As Integer, Y As Integer, cx As Integer, cy As Integer)
Dim iRtn As Integer
Dim hWndSize As Long
Dim strProcName As String
On Error Resume Next
strProcName = "xg_SizeWindow"
If sWindow = "Active" Then
hWndSize = Screen.ActiveForm.hwnd
If Err <> 0 Then
xg_ErrorMessage strProcName & " (1)"
GoTo Exit_Section
End If
ElseIf sWindow = "Access" Then
hWndSize = xg_GetAccesshWnd()
Else
MsgBox "Invalid parameter passed to xg_SizeWindow = " & sWindow
Exit Sub
End If
iRtn = WM_apiShowWindow(hWndSize, 9)
Call WM_apiSetWindowPos(hWndSize, 0, x, Y, cx, cy, &H4 Or &H40)
If Err <> 0 Then
xg_ErrorMessage strProcName & " (2)"
End If
Exit_Section:
End Sub
Public Function getversion() As String
Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
getversion = osinfo.dwMajorVersion & "." & osinfo.dwMinorVersion
End Function
Private Sub xg_ErrorMessage(sRoutineName As String)
MsgBox "Error in subroutine or function" & " '" & sRoutineName & "': " & Err & " - " & Err.Description
Err.Clear
End Sub
Public Function xg_YTaskbar(x As Integer) As Integer
xg_YTaskbar = WM_apiGetSystemMetrics(x)
End Function
Public Function xg_YTitlebar() As Integer
Dim Title_H As Integer
Title_H = WM_apiGetSystemMetrics(4)
Title_H = Title_H + (WM_apiGetSystemMetrics(6) * 2)
Title_H = Title_H + (WM_apiGetSystemMetrics(8) * 2)
Title_H = Title_H + WM_apiGetSystemMetrics(33)
xg_YTitlebar = Title_H
End Function
Public Function xg_XTitlebar() As Integer
Dim Title_W As Integer
Title_W = WM_apiGetSystemMetrics(5)
Title_W = Title_W + WM_apiGetSystemMetrics(7)
Title_W = Title_W + WM_apiGetSystemMetrics(32)
xg_XTitlebar = Title_W
End Function
11 @R18647
3. บนฟอร์มที่ Event > On Load:
4. บนฟอร์มที่ Event > On Open:
เท่านี้ครับลองสร้างตามตัวอย่างดูก่อนแล้วค่อยไปปรับใช้กับไฟล์จริงดูครับ โค๊ดทั้งหมดจะเกิดขึ้นตอนเปิดฟอร์มเท่านั้น หลังจากนั้นจะใส่โค๊ดอะไรต่อให้เหตุการณ์อะไรก็ใช้ได้ตามเติม
ปล. ต้องขออภัยที่ตัดเรื่องตัวแปรอะไรออกไปทำให้อาจดูอยากและไม่ได้อธิบายไว้แต่มันเยอะจริงๆ และเวลาจำกัดครับ
DoCmd.Maximize
Dim WSHShell As Object, Regkey As String, LogPixel As Double, x As Integer, Y As Integer, cx As Integer, cy As Integer, tx As Integer
Set WSHShell = CreateObject("WScript.Shell")
If getversion < 6 Then
Regkey = "HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI"
Else
Regkey = "HKEY_CURRENT_USER\Control Panel\Desktop\LogPixels"
End If
LogPixel = 15 / (WSHShell.regread(Regkey) / 96)
Set WSHShell = Nothing
tx = xg_YTaskbar(2) + xg_YTaskbar(5) + xg_YTaskbar(7)
Select Case Me.ScrollBars
Case 0
If Me.RecordSelectors = True Then cx = tx Else cx = 0
If Me.NavigationButtons = True Then cy = tx Else cy = 0
Case 1
cy = tx
If Me.RecordSelectors = True Then cx = tx Else cx = 0
Case 2
If Me.NavigationButtons = True Then cy = tx Else cy = 0
If Me.RecordSelectors = True Then cx = tx * 2 Else cx = tx
Case 3
If Me.RecordSelectors = True Then cx = tx * 2 Else cx = tx
cy = tx
End Select
cx = cx + Int((Me.Width / LogPixel) + xg_XTitlebar)
cy = cy + Int((Me.Detail.Height / LogPixel) + xg_YTitlebar)
'กรณีฟอร์มมีส่วนของ Header และ Footer ต้องบวกเพิ่มเข้าไปด้วย
'cy = cy + Int(((Me.Detail.Height + Me.FormHeader.Height + Me.FormFooter.Height) / LogPixel) + xg_YTitlebar)
x = (xg_YTaskbar(16) - cx) / 2
Y = (xg_YTaskbar(17) - cy) / 2
xg_SizeWindow "Access", x, Y, cx, cy
4. บนฟอร์มที่ Event > On Open:
If SysCmd(acSysCmdAccessVer) >= 12 Then
DoCmd.ShowToolbar "Ribbon", acToolbarNo
Else
DoCmd.ShowToolbar "Menu Bar", acToolbarNo
End If
If Me.Modal = True Then Me.Modal = False
Application.SetOption "Show Status Bar", False
If SysCmd(acSysCmdAccessVer) >= 12 Then DoCmd.NavigateTo "acNavigationCategoryObjectType"
DoCmd.RunCommand acCmdWindowHide
เท่านี้ครับลองสร้างตามตัวอย่างดูก่อนแล้วค่อยไปปรับใช้กับไฟล์จริงดูครับ โค๊ดทั้งหมดจะเกิดขึ้นตอนเปิดฟอร์มเท่านั้น หลังจากนั้นจะใส่โค๊ดอะไรต่อให้เหตุการณ์อะไรก็ใช้ได้ตามเติม
ปล. ต้องขออภัยที่ตัดเรื่องตัวแปรอะไรออกไปทำให้อาจดูอยากและไม่ได้อธิบายไว้แต่มันเยอะจริงๆ และเวลาจำกัดครับ
12 @R18648
ขอบคุณมากครับ จะลองปรับใช้ดู
13 @R18649
14 @R18664
ขึ้นอย่างนี้ครับ
15 @R18665
ใช้ Windows เวอร์ชั่น อะไรครับ
16 @R18666
windows 7 access 2007 ครับ
17 @R18667
ผมเขียนไว้เป็นคำสั่งอ่านค่ารีจีสเตอร์ในส่วนของ DPI เผื่อไว้ว่าบางเครื่องเค้าเซ็ท DPI เป็น 125% หรือ 150% ค่าการขยายฟอร์มมันจะผิด แต่ก็แปลกที่เครื่องคุณไม่มีค่ารีจีสเตอร์ตรงนี้
เอาเป็นว่าให้เพิ่มโค๊ดดัก Error ในส่วนของข้อ 3. Event > On Load เป็นอย่างนี้แทนดูครับ
คือประมาณว่าหากเครื่องใครไม่มีรีจีสเตอร์ระบุค่า DPI ไว้ ผมให้ค่าเป็น 96 เลย ผมเดาเลยนะครับเพราะเครื่องผมที่ใช้งานอยู่ 3 เครื่องมันไม่ Error เหมือนคุณเลยซักเครื่องทั้ง Windows xp, Windows 7, Windows 8.1 64bit
เอาเป็นว่าให้เพิ่มโค๊ดดัก Error ในส่วนของข้อ 3. Event > On Load เป็นอย่างนี้แทนดูครับ
DoCmd.Maximize
Dim WSHShell As Object, Regkey As String, LogPixel As Double, x As Integer, Y As Integer, cx As Integer, cy As Integer, tx As Integer
Set WSHShell = CreateObject("WScript.Shell")
If getversion < 6 Then
Regkey = "HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI"
Else
Regkey = "HKEY_CURRENT_USER\Control Panel\Desktop\LogPixels"
End If
On Error GoTo Err_Regkey
LogPixel = 15 / (WSHShell.regread(Regkey) / 96)
Err_GoNext:
Set WSHShell = Nothing
tx = xg_YTaskbar(2) + xg_YTaskbar(5) + xg_YTaskbar(7)
Select Case Me.ScrollBars
Case 0
If Me.RecordSelectors = True Then cx = tx Else cx = 0
If Me.NavigationButtons = True Then cy = tx Else cy = 0
Case 1
cy = tx
If Me.RecordSelectors = True Then cx = tx Else cx = 0
Case 2
If Me.NavigationButtons = True Then cy = tx Else cy = 0
If Me.RecordSelectors = True Then cx = tx * 2 Else cx = tx
Case 3
If Me.RecordSelectors = True Then cx = tx * 2 Else cx = tx
cy = tx
End Select
cx = cx + Int((Me.Width / LogPixel) + xg_XTitlebar)
cy = cy + Int((Me.Detail.Height / LogPixel) + xg_YTitlebar)
'การณีฟอร์มมีพื้นที่ส่วน Header และ Footer ต้องบวกเพิ่มเข้าไปด้วย
'cy = cy + Int(((Me.Detail.Height + Me.FormHeader.Height + Me.FormFooter.Height) / LogPixel) + xg_YTitlebar)
x = (xg_YTaskbar(16) - cx) / 2
Y = (xg_YTaskbar(17) - cy) / 2
xg_SizeWindow "Access", x, Y, cx, cy
Exit Sub
Err_Regkey:
LogPixel = 15
Resume Err_GoNext:
คือประมาณว่าหากเครื่องใครไม่มีรีจีสเตอร์ระบุค่า DPI ไว้ ผมให้ค่าเป็น 96 เลย ผมเดาเลยนะครับเพราะเครื่องผมที่ใช้งานอยู่ 3 เครื่องมันไม่ Error เหมือนคุณเลยซักเครื่องทั้ง Windows xp, Windows 7, Windows 8.1 64bit
18 @R18674
OK แล้วครับ ขอบคุณครับ
19 @R18678
ผมรู้ละ การใช้คำสั่งอ่านรีจีสเตอร์เครื่องจะใช้ได้กรณี user ต้องเป็นระดับ Admin เท่านั้น หากเข้า Windows ด้วย User ธรรมดา ระบบจะไม่ให้อ่าน งั้นต้องแก้โดยใช้การอ่านค่า DPI ด้วยการเรียก API แทนการอ่านค่าในรีจีสตี้ โดยต้องเปลี่ยนโค๊ดใหม่ดังนี้ครับ
1. เหมือนเดิมนะครับ
2. สร้าง Module ใหม่ ใส่โค๊ดดังนี้:
1. เหมือนเดิมนะครับ
2. สร้าง Module ใหม่ ใส่โค๊ดดังนี้:
Option Explicit
Global Const WM_LOGPIXELSY = 90
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
Declare Function WM_apiSetWindowPos Lib "user32" Alias "SetWindowPos" (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
Declare Function WM_apiGetSystemMetrics Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
Declare Function WM_apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Declare Function WM_apiGetDesktopWindow Lib "user32" Alias "GetDesktopWindow" () As Long
Declare Function WM_apiGetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Long) As Long
Declare Function WM_apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Function xg_GetAccesshWnd() As Long
xg_GetAccesshWnd = Application.hWndAccessApp
End Function
Sub xg_SizeWindow(sWindow As String, x As Integer, Y As Integer, cx As Integer, cy As Integer)
Dim iRtn As Integer
Dim hWndSize As Long
Dim strProcName As String
On Error Resume Next
strProcName = "xg_SizeWindow"
If sWindow = "Active" Then
hWndSize = Screen.ActiveForm.hwnd
If Err <> 0 Then
xg_ErrorMessage strProcName & " (1)"
GoTo Exit_Section
End If
ElseIf sWindow = "Access" Then
hWndSize = xg_GetAccesshWnd()
Else
MsgBox "Invalid parameter passed to xg_SizeWindow = " & sWindow
Exit Sub
End If
iRtn = WM_apiShowWindow(hWndSize, 9)
Call WM_apiSetWindowPos(hWndSize, 0, x, Y, cx, cy, &H4 Or &H40)
If Err <> 0 Then
xg_ErrorMessage strProcName & " (2)"
End If
Exit_Section:
End Sub
Public Function getversion() As String
Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
getversion = osinfo.dwMajorVersion & "." & osinfo.dwMinorVersion
End Function
Private Sub xg_ErrorMessage(sRoutineName As String)
MsgBox "Error in subroutine or function" & " '" & sRoutineName & "': " & Err & " - " & Err.Description
Err.Clear
End Sub
Public Function xg_YTaskbar(x As Integer) As Integer
xg_YTaskbar = WM_apiGetSystemMetrics(x)
End Function
Public Function xg_YTitlebar() As Integer
Dim Title_H As Integer
Title_H = WM_apiGetSystemMetrics(4)
Title_H = Title_H + (WM_apiGetSystemMetrics(6) * 2)
Title_H = Title_H + (WM_apiGetSystemMetrics(8) * 2)
Title_H = Title_H + WM_apiGetSystemMetrics(33)
xg_YTitlebar = Title_H
End Function
Public Function xg_XTitlebar() As Integer
Dim Title_W As Integer
Title_W = WM_apiGetSystemMetrics(5)
Title_W = Title_W + WM_apiGetSystemMetrics(7)
Title_W = Title_W + WM_apiGetSystemMetrics(32)
xg_XTitlebar = Title_W
End Function
20 @R18679
3. บนฟอร์มที่ Event > On Load:
4. เหมือนเดิม
ลองแก้ใหม่ดูนะครับ การดัก Error แบบก่อนหน้าที่ผมแก้ให้มันไม่ยืดหยุ่น ยังไงเราต้องอ่านค่า DPI ของ Windows ให้ได้การปรับขนาดหน้าต่างมันถึงจะตรงความเป็นจริงไม่ว่าเราจะเปิดกับเครื่องไหนก็ตาม
ปล. เป็นอีกปัญหาที่ผมลืมคิดไปในเรื่องของระดับของผู้ใช้งาน Windows
DoCmd.Maximize
Dim hDesktopWnd As Long, hDCcaps As Long, LogPixel As Integer, x As Integer, Y As Integer, cx As Integer, cy As Integer, tx As Integer
hDesktopWnd = WM_apiGetDesktopWindow()
hDCcaps = WM_apiGetDC(hDesktopWnd)
LogPixel = WM_apiGetDeviceCaps(hDCcaps, WM_LOGPIXELSY)
LogPixel = 1440 / LogPixel
tx = xg_YTaskbar(2) + xg_YTaskbar(5) + xg_YTaskbar(7)
Select Case Me.ScrollBars
Case 0
If Me.RecordSelectors = True Then cx = tx Else cx = 0
If Me.NavigationButtons = True Then cy = tx Else cy = 0
Case 1
cy = tx
If Me.RecordSelectors = True Then cx = tx Else cx = 0
Case 2
If Me.NavigationButtons = True Then cy = tx Else cy = 0
If Me.RecordSelectors = True Then cx = tx * 2 Else cx = tx
Case 3
If Me.RecordSelectors = True Then cx = tx * 2 Else cx = tx
cy = tx
End Select
cx = cx + Int((Me.Width / LogPixel) + xg_XTitlebar)
cy = cy + Int((Me.Detail.Height / LogPixel) + xg_YTitlebar)
'กรณีฟอร์มมี Header และ Footer ต้องนำค่ามาคิดเพิ่มด้วย
'cy = cy + Int(((Me.Detail.Height + Me.FormHeader.Height + Me.FormFooter.Height) / LogPixel) + xg_YTitlebar)
x = (xg_YTaskbar(16) - cx) / 2
Y = (xg_YTaskbar(17) - cy) / 2
xg_SizeWindow "Access", x, Y, cx, cy
4. เหมือนเดิม
ลองแก้ใหม่ดูนะครับ การดัก Error แบบก่อนหน้าที่ผมแก้ให้มันไม่ยืดหยุ่น ยังไงเราต้องอ่านค่า DPI ของ Windows ให้ได้การปรับขนาดหน้าต่างมันถึงจะตรงความเป็นจริงไม่ว่าเราจะเปิดกับเครื่องไหนก็ตาม
ปล. เป็นอีกปัญหาที่ผมลืมคิดไปในเรื่องของระดับของผู้ใช้งาน Windows
Time: 0.3310s