MyTetra Share
Делитесь знаниями!
Пиксели, поинты, твипы и DPI!
Ссылка на оригинал
Время создания: 02.03.2020 07:28
Текстовые метки: DPI, разрешение экрана
Раздел: VB
Запись: xintrea/mytetra_db_adgaver_new/master/base/1583123299g9wbzwehho/text.html на raw.githubusercontent.com

Уважаемые коллеги! Помогите разобраться с пикселями, поинтами, твипами и DPI! Третьи сутки "лопачу" инет, а ясности в этом вопросе как не было, так и нет! Наооборот, только ещё больше запутался! Функцией Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long вытащил GetDeviceCaps(hDC, HORZRES)=1024, a
GetDeviceCaps(hDC, VERTRES)=768! Это размеры дисплея? Но в каких единицах измерения выдаваемые числа?! Пиксели?! Поинты?! Твипы?! DPI?! В каких единицах измерения задаются UserForm1.Top, UserForm1.Left, UserForm1.Height, UserForm1.Width?! Каким образом связаны размер дисплея с UserForm1.Top?! Как все эти понятия (пиксели, поинты, твипы и DPI) связаны друг с другом? А суть такова: рисую форму на домашнем НЕТБУКе (1024х600) внизу экрана, дабы закрыть от пользователя нижнее Window'ое меню с кнопкой пуск и вкладку Excel'я с листами, на рабочем компе (1024х768) форма "всплывает" вверх! Как программно расчитать UserForm1.Top в зависимости от размеров дисплея? Заранее благодарен! Сегодня началась Олимпиада, а я из-за этой проблемы вообще ничего не посмотрел - искал не поднимая головы!


Сообщение было отмечено как решение

Решение

Насколько мне известно, все API-функции работают только с пискелами. 1024*768 - это размер экрана в пикселах.

"рисую форму на домашнем НЕТБУКе (1024х600) внизу экрана, дабы закрыть от пользователя нижнее Window'ое меню с кнопкой пуск и вкладку Excel'я с листами" - а зачем это нужно (закрывать от пользователя пусковую панель)? Пользователь может ведь перетянуть ее мышью в правую или левую вертикаль экрана...


Сообщение было отмечено как решение

Решение


Visual BasicВыделить код

1

2

3

4

5

6

7

8

9

'перевод твипов в пиксели

Public Function TwipToPixel(ByVal Twips As Long) As Long

  TwipToPixel = Twips / TwipsPerPixel()

End Function

 

'перевод пикселей в твипы

Public Function PixelToTwip(ByVal Pixels As Long) As Long

  PixelToTwip = Pixels * TwipsPerPixel()

End Function

Дополнительные пользовательские функции и АПИ


Visual BasicВыделить код

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Type RECT

    Left As Long

    Top As Long

    Right As Long

    Bottom As Long

    Width As Long

    Height As Long

End Type

 

Public Const LOGPIXELSX As Long = 88

Public Const LOGPIXELSY As Long = 90

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long

Private Declare Function GetDeviceCaps Lib "gdi32" ( _

        ByVal hDC As Long, _

        ByVal nIndex As Long _

    ) As Long

 

 

Sub inUse() '

     Debug.Print GetWindowRectSize(Application.hWndAccessApp).Height

End Sub

 

'=================================================================================

Public Function GetWindowRectSize(hwnWindow, Optional inpx As Boolean) As RECT

'Для визначення розмірів вікон

   Dim a As Long

        a = GetWindowRect(hwnWindow, GetWindowRectSize)

        With GetWindowRectSize

            .Height = .Right - .Left

            .Width = .Bottom - .Top

       

            If Not inpx Then

                .Left = PixelToTwip(.Left)

                .Top = PixelToTwip(.Top)

                .Right = PixelToTwip(.Right)

                .Bottom = PixelToTwip(.Bottom)

                .Width = PixelToTwip(.Width)

                .Height = PixelToTwip(.Height)

            End If

        End With

End Function

 

Private Function TwipsPerPixel(Optional ByVal Dimension As Long = LOGPIXELSX) As Long

  Const TwipsPerInch As Long = 1440

  Dim DesktopDC As Long

On Error GoTo ErrorHandle

  DesktopDC = GetDC(Application.hWndAccessApp) 'DesktopDC = GetDC(HWND_DESKTOP)

 TwipsPerPixel = TwipsPerInch / GetDeviceCaps(DesktopDC, Dimension)

ErrorHandle:

  Call ReleaseDC(Application.hWndAccessApp, DesktopDC) 'Call ReleaseDC(HWND_DESKTOP, DesktopDC)

 'Call Exception.RaiseAgain

End Function

hWndAccessApp - hwnd окна. В примере окна Access



С Уважением, Carpenter.
_________________________________________________


Visual BasicВыделить код 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
 
Private Declare Function ShowWindow& Lib _
        "user32" (ByVal q&, ByVal q1&)
        
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 Declare Function FindWindow Lib _
    "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
    
Const SWP_HIDEWINDOW = &H80
Const SWP_SHOWWINDOW = &H40
Dim hPanel As Long
Dim p As Long
 
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal hDC As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" ( _
    ByVal hDC As Long, _
    ByVal nIndex As Long) As Long
 
Const LOGPIXELSX = 88
Const LOGPIXELSY = 90
Const TWIPSPERINCH = 1440
 
Private Declare Function GetSystemMetrics Lib "user32" ( _
    ByVal nIndex As Long) As Long
 
Private Const SM_CXFULLSCREEN = 16
Private Const SM_CYFULLSCREEN = 17
 
Sub ConvertPixelsToPoints(ByRef x As Single, ByRef y As Single)
    Dim hDC As Long
    Dim RetVal As Long
    Dim XPixelsPerInch As Long
    Dim YPixelsPerInch As Long
 
    hDC = GetDC(0)
    XPixelsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
    YPixelsPerInch = GetDeviceCaps(hDC, LOGPIXELSY)
    RetVal = ReleaseDC(0, hDC)
    x = x * TWIPSPERINCH / 20 / XPixelsPerInch
    y = y * TWIPSPERINCH / 20 / YPixelsPerInch
End Sub
 
Sub Move()
    Dim Wt As Single
    Dim Ht As Single
Stop
    Wt = GetSystemMetrics(SM_CXFULLSCREEN)
    Ht = GetSystemMetrics(SM_CYFULLSCREEN)
    With UserForm1
        ConvertPixelsToPoints Wt, Ht
        .Left = Wt - .Width
        .Top = Ht - .Height  ' 1-ый вариант (выше)
        .Top = Ht               ' 2-ой вариант (ниже)
        .Show vbModeless
    End With
    
End Sub
 
Private Sub UserForm_Initialize()
    Call Move
End Sub

Все надо расположить модуле UserForm

Так же в этом разделе:
 
MyTetra Share v.0.65
Яндекс индекс цитирования