تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[سؤال] مطلوب برنامج تحويل الارقام او الحروف من شكل الى شكل
#1
السلام عليكم ورحمة الله
مطلوب برنامج تحويل الارقام او الحروف من شكل الى شكل
 
مثال: الرقم 2015 ممكن نستخرج له عده اشكال اخرى عندما نكتبه هكذا
5      1      0        2  ......................السطر رقم1
ناخذ من سطر رقم 1 ما يلي
رقم من اليسار (الاخير) ثم تاخذ رقم من اليمين (الاول) ثم رقم من قبل الاخير ثم رقم من الثاني هكذا
2    5    0         1...................... السطر رقم 2
ناخذ من سطر رقم 2 ما يلي
رقم من اليسار (الاخير) ثم تاخذ رقم من اليمين (الاول) ثم رقم من قبل الاخير ثم رقم من الثاني هكذا
1     2       0   5
وهكذا حتى يظهر السطر رقم 1 من جديد
وتكون الارقام هكذا
 
5      1      0        2  (اول سطر)
2    5       0          1
1     2       0        5   (سطر ما قبل الاخير)
5    1        0       2   كما نرى رجع السطر الاول (اخر سطر)
 
اذن الطريقة :
ناخذ رقم ايسر مع رقم ايمن حتى ناخذ كل ارقام السطر ويظهر سطر جديد
ناخذ من السطر الجديد رقم ايسر مع رقم ايمن حتى ناخذ كل ارقام السطر ويظهر سطر جديد اخر
وهكذا حتى يظهر السطر الاول
 
 
 
مثال اخر
كلمة مرحبا
 
م     ر       ح       ب       ا        سطر رقم 1
ا       م      ب        ر      ح       سطر رقم 2
ح      ا      ر        م       ب      سطر رقم   3
ب     ح      م       ا        ر       سطر رقم   4
ر      ب      ا       ح       م       سطر رقم   5  ما قبل الاخير
م     ر       ح       ب       ا       سطر رقم  6 (الاخير) مثل رقم 1
 
 
 
 
 
 
 
كن كالشمس تضئ الكون بالعلم والاخلاق Idea
الرد }}}
تم الشكر بواسطة:
#2
أهلا أخي الكريم ، جرب الكود التالي :

PHP كود :
Dim OrgLine As String
Dim TmpLine 
As String
Dim NewLine 
As String
Dim Lines_Array
() As String
Dim Is_individual 
As Boolean
Dim LeftIndex 
As Integer
Dim RightIndex 
As Integer
Dim Lines_Count 
As Integer
Dim I 
As Integer

OrgLine 
"2015"
TmpLine OrgLine
LeftIndex 
1
RightIndex 
Len(OrgLine)
Lines_Count 1

IF Len(OrgLineMod 2 0 Then
    Is_individual 
False
Else
  
Is_individual True
End 
IF

ReDim Lines_Array(1 To Lines_Count) As String

Lines_Array
(Lines_Count) = OrgLine

Do

      IF 
LeftIndex RightIndex Then
          
IF Is_individual True Then
              NewLine  
NewLine Mid$(TmpLine,LeftIndex,1)
          
End IF
          
Lines_Count Lines_Count 1
          ReDim Preserve Lines_Array
(1 To Lines_Count) As String
          Lines_Array
(Lines_Count) = NewLine
          
IF NewLine OrgLine Then Exit Do
          
TmpLine NewLine
           NewLine 
""
           
LeftIndex 1
           RightIndex 
Len(TmpLine)
      Else
          
NewLine  NewLine Mid$(TmpLine,LeftIndex,1)
          
NewLine  NewLine Mid$(TmpLine,RightIndex,1)
          
LeftIndex LeftIndex 1
          RightIndex 
RightIndex 1
      End 
IF

Loop

For LBound(Lines_ArrayTo UBound(Lines_Array
      
MsgBox Lines_Array(I)
Next 

ملاحظه : لم أجرب الكود لأني كتبته من الهاتف لكن إن شاء الله يعمل بشكل جيد
الرد }}}
تم الشكر بواسطة: sami2015
#3
(30-12-15, 02:26 AM)Ahmed_Mansoor كتب : أهلا أخي الكريم ، جرب الكود التالي :

PHP كود :
Dim OrgLine As String
Dim TmpLine 
As String
Dim NewLine 
As String
Dim Lines_Array
() As String
Dim Is_individual 
As Boolean
Dim LeftIndex 
As Integer
Dim RightIndex 
As Integer
Dim Lines_Count 
As Integer
Dim I 
As Integer

