Как узнать Горизонталь и Вертикаль монитора в сантиметрах?

[ugin_95]

Есть даже функция WinAPI

Код: Выделить всё

Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Int32
    Dim DESKTOPVERTRES As Integer = 117
    Dim DESKTOPHORZRES As Integer = 118
    Dim vert As String
    Dim horz As String
    vert = GetDeviceCaps(hdc:=???, nIndex:=DESKTOPVERTRES)
    horz = GetDeviceCaps(hdc:=???, nIndex:=DESKTOPHORZRES)


Что необходимо передать функции первым параметром(hdc)?
Прошу подробного ответа.
Функцию увидел на языке VB6, там эта переменная не объявляется, а VB.NET просит объявить

[DRU]

Есть даже: My.Computer.Screen.GetWorkingArea

[ugin_95]

Есть даже: My.Computer.Screen.GetWorkingArea

SystemInformation..::.WorkingArea - свойство
Получает размер (в точках) рабочей области экрана.
А мне в сантиметрах нужно!
Эта функция позволяет сделать это и многое другое

Private Const DRIVERVERSION As Long = 0 'Версия драйвера
Private Const TECHNOLOGY As Long = 2 'Классификация устройства
Private Const HORZSIZE As Long = 4 'Размер по горизонтали в мм.
Private Const VERTSIZE As Long = 6 'Размер по вертикали в мм.
Private Const HORZRES As Long = 8 'Размер по горизонтали в точках
Private Const VERTRES As Long = 10 'Размер по вертикали в точках
Private Const BITSPIXEL As Long = 12 'Кол-во бит на точку
Private Const PLANES As Long = 14 'Number of planes
Private Const NUMBRUSHES As Long = 16 'Number of brushes the device has
Private Const NUMPENS As Long = 18 'Number of pens the device has
Private Const NUMMARKERS As Long = 20 'Number of markers the device has
Private Const NUMFONTS As Long = 22 'Number of fonts the device has
Private Const NUMCOLORS As Long = 24 'Макс. кол-во возможных цветов
Private Const PDEVICESIZE As Long = 26 'Size required for device descripto
Private Const CURVECAPS As Long = 28 'Curve capabilities
Private Const LINECAPS As Long = 30 'Line capabilities
Private Const POLYGONALCAPS As Long = 32 'Polygonal capabilities
Private Const TEXTCAPS As Long = 34 'Text capabilities
Private Const CLIPCAPS As Long = 36 'Clipping capabilities
Private Const RASTERCAPS As Long = 38 'Bitblt capabilities
Private Const ASPECTX As Long = 40 'Length of the X leg
Private Const ASPECTY As Long = 42 'Length of the Y leg
Private Const ASPECTXY As Long = 44 'Length of the hypotenuse
Private Const SHADEBLENDCAPS As Long = 45 'Shading and blending caps (IE5)
Private Const LOGPIXELSX As Long = 88 'Logical pixels/inch in X
Private Const LOGPIXELSY As Long = 90 'Logical pixels/inch in Y
Private Const SIZEPALETTE As Long = 104 'Number of entries in physical palette
Private Const NUMRESERVED As Long = 106 'Number of reserved entries in palette
Private Const COLORRES As Long = 108 'Количество цветов
Private Const VREFRESH As Long = 116 'Текущий рефрешь по вертикали в Гц
'(только для монитора)
Private Const DESKTOPVERTRES As Long = 117 'Размер десктопа по горизонтали
Private Const DESKTOPHORZRES As Long = 118 'Размер десктопа по вертикали
Private Const BLTALIGNMENT As Long = 119 'Preferred blt alignment

[DRU]

Не знаю как ты там без hdc использовал, но в примере из api-guide'а этот параметр не опускается.

Код: Выделить всё

'This project needs 2 Buttons
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Dim P As POINTAPI
Private Sub Form_Load()
    'KPD-Team 1998
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net

    Command1.Caption = "Screen Middle"
    Command2.Caption = "Form Middle"
    'API uses pixels
    Me.ScaleMode = vbPixels
End Sub
Private Sub Command1_Click()
    'Get information about the screen's width
    P.x = GetDeviceCaps(Form1.hdc, 8) / 2
    'Get information about the screen's height
    P.y = GetDeviceCaps(Form1.hdc, 10) / 2
    'Set the mouse cursor to the middle of the screen
    ret& = SetCursorPos(P.x, P.y)
End Sub
Private Sub Command2_Click()
    P.x = 0
    P.y = 0
    'Get information about the form's left and top
    ret& = ClientToScreen&(Form1.hwnd, P)
    P.x = P.x + Me.ScaleWidth / 2
    P.y = P.y + Me.ScaleHeight / 2
    'Set the cursor to the middle of the form
    ret& = SetCursorPos&(P.x, P.y)
End Sub


