Пишем текстовой редактор , статья для новичков

[miksayer]

Эта статья предназначена для новичков, так как проффесиональному программисту не составит труда написать такую программу.
Для начала создадим новый проект, переименуем главную форму в frmMain. Добавим текстовое поле(Name = txtMain,
Multiline = True, ScrollBars = 3). Теперь пишем слюдующий код:

Private Sub Form_Resize()
txtMain.Left=0
txtMain.Top=0
txtMain.Width=Me.Width
txtMain.Height=Me.Height
End Sub

Теперь при изменении размеров формы изменяется и размер текстового поля. Теперь добавим меню Файл с именем mnuFile и несколько подменю Новый - mnuNew, Открыть - mnuOpen, Сохранить - mnuSave, Сохранить как - mnuSaveAs, Печать - mnuPrint, Выход - mnuExit. Теперь объявим две переменные:

Dim old As Boolean
Dim change As Boolean

Переменная old будет определять старый ли файл или только, что созданный, а переменная change определяет были ли сделаны изменения в тексте. Теперь добавим Microsoft Common Dialog(Project->Components), назовем его CD1. Пишем код для mnuSaveAs:

Private Sub mnuSaveAs_Click()
CD1.ShowSave ' диалог сохранения файлов
If CD1.FileName <> "" Then ' определяем не нажал ли юзер кнопку Отмена
Open CD1.FileName For Output As #1 ' открываем файл
Print #1, txtMain.Text ' записываем текст из текстового поля
Close #1 ' закрываем файл
End If
End Sub

Вставляем следующий код в событие mnuSave_Click:

If Old = True Then ' определяем был ли открыт файл или его только, что создали
Open CD1.FileName For Output As #1 ' открываем файл
Print #1, txtMain.Text ' записываем текст из текстового поля
Close #1 ' закрываем файл
Else ' если файл был только что создан
CD1.ShowSave
If CD1.FileName <> "" Then
Open CD1.FileName For Output As #1 ' открываем файл
Print #1, txtMain.Text ' записываем текст из текстового поля
Close #1 ' закрываем файл
End If
End If

Далее пишем код для mnuNew, он немного сложноват:

Private Sub mnuNew_Click()
If change = True Then ' если были сделаны изменения
Dim Ans
Ans = MsgBox("Сохранить изменения?", vbQuestion + vbYesNoCancel, "Текстовой редактор")
If Ans = vbNo Then
txtMain.Text = ""
old = False
change = False
ElseIf Ans = vbYes Then
'СОХРАНЕНИЕ ФАЙЛА
mnuSave_Click
txtMain.Text = ""
old = False
change = False
End If
Else ' если изменений нет
txtMain.Text = ""
old = False
change = False
End If
End Sub

Примерно тоже самое для mnuOpen:

Private Sub mnuOpen_Click()
If change = True Then
Dim Ans
Ans = MsgBox("Сохранить изменения?", vbQuestion + vbYesNoCancel, "Текстовой редактор")
If Ans = vbNo Then
'ОТКРЫТИЕ ФАЙЛА
CD1.ShowOpen
If CD1.FileName <> "" Then
Open CD1.FileName For Input As #1
Do Until EOF(1)
Line Input #1, txt
AllTxt = AllTxt + txt + vbCrLf
Loop
Close #1
txtMain.Text = AllTxt
old = True
change = False
End If
ElseIf Ans = vbYes Then
'СОХРАНЕНИЕ ФАЙЛА
mnuSave_Click()
'ОТКРЫТИЕ ФАЙЛА
CD1.ShowOpen
If CD1.FileName <> "" Then
Open CD1.FileName For Input As #1
Do Until EOF(1)
Line Input #1, txt
AllTxt = AllTxt + txt + vbCrLf
Loop
Close #1
txtMain.Text = AllTxt
old = True
change = False
End If
End If
Else
'ОТКРЫТИЕ ФАЙЛА
CD1.ShowOpen
If CD1.FileName <> "" Then
Open CD1.FileName For Input As #1
Do Until EOF(1)
Line Input #1, txt
AllTxt = AllTxt + txt + vbCrLf
Loop
Close #1
txtMain.Text = AllTxt
old = True
change = False
End If
End If[/QUOTE]
Еще пишем такой код:
[QUOTE]Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If сhange = True Then
Dim Ans
Ans = MsgBox("Сохранить изменения?", vbQuestion + vbYesNoCancel, "Текстовой редактор")
If Ans = vbNo Then
End
ElseIf Ans = vbYes Then
mnuSave_Click
End
Else
Cancel = -1
End If
End If
Код для mnuExit:
Private Sub mnuExit_Click()
If change = True Then
Dim Ans
Ans = MsgBox("Сохранить изменения?", vbQuestion + vbYesNoCancel, "Mik HTML Editor")
If Ans = vbNo Then
End
ElseIf Ans = vbYes Then
mnuSave_Click
End
End If
Else
End
End If
End Sub

