هذا الكود يكتب لك نص على الفورم بأي زاوية :

هذا الكود يكتب لك نص على الفورم بأي زاوية :

أنشئ الأدوات التالية :

1-أداة نص وسمها txtDegree

2-أداة نص أخرى إسمها txtSize

3-أداة ليبل مكتوب عليها حجم الخط

4- وليبل آخر مكتوب عليه الزاوية

5- سم أنشئ زر command1

والصق الكود التالي :

Option Explicit

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 As String * 33

End Type

Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) 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 CheckVals()

Command1.Enabled = ((Val(txtDegree.Text) < 360) And Val(txtSize.Text) > 7)

End Sub

Private Sub FontStuff()

On Error GoTo GetOut

Dim F As LOGFONT, hPrevFont As Long, hFont As Long, FontName As String

Dim FONTSIZE As Integer

FONTSIZE = Val(txtSize.Text)

F.lfEscapement = 10 * Val(txtDegree.Text) 'rotation angle, in tenths

FontName = "Arial Black" + Chr$(0) 'null terminated

F.lfFacename = FontName

F.lfHeight = (FONTSIZE * -20) / Screen.TwipsPerPixelY

hFont = CreateFontIndirect(F)

hPrevFont = SelectObject(Me.hdc, hFont)

CurrentX = 3930

CurrentY = 3860

Print "mofakfree@hotmail.com"

hFont = SelectObject(Me.hdc, hPrevFont)

DeleteObject hFont

Exit Sub

GetOut:

Exit Sub

End Sub

Private Sub Command1_Click()

Me.Cls

FontStuff

End Sub

Private Sub txtDegree_Change()

If Not IsNumeric(txtDegree.Text) Then txtDegree.Text = "90"

CheckVals

End Sub

Private Sub txtsize_Change()

If Not IsNumeric(txtSize.Text) Then txtSize.Text = "18"

CheckVals

End Sub

(gift)(f)