كاتب المشاركة : أنس محمود
قم باضافة الادوات واعداد النافذة عن كالتالي :-
الان الى الاكواد ===>
ثانيا : الاكواد والاوامر :-
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 أكتب :-
في الحدث 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
بحث واستبدال :-
قص :-
كود :
Me.RichTextBox1.Cut()
نسخ :-
كود :
Me.RichTextBox1.Copy()
لصق :-
كود :
Me.RichTextBox1.Paste()
تراجع :-
كود :
Me.RichTextBox1.Undo()
اعادة :-
كود :
Me.RichTextBox1.Redo()
تحديد الكل :-
كود :
Me.RichTextBox1.SelectAll()
حفظ :-
فتح :-
جديد :-
اغلاق :-
تغيير نوع الخط للنص المحدد ( ادوات - خيارات - تغيير نوع الخط - النص المحدد ) وفي شريط الادوات :-
كود :
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
عن ( في قائمة مساعدة ، وشريط الادوات ) :-
اعداد المفكرة :-
كود :
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
الكود الخاص بالمربع عن :-
في زر انتهى اكتب :-
هذا كل شي ،،
المثال الذي صنعناه :- ( طبعا حذفت الملفات التنفيذية الموجودة فية عشان مايكونش فيه فايروس ! ) :-
http://vb4arb.com/vb/uploaded/18_01349341566.zip
وعلى فكرة انت ممكن تشغب دماغك شويه وتعمل احسن من كدة
وهذه مفكرة صنعتها انا ( أيضا حذفت الملفات التنفيذية الموجودة فية عشان مايكونش فيه فايروس ! ) :-
http://vb4arb.com/vb/uploaded/18_11349341566.zip
================================================== =====
واتمنى يكون عجبكم الشرح ،
والسلام عليكم ورحمة الله وبركاته ،،