Форум на Исходниках.RU

Форум на Исходниках.RU https://forum.sources.ru Форум на Исходниках.RU Форум на Исходниках.RU https://forum.sources.ru/index.php?showtopic=64106&view=findpost&p=443423 Fri, 27 Aug 2004 17:26:27 +0000 Пишем текстовой редактор https://forum.sources.ru/index.php?showtopic=64106&view=findpost&p=443423 Все очень просто. Кидаем на форму Common Dialog и называем его
CD3. Теперь пора добавить меню mnuColor. Пишем
код для него:

Private Sub mnuColor_Click()

CD3.ShowColor 'Вызываем диалог выбора цвета

txtMain.ForeColor=CD3.Color

End Sub

В программу еще можно добавить много функций. Например, можно
добавить тулбар, только при этом нужно учитывать его при изменении
размеров формы. Пример для этой статьи я выложу позже.]]> miksayer Разное (кодинг) https://forum.sources.ru/index.php?showtopic=64106&view=findpost&p=442419 Thu, 26 Aug 2004 18:55:32 +0000 Пишем текстовой редактор https://forum.sources.ru/index.php?showtopic=64106&view=findpost&p=442419 Добавим меню 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 Разное (кодинг) https://forum.sources.ru/index.php?showtopic=64106&view=findpost&p=442021 Thu, 26 Aug 2004 11:20:28 +0000 Пишем текстовой редактор https://forum.sources.ru/index.php?showtopic=64106&view=findpost&p=442021 Для начала создадим новый проект, переименуем главную форму в 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

Далее пишем код для 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

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

Код для 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 Разное (кодинг)