Получение ширины текста

[13GHOST]

Как можно быстро получить ширину текста? Делаю так:
DrawTextUnicode UserControl.hdc, StrPtr(sString), -1, TextRect, DT_CALCRECT Or DT_SINGLELINE Or DT_NOPREFIX Or DT_LEFT
Работает, но получение ширины происходит очень часто и поэтому хотелось бы получать ее быстрее, потому что сам по себе DrawTextUnicode достаточно медленный и в сумме уходит достаточно большое количество времени(.

[arthur2]

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

Public Declare Function GetTextSizeW Lib "gdi32" _
                 Alias "GetTextExtentPoint32W" (ByVal hDc As Long _
                 , ByVal lpsz As Long, ByVal cbString As Long _
                 , lpSize As size) As Long


[13GHOST]

можно узнать как ее использовать? что то даже в MSDN ее не увидел

[MIT]

Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE) As Long

The GetTextExtentPoint32 function computes the width and height of the specified string of text. This function supersedes the GetTextExtentPoint function.

· hdc
Identifies the device context.

· lpString
Points to the string of text. The string does not need to be zero-terminated, since cbString specifies the length of the string.

· cbString
Specifies the number of characters in the string.

· lpSize
Points to a SIZE structure in which the dimensions of the string are to be returned.

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

Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ExtTextOut Lib "gdi32" Alias "ExtTextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal wOptions As Long, ByVal lpRect As Any, ByVal lpString As String, ByVal nCount As Long, lpDx As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As POINTAPI) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'KPD-Team 1998
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim Pt As POINTAPI, mWnd As Long, WR As RECT, nDC As Long
    Dim TextSize As POINTAPI, CX As Long, CY As Long
    'Get the current cursor position
    GetCursorPos Pt
    'Get the window under the cursor
    mWnd = WindowFromPoint(Pt.X, Pt.Y)
    'Get the window's position
    GetWindowRect mWnd, WR
    'Get the window'zs device context
    nDC = GetWindowDC(mWnd)
    'Get the height and width of our text
    GetTextExtentPoint32 nDC, "Hello !", Len("Hello !"), TextSize
    For CX = 1 To WR.Right - WR.Left Step TextSize.X
        For CY = 1 To WR.Bottom - WR.Top Step TextSize.Y
            'Draw the text on the window
            ExtTextOut nDC, CX, CY, 0, ByVal 0&, "Hello !", Len("Hello !"), ByVal 0&
        Next
    Next
End Sub
Private Sub Form_Paint()
    Me.CurrentX = 0
    Me.CurrentY = 0
    Me.Print "Click on this form," + vbCrLf + "Hold the mouse button," + vbCrLf + "drag the mouse over another window," + vbCrLf + "release the mouse button" + vbCrLf + "and see what happens!"
End Sub

[arthur2]

Ага, только надо не GetTextExtentPoint32A, а GetTextExtentPoint32W, как у меня - ведь работать нужно с уникодом (судя по DrawTextUnicode)

И в моём объявлении уже поменено string на long, а без этого с уникодом ничего не выйдет

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

Public Type size
    cx As Long
    cy As Long
End Type

Public Declare Function GetTextSizeW Lib "gdi32" _
                 Alias "GetTextExtentPoint32W" (ByVal hDc As Long _
                 , ByVal lpsz As Long, ByVal cbString As Long _
                 , lpSize As size) As Long

Function getTextWidth(s As String, hDc As Long, Optional getH As Long) As Long
Dim sz As size
If Len(s) Then

    GetTextSizeW hDc, StrPtr(s), Len(s), sz
    getTextWidth = sz.cx
    getH = sz.cy
End If

End Function



можно узнать как ее использовать? что то даже в MSDN ее не увидел

Так искать надо не по псевдониму, а по названию Твоего DrawTextUnicode тоже ведь там не найдёшь?

[13GHOST]

большое спасибо, все работает, но как показывает профайлер - всего в 2 раза быстрее, а еще быстрее никак?
ЗЫ: всевдоним это где?

[tyomitch]

Alias

[arthur2]

GetTextSizeW пвевдоним (можно вообще написать что угодно), GetTextExtentPoint32W - настоящее название (их там две - A и W). Если объявлять с псевдонимом, нужно слово Alias.

Немного быстрее будет, наверное, если функцию объявить в тлб, юзать без обёртки, а hdc не спрашивать у контрола каждый раз, а записать в переменную и брать готовым.

[13GHOST]

спасибо... вроде искал по alias(

[13GHOST]

ну раз уж мы заговорили об оптимизации, то у меня есть еще пара вопросиков)
1. Есть ли что-нибудь быстрее, чем bitblt?
2. Как установить свойства шрифта (жирный, курсив, рахмер, имя и т д) для определенной DC? Просто щас использую picturebox а менять ему свойства fontbold и т д очень медленно ((
3. Есть ли что-нибудь быстрее FillRect?
4. Можно ли как нибудь ускорить эту строчку кода: "string = string & char" ?

[tyomitch]

1. нет
2. SelectObject
3. нет
4. заранее создать строку нужной длины, и внутри неё Mid(s,i,1)=c

[13GHOST]

большое спасибо. А вот еще вопрос, делаю так:
SetTextColor c_BufDC, RGB(255, 0, 0)
LineTo c_BufDC, pts(1).x, pts(1).y
При этом линия рисуется все равно черной что не так?

[Viper]

Потому что линия рисуется текущим пером, а оно по умолчанию черное. Надо создать и выбрать в контекст перо нужного цвета. Функции CreatePen и SelectObject тебе в помощь. А SetTextColor устанавливает цвет символов выводимых функциями TextOut и ExtTextOut.

[13GHOST]

большое спасибо, разобрался)