[سوال] چرخش متن

[treasury]

با سلام خدمت دوستان

مي خواستم بدونم ميشه يه text box يا label رو به صورت عمودي در آورد؟؟

مثلاً اين شكلي بشه؟



اگه ميشه لطفاً راهنمايي كنيد.

ممنون

[setroyd]

نه کار نشد نداره ولی اگرم بشه کدش وحشتناک میشه ولی می تونی روی فرم یا هر dc دیگه چاپ کنی به این شکل
angel رو هر مقدار بزاری به همون مقدار چرخش میکنه

Private Const LF_FACESIZE = 32
Private 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(1 To LF_FACESIZE) As Byte
End Type
Private Const OBJ_FONT = 6
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 CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetCurrentObject Lib "gdi32" (ByVal hdc As Long, ByVal uObjectType As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) 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 Function GetFont(hdc As Long, Angle As Double) As Long
Dim hFont As Long
Dim lf As LOGFONT
hFont = GetCurrentObject(hdc, OBJ_FONT)
GetObject hFont, Len(lf), lf
lf.lfEscapement = CInt(Angle * 10)
lf.lfOrientation = lf.lfEscapement
GetFont = CreateFontIndirect(lf)
End Function

Private Sub DrawText(hdc As Long, Text As String, X As Integer, Y As Integer, Angle As Double, Color As Long)
Dim hFont As Long
Dim hPrevFont As Long
SetTextColor hdc, Color
hFont = GetFont(hdc, Angle)
hPrevFont = SelectObject(hdc, hFont)
TextOut hdc, X, Y, Text, Len(Text)
SelectObject hdc, hPrevFont
DeleteObject hFont
End Sub

Private Sub Form_Load()
Me.AutoRedraw = True
Dim TextToDraw As String
Dim X As Integer
Dim Y As Integer
Dim Angle As Double
Font.Name = "Arial"
Font.Bold = True
Font.Size = 36
TextToDraw = "treasury"
X = 120: Y = 270
Angle = 45
DrawText hdc, TextToDraw, X - 1, Y - 1, Angle, RGB(0, 0, 255) ' range asliye neveshte
DrawText hdc, TextToDraw, X + 1, Y + 1, Angle, RGB(0, 0, 0) ' ijad range meshki baraye efect 3d
DrawText hdc, TextToDraw, X, Y, Angle, RGB(0, 0, 192) ' ijad range kamtar baraye efect 3d
End Sub

[treasury]

نه کار نشد نداره ولی اگرم بشه کدش وحشتناک میشه ولی می تونی روی فرم یا هر dc دیگه چاپ کنی به این شکل
angel رو هر مقدار بزاری به همون مقدار چرخش میکنه

سلام
دستت درد نكنه. دمت گرم.
واقعاً وحشتناك بود.
ولي كارت خيلي درسته