Как узнать нужный чекбоксу размер?

[tyomitch]

Типа как AutoSize у лейбла.
Положить рядом с чекбоксом без подписи лейбл с автосайзом не подходит.
Закладываться на конкретный размер квадратика тоже не хочется. А правильный размер должен бы возвращаться из GetSystemMetrics, но не возвращается.

Искал, но чего-то ничего не нашёл

[GSerg]

Размер чего именно?

[Хакер]

Видимо нужно узнать, какой должен быть Height и Width чекбокса, чтобы ничего не обрезалось (ни текст, ни квадратик).

[alibek]

А как должно проверятся?
Я у себя только smCYMenuCheck нашел, как самое похожее.
Но оно возвращает данные, причем правильные.

[tyomitch]

2GSerg: Хакер прав.

2alibek: проверяться должно, как минимум, при разных нестандартных размерах системных шрифтов.

[tyomitch]

Извиняюсь, но ап.
Сильно нужно.
Ни у кого нет идей?

[GSerg]

А помнишь как-то давно ты мне показывал, как определить высоту комбобокса исходя из размера диалоговых единиц окна? Мне кажется, тут так же считается...

[tyomitch]

не помню
напомни плз

[alibek]

Кстати, если я не путаю, то чекбокс не масштабируется.
Это растр на три фиксированных размера (нормальный, большой, очень большой).
Может быть в этом дело?

[tyomitch]

размер чекбокса уже нашёл где взять: LoadBitmap(NULL,OBM_CHECKBOXES)
ещё пара часиков тестирования, и додавлю код...

[tyomitch]

Вот этот код -- является, по-видимому, окончательным.
Не поддерживаются многострочные чекбоксы и чекбоксы с недефолтным выравниванием. Темы тоже не поддерживаются.
Задо поддерживаются все размеры шрифтов.
Тестьте, если кому надо.

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

Option Explicit

Private Declare Function LoadBitmap Lib "user32" Alias "LoadBitmapA" (ByVal hInstance As Long, ByVal lpBitmapName As Long) As Long
Private Const OBM_CHECKBOXES = 32759
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CYBORDER = 6
Private Const SM_CXEDGE = 45
Private Type SIZE
    cx As Long
    cy As Long
End Type
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hDC As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE) 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 SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_GETFONT = &H31
Private Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal nBkMode As Long) As Long
Private Const TRANSPARENT = 1
Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long

Public Sub AutosizeCheckbox(ByVal cb As CheckBox)
Dim bm As BITMAP, sz As SIZE, sz1 As SIZE
Dim hDC As Long, hBM As Long, hFont As Long
    hBM = LoadBitmap(0, OBM_CHECKBOXES)
    GetObject hBM, Len(bm), bm
    DeleteObject hBM
    hDC = CreateCompatibleDC(0)
    hFont = SendMessage(cb.hwnd, WM_GETFONT, 0, ByVal 0&)
    SelectObject hDC, hFont
    GetTextExtentPoint32 hDC, cb.Caption, Len(cb.Caption), sz
    GetTextExtentPoint32 hDC, "0", 1, sz1 'wtf?
    DeleteDC hDC
    cb.Width = bm.bmWidth / 4 + sz1.cx / 2 + 2 * GetSystemMetrics(SM_CXEDGE) + sz.cx
    cb.Height = bm.bmHeight / 3 ' либо sz.cy + GetSystemMetrics(SM_CYBORDER))
    'проверка
    DoEvents
    hDC = GetDC(cb.hwnd)
    SelectObject hDC, hFont
    SetBkMode hDC, TRANSPARENT
    SetTextColor hDC, vbBlue
    TextOut hDC, bm.bmWidth / 4 + sz1.cx / 2 + GetSystemMetrics(SM_CXEDGE), 0, cb.Caption, Len(cb.Caption)
    ReleaseDC cb.hwnd, hDC
End Sub