OrgLine 
"2015"
TmpLine OrgLine
LeftIndex 
1
RightIndex 
Len(OrgLine)
Lines_Count 1

IF Len(OrgLineMod 2 0 Then
    Is_individual 
False
Else
 
 Is_individual True
End 
IF

ReDim Lines_Array(1 To Lines_Count) As String

Lines_Array
(Lines_Count) = OrgLine

Do

 
     IF LeftIndex RightIndex Then
          IF Is_individual 
True Then
              NewLine  
NewLine Mid$(TmpLine,LeftIndex,1)
 
         End IF
 
         Lines_Count Lines_Count 1
          ReDim Preserve Lines_Array
(1 To Lines_Count) As String
          Lines_Array
(Lines_Count) = NewLine
          IF NewLine 
OrgLine Then Exit Do
 
         TmpLine NewLine
           NewLine 
""
 
          LeftIndex 1
           RightIndex 
Len(TmpLine)
 
     Else
          NewLine  
NewLine Mid$(TmpLine,LeftIndex,1)
 
         NewLine  NewLine Mid$(TmpLine,RightIndex,1)
 
         LeftIndex LeftIndex 1
          RightIndex 
RightIndex 1
      End 
IF

Loop

For LBound(Lines_ArrayTo UBound(Lines_Array
 
     MsgBox Lines_Array(I)
Next 

ملاحظه : لم أجرب الكود لأني كتبته من الهاتف لكن إن شاء الله يعمل بشكل جيد

اخي احمد منصور
السلام عليكم ورحمة الله
اشكر لك اهتمامك باجابة اسئلتي
ولكن يظهر هذا الخطا باللون الاصفر
والبرنامج فى المرفقات
PHP كود :
NewLine NewLine Mid$(TmpLineRightIndex1

(30-12-15, 05:16 AM)sami2015 كتب : Dim s$, i%, m$
s$ = "مرحبا"
m$ = m$ & s$ & vbCrLf
For i% = 1 To Len(s$)
   s$ = Mid$(s$, 2) & Mid$(s$, 1, 1)
   m$ = m$ & s$ & vbCrLf
Next
MsgBox m$

اخي الكريم سامي
اسعد الله   اوقاتك بكل خير
اشكرك على المساعدة
ولكن فكرة حرف من اليسار ثم حرف من اليمين حتى تنتهي حروف السطر ويظهر سطر جديد
ثم ناخذ من السطر الجديد حرف من اليسار وحرف من اليمين حتى يظهر سطر جديد اخر
وتستمر العملية حتى يظهر السطر الاصلي الاول
وهذا لم يحدث فى الكود الذي زودتنى به
المرفق الخاص الكود موجود ضمن المرفقات
ارجو التعديل عليه
ولك كل الشكر


الملفات المرفقة
.rar   sami2015.rar (الحجم : 1.34 ك ب / التحميلات : 41)
.rar   Ahmed_Mansoor.rar (الحجم : 1.46 ك ب / التحميلات : 46)
كن كالشمس تضئ الكون بالعلم والاخلاق Idea
الرد }}}
تم الشكر بواسطة:
#4
أهلا أخي الكريم , معليش أرجو المعذره فعلا كان فيه خطأ بسيط , وعند التجربة أكتشف مشكله في الكلماات العربيه فقط أما الأرقام والكلمات الإنجليزية فلامشكلة فيها , المشكله في الكلمة العربيه أن الحرف الأيسر فيها  يكون هو الحرف الأيمن عندما نستخدم دالة جلب الحرف الأيسر للكلمة الدالة Left والعكس صحيح لذلك هذا الشئ سبب لخبطه في أظهار النتيجة للكلمة العربيه فقط لذلك لابد من قلب العمليه لتظهر النتيجة بالشكل الذي تريده , ولذلك لابد من أن نعرف هل الكلمة عربيه أم لا قبل البدء في عمل الكود لذلك وضع أداتين أوبشن بوكس لذلك , لكي يعمل الكود بالشكل الصحيح .


الملفات المرفقة
.rar   Ahmed_Mansoor_1.rar (الحجم : 2.05 ك ب / التحميلات : 49)
الرد }}}
تم الشكر بواسطة: sami2015
#5
(30-12-15, 10:47 AM)Ahmed_Mansoor كتب : أهلا أخي الكريم , معليش أرجو المعذره فعلا كان فيه خطأ بسيط , وعند التجربة أكتشف مشكله في الكلماات العربيه فقط أما الأرقام والكلمات الإنجليزية فلامشكلة فيها , المشكله في الكلمة العربيه أن الحرف الأيسر فيها  يكون هو الحرف الأيمن عندما نستخدم دالة جلب الحرف الأيسر للكلمة الدالة Left والعكس صحيح لذلك هذا الشئ سبب لخبطه في أظهار النتيجة للكلمة العربيه فقط لذلك لابد من قلب العمليه لتظهر النتيجة بالشكل الذي تريده , ولذلك لابد من أن نعرف هل الكلمة عربيه أم لا قبل البدء في عمل الكود لذلك وضع أداتين أوبشن بوكس لذلك , لكي يعمل الكود بالشكل الصحيح .
اخى الكريم
هناك مشكلة في السطر الثالث
حيث انه المفروض ياخذ حرفا من اليسار اولا ثم حرفا من اليمين
لكنه بدأ بحرف من اليمين اولا
والصورة توضح ذلك
[صورة مرفقة: 145148949810971.bmp]
كن كالشمس تضئ الكون بالعلم والاخلاق Idea
الرد }}}
تم الشكر بواسطة:
#6
PHP كود :
Private Sub Command1_Click()
    
