Сайт Алексея Муртазина (Star Cat) E-mail: starcat @ nm.ru

Мои программы Новости сайта Мои идеи Мои стихи Форум Моё фото Мой ЖЖ Заработай!!! VB коды Статьи о VB6 API функции VB.NET Более 3000 ссылок Интернет Все работы с фото и видео Сайт о моём деде Муртазине ГР Картинная галерея "Дыхание души"

Объект CommonDialog

   'ОТКРЫТЬ ФАЙЛ
Public Sub OpenFile()
    Dim F As Long, NmFile As String
    With Form1.CommonDialog1
        .FileName = vbNullString
        .Flags = 0
        .ShowOpen
        If .Flags = 0 Then Exit face="Times New Roman" sub
        NmFile = .FileName
    End With
    On Error Resume Next
    Open NmFile For Input As #1
    If Err Then
        If Err = 53 Then
             MsgBox "Файл не найден.", vbCritical, "Ошибка"
         Else
             MsgBox "Файл открыть не возможно.", vbCritical, "Ошибка"
         End If
    Else
        With Form1
            .Text1.Text = Input(LOF(1), 1)
            .IzmText = False
            .NameFile = NmFile
            F = InStrRev(NmFile, "\")
            .Caption = Right$(NmFile, Len(NmFile) - F)
        End With
    End If
    Close #1
End Sub

'Сохранить Файл
Public Sub SaveFile(ByVal NmFile As String)
    Dim F As Long, H As String
    If .NameFile <> NmFile Then
        On Error Resume Next
        F = FileLen(NmFile)
        If Err = 0 Then
            H = "Файл уже существует." & vbCrLf & "Заменить его?"
            If MsgBox(H, , vbCritical, "Ошибка") = vbNo Then Exit face="Times New Roman" sub
        End If
        F = 1
    End If
    On Error Resume Next
    Open NmFile For Output As #1
        If Err Then
            If Err = 75 Then
                MsgBox "Файл защищён от записи.", vbCritical, "Ошибка"
            Else
                MsgBox "Файл сохранить не возможно.", vbCritical, "Ошибка"
            End If
        Else
            With Form1
                Print #1, .Text1.Text
                .IzmText = False
                If F Then
                    .NameFile = NmFile
                    F = InStrRev(NmFile, "\")
                    .Caption = Right$(NmFile, Len(NmFile) - F)
                End If
            End With
        End If
    Close #1
End Sub

Public NameFile As String
Public IzmText As Boolean

Private Sub Form_Load()
    CommonDialog1.InitDir = App.Path ' Выбор открываемой папки
End Sub

Private Sub Form_Resize()
    If WindowState <> vbMinimized Then Text1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub

Private Sub Form_Unload(Cancel As Integer)
     If IzmText = True Then
        Dim F As Long
        F = MsgBox("Сохранить изменение в тексте?", 307)
        If F = vbYes Then
            mFileSave_Click
        ElseIf F = vbCancel Then
            Cancel = 1
        End If
    End If
End Sub

Private Sub mFileBackColor_Click()
    Dim C As Long
    CommonDialog1.Color = 0
    CommonDialog1.ShowColor
    C = CommonDialog1.Color
    If C Then Text1.BackColor = C
End Sub

Private Sub mFileExit_Click()
    Unload Me
End Sub

Private Sub mFileFontColor_Click()
    Dim C As Long
    CommonDialog1.Color = 0
    CommonDialog1.ShowColor
    C = CommonDialog1.Color
    If C Then Text1.ForeColor = C
End Sub

Private Sub mFileNew_Click()
     If IzmText = True Then
        Dim F As Long
        F = MsgBox("Сохранить изменение в тексте?", 307)
        If F = vbYes Then
            mFileSave_Click
        ElseIf F = vbCancel Then
            Exit face="Times New Roman" sub
        End If
    End If
    IzmText = False
    NameFile = vbNullString
    Caption = vbNullString
    Text1.Text = vbNullString
End Sub

Private Sub mFileNewFont_Click()
    With CommonDialog1
        .Flags = cdlCFScreenFonts
        .ShowFont
        Text1.Font = .FontName
        Text1.FontSize = .FontSize
        Text1.FontBold = .FontBold
        Text1.FontItalic = .FontItalic
        Text1.FontUnderline = .FontUnderline
    End With
End Sub

Private Sub mFileOpen_Click()
     If IzmText = True Then
        Dim F As Long
        F = MsgBox("Сохранить изменение в тексте?", 307)
        If F = vbYes Then
            mFileSave_Click
        ElseIf F = vbCancel Then
            Exit face="Times New Roman" sub
        End If
    End If
    OpenFile
End Sub

 'СОХРАНИТЬ ФАЙЛ
Private Sub mFileSave_Click()
    If Len(NameFile) Then
        SaveFile NameFile
    Else
        mFileSaveAs_Click
    End If
End Sub

Private Sub mFileSaveAs_Click()
    With CommonDialog1
        .FileName = NameFile
        .Flags = 0
        .ShowSave
        If .Flags = 0 Then Exit face="Times New Roman" sub
        SaveFile .FileName
    End With
End Sub

Private Sub Text1_Change()
    IzmText = True
End Sub

Заказ программ! Вы можете заказать у меня написание необходимой вам программы. Чем популярнее будет она, тем меньше стоит работа. Инфо Сайт создан: 3 февраля 2000 г.