Programming Forums
User Name Password Register
 

RSS Feed
FORUM INDEX | TODAY'S POSTS | UNANSWERED THREADS | ADVANCED SEARCH

Reply
Page 2 of 2 < 1 2
 
Thread Tools Display Modes
Old Aug 25th, 2005, 8:36 AM   #11
cloud-
Hobbyist Programmer
 
Join Date: Jan 2005
Posts: 110
Rep Power: 4 cloud- is on a distinguished road
okay
heres the frmDocument code..
controls:
(Toggle Plain Text) 
TV1 = treeview control
cd1 = common dialog control
label1
label2
command1 
command2
command3
command4
(Toggle Plain Text) 
' frmDocument.frm
Public Function ProjectWindow(Hide As Boolean)
If (Hide = False) Then
Me.Hide
ElseIf (Hide = True) Then
Me.Show
End If
End Function

Private Sub Command3_Click()
If (TV1.SelectedItem.Key = "root1") Or (TV1.SelectedItem.Key = "root2") Or (TV1.SelectedItem.Key = "root3") Or (TV1.SelectedItem.Key = "Scripts1_root") Or (TV1.SelectedItem.Key = "Scripts2_root") Or (TV1.SelectedItem.Key = "Video1_root") Or (TV1.SelectedItem.Key = "Video2_root") Or (TV1.SelectedItem.Key = "Image1_root") Or (TV1.SelectedItem.Key = "Image2_root") Or (TV1.SelectedItem.Key = "Image3_root") Or (TV1.SelectedItem.Key = "Image4_root") Then
Exit Sub
ElseIf (TV1.SelectedItem.Key = "Scripts1_child") Or (TV1.SelectedItem.Key = "Scripts2_child") Then
Exit Sub
Else
If (MsgBox("Are you sure you want to remove " & TV1.SelectedItem.Text & " from the project window", vbYesNoCancel, "Remove File") = vbYes) Then
TV1.Nodes.Remove TV1.SelectedItem.Key
End If
End If
End Sub





Private Sub Command3_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As String
i = Data.GetData(vbCFText)
If (i = "root1") Or (i = "root2") Or (i = "root3") Or (i = "Scripts1_root") Or (i = "Scripts2_root") Or (i = "Video1_root") Or (i = "Video2_root") Or (i = "Image1_root") Or (i = "Image2_root") Or (i = "Image3_root") Or (i = "Image4_root") Then
Exit Sub
ElseIf (i = "Scripts1_child") Or (i = "Scripts2_child") Then
Exit Sub
Else
If (MsgBox("Are you sure you want to remove " & i & " from the project window", vbYesNoCancel, "Remove File") = vbYes) Then
TV1.Nodes.Remove i
End If
End If
End Sub

Private Sub Command4_Click()
reselect:
On Error GoTo errhandle
Dim fName As String
cd1.DialogTitle = "Open File"
 cd1.CancelError = True