Dim s$, l%, i%, i1%, i2%, r$, m$
    
s$ = "مرحبا"
    
    
m$ = s$ & vbCrLf
    l
% = Len(s$)
    For 
i% = 1 To l% - IIf((lMod 2 0), 01)
        
r$ = ""
        
For i1% = 1 To (l% \ 2) + (lMod 2)
            
i2% = (Len(s$) - i1% + 1)
            
r$ = r$ & Mid$(s$, i2%, 1) & IIf(i1% <> i2%, Mid$(s$, i1%, 1), "")
        
Next
        m
$ = m$ & r$ & vbCrLf
        s
$ = r$
    
Next
    
    MsgBox m
$
End Sub 
الرد }}}
تم الشكر بواسطة: Ahmed_Mansoor
#7
اخي سامي
لو ترفق الكود في برنامج بيكون افضل
ولا مجال للخطأ
دمت سالما
كن كالشمس تضئ الكون بالعلم والاخلاق Idea
الرد }}}
تم الشكر بواسطة: sami2015 , Ahmed_Mansoor
#8
اخي سامي
الكود يعمل بنجاج
اشكرك جزيل الشكر
والشكر موصول للاخ احمد ايضا
ولكن شرح الكود
بارك الله فيك
كن كالشمس تضئ الكون بالعلم والاخلاق Idea
الرد }}}
تم الشكر بواسطة: Ahmed_Mansoor
#9
اخي سامي
الكود يعمل بنجاج
اشكرك جزيل الشكر
والشكر موصول للاخ احمد ايضا
ولكن شرح الكود
بارك الله فيك
كن كالشمس تضئ الكون بالعلم والاخلاق Idea
الرد }}}
تم الشكر بواسطة: Ahmed_Mansoor , Ahmed_Mansoor


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  [سؤال] برنامج تنبيه صوتي ويندوز 10 aboezzat84 0 83 07-01-24, 06:46 PM
آخر رد: aboezzat84
  برنامج VB6 النسخة الفرنسية كاملة الخير طهوري 7 11,935 02-01-24, 06:55 PM
آخر رد: الخير19
  [vb6.0] ريد كود طيع التقرير نسختين علماً انني استخدم برنامج Active Report ؟ Microformt 2 358 12-11-23, 05:05 PM
آخر رد: Microformt
Question [vb6.0] عندي مشكلة في هذا الكود حيث انه لا يقبل الا رقم فقط اريد ان يقبل الارقام والاحرف ؟ Microformt 1 269 25-10-23, 04:10 PM
آخر رد: Amir_Alzubidy
  [vb6.0] سؤال حول تحويل الرقم لعملة في Msflexgrid جلال اليمني 3 408 28-08-23, 07:19 PM
آخر رد: جلال اليمني
Information [vb6.0] كيف اجعل الارقم في التقرير باء الغه الانجليزية حتى لو كان نظام الارقام في الويندوز Microformt 0 179 16-08-23, 10:41 AM
آخر رد: Microformt
  [سؤال] ماهو سبب خروج هذه الرسالة كما في الصورة المرفقة عند تشغيل برنامج الفيجوال بيسك6 وادي العوضي 3 498 24-07-23, 11:50 PM
آخر رد: وادي العوضي
  تحويل أكواد فيصل الحطامي 0 246 09-05-23, 04:45 PM
آخر رد: فيصل الحطامي
  تحويل أكواد فيصل الحطامي 0 227 09-05-23, 04:36 PM
آخر رد: فيصل الحطامي
  تحويل أكواد فيصل الحطامي 1 425 01-03-23, 02:37 AM
آخر رد: Amir_Alzubidy

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم