طلب كود التحويل من تيكست الى باينري

تفضلى

Function TransToBinary(Text As String) As String
	Dim TXTAsc
	TXTAsc = Asc(Text)
	Do While TXTAsc >= 1
	r = TXTAsc - (TXTAsc \ 2) * 2
	TXTAsc = TXTAsc \ 2
	TransToBinary = r & TransToBinary
	Loop
End Function

هذا الكود خاص بتحويل حرف واحد ... وبالطبع يمكن تعديله للتطبيق على سلاسل حرفية

شكراااااااا اخي على الرد

اذا امكن توضيح على الكود

وفي حالة سلسلة نصية كيف يكون التعديل

شكراااااااااااااااا

عند استخدامها لتحويل الصفر إلى قيم ثنائية , تظهر 110000 !!!

لتحويل سلسلة نصية

اقتباس

Function TransToBinary(Text As String) As String

Dim TXTAsc As Byte, r As Byte, res As String, cnt As Byte

If Text = "" Then Exit Function

For i = 1 To Len(Text)

TXTAsc = Asc(Mid(Text, i, 1))

cnt = 0

Do While TXTAsc >= 1

r = TXTAsc - (TXTAsc \ 2) * 2

TXTAsc = TXTAsc \ 2

res = r & res

cnt = cnt + 1

Loop

If i = Len(Text) Then

TransToBinary = TransToBinary & res

Else

TransToBinary = TransToBinary & res & "-"

End If

res = ""

Next

End Function

الأخ الكريم ، الكود صحيح ولكن يجب عليك قلب القيم الثنائية ، فيجب تعديل السطر التالي :

res = r & res

بحيث أن يصبح كما يلي :

res = res & r

شكراً أخي علي هذا الكود الرائع

جزاك الله كل خير

علي أي أساس قلت كده أخ MMA ..الأخ عبد الفتاح قام بقلب القيم بطريقة صحيحة

اقتباس

علي أي أساس قلت كده أخ MMA ..الأخ عبد الفتاح قام بقلب القيم بطريقة صحيحة

في بداية الأمر كان غير صحيح !!!!

مع إحترامي للأخ الغالي عبدالفتاح حسن ، وآسف جداً

شكراً

اقتباس

شكراً أخي علي هذا الكود الرائع

اقتباس

وآسف جداً

اقتباس

لتحويل سلسلة نصية

وكذلك يمكن تقسيمه الى كودين بهدف التبسيط :

'الكود الأول لتحويل الحروف
Function TransToBinary(Text As String) As String
	Dim TXTAsc
	TXTAsc = Asc(Text)
	Do While TXTAsc >= 1
	r = TXTAsc - (TXTAsc \ 2) * 2
	TXTAsc = TXTAsc \ 2
	TransToBinary = r & TransToBinary
	Loop
End Function
'الكود الثانى لتحويل النصوص
Public Function TransTexttoBinary(Text As String) As String
	For n = 1 To Len(Text)
	If TransTexttoBinary <> "" Then TransTexttoBinary = TransTexttoBinary & ","
	TransTexttoBinary = TransTexttoBinary & TransToBinary(Mid(Text, n, 1))
	Next n
End Function

اقتباس

عند استخدامها لتحويل الصفر إلى قيم ثنائية , تظهر 110000 !!!

الأخ الفاضل الكود السابق حاص بتحويل النصوص وليس الأرقام وهو يتعامل مع الأسكى كود ... والأسكى كود الخاص بالرقم 0 = 48