منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب قسم لغة الفيجوال بيسك VB.NET قسم مقالات VB.NET كـيـف تـصـنـع مـفـكـرة رائـعـة ( بـــــالـــــصــــــور ) !!!
موضوع مغلق 
تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
ادوات الموضوع
كـيـف تـصـنـع مـفـكـرة رائـعـة ( بـــــالـــــصــــــور ) !!!
RaggiTech غير متصل
مراقب منتدى
المشاركات : 2,523
المواضيع 707
الإنتساب : Sep 2012
السمعة : 48
الشكر: 91
تم شكره 1120 مرات في 307 مشاركات
#2
04-10-12, 01:06 PM (آخر تعديل لهذه المشاركة : 04-10-12, 01:15 PM {2} بواسطة محمود رغمان.)
كاتب المشاركة : أنس محمود

قم باضافة الادوات واعداد النافذة عن كالتالي :-


الان الى الاكواد ===>


ثانيا : الاكواد والاوامر :-

1- الاوامر الخاصة بالنموذج الاول ( form1 ) :-

قبل تعريف الكلاس ( قبل PublicClass Form1 ) قم بكتابة :-


كود :
Option Strict Off
Option Explicit On
Imports VB = Microsoft.VisualBasic
بعد تعريف الكلاس ( في قسم التصريحات العامة ) أكتب :-

كود :
Inherits System.Windows.Forms.Form
Dim path As String, ch As Boolean = False
السطر الثاني لتصريح متغيرين ، أحدهما سيحمل مسار الملف الحالي ، والاخر لاختبار ما اذا اجرى المستخدم تعديلات ام لا ،
[SIZE=2]اما السطر الاول ، فوجدته بمثال لمايكروسوفت ، ولا أدري لما هو ،
الان سنقوم بتعريف مجموعة اجراءات
* اجراء لانشاء امتاد خاص بالمفكرة ، وجعل المفكرة افتراضية لهذا الامتداد كما وضحت في موضوعي هذا :-
[/SIZE]

