تقييم الموضوع :
  • 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 ك ب / التحميلات : 5)
.rar   Ahmed_Mansoor.rar (الحجم : 1.46 ك ب / التحميلات : 10)
كن كالشمس تضئ الكون بالعلم والاخلاق Idea
الرد }}}}
تم الشكر بواسطة:
#4
أهلا أخي الكريم , معليش أرجو المعذره فعلا كان فيه خطأ بسيط , وعند التجربة أكتشف مشكله في الكلماات العربيه فقط أما الأرقام والكلمات الإنجليزية فلامشكلة فيها , المشكله في الكلمة العربيه أن الحرف الأيسر فيها  يكون هو الحرف الأيمن عندما نستخدم دالة جلب الحرف الأيسر للكلمة الدالة Left والعكس صحيح لذلك هذا الشئ سبب لخبطه في أظهار النتيجة للكلمة العربيه فقط لذلك لابد من قلب العمليه لتظهر النتيجة بالشكل الذي تريده , ولذلك لابد من أن نعرف هل الكلمة عربيه أم لا قبل البدء في عمل الكود لذلك وضع أداتين أوبشن بوكس لذلك , لكي يعمل الكود بالشكل الصحيح .


الملفات المرفقة
.rar   Ahmed_Mansoor_1.rar (الحجم : 2.05 ك ب / التحميلات : 10)
الرد }}}}
تم الشكر بواسطة: 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


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  فتح برنامج مبرمج بالفيجوال بيسك6 و قاعدة بيانات MYSQL Ahmed Salem12 1 65 01-12-16, 03:40 PM
آخر رد: sendbad100
  [سؤال] احتاج مساعده في برنامج موعد الحضور والانصراف mera 6 320 30-11-16, 10:59 PM
آخر رد: فاطمة غ
  ود ان اضيف هذه الارقام مع بعضها في تكست ثالث و وضع علامة ( / ) بينهما allobaed 3 95 23-11-16, 02:08 PM
آخر رد: sendbad100
  برنامج فجوال ستوديو 6 اسلام الكبابى 5 153 05-11-16, 11:10 PM
آخر رد: اسلام الكبابى
  برنامج القسمة المطولة احمداحمداحمد6 1 82 30-10-16, 01:22 AM
آخر رد: Ahmed_Mansoor
  [vb6.0] كيف اجعل عند إدارج مسار الصورة في Text تظهر الصوره في برنامج المرفق ؟؟ Microformt 1 90 07-10-16, 12:37 PM
آخر رد: Amir_alzubidy
Question [vb6.0] كيف يمكن إدراج مسار الصورة في التكس بوكس في برنامج المرفق ؟؟ Microformt 1 134 01-10-16, 06:25 PM
آخر رد: Amir_alzubidy
  مساعدة فى عمل برنامج بسيط hithemlion 23 625 27-09-16, 05:22 PM
آخر رد: Amir_alzubidy
  [vb6.0] طلب تعديل على برنامج iisys 21 604 23-09-16, 03:03 PM
آخر رد: iisys
  اريد برنامج لتعلم الحروف الانجليزية عبدالله الجذيلات 0 112 04-08-16, 03:01 PM
آخر رد: عبدالله الجذيلات

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


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