cd1.Filter = "All Files (*.*)|*.*|Script Files (*.ssa, *.ass)|*.ssa;*.ass|Video Files (*.avi, *.mpg, *.mpeg, *.mkv, *.ogm, *.rm, *.rmvb, *.wmv)|*.avi;*.mpg;*.mpeg;*.mkv;*.ogm;*.rm;*.rmvb;*.wmv|Image Files (*.png, *.jpg, *.jpeg, *.bmp, *.gif)|*.png;*.jpg;*.jpeg;*.bmp;*.gif)"
cd1.ShowOpen
fName = cd1.FileName
If (LCase(Right(fName, 4)) = ".ssa") Or (LCase(Right(fName, 4)) = ".ass") Then
If (LCase(Right(fName, 4)) = ".ssa") Then
TV1.Nodes.Add "Scripts2_root", tvwChild, fName, FileName(fName)
TV1.Nodes(fName).EnsureVisible
Else
TV1.Nodes.Add "Scripts1_root", tvwChild, fName, FileName(fName)
TV1.Nodes(fName).EnsureVisible
End If
ElseIf (LCase(Right(fName, 4)) = ".avi") Then
TV1.Nodes.Add "Video1_root", tvwChild, fName, FileName(fName)
TV1.Nodes(fName).EnsureVisible
ElseIf (LCase(Right(fName, 4)) = ".mpg") Or (LCase(Right(fName, 4)) = ".mpeg") Or (LCase(Right(fName, 4)) = ".mkv") Or (LCase(Right(fName, 4)) = ".ogm") Or (LCase(Right(fName, 4)) = ".rm") Or (LCase(Right(fName, 4)) = ".rmvb") Or (LCase(Right(fName, 4)) = ".wmv") Then
TV1.Nodes.Add "Video2_root", tvwChild, fName, FileName(fName)
TV1.Nodes(fName).EnsureVisible
ElseIf (LCase(Right(fName, 4)) = ".png") Then
TV1.Nodes.Add "Image1_root", tvwChild, fName, FileName(fName)
TV1.Nodes(fName).EnsureVisible
ElseIf (LCase(Right(fName, 4)) = ".jpg") Then
TV1.Nodes.Add "Image2_root", tvwChild, fName, FileName(fName)
TV1.Nodes(fName).EnsureVisible
ElseIf (LCase(Right(fName, 4)) = ".jpeg") Then
TV1.Nodes.Add "Image2_root", tvwChild, fName, FileName(fName)
TV1.Nodes(fName).EnsureVisible
ElseIf (LCase(Right(fName, 4)) = ".bmp") Then
TV1.Nodes.Add "Image3_root", tvwChild, fName, FileName(fName)
TV1.Nodes(fName).EnsureVisible
ElseIf (LCase(Right(fName, 4)) = ".gif") Then
TV1.Nodes.Add "Image4_root", tvwChild, fName, FileName(fName)
TV1.Nodes(fName).EnsureVisible
End If
exito:
Exit Sub
errhandle:
If (Err.Number = 35602) Then
GoTo exito
ElseIf (Err.Number <> 35602) Then
GoTo exito
End If
End Sub

Private Sub Form_Load()
    TV1.Nodes.Add , , "root1", "Scripts"
    TV1.Nodes.Add "root1", tvwChild, "Scripts1_root", "ASS Scripts"
    TV1.Nodes.Add "root1", tvwChild, "Scripts2_root", "SSA Scripts"
    TV1.Nodes.Add "Scripts1_root", tvwChild, "Scripts1_child", "Blank ASS Header"
    TV1.Nodes.Add "Scripts2_root", tvwChild, "Scripts2_child", "Blank SSA Header"

    TV1.Nodes("Scripts1_child").EnsureVisible
    TV1.Nodes("Scripts2_child").EnsureVisible
    
    TV1.Nodes.Add , , "root2", "Video Files"
    TV1.Nodes.Add "root2", tvwChild, "Video1_root", "Avi Files"
    TV1.Nodes.Add "root2", tvwChild, "Video2_root", "Other Supported Video Files"

    TV1.Nodes.Add , , "root3", "Images"
    TV1.Nodes.Add "root3", tvwChild, "Image1_root", "PNG Image Files"
    TV1.Nodes.Add "root3", tvwChild, "Image2_root", "JPG Image Files"
    TV1.Nodes.Add "root3", tvwChild, "Image3_root", "BMP Image Files"
    TV1.Nodes.Add "root3", tvwChild, "Image4_root", "GIF Image Files"
    
    
    Form_Resizei
End Sub

Private Sub Form_Resizei()
Me.Move 0, 0, 4000, 4000
End Sub