كود :
Sub NewFileType(ByRef ProgramPath As String, ByVal Extension As String _
, ByRef FileIcon As String, ByRef Description As String)
Dim W As Object
Dim E As String
W = CreateObject("Wscript.shell")
If VB.Left(Extension, 1) <> "." Then
E = "." & Extension & "\"
Else
E = Extension & "\"
Extension = Mid(Extension, 2)
End If
W.regwrite("HKCR\" & E, Extension & " File")
W.regwrite("HKCR\" & Extension & " File\", Description)
W.regwrite("HKCR\" & Extension & " File\DefaultIcon\", FileIcon)
W.regwrite("HKCR\" & Extension & " File\Shell\Open\Command\", ProgramPath & " %1")
W.regwrite("HKCR\" & Extension & " File\Shell\", "Open")
End Sub
الان اجراء للحفظ :-

كود :
Sub do_save()
If path = "" Then
Dim s As New SaveFileDialog
s.Filter = "جميع الملفات|*.*|ملفات مفكرة أنس (ans)|*.ans|txt|*.txt"
If s.ShowDialog = Windows.Forms.DialogResult.OK Then
Me.RichTextBox1.SaveFile(s.FileName)
path = s.FileName
ch = False
End If
Else
Me.RichTextBox1.SaveFile(path)
ch = False
End If
Me.Text = "مفكرة أنس العربية - " & IO.Path.GetFileNameWithoutExtension(path)
End Sub
في الاجراء السابق ، يتم اختبار ما اذا المفكرة لا تحوي مسارا ، وبذلك يتم الحفظ باسم

، والان اجراء للفتح :-


كود :
Sub do_open()
If ch = True Then
Dim x As DialogResult = MsgBox("هل تريد حفظ التغيرات ؟", MsgBoxStyle.Question + MsgBoxStyle.YesNoCancel)
If x = Windows.Forms.DialogResult.Cancel Then
Exit Sub
ElseIf x = Windows.Forms.DialogResult.Yes Then
do_save()
End If
End If
Dim o As New OpenFileDialog
o.Filter = "جميع الملفات|*.*| ملفات مفكرة أنس )ans(|*.ans|txt|*.txt"
If o.ShowDialog = Windows.Forms.DialogResult.OK Then
Try
Me.RichTextBox1.LoadFile(o.FileName)
Catch ex As Exception
Me.RichTextBox1.Text = My.Computer.FileSystem.ReadAllText(o.FileName)
End Try
path = o.FileName
ch = False
Me.Text = "مفكرة أنس العربية - " & IO.Path.GetFileNameWithoutExtension(path)
End If
End Sub

يتم اختبار التغييرات ، والسؤال عن حفظ التغييرات ام لا ، في حالة نعم يتم

استدعاء الاجراء الخاص بالحفظ ، في حالة الغاء الامر ، لا يتم عمل ش

* الاجراء جديد :-

كود :
Sub get_new()
If ch = True Then
Dim x As DialogResult = MsgBox("هل تريد حفظ التغيرات ؟", MsgBoxStyle.Question + MsgBoxStyle.YesNoCancel)
If x = Windows.Forms.DialogResult.Cancel Then
Exit Sub
ElseIf x = Windows.Forms.DialogResult.Yes Then
do_save()
End If
End If
Me.RichTextBox1.Text = ""
Me.ch = False
Me.path = ""
Me.Text = "مفكرة أنس العربية - " & IO.Path.GetFileNameWithoutExtension(path)
End Sub
[SIZE=2]يتم ايضا اختبار التغييرات ، ( احفظ ام لا)،


الأن الى الاحداث :-
في الحدث [SIZE=2]FormClosing للنموذج أكتب :-[/SIZE]
[/SIZE]


كود :
If ch = True Then
Dim x As DialogResult = MsgBox("هل تريد حفظ التغيرات ؟", MsgBoxStyle.Question + MsgBoxStyle.YesNoCancel)
If x = Windows.Forms.DialogResult.Cancel Then
e.Cancel = True
ElseIf x = Windows.Forms.DialogResult.Yes Then
do_save()
End If
End If
في الحدث load للنموذج اكتب :-

كود :
If Trim(VB.Command()) <> "" Then
If Dir(Trim(VB.Command())) <> "" Then
Try
RichTextBox1.LoadFile(Trim(VB.Command()))
Catch ex As Exception
Try
RichTextBox1.LoadFile(Trim(VB.Command()))
Catch eh As Exception
Me.RichTextBox1.Text = My.Computer.FileSystem.ReadAllText(Trim(VB.Command()))
End Try
End Try
ch = False
path = Trim(VB.Command())
End If
End If
Me.Office2007ColorPicker1.Color = Me.RichTextBox1.ForeColor
For Each MyFontFamily As FontFamily In System.Drawing.FontFamily.Families
ComboBox1.Items.Add(MyFontFamily.Name)
Next
For a As Integer = 1 To 100
Me.ComboBox2.Items.Add(a)
Next
Me.ComboBox1.Text = Me.RichTextBox1.Font.Name
Me.ComboBox2.Text = Me.RichTextBox1.Font.Size
في الاسطر الاولى يتم جلب النص من الملف النصي في حالة تم فتحه باستخدامه ، اما السطر الاوسط فهو لجعل قيمة اللون للاداة مثل لون النص ، الاسطر القبل الاخيرة لاضافة الخطوط للاداة ComboBox1 ، الاسطر الاخيرة، لاضاقة الارقام من 1 الى 100 لتغيير حجم الخط ، ثم اسدال قيمة نوع الخط الى الاداة combobox الخاص بالخط ، وكذلك جحجمه ،
في الحدث SelectedColorChanged للاداة Office2007ColorPicker1 أكتب :-

كود :
Me.RichTextBox1.SelectionColor = Me.Office2007ColorPicker1.Color
الكود السابق لتغيير لون النص المحدد حسب اللون المختار من الاداة ،

في الحدث TextChanged للـ RichTextBox1 أكتب :-


كود :
ch = True
في الحدث SelectedIndexChanged للـ comboBox الخاص بالخطوط :-

كود :
Try
Me.RichTextBox1.SelectionFont = New Font(Me.ComboBox1.SelectedItem.ToString, Me.RichTextBox1.SelectionFont.Size, Me.RichTextBox1.SelectionFont.Style)
Catch ex As Exception
End Try
في الحدث SelectedIndexChanged للـ comboBox الخاص بحجم الخط :-

كود :
Try
Me.RichTextBox1.SelectionFont = New Font(Me.RichTextBox1.SelectionFont.FontFamily, Me.ComboBox2.SelectedItem, Me.RichTextBox1.SelectionFont.Style)
Catch ex As Exception
End Try
الان الى الاحداث click للازرار الخاصة بالقوائم وشريط الادوات :-

الزر الخاص بتعدبل شفافية المفكرة :-

كود :
Dim x As Single = Me.Opacity
If Dialog1.ShowDialog = Windows.Forms.DialogResult.Cancel Then
Dialog1.NumericUpDown1.Value = x * 100
End If
حفظ باسم :-

كود :
Dim s As New SaveFileDialog
s.Filter = "جميع الملفات|*.*| ملفات مفكرة أنس )ans(|*.ans|txt|*.txt"
If s.ShowDialog = Windows.Forms.DialogResult.OK Then
Me.RichTextBox1.SaveFile(s.FileName)
path = s.FileName
ch = False
Me.Text = "مفكرة أنس العربية - " & IO.Path.GetFileNameWithoutExtension(path)
End If
بحث واستبدال :-


كود :
Dialog2.Show()
قص :-

كود :
Me.RichTextBox1.Cut()
نسخ :-

كود :
Me.RichTextBox1.Copy()
لصق :-

كود :
Me.RichTextBox1.Paste()
تراجع :-

كود :
Me.RichTextBox1.Undo()
اعادة :-

كود :
Me.RichTextBox1.Redo()
تحديد الكل :-

كود :
Me.RichTextBox1.SelectAll()
حفظ :-

كود :
do_save()
فتح :-
كود :
do_open()
جديد :-

كود :
get_new()
اغلاق :-

كود :
Me.Close()

تغيير نوع الخط للنص المحدد ( ادوات - خيارات - تغيير نوع الخط - النص المحدد ) وفي شريط الادوات :-

كود :
Dim f As New FontDialog
f.Font = Me.RichTextBox1.SelectionFont
       If f.ShowDialog = Windows.Forms.DialogResult.OK Then
Me.RichTextBox1.SelectionFont = f.Font
       End If
تغيير نوع الخط لكل النص ( ادوات - خيارات - تغيير نوع الخط - كل النص ) :-

كود :
Dim f As New FontDialog
        If f.ShowDialog = Windows.Forms.DialogResult.OK Then
           Me.RichTextBox1.Font = f.Font
       End If
تغيير لون الخط للنص المحدد ( ادوات - خيارات - تغيير لون الخط - النص المحدد ) :-

كود :
Dim c As New ColorDialog
       c.Color = Me.RichTextBox1.SelectionColor
       If c.ShowDialog = Windows.Forms.DialogResult.OK Then
Me.RichTextBox1.SelectionColor = c.Color
       End If
تغيير لون الخط لكل النص ( ادوات - خيارات - تغيير لون الخط - كل النص ) :-

كود :
Dim c As New ColorDialog
       If c.ShowDialog = Windows.Forms.DialogResult.OK Then
            Me.RichTextBox1.ForeColor = c.Color
       End If
تغيير لون الخلفية :-

كود :
Dim c As New ColorDialog
       If c.ShowDialog = Windows.Forms.DialogResult.OK Then
           Me.RichTextBox1.BackColor = c.Color
        End If
عن ( في قائمة مساعدة ، وشريط الادوات ) :-

كود :
AboutBox1.Show()
اعداد المفكرة :-

كود :
NewFileType((Application.ExecutablePath), ("ans"), (Application.StartupPath & "\برنامج.ico"), ("ملفات مفكرة أنس العربية"))        MsgBox("تم اعداد المفكرة بنجاح")
لاحظ كتابه مسار البرنامج ، واسم الامتداد ، مسارالايقونة ، التوضيح عن الامتداد ، كما وضحت مسبقا ،

الان المحاذاة لليمين : -

كود :
Me.RichTextBox1.SelectionAlignment = HorizontalAlignment.Right
المحاذاة للوسط :-

كود :
Me.RichTextBox1.SelectionAlignment = HorizontalAlignment.Center
المحاذاة لليسار :-

كود :
Me.RichTextBox1.SelectionAlignment = HorizontalAlignment.Left
الزر عريض bold :-

كود :
Dim newFontStyle As System.Drawing.FontStyle
       If Me.RichTextBox1.SelectionFont.Bold = True Then
            newFontStyle = FontStyle.Regular
Else
newFontStyle = FontStyle.Bold + Me.RichTextBox1.SelectionFont.Style
       End If
        Me.RichTextBox1.SelectionFont = New Font(Me.RichTextBox1.SelectionFont.FontFamily, Me.RichTextBox1.SelectionFont.Size, newFontStyle)
مائل :-

كود :
Dim newFontStyle As System.Drawing.FontStyle
       If Me.RichTextBox1.SelectionFont.Italic = True Then
           newFontStyle = FontStyle.Regular      
  Else
      newFontStyle = FontStyle.Italic + Me.RichTextBox1.SelectionFont.Styl
      
End If
       Me.RichTextBox1.SelectionFont = New Font(Me.RichTextBox1.SelectionFont.FontFamily, Me.RichTextBox1.SelectionFont.Size, newFontStyle)
تحته خط :-

كود :
Dim newFontStyle As System.Drawing.FontStyle
       If Me.RichTextBox1.SelectionFont.Underline = True Then
           newFontStyle = FontStyle.Regular
Else

newFontStyle = FontStyle.Underline + Me.RichTextBox1.SelectionFont.Style
       End If
       Me.RichTextBox1.SelectionFont = New Font(Me.RichTextBox1.SelectionFont.FontFamily, Me.RichTextBox1.SelectionFont.Size, newFontStyle)
الان انتهينا من الكود الخاص بالنموذج الاول ( form1 ) ،

الكود الخاص بالمربع الحواري للشفافية :-
حتجد الكود الخاص بنتيجة المربع الحواري مكتوب ، الان في حدث الـ ValueChanged للاداة NumericUpDown1 أكتب :-

كود :
Form1.Opacity = Me.NumericUpDown1.Value / 100

الكود الخاص بالمربع الحواري للبحث والاستبدال :-

قي قسم التصريحات العامة اكتب :-

كود :
Dim find As Boolean Dim x As Integer
في زر البحث عن التالي أكتب :-

كود :
If Not Me.TextBox1.Text = "" Then
           find = False  
         Me.Hide()
           Do Until find = True
Form1.RichTextBox1.Select(x, Me.TextBox1.TextLength)
               If Form1.RichTextBox1.SelectedText = Me.TextBox1.Text Then
                    find = True
               End If
               If x = Form1.RichTextBox1.TextLength Then
                    x = 0
                    find = True
                   MsgBox("انتهى البحث", MsgBoxStyle.Information)
x = -1
                End If
               x = x + 1
           Loop
            Me.Show()
        End If
في زر استبدال الحالى :-

كود :
If Not Form1.RichTextBox1.SelectionLength = 0 Then
Form1.RichTextBox1.SelectedText = Me.TextBox2.Text
End If
في زر بحث واستبدال الكل :-

كود :
If Not Me.TextBox1.Text = "" Then
           find = False
Me.Hide()
           Do Until find = True
Form1.RichTextBox1.Select(x, Me.TextBox1.TextLength)
If Form1.RichTextBox1.SelectedText = Me.TextBox1.Text Then
                    Form1.RichTextBox1.SelectedText = Me.TextBox2.Text
               End If
               If x = Form1.RichTextBox1.TextLength Then
                    x = 0
                   find = True
                   MsgBox("تمت العملية بنجاح", MsgBoxStyle.Information)
x = -1
               End If
x = x + 1
           Loop
           Me.Show()
       End If
في زر انتهى :-

كود :
Me.Hide()
find = False
x = 0
الكود الخاص بالمربع عن :-

في زر انتهى اكتب :-

كود :
Me.Hide()
هذا كل شي ،،

المثال الذي صنعناه :- ( طبعا حذفت الملفات التنفيذية الموجودة فية عشان مايكونش فيه فايروس ! ) :-
http://vb4arb.com/vb/uploaded/18_01349341566.zip
وعلى فكرة انت ممكن تشغب دماغك شويه وتعمل احسن من كدة

وهذه مفكرة صنعتها انا ( أيضا حذفت الملفات التنفيذية الموجودة فية عشان مايكونش فيه فايروس ! ) :-

http://vb4arb.com/vb/uploaded/18_11349341566.zip
================================================== =====
واتمنى يكون عجبكم الشرح ،
والسلام عليكم ورحمة الله وبركاته ،،
متغيب
الموقع البحث
}}}
تم الشكر بواسطة:
موضوع مغلق 


الردود في هذا الموضوع
كـيـف تـصـنـع مـفـكـرة رائـعـة ( بـــــالـــــصــــــور ) !!! - بواسطة Raggi Tech - 04-10-12, 01:06 PM

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


يقوم بقرائة الموضوع: