Rotating a Label 90۫

I have searched the forum and found that you obvously can rotate a label but...

I would just use an image for what i need but I need it to be changable on the fly.

so I guess I am wondering how I can do this.

maby make a controll with a picturebox and have it rotate then display the text? (ZOOM over my head. :eek: )

does any one know of any controls that do what I want?


thanks in advance

You can try http://www.pscode.com/vb/scripts/ShowCode.asp?txtCodeId=43161&lngWId=1#zip

It doesn't seem to be a very OS-Friendly code though. Thats the only one I can find.

well um....

I looked at it and was unable to get it to evan work correctly :)

nor was I able to figuear out how to set the caption of let alone any thing :(

oh well thanks though

if you can understand it better than me please explain it thanks

Maybe what you can do is store the contents of the Label as an image in RAM, then use a rotation program of your choice from www.pscode.com and rotate the image the amount you want to, then Blit it with BitBLT back onto the form. Besides that, I have no other ideas, sorry.

You could create a vertical font(or any angle for that matter) with API, and then just print it onto the form...the calls are...


Private 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
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

'draw to form like this:
DrawText "this is a label", 20, 20, "Times New Roman", 12, 400, 2700, False

Private Sub DrawText(tXt As String, myX As Single, myY As Single, font_name As String, sIze As Long, wEight As Long, eScapement As Long, uSe_italic As Boolean)
Const PI = 3.14159
Dim oldFont As Long
Dim newFont As Long

newFont = CreateFont(sIze, 0, eScapement, eScapement, wEight, uSe_italic, False, False, 0, 0, 16, 0, 0, font_name)

oldFont = SelectObject(picA.hdc, newFont)

picA.CurrentX = myX
picA.CurrentY = myY

picA.Print tXt

newFont = SelectObject(hdc, oldFont)
DeleteObject newFont
End Sub

Yeah, that works, but then you have to hardcode stuff you can usually get from labels like "MouseOver", "Click", etc. But, if the text is all you wanted, then yeah, I guess that is a good way. =)

thanks RyRyRy

and I kind of under stand what its doing but I am not sure how to go about implamenting it. this is waht I did



Private 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
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 Sub DrawText(tXt As String, myX As Single, myY As Single, font_name As String, sIze As Long, wEight As Long, eScapement As Long, uSe_italic As Boolean)
Const PI = 3.14159
Dim oldFont As Long
Dim newFont As Long

newFont = CreateFont(sIze, 0, eScapement, eScapement, wEight, uSe_italic, False, False, 0, 0, 16, 0, 0, font_name)

oldFont = SelectObject(picA.hdc, newFont)

picA.CurrentX = myX
picA.CurrentY = myY

picA.Print tXt

newFont = SelectObject(hdc, oldFont)
DeleteObject newFont
End Sub

Private Sub Form_Load()
'draw to form like this:
DrawText "this is a label", 20, 20, "Times New Roman", 12, 400, 2700, False
End Sub

you would have to change all of those picA. into <yourform>. ...and your form would have to have autoredrew set to true

I tried implementing the code above in a new project and could not get it to work. This is the code:

Private 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
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 Sub DrawText(tXt As String, myX As Single, myY As Single, font_name As String, sIze As Long, wEight As Long, eScapement As Long, uSe_italic As Boolean)
Const PI = 3.14159
Dim oldFont As Long
Dim newFont As Long

newFont = CreateFont(sIze, 0, eScapement, eScapement, wEight, uSe_italic, False, False, 0, 0, 16, 0, 0, font_name)

oldFont = SelectObject(Me.hdc, newFont)

Me.CurrentX = myX
Me.CurrentY = myY

Me.Print tXt

newFont = SelectObject(hdc, oldFont)
DeleteObject newFont
End Sub

Private Sub Form_Load()
'draw to form like this:
Me.AutoRedraw = True
Me.ForeColor = vbBlack
DrawText "this is a label", 100, 100, "Times New Roman", 120, 400, 2700, False
End Sub


Any ideas?

Thanks,
Bdagnall

well the thing is that I was never able to get it to work either. then I stoped trying because of school stuff that needed to be done.

as far as I got was getting it to run the program with no errors except that it does not put any thing on the form. :-\

yea...set the forms scale mode to pixels...then it will work just fine...if you need it in twips or something else, just alter the Draw sub to use whatever unit you need...i just threw the code into a form and set scalemode to pixels and it worked just fine