VB6 Object Browser:
Property hDC As Long
read-only
Member of VB.Form
Returns a handle (from Microsoft Windows) to the object's device context.

[iGrok]

Попробуй дать ей GetDC(GetDesktopWindow())..

[ugin_95]

Не знаю как ты там без hdc использовал, но в примере из api-guide'а этот параметр не опускается.

VB6 Object Browser:

яже объяснил что в VB6 hdc не обявляется и поэтому я незнаю что доложна принимать эта функция
и естественно этот код у меня не работает

Попробуй дать ей GetDC(GetDesktopWindow())..

это уже пробовал.... программа запускается, но возвращает какие-то невероятные значения типа -456322322 или 32428346735

[iGrok]

Попробуй дать ей GetDC(GetDesktopWindow())..

это уже пробовал.... программа запускается, но возвращает какие-то невероятные значения типа -456322322 или 32428346735

Эмм.. У меня, конечно, не .net.. Но вообще именно так это и делается.

Код: Выделить всё

?GetDeviceCaps(GetDc(0), HORZSIZE) & "x" & GetDeviceCaps(GetDc(0), VERTSIZE)
384x240


Правда, значния действительно не совсем верны. Моник у меня в сантиметрах примерно 36 * 22..

[Viper]

Код: Выделить всё

<DllImport("gdi32.dll", EntryPoint:="GetDeviceCaps")> Private Shared Function GetDeviceCaps(ByVal hDC As IntPtr, ByVal index As Integer) As Integer
End Function
<DllImport("user32.dll", EntryPoint:="GetDC")> Private Shared Function GetDC(ByVal hWnd As IntPtr) As IntPtr
End Function
<DllImport("user32.dll", EntryPoint:="ReleaseDC")> Private Shared Function ReleaseDC(ByVal hWnd As IntPtr, ByVal hDC As IntPtr) As IntPtr
End Function
Public Const HORZSIZE As Integer = 4
Public Const VERTSIZE As Integer = 6
...
Dim hDC As IntPtr = GetDC(IntPtr.Zero)
Dim dX As Integer = GetDeviceCaps(hDC, HORZSIZE)
Dim dY As Integer = GetDeviceCaps(hDC, VERTSIZE)
ReleaseDC(IntPtr.Zero, hDC)

Сие дает размер экрана в миллиметрах.
З.Ы. Но как то своеобразно дает - на работе размеры ЖК-экрана дает точно, дома на ноуте несколько врет.

[1Steps]

Код: Выделить всё

Imports System.Text

Public Class Form1
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim dpi As Single = Me.CreateGraphics.DpiX
        Dim rec As Rectangle = Screen.PrimaryScreen.WorkingArea
        'Округляем
        Dim w As Integer = CInt(rec.Width / dpi * 2.54)
        Dim h As Integer = CInt(rec.Height / dpi * 2.54)
        Dim SB As New StringBuilder("Width - ")
        SB.Append(w & vbCrLf)
        SB.Append("Height - " & h)
        MsgBox(SB.ToString)
    End Sub
End Class

[ugin_95]

1Steps , Viper
спасибо теперь всё работает. Причём оба способа. Конечно не совсем точно:
1Steps 44,45 x 26,98 см при максимальном разрешение(1680 x 1050) и 40,00 x 30,00 см при разрешение (640x480)
Viper 47,00 x 29,30 см при максимальном разрешение(1680 x 1050) и 21,16 x 15,08 см при разрешение (640x480)
ну а метром 46,50 x 28,7 см
так что функции WinAPI работоспособны при любых разрешениях

Код: Выделить всё

Public Class Form1
    Private Declare Function GetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hDC As IntPtr, ByVal index As Integer) As Integer
    Private Declare Function GetDC Lib "user32" Alias "GetDC" (ByVal hWnd As IntPtr) As IntPtr
    Private Declare Function ReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hWnd As IntPtr, ByVal hDC As IntPtr) As IntPtr
    Public Const HORZSIZE As Integer = 4
    Public Const VERTSIZE As Integer = 6
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim hDC As IntPtr = GetDC(IntPtr.Zero)
        Dim dX As Double = GetDeviceCaps(hDC, HORZSIZE) / 10
        Dim dY As Double = GetDeviceCaps(hDC, VERTSIZE) / 10
        ReleaseDC(IntPtr.Zero, hDC)
        Label1.Text = dX & " x " & dY

        Dim dpix As Double = Me.CreateGraphics.DpiX
        Dim dpiy As Double = Me.CreateGraphics.DpiY
        Dim rec As Rectangle = Screen.PrimaryScreen.WorkingArea
        Dim w As Double = CInt((rec.Width / dpix * 2.54) * 100) / 100
        Dim h As Double = CInt((rec.Height / dpiy * 2.54) * 100) / 100
        Label2.Text = w & " x " & h
    End Sub
End Class