Форум пользователей Visio

Форум по вопросам применения и программирования в Visio
Текущее время: 28 мар 2024, 20:58

Часовой пояс: UTC + 3 часа [ Летнее время ]


Правила форума


При размещении файлов предпочтительным является формат vsd (а не vsdx/vsdm)
Размещая ваши вложения на форуме не используйте имена файлов содержащих кириллицу, в противном случае файл будет иметь имя .<расширение файла> !

Для форматирования ваших сообщений используйте BBCodes, описание используемых на форуме BBCodes.



Начать новую тему Ответить на тему  [ Сообщений: 6 ] 
Автор Сообщение
 Заголовок сообщения: Единицы измерения UserForm
СообщениеДобавлено: 21 авг 2015, 15:02 
Не в сети
Бывалый

Зарегистрирован: 19 июн 2015, 22:18
Сообщений: 114
Использую Visio c: 2013
Очков репутации: 21

Добавить очки репутацииУменьшить очки репутации
Подскажите, в чем измеряется Width, Heigth, Left, Rigth UserFrom?

Мне нужно было разместить форму на экране. Почитал в чем измеряется формы в VBA, вроде как должно быть в твипах (Твип равен 1/1440 дюйма, о твипах в Википедии - https://ru.wikipedia.org/wiki/%D0%A2%D0%B2%D0%B8%D0%BF)

На самом деле не в них. Я вышел из положения - нашел сколько пикселей содержится в единицах формы и, умножив это число на количество пикселей, получил нужный мне сдвиг для формы.

Код:
Private Sub CommandButton1_Click()
    hwnd = FindWindow("ThunderDFrame", Me.Caption)
    relPixelInUnitFormX = Me.Width / GetMyWindowRectSize(hwnd).Width  ' пикселей в единице формы по X
    relPixelInUnitFormY = Me.Height / GetMyWindowRectSize(hwnd).Height ' пикселей в единице формы по Y
   
   ' Размещаю 30 пикселей сверху
    Me.Top = 30 * relPixelInUnitFormY
   
   ' Размещаю 30 пикселей справа
    x = GetSystemMetrics(SM_CXSCREEN)
    Me.Left = (GetSystemMetrics(SM_CXSCREEN) - GetMyWindowRectSize(hwnd).Width - 30) * relPixelInUnitFormX
End Sub


где

Код:
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Declare Function GetSystemMetrics Lib "User32.dll" (ByVal nIndex As Long) As Long
Public Const SM_CXSCREEN = 0, SM_CYSCREEN = 1

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 Function GetMyWindowRectSize(hwnWindow) As RECT
'вычисление размера окна в пикселях
    Dim a As Long
   
        a = GetWindowRect(hwnWindow, GetMyWindowRectSize)
        With GetMyWindowRectSize
            .Height = .Bottom - .Top
            .Width = .Right - .Left
        End With
End Function


Задачу я решил. Но вопрос остался: в чем измеряются UserForm?

Решил исправить код, который будет использоваться в реальном приложении при работе с Office 2010 и выше.
Прежний код не удаляю специально, чтобы была видна разница.

Код:
    #If VBA7 Then
        Dim hwnd As LongPtr
    #Else
        Dim hwnd As Long
    #End If
   
    Dim relPixelInUnitFormX As Double, relPixelInUnitFormY As Double, SceenSize As Long
   
    hwnd = FindWindow("ThunderDFrame", Me.Caption)
    relPixelInUnitFormX = Me.Width / GetMyWindowRectSize(hwnd).Width 
    relPixelInUnitFormY = Me.Height / GetMyWindowRectSize(hwnd).Height
   

    Me.Top = 30 * relPixelInUnitFormY
   
    SceenSize = GetSystemMetrics(SM_CXSCREEN)
    Me.Left = (GetSystemMetrics(SM_CXSCREEN) - GetMyWindowRectSize(hwnd).Width - 30) * relPixelInUnitFormX


Код:
#If VBA7 Then
    Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Declare PtrSafe Function GetSystemMetrics Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
    Declare PtrSafe Function GetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
#Else
    Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Declare Function GetSystemMetrics Lib "User32.dll" (ByVal nIndex As Long) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
#End If

Public Const SM_CXSCREEN = 0, SM_CYSCREEN = 1

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

Public Function GetMyWindowRectSize(hwnWindow) As RECT
    Dim a As Long
   
    a = GetWindowRect(hwnWindow, GetMyWindowRectSize)
    With GetMyWindowRectSize
        .Height = .Bottom - .Top
        .Width = .Right - .Left
    End With
End Function


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Единицы измерения UserForm
СообщениеДобавлено: 21 авг 2015, 16:37 
Не в сети
Ветеран

Зарегистрирован: 21 окт 2011, 12:01
Сообщений: 939
Откуда: г. Екатеринбург
Использую Visio c: 2011
Очков репутации: 127

Добавить очки репутацииУменьшить очки репутации
измеряется в поинтах вроде. тоже таким страдал. только я пошел дальше, когда понял что такая формула недостаточна, когда у тебя масштаб не 100% (у меня на ноуте 13' fullHD очень мелко, приходится поднимать масштаб).

hdc = GetDC(0)
LogPixPerInch = GetDeviceCaps(hdc, LOGPIXELSX)
PointsPerPixel = 72 / LogPixPerInch 'коэф. перевода пикселей в поинты
ScreenX = GetSystemMetrics(SM_CXSCREEN) * PointsPerPixel
ScreenY = GetSystemMetrics(SM_CYSCREEN) * PointsPerPixel
ReleaseDC 0, hdc

ScreenX и ScreenY - размеры экрана в поинтах


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Единицы измерения UserForm
СообщениеДобавлено: 21 авг 2015, 17:18 
Не в сети
Бывалый

Зарегистрирован: 19 июн 2015, 22:18
Сообщений: 114
Использую Visio c: 2013
Очков репутации: 21

Добавить очки репутацииУменьшить очки репутации
Спасибо за ответ.

Только вопрос - нет ли ошибки?
Может так будет правильно?

hdc = GetDC(0)
LogPixPerInchX = GetDeviceCaps(hdc, LOGPIXELSX)
LogPixPerInchY = GetDeviceCaps(hdc, LOGPIXELSY)

PointsPerPixelX = 72 / LogPixPerInchX 'коэф. перевода пикселей в поинты
PointsPerPixelY = 72 / LogPixPerInchY 'коэф. перевода пикселей в поинты

ScreenX = GetSystemMetrics(SM_CXSCREEN) * PointsPerPixelX
ScreenY = GetSystemMetrics(SM_CYSCREEN) * PointsPerPixelY
ReleaseDC 0, hdc


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Единицы измерения UserForm
СообщениеДобавлено: 21 авг 2015, 17:34 
Не в сети
Бывалый

Зарегистрирован: 19 июн 2015, 22:18
Сообщений: 114
Использую Visio c: 2013
Очков репутации: 21

Добавить очки репутацииУменьшить очки репутации
Тогда получается так:

Код:
##If VBA7 Then
    Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Declare PtrSafe Function GetSystemMetrics Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
    Declare PtrSafe Function GetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Declare PtrSafe Function GetDC Lib "user32" Alias "GetDC" (ByVal hwnd As LongPtr) As LongPtr
    Declare PtrSafe Function GetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
    Declare PtrSafe Function ReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
#Else
    Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Declare Function GetSystemMetrics Lib "User32.dll" (ByVal nIndex As Long) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
    Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
#End If

Public Const SM_CXSCREEN = 0, SM_CYSCREEN = 1
Public Const LOGPIXELSX = 88        '  Logical pixels/inch in X
Public Const LOGPIXELSY = 90        '  Logical pixels/inch in Y

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

Type SIZE_IN_POINT
    Width As Double
    Height As Double
End Type

Public Function GetSreenSizeInPoint() As SIZE_IN_POINT
    #If VBA7 Then
        Dim hdc As LongPtr
    #Else
        Dim hdc As Long
    #End If
    Dim LogPixPerInchX As Long, LogPixPerInchY As Long, PointsPerPixelX As Double, PointsPerPixelY As Double
   
    hdc = GetDC(0)
    LogPixPerInchX = GetDeviceCaps(hdc, LOGPIXELSX)
    LogPixPerInchY = GetDeviceCaps(hdc, LOGPIXELSY)
   
    PointsPerPixelX = 72 / LogPixPerInchX
    PointsPerPixelY = 72 / LogPixPerInchY
   
    GetSreenSizeInPoint.Width = GetSystemMetrics(SM_CXSCREEN) * PointsPerPixelX
    GetSreenSizeInPoint.Height = GetSystemMetrics(SM_CYSCREEN) * PointsPerPixelY
   
    ReleaseDC 0, hdc
End Function


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Единицы измерения UserForm
СообщениеДобавлено: 21 авг 2015, 17:56 
Не в сети
Ветеран

Зарегистрирован: 21 окт 2011, 12:01
Сообщений: 939
Откуда: г. Екатеринбург
Использую Visio c: 2011
Очков репутации: 127

Добавить очки репутацииУменьшить очки репутации
можно только Х брать. ибо у тебя масштаб, а не растягивания. т.е. коэффициент для Х и У одинаков


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Единицы измерения UserForm
СообщениеДобавлено: 21 авг 2015, 21:56 
Не в сети
Бывалый

Зарегистрирован: 19 июн 2015, 22:18
Сообщений: 114
Использую Visio c: 2013
Очков репутации: 21

Добавить очки репутацииУменьшить очки репутации
Понял. Спасибо.


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 6 ] 

Часовой пояс: UTC + 3 часа [ Летнее время ]



Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 6


Вы можете начинать темы
Вы можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
cron
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
Вы можете создать форум бесплатно PHPBB3 на Getbb.Ru, Также возможно сделать готовый форум PHPBB2 на Mybb2.ru
Русская поддержка phpBB