Пишем код для печати текста:

Private Sub mnuPrint_Click()
Printer.Print txtMain.Text
Printer.EndDoc
End Sub

Мы написали код для всех подменю меню Файл. Теперь добавим меню Правка(Name = mnuEdit) и
несколько подменю Отменить - mnuUndo, Вырезать - mnuCut, Копировать - mnuCopy,
Вставить - mnuPaste, Удалить - mnuRemove, Выделить все - mnuSelectAll. Пишем код:

Private Sub mnuCut_Click()
Clipboard.SetText txtMain.SelText
txtMain.Text = ""
End Sub
Private Sub mnuCopy_Click()
Clipboard.SetText txtMain.SelText
End Sub
Private Sub mnuPaste_Click()
txtMain.SelText = Clipboard.GetText
End Sub
Private Sub mnuRemove_Click()
txtMain.SelText = ""
End Sub
Private Sub mnuSelectAll_Click()
txtMain.SelStart = 0
txtMain.SelLength = Len(txtMain.Text)
End Sub

Теперь объявим API-функцию SendMessage и константу EM_UNDO:

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Private Const EM_UNDO = &HC7

А вот и код для mnuUndo:

Private Sub mnuUndo_Click()
Call SendMessage(txtMain.hwnd, EM_UNDO, 0, 0)
End Sub

Вот вы и написали свой первый текстовой редактор!

Сообщение отредактировано: miksayer - 26.08.04, 11:44

[miksayer]

Давайте немного усовершенствуем нашу программу, добавим поиск и выбор шрифта.
Добавим меню mnuFind(Caption = Поиск).
Пишем код для mnuFind:

 
frmFind.Show

Теперь добавим форму frmFind(BorderStyle = 1). На форму кидаем
текстовое поле txtFind и кнопку cmdFind(Caption = Поиск).
Объявим переменную:

Dim P As Integer

Пишем код для события Form_Load:

P = 1

Потом код кнопки:

 
Private Sub cmdFind_Click()
If InStr(P, frmMain.txtMain.Text, txtFind.Text) <> 0 Then
' Если искомое слово присутствует то...
frmMain.txtMain.SetFocus
' Текстовое поле с главным текстом получает фокус:)
frmMain.txtMain.SelStart = InStr(P, frmMain.txtMain.Text, txtFind.Text) - 1
'Начинаем выделять слово...
frmMain.txtMain.SelLength = Len(txtFind.Text) ' Завершаем выделение
P = InStr(P, frmMain.txtMain.Text, txtFind.Text) + Len(txtFind.Text)
' Изменяем переменную на позицию курсора
frmFind.WindowState = 1
Else ' Если в тексте больше нет искомого слова, то выводим об этом сообщение.
MsgBox "Искомое слово не найдено"
End If
End Sub

Простейший поиск готов!
Теперь сделаем выбор шрифта. На главную форму(frmMain) добавим меню
mnuFont с Caption = Шрифт и Common Dialog с Name = CD2.
Пишем код для этого меню:

 
CD2.Flags = cdlCFBoth Or cdlCFEffects Or cdlCFLimitSize Or cdlCFTTOnly Or dlCFForceFontExist
CD2.Min = 8 'минимальный размер шрифта
CD2.Max = 22 'максимальный размер шрифта
CD2.ShowFont 'открываем диалог шрифтов
txtMain.FontName = CD2.FontName
'имя шрифта для текстового поля будет равно выбранному в диалоге
txtMain.FontBold = CD2.FontBold
'таже редиска, но для тольщены (жирный или нет)
txtMain.FontItalic = CD2.FontItalic '~, но для наклона
txtMain.FontStrikethru = CD2.FontStrikethru '~, для зачёркнуттости
txtMain.FontUnderline = CD2.FontUnderline '~, для подчёркнуттости
txtMain.FontSize = CD2.FontSize 'собственно размер шрифта

Все! Мы усовешенствовали нашу программу!

Сообщение отредактировано: miksayer - 26.08.04, 18:57

[miksayer]

Давайте добавим в нашу программу функцию выбора цвета текста.
Все очень просто. Кидаем на форму Common Dialog и называем его
CD3. Теперь пора добавить меню mnuColor. Пишем
код для него:

 
Private Sub mnuColor_Click()
CD3.ShowColor 'Вызываем диалог выбора цвета
txtMain.ForeColor=CD3.Color
End Sub

В программу еще можно добавить много функций. Например, можно
добавить тулбар, только при этом нужно учитывать его при изменении
размеров формы. Пример для этой статьи я выложу позже.

Сообщение отредактировано: miksayer - 27.08.04, 17:27