Programación VB: imprime texto en el cuadro de imagen y el texto debe girarse 90°

Opción explícita

' Fuente lógica

Public Const LF_FACESIZE = 32 'El nombre de fuente más largo

Public Const SYSTEM_FONT = 13

p>

Escriba LOGFONT

lfAltura Mientras

lfAncho Mientras

lfEscapement Mientras

lfOrientación Mientras

lfPeso tan largo

lfCursiva como byte

lfSubrayado como byte

lfTachado como byte

lfCharSet como byte

lfOutPrecision como byte

lfClipPrecision como byte

lfQuality como byte

lfPitchAndFamily como byte

lfFaceName(LF_FACESIZE) como byte

Tipo de fin

' Familia de fuentes

Const pública VARIABLE_PITCH = 2

Const pública FF_DONTCARE = ​​0 ' No importa

Public Const FF_ROMAN = 16' Ancho de fuente variable, Times Roman, Century 'Schoolbook, etc.

Public Const FF_SWISS = 32' Ancho variable, con serifas, como Helvetica, Swiss , etc.

p>

Public Const FF_MODERN = 48 ' tiene un ancho específico, las serifas son opcionales,

' como Pica, Elite, Courier, etc.

Public Const FF_SCRIPT = 64 'Escritura a mano, como cursiva

Public Const FF_DECORATIVE = 80 'Fuentes especiales, como inglés antiguo

' Función de fuente GDI

Declarar la función CreateFontIndirect Lib "gdi32 " Alias ​​​​"CreateFontIndirectA" (lpLogFont como LOGFONT) mientras

Declarar la función SelectObject Lib "gdi32" (ByVal hdc mientras, ByVal hObject mientras) como Largo

Declarar función DeleteObject Lib "gdi32" (ByVal hObject As Long) Mientras

Declarar divertido

ction GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long

Declarar función GDIGetObject Lib "gdi32" Alias ​​​​"GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Declarar Función 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

Declarar la función lstrlen Lib "KERNEL32" Alias ​​​​"lstrlenA" (ByVal lpString como cadena) durante el tiempo

Declarar la función GetWindowDC Lib "user32" (ByVal hwnd mientras) el tiempo

Sub RotPrint(ByVal hDestDC Mientras, Texto Como Cadena, x Como Doble, y Como Doble, LineAngle Como Doble)

Dim hFont Mientras, HoldFont Mientras, R Mientras

Atenuar fuente como LOGFONT

hOldFont = SelectObject(hDestDC, GetStockObject(SYSTEM_FONT))

GDIGetObject hOldFont, Len(Fuente), Fuente

' Complete la estructura LOGFONT

Font.lfEscapement = LineAngle * 10 ' Genera el ángulo entre la línea de fuente y la parte inferior horizontal de la página (en 1/10 grados)

' Debe ser una fuente de punto variable

Font.lfPitchAndFamily = VARIABLE_PITCH O FF_DONTCARE

' Crear fuente

hFont = CreateFontIndirect(Font)

' Seleccionar fuente rotada

R = SelectObject(hDestDC, hFont)

' Mostrar fuente

TextOut hDestDC, x, y, Text, lstrlen(Text)

' Restaurar fuente original

hFont = SelectObject(hDestDC, hOldFont)

' Eliminar la fuente creada

DeleteObject hFont

'DeleteObject hOldFont

End Sub