[GSerg]

LoadImage было второе, что пришло мне в голову, но я думал, что там неправильно, без учёта шрифтов

[Mikle]

tyomitch
Если "очень надо", то я бы просто хранил невидимый Label с AutoSise на форме, присваивал сначала ему нужный шрифт и Caption, а потом вычислял размер чекбокса, как сумму размеров чекбокса без названия и этого Label.
Но это, конечно, решение не в стиле "Visual Basic 1-6 для Профессионалов"

[Viper]

+а заодно еще и невидимый чекбокс без названия придется хранить

[keks-n]

Не обязательно лейбл. Есть у формы такие методы как TextWidth и TextHeight.

[tyomitch]

Если "очень надо", то я бы просто хранил невидимый Label с AutoSise на форме, присваивал сначала ему нужный шрифт и Caption, а потом вычислял размер чекбокса, как сумму размеров чекбокса без названия и этого Label.
Но это, конечно, решение не в стиле "Visual Basic 1-6 для Профессионалов"

Во-первых, проблема уже решена.
Во-вторых, а где мне взять "размеры чекбокса без названия"? Они же тоже меняются в зависимости от размеров системных шрифтов.

[Mikle]

где мне взять "размеры чекбокса без названия"? Они же тоже меняются в зависимости от размеров системных шрифтов.

Я имел ввиду что-то вроде этого:

[tyomitch]

где мне взять "размеры чекбокса без названия"? Они же тоже меняются в зависимости от размеров системных шрифтов.

Я имел ввиду что-то вроде этого:

Не заработает.
При изменении размеров системных шрифтов размер квадратика с галочкой тоже меняется.

[Mikle]

tyomitch
Разве размер системных шрифтов не зависит однозначно от Screen.TwipsPerPixelX и Screen.TwipsPerPixelY ?

[tyomitch]

Чуть-чуть наоборот: это они от него однозначно зависят.
А что? ты подозреваешь, что размер чекбокса в твипах постоянен?
Может, и так: но надо проверять

[lister]

При изменении размеров системных шрифтов размер квадратика с галочкой тоже меняется.

tyomitch, скажи, пожалуйста, что и где нужно поменять, чтобы изменился размер квадратика с галочкой?
У меня он ни черта не меняется

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

Хотя даже темами XP (по крайней мере Луной) предусмотрены 13, 16 и 25 - пиксельные чекбоксы. (Правда многие темы не содержат растры на 16 и 25 px)

Кстати, если я не путаю, то чекбокс не масштабируется.
Это растр на три фиксированных размера (нормальный, большой, очень большой).

Во-во: 13, 16 и 25 px. И чекбоксы и радиокнопки.

[Naked]

а если масштаб увеличить с 96 до 120 ?

[alibek]

Только это не масштаб.

[tyomitch]

При изменении размеров системных шрифтов размер квадратика с галочкой тоже меняется.

tyomitch, скажи, пожалуйста, что и где нужно поменять, чтобы изменился размер квадратика с галочкой?
У меня он ни черта не меняется

Панель управления, Экран, Параметры, Дополнительно, Особые параметры, 200%, OK, OK, OK, перезагрузка.


2alibek: таки-да, в моей русской XP это называется масштабом.

[lister]

Ага, понял. Что-то про масштаб я и не подумал

[Конь]

А нельзя каким-либо образом получить этот "системный" масштаб?

[tyomitch]

По-видимому, 15/Screen.TwipsPerPixelX

[Конь]

tyomitch
Наверное, ты меня не так понял. Можно узнать, какой из этих трех размеров в данный момент установлен юзером?

[Naked]

GetDeviceCaps(hdc, LOGPIXELSY)

[tyomitch]

tyomitch
Наверное, ты меня не так понял. Можно узнать, какой из этих трех размеров в данный момент установлен юзером?

Наверное, это ты меня не так понял.
Что, по-твоему, делает мой код?