|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Miscelâneas)
|
|
 |
Título da Dica: Gira um label de 0 a 360º
|
 |
|
|
|
Postada em 1/10/2003 por Tekki
'No módulo
Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal I As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Const FW_NORMAL = 400
'No Form
Private Sub DrawRotatedText(ByVal txt As String, _
ByVal X As Single, ByVal Y As Single, _
ByVal font_name As String, ByVal size As Long, _
ByVal weight As Long, ByVal escapement As Long, _
ByVal use_italic As Boolean, ByVal use_underline As Boolean, _
ByVal use_strikethrough As Boolean)
Const CLIP_LH_ANGLES = 16
Const PI = 3.14159625
Const PI_180 = PI / 180#
Dim newfont As Long
Dim oldfont As Long
newfont = CreateFont(size, 0, _
escapement, escapement, weight, _
use_italic, use_underline, _
use_strikethrough, 0, 0, _
CLIP_LH_ANGLES, 0, 0, font_name)
oldfont = SelectObject(hdc, newfont)
CurrentX = X
CurrentY = Y
Print txt
newfont = SelectObject(hdc, oldfont)
DeleteObject newfont
End Sub
Private Sub Form_Activate()
Print "Clique no form"
End Sub
Private Sub Form_Click()
Static angle As Long
Cls
DrawRotatedText "VBWeb", 2000, 1500, _
"Times New Roman", 20, _
FW_NORMAL, angle * 10, _
False, False, False
angle = angle + 10
End Sub
Private Sub Form_Load()
Me.Width = 4800
Me.Height = 3600
End Sub
|
|
|
|
|
