Ver Mensaje Individual
  #3  
Antiguo 29-06-2004
senpiterno senpiterno is offline
Miembro
 
Registrado: abr 2004
Posts: 112
Reputación: 21
senpiterno Va por buen camino
vic_ia, aqui esta el codigo en VB:

Código:
'Declaracion de tipo
 
Public 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 As String * 33
End Type
 
'Funciones de la api win
 
Public Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long

Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
 
 
'Procedure que crea el texto vertical
 
Public Sub StringVertical(ByVal Titulo As String, picMain As PictureBox)
	
On Error GoTo GetOut
	Dim f As LOGFONT
	Dim hPrevFont As Long
	Dim hFont As Long
	Dim FontName As String
	Dim FONTSIZE As Integer
	
	FONTSIZE = 10
	
	f.lfEscapement = 10 * 90 
	FontName = "Tahoma" + Chr$(0) 'caracter nulo
	f.lfFaceName = FontName
	f.lfHeight = (FONTSIZE * -20) / Screen.TwipsPerPixelY
	hFont = CreateFontIndirect(f)
	hPrevFont = SelectObject(picMain.hdc, hFont)
	
	picMain.CurrentX = 3
	   
	picMain.CurrentY = picMain.Height - 10
	picMain.Print Titulo
	
	'  Restauramos el estado original
	hFont = SelectObject(picMain.hdc, hPrevFont)
	DeleteObject hFont
	
	Exit Sub
GetOut:
	Exit Sub
End Sub

Espero lo entindas...Saludos.
Responder Con Cita