Private Sub Form_Resize()
If Me.Height <= 1000 Then
Label1.Visible = False
Command1.Visible = False
Command2.Visible = False
Command3.Visible = False
Command4.Visible = False
Else
Label1.Visible = True
Command1.Visible = True
Command2.Visible = True
Command3.Visible = True
Command4.Visible = True
End If
    On Error Resume Next
    If (Me.ScaleHeight < 550) Then
    TV1.Visible = False
    Else
    TV1.Visible = True
    End If
    TV1.Move -10, 200, Me.ScaleWidth + 40, Me.ScaleHeight - 500
    Command1.Move 100, Me.ScaleHeight - 280
    Command2.Move 350, Me.ScaleHeight - 280
    If (Me.ScaleWidth > "2800") Then
    Label1.Move 0 + Me.ScaleWidth / 2 - 660, Me.ScaleHeight - 250
    Else
    Label1.Move 740, Me.ScaleHeight - 250
    End If
    Command3.Move Me.ScaleWidth - 350, Me.ScaleHeight - 280
    Command4.Move Me.ScaleWidth - 595, Me.ScaleHeight - 280
    If (Me.ScaleWidth <= "2750") And (Me.ScaleWidth > 2550) Then
    Label1.Caption = "Project Wind..."
    ElseIf (Me.ScaleWidth <= 2550) And (Me.ScaleWidth > 2350) Then
    Label1.Caption = "Project Wi..."
    ElseIf (Me.ScaleWidth <= 2350) And (Me.ScaleWidth > 2150) Then
    Label1.Caption = "Project ..."
    ElseIf (Me.ScaleWidth <= 2150) And (Me.ScaleWidth > 1950) Then
    Label1.Caption = "Proje..."
    ElseIf (Me.ScaleWidth <= 1950) And (Me.ScaleWidth > 1800) Then
    Label1.Caption = "Pro..."
    ElseIf (Me.ScaleWidth <= 1800) Then
    Label1.Caption = "P..."
    Else
    Label1.Caption = "Project Window"
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
Cancel = 0
frmDocument.Hide
End Sub

Private Sub TV1_Click()
If (TV1.SelectedItem.Key = "root1") Or (TV1.SelectedItem.Key = "root2") Or (TV1.SelectedItem.Key = "root3") Or (TV1.SelectedItem.Key = "Scripts1_root") Or (TV1.SelectedItem.Key = "Scripts2_root") Or (TV1.SelectedItem.Key = "Video1_root") Or (TV1.SelectedItem.Key = "Video2_root") Or (TV1.SelectedItem.Key = "Image1_root") Or (TV1.SelectedItem.Key = "Image2_root") Or (TV1.SelectedItem.Key = "Image3_root") Or (TV1.SelectedItem.Key = "Image4_root") Then
Label2.Caption = "File Type: N/A     Filesize: N/A     Path: N/A"
ElseIf (TV1.SelectedItem.Key = "Scripts1_child") Or (TV1.SelectedItem.Key = "Scripts2_child") Then
Label2.Caption = "File Type: N/A     Filesize: N/A     Path: N/A"
Else
Dim fType As String, fSize As Long, fPath As String
fType = Right(TV1.SelectedItem.Text, 3)
fSize& = FileLen(TV1.SelectedItem.Key) / 1024
If (Len(TV1.SelectedItem.Key) < 80) Then
fPath = TV1.SelectedItem.Key
Else
fPath = Left(TV1.SelectedItem.Key, 75) & "..."
End If
Label2.Caption = "File Type: " & fType & "     Filesize: " & fSize& & " KB     Path: " & fPath
End If
End Sub

Private Sub TV1_DblClick()
reselect:
On Error GoTo errhandle
Dim fName As String
cd1.DialogTitle = "Open File"
 cd1.CancelError = True
