VBNet - Форум - API поменять шрифт, пользуясь TextOut

Вопрос: API поменять шрифт, пользуясь TextOut Добавлено: 02.09.06 12:27

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

Помогите плиз. Только не знаю как поменять шрифт и сделать его побольше. Заранее спасибо!

кнопка - Command1
таймер - Tmr1

Private Const TRANSPARENT = 1

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

Dim deskDC As Long
Dim Printstr As String
Dim R As Integer
Dim G As Integer
Dim B As Integer

Private Sub Command1_Click()
        Tmr1.Enabled = True
End Sub

Private Sub Form_Load()
        R = 1: G = 1: B = 1
        'Создаём контекст устройства (DC)
        deskDC = CreateDC("DISPLAY", vbNullString, vbNullString, 0)
        'Установить режим прозрачного фона при выводе текста
        SetBkMode deskDC, TRANSPARENT
        Printstr = "Текст на экране"
End Sub

Private Sub Tmr1_Timer()
        If R < 255 And G = 1 And B = 1 Then
                R = R + 2
        ElseIf R = 255 And G < 255 And B = 1 Then
                G = G + 2
        ElseIf G = 255 And R = 255 And B < 255 Then
                B = B + 2
        ElseIf B = 255 Then
                R = 1
                G = 1
                B = 1
        End If
        Call SetTextColor(deskDC, RGB(R, G, B))
        Call TextOut(deskDC, 200, 300, Printstr, Len(Printstr))
End Sub
Ответить

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

Номер ответа: 1 Автор ответа: FIX ICQ: 348680795 Вопросов: 39 Ответов: 62	Профиль \| \| #1	Добавлено: 02.09.06 12:33
	извиняюсь. Не пользуясь TextOut. А я использую TextOut. Ответить

Номер ответа: 2 Автор ответа: VerhoLom Вопросов: 20 Ответов: 285	Профиль \| \| #2	Добавлено: 02.09.06 17:05
	Используйте функции: CreateFontIndirect SelectObject DeleteObject Для CreateFontIndirect нужна структура Logfont. Заполните структуру (она в АПИ вьюере есть), вызовите CreateFontIndirect и передайте параметром ей єту структуру. Потом Делайте SelectObject, передавая ей значение, возвращенное CreateFontIndirect (не забудьте сохранить то, что она вернет). Далее хоть Print пользуйтесь. После вывода теста вызовите SelectObject, передав ей предварительно сохраненное значение. Потом DeleteObject чтобы удалить шрифт, созданный Вами (его манипулятор вернула Вам CreateFontIndirect при первом вызове). Вот и все. В структуре Logfont наибольший интерес вызывает поле lfEscapement. Попробуйте установить его в 900. Ответить

Номер ответа: 3 Автор ответа: FIX ICQ: 348680795 Вопросов: 39 Ответов: 62	Профиль \| \| #3	Добавлено: 02.09.06 21:51
	Не работает . Размер шрифта не поменял. хотя когда я закрыл приложение и создал новую кнопку. у неё размер был больше чем обычно... ... 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("ISPLAY", vbNullString, vbNullString, 0) 'Установить режим прозрачного фона при выводе текста SetBkMode deskDC, TRANSPARENT Printstr = "Текст на экране" End Sub Private Sub Form_Unload(Cancel As Integer) SelectObject deskDC, pValue eleteObject pValue End Sub Private Sub Command1_Click() Call SetTextColor(deskDC, vbWhite) Call TextOut(deskDC, 200, 300, Printstr, Len(Printstr)) End Sub Ответить

Номер ответа: 4 Автор ответа: LamerOnLine ICQ: 334781088 Вопросов: 108 Ответов: 2822	Профиль \| \| #4	Добавлено: 04.09.06 10:28
	1. pValue = SelectObject(deskDC, CreateFontIndirect(pFont)) 'Создаём контекст устройства (DC) deskDC = CreateDC("ISPLAY", vbNullString, vbNullString, 0) Как думаешь, имеет смысл поменять местами эти строки? 2. Нахрена тебе CreateDC? Используй GetDC(0). Ответить

Страница: 1 |