برنامج يشبه المفكرة ////////// تعديل

البرق الأبيض

البرق الأبيض

New Member
اليكم البرنامج الجديد الذي يشبه المفكرة من حيث فتح الملفات وتعديل عليها وحفظها


البرنامج في الملف المرفق
 

المرفقات

  • shalalfeh word.rar
    6 KB · المشاهدات: 26


ملاحظة

في البرنامج الزر تعليمات يحتوي على معلومات حول البرنامج

لن يعمل هذا الزر وذلك للسبب التالي

لقد ربطت التعليمات بملف نصي موجود في جهازي بالمسار التالي
d:\windows\shhelp.txt
فاذا اردت ان يعمل هذا الزر عليك بانشاء ملف نصي txt في المسار المذكور واكتب فيه ما تشاء من المعلومات بشرط ان تكون المعلومة سطرا واحدا فقط

اما اذا لم يكن المسار المذكور موجودا عندك ,,,, من فضلك انشئه لكي يعمل البرنامج

البرنامج يعمل بشكل صحيح دون زر التعليمات ولكن لكي يكتمل البرنامج



ملاحظة 2

البرنامج قيد التطوير والتعديل وسوف اوافيكم بالنسخة الكاملة ان شاء الله في القريب العاجل

والسلام عليكم
 


كود البرنامج

Dim h1 As String
Dim rr, ss, m As Integer
Public Function readLine(ByRef strFilePath As String, ByVal nLine _
As Integer) As String

Dim NextLine As String
Dim n As Integer
FileNum = FreeFile
Open strFilePath For Input As FileNum
Do Until EOF(FileNum)
Line Input #FileNum, NextLine
n = n + 1
If n = nLine Then readLine = NextLine
Loop
Close
End Function

Private Sub Check1_Click()
If Check1.Value = 1 Then
Text1.FontBold = True
Else
Text1.FontBold = False
End If
End Sub
Private Sub Check2_Click()
If Check2.Value = 1 Then
Text1.FontItalic = True
Else
Text1.FontItalic = False
End If
End Sub
Private Sub Check3_Click()
If Check3.Value = 1 Then
Text1.FontUnderline = True
Else
Text1.FontUnderline = False
End If
End Sub
Private Sub close_Click()
msg = MsgBox("áÞÏ ÇÎÊÑÊ ÇáÃãÑ áÇÛáÇÞ ÇáÈÑäÇãÌ ,,, åá ÇäÊ ãÊÇßÏ ãä Ðáß¿¿¿¿", vbQuestion + vbYesNo, "ÎÑæÌ")
If msg = vbYes Then End
End Sub
Private Sub Combo1_click()
Text1.Font = Combo1
End Sub
Private Sub Combo2_Click()
Text1.FontSize = Combo2
End Sub
Private Sub Form_Load()
For i = 0 To Screen.FontCount
Combo1.AddItem Screen.Fonts(i)
Next
Open "d:\windows\shhelp.txt" For Input As #1
Count:
ss = ss + 1
Line Input #1, X
If EOF(1) Then
Exit Sub
Else
GoTo Count:
End If
Close
End Sub
Private Sub Form_Unload(Cancel As Integer)
Cancel = True
msg = MsgBox("áÞÏ ÇÎÊÑÊ ÇáÃãÑ áÇÛáÇÞ ÇáÈÑäÇãÌ ,,, åá ÇäÊ ãÊÇßÏ ãä Ðáß¿¿¿¿", vbQuestion + vbYesNo, "ÎÑæÌ")
If msg = vbYes Then End
End Sub
Private Sub help_Click()
rr = rr + 1
m = m + 1
If m < 2 Then
MsgBox "ÓæÝ ÊÍÕá Úáì ÇáãÚáæãÇÊ ÇáÂä ,,, ááÍÕæá Úáì ãÚáæãÇÊ ÇÎÑì ÇÖÛØ Úáì ÒÑ ÊÚáíãÇÊ ãÑÉ ÇÎÑì ÈÚÏ ÞÑÇÁÉ ÇáÑÓÇáÉ"
Else
End If
If rr > ss Then
rr = 0
Else
MsgBox readLine("d:\windows\shhelp.txt", rr)
End If
End Sub
Private Sub open_Click()
c1.DefaultExt = ".txt"
c1.ShowOpen
h1 = c1.FileName
Open c1.FileName For Input As #1
Text1 = Input(LOF(1), 1)
Close #1
End Sub
Private Sub save_Click()
Open c1.FileName For Output As #1
Print #1, Text1
Close #1
End Sub
Private Sub saveas_Click()
c1.DefaultExt = ".txt"
c1.ShowSave
Open c1.FileName For Output As #1
Print #1, Text1
Close #1
End Sub
 


شرح البرنامج


هذا الكود لقراءة سطور الملف النصي
Public Function readLine(ByRef strFilePath As String, ByVal nLine _
As Integer) As String

Dim NextLine As String
Dim n As Integer
FileNum = FreeFile
Open strFilePath For Input As FileNum
Do Until EOF(FileNum)
Line Input #FileNum, NextLine
n = n + 1
If n = nLine Then readLine = NextLine
Loop
Close
End Function

وهذا الكود لحساب عدد سطور الملف النصي
Open "d:\windows\shhelp.txt" For Input As #1
Count:
ss = ss + 1
Line Input #1, X
If EOF(1) Then
Exit Sub
Else
GoTo Count:
End If
Close
 
يجب تسجيل الدخول أو التسجيل كي تتمكن من الرد هنا.
عودة
أعلى