الكتابة عموديا

السلام عليكم...

بالتأكيد يوجد مكون جاهز يقوم بذلك لكني شخصياً لا أعرفه. و لكن يمكنك إنجاز ذلك بالطباعة على PictureBox باستعمال الكود التالي، مع الملاحظات التالية:

1. اضبط الخاصية AutoRedraw للـ PictureBox على True.

2. اضبط الخاصية ScaleMode للـ PictureBox على Pixel.

3. يجب أن يكون خط (Font) الـ PictureBox من النوع TrueType (تجد أمام اسم الخط الرمز O أو TT عند اختيار الخط).

4. يمكنك تحديد مواصفات الخط كما تشاء (حجم الخط أو Bold أو Italic ... إلخ).

5. يمكنك تحديد لون الخط باستعمال الخاصية ForeColor للـ PictureBox.

6. بدل كتابة النص عمودياً يمكنك كتابته مائلاً بتغيير الزاوية عند استدعاء الإجراء RotateText.

Private Const LOGPIXELSY& = 90
Private Const CLIP_LH_ANGLES = 16
'Private Const ARABIC_CHARSET = &HB2	 ' = 178

Private Declare Function MulDiv _
  Lib "kernel32" _
  (ByVal nNumber As Long, _
   ByVal nNumerator As Long, _
   ByVal nDenominator As Long) _
  As Long

Private Declare Function GetDeviceCaps _
  Lib "gdi32" _
  (ByVal hdc As Long, _
   ByVal nIndex As Long) _
  As Long

Private Declare Function CreateFont _
  Lib "gdi32" _
  Alias "CreateFontA" _
  (ByVal nHeight As Long, _
   ByVal nWidth As Long, _
   ByVal nEscapement As Long, _
   ByVal nOrientation As Long, _
   ByVal fnWeight As Long, _
   ByVal fdwItalic As Long, _
   ByVal fdwUnderline As Long, _
   ByVal fdwStrikeOut As Long, _
   ByVal fdwCharSet As Long, _
   ByVal fdwOutputPrecision As Long, _
   ByVal fdwClipPrecision As Long, _
   ByVal fdwQuality As Long, _
   ByVal PitchAndFamily As Long, _
   ByVal lpszFace 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 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

Public Sub RotateText(lnghDC As Long, ByVal strText As String, ByVal intAngle As Integer, ByVal lngX As Long, ByVal lngY As Long, fntText As StdFont)

	Dim lnghNewFont As Long
	Dim lnghOrigFont As Long
	Dim lngHeight As Long
	Dim lngResult As Long

	On Error GoTo RotateText_Error

	' أخذ المواصفات من الخط الذي تم تمريره إلى الإجراء:
	With fntText
		' حساب ارتفاع الخط من حجم الخط:
		lngHeight = -MulDiv(.Size, GetDeviceCaps(lnghDC, LOGPIXELSY), 72)
		' إنشاء خط من المواصفات الممررة:
		lnghNewFont = CreateFont( _
			nHeight:=lngHeight, _
			nWidth:=0, _
			nEscapement:=intAngle * 10, _
			nOrientation:=intAngle * 10, _
			fnWeight:=.Weight, _
			fdwItalic:=.Italic, _
			fdwUnderline:=.Underline, _
			fdwStrikeOut:=.Strikethrough, _
			fdwCharSet:=.Charset, _
			fdwOutputPrecision:=0, _
			fdwClipPrecision:=CLIP_LH_ANGLES, _
			fdwQuality:=0, _
			PitchAndFamily:=0, _
			lpszFace:=.Name)
	End With

	' تعيين الخط الجديد إلى مربع الصورة:
	lnghOrigFont = SelectObject(lnghDC, lnghNewFont)

	' كتابة النص:
	lngResult = TextOut(lnghDC, lngX, lngY, strText, Len(strText))

	' استعادة الخط الأصلي لمربع الصورة:
	lnghNewFont = SelectObject(lnghDC, lnghOrigFont)

	' حذف الخط الذي تم إنشاؤه لغرض تحرير الذاكرة:
	DeleteObject lnghNewFont

	Exit Sub
RotateText_Error:
	MsgBox "Error: " & Err.Number & ". " & Err.Description, vbCritical, "RotateText"
End Sub

Private Sub Form_Load()
	Dim MyStr As String

	MyStr = "الفريق العربي للبرمجة"
	RotateText Picture1.hdc, MyStr, 90, 4, Picture1.ScaleHeight - 4, Picture1.Font
	' يمكنك في السطر السابق تغيير العدد 90 إلى أي قيمة بين 0 و 360 لكتابة نص مائل.
End Sub

ملاحظة: الكود مأخوذ من برنامج Total VB SourceBook 6 مع إجراء بعض التعديلات عليه.

نرجو الاستفادة و السلام.

شكرا على الكود...جاري التجربة

مثال للكتابة بشكل عمودي على النمودج

DiVLabel6.ocx.rar

اهلا بيك الأخ ناصر و ولاد الجزائر

هذه الأداة موجودة من السابق عندي لكنها لا تتعامل مع اللغة العربية..شكرا

الأخ الكريم zine pef

أولا و قبل كل شئ أنا ناصر من الجزائر و ليس نصيرة

أما فيما يخص الأداة فعلا لا تدعم العربية و لم يسبق لي و أن أستعملتها في برامجي

فربما هناك من يريد أستعمالها في اللغات الأجنبية

شكرا لك على التوضيح ...و معدرى على الخطأ