ディスプレイの座標と作業領域        <TOP>


ディスプレイモニターの画面座標と、作業領域を取得します。

MonitorFromWindow ディスプレイモニターのハンドルを取得

GetMonitorInfo ディスプレイモニターに関する情報を取得(Windows98以降)

 

左:Windows Vista(1680x1050)    中:WindowsXP(1280x1024)    右:Windows2000(1024x768)

  

 

'================================================================
'= ディスプレイの座標と作業領域
'=    (GetMonitorInfo.bas)
'================================================================
#include "Windows.bi"

#define MONITOR_DEFAULTTONEAREST &H2    '指定したウィンドウに最も近い位置にあるディスプレイモニタのハンドルが返る
#define MONITOR_DEFAULTTONULL &H0       'NULLが返る
#define MONITOR_DEFAULTTOPRIMARY &H1    'プライマリディスプレイモニタのハンドルが返る
#define vbCrLf (Chr$(13) & Chr$(10))    'キャリッジリターンとラインフィード(\r\n)

Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type

Type MONITORINFO
    cbSize    As Long
    rcMonitor As RECT
    rcWork    As RECT
    dwFlags   As Long
End Type

' 指定されたウィンドウに外接する四角形との交差部分が最も大きいディスプレイモニタへのハンドルを取得
Declare Function Api_MonitorFromWindow& Lib "user32" Alias "MonitorFromWindow" (ByVal hWnd&, ByVal dwFlags&)

' ディスプレイモニターに関する情報を取得
Declare Function Api_GetMonitorInfo& Lib "user32" Alias "GetMonitorInfoA" (ByVal hMonitor&, ByRef lpmi As MONITORINFO)

Var Shared Text1 As Object
Var Shared Button1 As Object

Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var mi As MONITORINFO
    Var hMonitor As Long
    Var msg As String

    'モニタのハンドルを取得
    hMonitor = Api_MonitorFromWindow(GethWnd, MONITOR_DEFAULTTONEAREST)
    mi.cbSize = Len(mi)

    'モニタの情報を取得
    If Api_GetMonitorInfo(hMonitor, mi) Then
        '画面の座標
        msg = "画面の座標" & vbCrLf
        msg = msg & "  " & Str$(mi.rcMonitor.Left) & "," & Str$(mi.rcMonitor.Top) & "," & Str$(mi.rcMonitor.Right) & "," &  Str$(mi.rcMonitor.Bottom) & vbCrLf

        '作業領域の座標
        msg = msg & "作業領域" & vbCrLf
        msg = msg & "  " & Str$(mi.rcWork.Left) & "," & STr$(mi.rcWork.Top) & "," & Str$(mi.rcWork.Right) & "," &  Str$(mi.rcWork.Bottom)
        Text1.SetWindowtEXT msg
    Else
        Text1.SetWindowText "取得失敗しました!"
    End If
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End