cd1.Filter = "All Files (*.*)|*.*|Script Files (*.ssa, *.ass)|*.ssa;*.ass|Video Files (*.avi, *.mpg, *.mpeg, *.mkv, *.ogm, *.rm, *.rmvb, *.wmv)|*.avi;*.mpg;*.mpeg;*.mkv;*.ogm;*.rm;*.rmvb;*.wmv|Image Files (*.png, *.jpg, *.jpeg, *.bmp, *.gif)|*.png;*.jpg;*.jpeg;*.bmp;*.gif)"
cd1.ShowOpen
fName = cd1.FileName
If (LCase(Right(fName, 4)) = ".ssa") Or (LCase(Right(fName, 4)) = ".ass") Then
If (LCase(Right(fName, 4)) = ".ssa") Then
TV1.Nodes.Add "Scripts2_root", tvwChild, fName, FileName(fName)
TV1.Nodes(fName).EnsureVisible
Else
TV1.Nodes.Add "Scripts1_root", tvwChild, fName, FileName(fName)
TV1.Nodes(fName).EnsureVisible
End If
ElseIf (LCase(Right(fName, 4)) = ".avi") Then
TV1.Nodes.Add "Video1_root", tvwChild, fName, FileName(fName)
TV1.Nodes(fName).EnsureVisible
ElseIf (LCase(Right(fName, 4)) = ".mpg") Or (LCase(Right(fName, 4)) = ".mpeg") Or (LCase(Right(fName, 4)) = ".mkv") Or (LCase(Right(fName, 4)) = ".ogm") Or (LCase(Right(fName, 4)) = ".rm") Or (LCase(Right(fName, 4)) = ".rmvb") Or (LCase(Right(fName, 4)) = ".wmv") Then
TV1.Nodes.Add "Video2_root", tvwChild, fName, FileName(fName)
TV1.Nodes(fName).EnsureVisible
ElseIf (LCase(Right(fName, 4)) = ".png") Then
TV1.Nodes.Add "Image1_root", tvwChild, fName, FileName(fName)
TV1.Nodes(fName).EnsureVisible
ElseIf (LCase(Right(fName, 4)) = ".jpg") Then
TV1.Nodes.Add "Image2_root", tvwChild, fName, FileName(fName)
TV1.Nodes(fName).EnsureVisible
ElseIf (LCase(Right(fName, 4)) = ".jpeg") Then
TV1.Nodes.Add "Image2_root", tvwChild, fName, FileName(fName)
TV1.Nodes(fName).EnsureVisible
ElseIf (LCase(Right(fName, 4)) = ".bmp") Then
TV1.Nodes.Add "Image3_root", tvwChild, fName, FileName(fName)
TV1.Nodes(fName).EnsureVisible
ElseIf (LCase(Right(fName, 4)) = ".gif") Then
TV1.Nodes.Add "Image4_root", tvwChild, fName, FileName(fName)
TV1.Nodes(fName).EnsureVisible
End If
exito:
Exit Sub
errhandle:
If (Err.Number = 35602) Then
GoTo exito
ElseIf (Err.Number <> 35602) Then
GoTo exito
End If
End Sub
Public Function FileName(WithPath As String)
Dim sWithoutPath As String
Dim iLen As Integer
Dim iWhere As Integer
sWithoutPath = WithPath
Do Until InStr(sWithoutPath, "\") = 0
iLen = Len(sWithoutPath)
iWhere = InStr(sWithoutPath, "\")
sWithoutPath = Right(sWithoutPath, iLen - iWhere)
Loop
FileName = sWithoutPath
End Function



Private Sub TV1_KeyUp(KeyCode As Integer, Shift As Integer)
If (KeyCode = vbKeyDelete) Then
If (TV1.SelectedItem.Key = "root1") Or (TV1.SelectedItem.Key = "root2") Or (TV1.SelectedItem.Key = "root3") Or (TV1.SelectedItem.Key = "Scripts1_root") Or (TV1.SelectedItem.Key = "Scripts2_root") Or (TV1.SelectedItem.Key = "Video1_root") Or (TV1.SelectedItem.Key = "Video2_root") Or (TV1.SelectedItem.Key = "Image1_root") Or (TV1.SelectedItem.Key = "Image2_root") Or (TV1.SelectedItem.Key = "Image3_root") Or (TV1.SelectedItem.Key = "Image4_root") Then
Exit Sub
ElseIf (TV1.SelectedItem.Key = "Scripts1_child") Or (TV1.SelectedItem.Key = "Scripts2_child") Then
Exit Sub
Else
TV1.Nodes.Remove TV1.SelectedItem.Key
End If
End If
End Sub

Private Sub TV1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
TV1.DropHighlight = TV1.HitTest(X, Y)
If (TV1.SelectedItem.Key = "root1") Or (TV1.SelectedItem.Key = "root2") Or (TV1.SelectedItem.Key = "root3") Or (TV1.SelectedItem.Key = "Scripts1_root") Or (TV1.SelectedItem.Key = "Scripts2_root") Or (TV1.SelectedItem.Key = "Video1_root") Or (TV1.SelectedItem.Key = "Video2_root") Or (TV1.SelectedItem.Key = "Image1_root") Or (TV1.SelectedItem.Key = "Image2_root") Or (TV1.SelectedItem.Key = "Image3_root") Or (TV1.SelectedItem.Key = "Image4_root") Then
Label2.Caption = "File Type: N/A     Filesize: N/A     Path: N/A"
ElseIf (TV1.SelectedItem.Key = "Scripts1_child") Or (TV1.SelectedItem.Key = "Scripts2_child") Then
Label2.Caption = "File Type: N/A     Filesize: N/A     Path: N/A"
Else
Dim fType As String, fSize As Long, fPath As String
fType = Right(TV1.SelectedItem.Text, 3)
fSize& = FileLen(TV1.SelectedItem.Key) / 1024
If (Len(TV1.SelectedItem.Key) < 80) Then
fPath = TV1.SelectedItem.Key
Else
fPath = Left(TV1.SelectedItem.Key, 75) & "..."
End If
Label2.Caption = "File Type: " & fType & "     Filesize: " & fSize& & " KB     Path: " & fPath
End If
TV1.OLEDrag
End Sub
Private Sub HandleDragOver(ByVal X As Long, ByVal Y As Long)
    Set TreeView1.SelectedItem = TreeView1.HitTest(X, Y)
    TreeView1.DropHighlight = TreeView1.SelectedItem
    If (Not TreeView1.SelectedItem Is Nothing) Then
        If (Not TreeView1.SelectedItem.Expanded) Then
            TreeView1.SelectedItem.Expanded = True
        End If
    End If
End Sub

Private Sub TV1_OLESetData(Data As MSComctlLib.DataObject, DataFormat As Integer)
Data.SetData TV1.SelectedItem.Key
End Sub

heres the frmmain code..i used the program cretor thing in VB lol..
because i didnt know you could set a form as a child just in the properties..anyway...
controls
(Toggle Plain Text) 
dlgCommonDialog = common dialog control
imlToolbarIcons = toolbar
sbStatusBar = statusbar
(Toggle Plain Text) 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Const EM_UNDO = &HC7
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hWnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)

Private Sub MDIForm_Load()
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    LoadNewDoc
End Sub

Private Sub LoadNewDoc()
    frmDocument.Show
End Sub


Private Sub MDIForm_Unload(Cancel As Integer)
Cancel = 0
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
End Sub


Private Sub mnuHelpAbout_Click()
    frmAbout.Show vbModal, Me
End Sub

Private Sub mnuHelpSearchForHelpOn_Click()
    Dim nRet As Integer


    'if there is no helpfile for this project display a message to the user
    'you can set the HelpFile for your application in the
    'Project Properties dialog
    If Len(App.HelpFile) = 0 Then
        MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption
    Else
        On Error Resume Next
        nRet = OSWinHelp(Me.hWnd, App.HelpFile, 261, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If

End Sub

Private Sub mnuHelpContents_Click()
    Dim nRet As Integer


    'if there is no helpfile for this project display a message to the user
    'you can set the HelpFile for your application in the
    'Project Properties dialog
    If Len(App.HelpFile) = 0 Then
        MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption
    Else
        On Error Resume Next
        nRet = OSWinHelp(Me.hWnd, App.HelpFile, 3, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If

End Sub


Private Sub mnuWindowArrangeIcons_Click()
    Me.Arrange vbArrangeIcons
End Sub

Private Sub mnuWindowTileVertical_Click()
    Me.Arrange vbTileVertical
End Sub

Private Sub mnuWindowTileHorizontal_Click()
    Me.Arrange vbTileHorizontal
End Sub

Private Sub mnuWindowCascade_Click()
    Me.Arrange vbCascade
End Sub

Private Sub mnuWindowNewWindow_Click()
    LoadNewDoc
End Sub

Private Sub mnuViewWebBrowser_Click()
    'ToDo: Add 'mnuViewWebBrowser_Click' code.
    MsgBox "Add 'mnuViewWebBrowser_Click' code."
End Sub

Private Sub mnuViewOptions_Click()
    'ToDo: Add 'mnuViewOptions_Click' code.
    MsgBox "Add 'mnuViewOptions_Click' code."
End Sub

Private Sub mnuViewRefresh_Click()
    'ToDo: Add 'mnuViewRefresh_Click' code.
    MsgBox "Add 'mnuViewRefresh_Click' code."
End Sub

Private Sub mnuViewStatus_Click()

End Sub
Public Function uncheckstatus()
mnuViewStatusBar.Checked = False
End Function

Private Sub mnuViewToolbar_Click()
    mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
    tbToolBar.Visible = mnuViewToolbar.Checked
End Sub

Private Sub mnuEditPasteSpecial_Click()
    'ToDo: Add 'mnuEditPasteSpecial_Click' code.
    MsgBox "Add 'mnuEditPasteSpecial_Click' code."
End Sub

Private Sub mnuEditPaste_Click()
    On Error Resume Next
    ActiveForm.rtfText.SelRTF = Clipboard.GetText

End Sub

Private Sub mnuEditCopy_Click()
    On Error Resume Next
    Clipboard.SetText ActiveForm.rtfText.SelRTF

End Sub

Private Sub mnuEditCut_Click()
    On Error Resume Next
    Clipboard.SetText ActiveForm.rtfText.SelRTF
    ActiveForm.rtfText.SelText = vbNullString

End Sub

Private Sub mnuEditUndo_Click()
    'ToDo: Add 'mnuEditUndo_Click' code.
    MsgBox "Add 'mnuEditUndo_Click' code."
End Sub


Private Sub mnuFileExit_Click()
    'unload the form
    Unload Me

End Sub

Private Sub mnuFileSend_Click()
    'ToDo: Add 'mnuFileSend_Click' code.
    MsgBox "Add 'mnuFileSend_Click' code."
End Sub

Private Sub mnuFilePrint_Click()
    On Error Resume Next
    If ActiveForm Is Nothing Then Exit Sub
    

    With dlgCommonDialog
        .DialogTitle = "Print"
        .CancelError = True
        .Flags = cdlPDReturnDC + cdlPDNoPageNums
        If ActiveForm.rtfText.SelLength = 0 Then
            .Flags = .Flags + cdlPDAllPages
        Else
            .Flags = .Flags + cdlPDSelection
        End If
        .ShowPrinter
        If Err <> MSComDlg.cdlCancel Then
            ActiveForm.rtfText.SelPrint .hdc
        End If
    End With

End Sub

Private Sub mnuFilePrintPreview_Click()
    'ToDo: Add 'mnuFilePrintPreview_Click' code.
    MsgBox "Add 'mnuFilePrintPreview_Click' code."
End Sub

Private Sub mnuFilePageSetup_Click()
    On Error Resume Next
    With dlgCommonDialog
        .DialogTitle = "Page Setup"
        .CancelError = True
        .ShowPrinter
    End With

End Sub

Private Sub mnuFileProperties_Click()
    'ToDo: Add 'mnuFileProperties_Click' code.
    MsgBox "Add 'mnuFileProperties_Click' code."
End Sub

Private Sub mnuFileSaveAll_Click()
    'ToDo: Add 'mnuFileSaveAll_Click' code.
    MsgBox "Add 'mnuFileSaveAll_Click' code."
End Sub

Private Sub mnuFileSaveAs_Click()
    Dim sFile As String
    

    If ActiveForm Is Nothing Then Exit Sub
    

    With dlgCommonDialog
        .DialogTitle = "Save As"
        .CancelError = False
        'ToDo: set the flags and attributes of the common dialog control
        .Filter = "All Files (*.*)|*.*"
        .ShowSave
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
    End With
    ActiveForm.Caption = sFile
    ActiveForm.rtfText.SaveFile sFile

End Sub

Private Sub mnuFileSave_Click()
    Dim sFile As String
    If Left$(ActiveForm.Caption, 8) = "Document" Then
        With dlgCommonDialog
            .DialogTitle = "Save"
            .CancelError = False
            'ToDo: set the flags and attributes of the common dialog control
            .Filter = "All Files (*.*)|*.*"
            .ShowSave
            If Len(.FileName) = 0 Then
                Exit Sub
            End If
            sFile = .FileName
        End With
        ActiveForm.rtfText.SaveFile sFile
    Else
        sFile = ActiveForm.Caption
        ActiveForm.rtfText.SaveFile sFile
    End If

End Sub

Private Sub mnuFileClose_Click()
    'ToDo: Add 'mnuFileClose_Click' code.
    MsgBox "Add 'mnuFileClose_Click' code."
End Sub

Private Sub mnuFileOpen_Click()
    Dim sFile As String


    If ActiveForm Is Nothing Then LoadNewDoc
    

    With dlgCommonDialog
        .DialogTitle = "Open"
        .CancelError = False
        'ToDo: set the flags and attributes of the common dialog control
        .Filter = "All Files (*.*)|*.*"
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
    End With
    ActiveForm.rtfText.LoadFile sFile
    ActiveForm.Caption = sFile

End Sub

Private Sub mnuFileNew_Click()
    LoadNewDoc
End Sub
Private Sub mnuView_Click()
If (frmDocument.Visible = True) Then
mnuViewStatusBar.Checked = True
Else
mnuViewStatusBar.Checked = False
End If
End Sub
Private Sub mnuViewStatusBar_Click()
    If mnuViewStatusBar.Checked = True Then
        frmDocument.Hide
        mnuViewStatusBar.Checked = False
    Else
        frmDocument.Show
        mnuViewStatusBar.Checked = True
    End If
End Sub

The menu is this part (its right at the bottom of the above) but here it is again
(Toggle Plain Text) 
Private Sub mnuView_Click()
If (frmDocument.Visible = True) Then
mnuViewStatusBar.Checked = True
Else
mnuViewStatusBar.Checked = False
End If
End Sub
Private Sub mnuViewStatusBar_Click()
    If mnuViewStatusBar.Checked = True Then
        frmDocument.Hide
        mnuViewStatusBar.Checked = False
    Else
        frmDocument.Show
        mnuViewStatusBar.Checked = True
    End If
End Sub

so the menus are just renamed from what was orignally there.
code is really messy sorry >.<
thanks
cloud- is offline   Reply With Quote
Old Sep 7th, 2005, 2:17 PM   #12
Rory
Expert Programmer
 
Rory's Avatar
 
Join Date: Jan 2005
Location: London
Posts: 542
Rep Power: 4 Rory is on a distinguished road
Send a message via MSN to Rory
You don't appear to be checking if the form's loaded:
(Toggle Plain Text) 
> If Not (frmDocument is Nothing) Then
    If frmDocument.Visible Then
    ...
    End If
> End If
Rory is offline   Reply With Quote
Reply
Page 2 of 2 < 1 2

Bookmarks

« Previous Thread in Forum | Next Thread in Forum »

Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools
Display Modes
Linear Mode Linear Mode

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts
BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Forum Jump


Contact Us - DaniWeb IT Discussion Community - Privacy Statement - Top


DaniWeb IT Discussion Community
All times are GMT -5. The time now is 10:10 AM.

Powered by vBulletin® Version 3.7.0, Copyright ©2000 - 2008, Jelsoft Enterprises Ltd.
Copyright ©2007 DaniWeb® LLC