VBNet - Форум - API поменять Font и вывести TextOut

Вопрос: API поменять Font и вывести TextOut Добавлено: 03.09.06 20:40

Автор вопроса: FIX | ICQ: 348680795

Размер шрифта не меняет. хотя когда я закрыл приложение и создал новую кнопку. у неё размер был больше чем обычно...

Private Const TRANSPARENT = 1
Private Const LF_FACESIZE = 32

Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode 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 SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long

Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Type LOGFONT
        lfHeight As Long
        lfWidth As Long
        lfEscapement As Long
        lfOrientation As Long
        lfWeight As Long
        lfItalic As Byte
        lfUnderline As Byte
        lfStrikeOut As Byte
        lfCharSet As Byte
        lfOutPrecision As Byte
        lfClipPrecision As Byte
        lfQuality As Byte
        lfPitchAndFamily As Byte
        lfFaceName(1 To LF_FACESIZE) As Byte
End Type

Dim pValue
Dim pFont As LOGFONT
Dim deskDC As Long
Dim Printstr As String

Private Sub Form_Load()
        pFont.lfFaceName(1) = 0
        pFont.lfCharSet = 0
        pFont.lfEscapement = 0
        pFont.lfOrientation = 0
        pFont.lfHeight = 24
        pFont.lfWidth = 16
        pFont.lfWeight = 1
        pValue = SelectObject(deskDC, CreateFontIndirect(pFont))
        'Создаём контекст устройства (DC)
        deskDC = CreateDC("DISPLAY", vbNullString, vbNullString, 0)
        'Установить режим прозрачного фона при выводе текста
        SetBkMode deskDC, TRANSPARENT
        Printstr = "Текст на экране"
End Sub

Private Sub Form_Unload(Cancel As Integer)
        SelectObject deskDC, pValue
        DeleteObject pValue
End Sub

Private Sub Command1_Click()
        Call SetTextColor(deskDC, vbWhite)
        Call TextOut(deskDC, 200, 300, Printstr, Len(Printstr))
End Sub
Ответить

Ответы Всего ответов: 7

Номер ответа: 1 Автор ответа: Viper ICQ: 249094859 Вопросов: 0 Ответов: 310	Профиль \| \| #1	Добавлено: 04.09.06 11:00
	супер последовательность! Сначала выбираем шрифт, потом создаем контекст устройства, а потом удивляемся что не так Ответить

Номер ответа: 2 Автор ответа: LamerOnLine ICQ: 334781088 Вопросов: 108 Ответов: 2822	Профиль \| \| #2	Добавлено: 04.09.06 11:11
	Во блин! Он и тут вопрос продублировал! А я сдуру ответил о том же несколькими постами ниже ) Ответить

Номер ответа: 3 Автор ответа: FIX ICQ: 348680795 Вопросов: 39 Ответов: 62	Профиль \| \| #3	Добавлено: 05.09.06 21:22
	Ещё один трабл. В поиске юзал, не нашел. В структуре LOGFONT поле lfFaceName(1 To LF_FACESIZE) As Byte, т.е название шрифта. КАК его вводить? Допустим Courier New P.S. Извиняюсь за дубликат Ответить

Номер ответа: 4 Автор ответа: FIX ICQ: 348680795 Вопросов: 39 Ответов: 62	Профиль \| \| #4	Добавлено: 05.09.06 21:22
	Ещё один трабл. В поиске юзал, не нашел. В структуре LOGFONT поле lfFaceName(1 To LF_FACESIZE) As Byte, т.е название шрифта. КАК его вводить? Допустим Courier New Заранее благодарен. P.S. Извиняюсь за дубликат Ответить

Номер ответа: 5 Автор ответа: Viper ICQ: 249094859 Вопросов: 0 Ответов: 310	Профиль \| \| #5	Добавлено: 06.09.06 10:45
	Имеется куча способов. Вот тебе 2 1. Создаешь строку содержащую имя шрифта, до нужной длины (LF_FACESIZE) дополняешь символами vbNullChar, после чего копируешь эту строку в массив байтов при помощи StrConv. 2. Создаешь строку содержащую имя шрифта, и копируешь ее содержимое в поле lfFaceName при помощи CopyMemory Ответить

Номер ответа: 6 Автор ответа: FIX ICQ: 348680795 Вопросов: 39 Ответов: 62	Профиль \| \| #6	Добавлено: 06.09.06 20:17
	Опять че-нть не так написал. Пишет: невозможно присвоить массиву: Dim pFont As LOGFONT Dim mFontName As String * LF_FACESIZE Private Sub ConvertFontName(FName As String) mFontName = FName For i = 1 To LF_FACESIZE - Len(FName) mFontName = mFontName & vbNullChar Next End Sub Call ConvertFontName("Comic Sans MS" pFont.lfFaceName = StrConv(mFontName, vbFromUnicode) пробовал и посимвольно занести. В этом случае пишет: несоответсвие типа. Ответить

Номер ответа: 7 Автор ответа: Viper ICQ: 249094859 Вопросов: 0 Ответов: 310	Профиль \| \| #7	Добавлено: 07.09.06 11:46
	Бред! Полнейший причем! Держи код, пока я добрый Dim lf As LOGFONT Dim sFontName As String sFontName = "Comic Sans MS" Dim c As Long c = Len(sFontName) CopyMemory ab(LBound(lf.lfFaceName)), ByVal s, c Ответить

Страница: 1 |