frmmain.frm

NOPAD的VB6原碼,寫的還蠻齊全的,請參考

Next x

If Not Flag = True Then
    
    'if there is a space open
    If Not NextPos = 10 Then
        Files(NextPos) = Filename
        mnuFileList(NextPos).Caption = Filename
        mnuFileList(NextPos).Visible = True
    
    Else    'if there is not a space open
        
        For x = 1 To 9
            Files(x - 1) = Files(x)
            mnuFileList(x - 1).Caption = Files(x)
        Next x
        Files(9) = Filename
        mnuFileList(9).Caption = Filename
    End If
    
End If

End Sub


Private Sub MDIForm_Load()

Dim T As Toolbar
Set T = frmMain.Toolbar

'initialize menu items
mnuFileSave.Enabled = False
mnuFileSaveAs.Enabled = False
mnuEditCut.Enabled = False
mnuEditCopy.Enabled = False
mnuEditPaste.Enabled = False
mnuEditFind.Enabled = False
mnuWinArrange.Enabled = False
mnuWinCascade.Enabled = False
mnuWinHTile.Enabled = False
mnuWinVTile.Enabled = False

'initialize toolbar buttons
T.Buttons("SaveDoc").Enabled = False
T.Buttons("PrintDoc").Enabled = False
T.Buttons("EditCut").Enabled = False
T.Buttons("EditCopy").Enabled = False
T.Buttons("EditPaste").Enabled = False
T.Buttons("Find").Enabled = False
T.Buttons("Cascade").Enabled = False
T.Buttons("Tile").Enabled = False

'initialize Files() array
For x = 1 To 0
    Files(x) = ""
Next x

'init system forms and load into memory
frmFile.Filter = "All Files        *.*|*.*|Hypertext Files        *.htm|*.htm|Plain Text Files        *.txt|*.txt"
frmFile.FilterIndex = 0
Load frmFile
Load frmSearch

End Sub

Private Sub MDIForm_Resize()

Progress.Move Me.ScaleWidth - Progress.Width - 75

End Sub


Private Sub MDIForm_Unload(Cancel As Integer)

'Unload all MDI child forms
While Forms.Count > 3
    Unload frmMain.ActiveForm
Wend

'unload system forms
Unload frmFile
Unload frmSearch

'this form's unload has already been called as evidence
'by this event

End Sub

Private Sub mnuEditCopy_Click()

Dim S As String

Dim F As Form
Set F = frmMain.ActiveForm

'if not text selected then exit
If F.Text1.SelLength = 0 Then Exit Sub

'copy text to clipboard
Clipboard.SetText F.Text1.SelText

'enable paste button
If frmMain.Toolbar.Buttons("EditPaste").Enabled = False Then
    frmMain.Toolbar.Buttons("EditPaste").Enabled = True
End If

End Sub

Private Sub mnuEditCut_Click()

Dim S As String
Dim SPos As Long
Dim Pos1 As Long, Pos2 As Long

Dim F As Form
Set F = frmMain.ActiveForm

'if not text selected then exit
If F.Text1.SelLength = 0 Then Exit Sub

'copy text to clipboard
Clipboard.SetText F.Text1.SelText

'assign values to local vars for manipulation
S = F.Text1.Text
SPos = F.Text1.SelStart
Pos1 = F.Text1.SelStart
Pos2 = F.Text1.SelStart + F.Text1.SelLength + 1

'delete highlighted text from textbox
F.Text1.Text = Left$(S, Pos1) & Mid$(S, Pos2)

'enable paste button
If frmMain.Toolbar.Buttons("EditPaste").Enabled = False Then
    frmMain.Toolbar.Buttons("EditPaste").Enabled = True
End If

'reset cursor to start of highlight
F.Text1.SelStart = SPos
F.SetFocus

End Sub

Private Sub mnuEditFind_Click()

Dim Flag As Boolean

Dim F As frmSearch
Set F = frmSearch

Dim FText As Form
Set FText = frmMain.ActiveForm

'center search form on screen
F.Move (Screen.Width - F.Width) / 2, (Screen.Height - F.Height) / 2

'set search form caption
F.Caption = "Find"

'initialize search box
frmSearch.Init

'if there is text selected, add it to the Find What combo box
If FText.Text1.SelLength > 0 Then
    F.cboFind.AddItem FText.Text1.SelText
    F.cboFind.ListIndex = F.cboFind.NewIndex
End If

'show form and make topmost window
frmSearch.Show
success% = SetWindowPos(frmSearch.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)

End Sub

Private Sub mnuEditFindNext_Click()

Dim Dummy As Variant

End Sub

Private Sub mnuEditPaste_Click()

Dim S As String
Dim T As String
Dim SPos As Long
Dim Pos1 As Long, Pos2 As Long

Dim F As Form
Set F = frmMain.ActiveForm

'assign contents of clipboard to local var
S = Clipboard.GetText

'get coordinates for paste
SPos = F.Text1.SelStart
Pos1 = F.Text1.SelStart
Pos2 = F.Text1.SelStart + F.Text1.SelLength + 1

'assign contents of textbox to local var
T = F.Text1.Text

'paste local var into text
F.Text1.Text = Left$(T, Pos1) & S & Mid$(T, Pos2)

'reset cursor to start of highlight
F.Text1.SelStart = SPos
F.SetFocus

End Sub

Private Sub mnuEditReplace_Click()

Dim Dummy As Variant

End Sub

Private Sub mnuFileCloseAll_Click()

While Forms.Count > 3

    Unload frmMain.ActiveForm

    If UserMsgChoice = "Cancel" Then
        UserMsgChoice = ""
        Exit Sub
    End If
    
Wend

UserMsgChoice = 0

End Sub


Private Sub mnuFileExit_Click()

End

End Sub

Private Sub mnuFileList_Click(Index As Integer)

'declare vars
Dim FileNum As Integer
Dim F As Form
Dim TempFile As String

'assign fully qualified path and filename to local var
TempFile = mnuFileList(Index).Caption

'look for current instance of form containing Filename
'if found, don't create new instance
For x = 0 To Forms.Count - 1
    If Forms(x).Caption = TempFile Then
        MsgBox "The file " & Chr$(34) & UCase(TempFile) & Chr$(34) & " is currently opened.", 64, "FILE I/O ERROR"
        Exit Sub
    End If
Next x
  
'instantiate new text form
Set F = New frmText

'get next available free filenumber
FileNum = FreeFile

'open the file
Open TempFile For Input As FileNum

'assign file contents to textbox on new form
F.Text1 = Input(LOF(FileNum), FileNum)

Close FileNum

'assign values to form properties for Save As procedure
F.Drive = Left$(TempFile, 1)
F.Dir = frmFile.GetPath(TempFile)
F.File = frmFile.GetFilename(TempFile)

'assign filename to the form's caption and show the form
F.Caption = TempFile

'show form
F.Show

'init form's Changed property to False
F.Changed = False

End Sub

Private Sub mnuFileNew_Click()

Dim F As Form
Static Counter As Integer

Counter = Counter + 1

Set F = New frmText

F.Caption = "New-" & Format(Counter, "000")
F.Show
F.Changed = False

End Sub

Private Sub mnuFileOpen_Click()

Dim F As frmFile
Set F = frmFile

F.Filter = "All Files        *.*|*.*|Hypertext Files        *.htm|*.htm|Plain Text Files        *.txt|*.txt"
F.FilterIndex = 1
F.Action = 0

F.Init
 

End Sub

Public Sub mnuFileSave_Click()

Dim F As Form
Set F = frmMain.ActiveForm

Dim FileNum As Integer

'if form is empty or has not changed then exit
If F.Text1 = "" Or F.Changed = False Then Exit Sub

'check for newly created form
If Left$(F.Caption, 3) = "NEW" Then
    
    'if form is newly created call File Save As
    mnuFileSaveAs_Click
Else
    'if form was opened from disk
    FileNum = FreeFile
    Open F.Caption For Output As FileNum
    Print #FileNum, F.Text1
    Close FileNum

End If


End Sub

Private Sub mnuFileSaveAs_Click()

Dim F As frmFile
Set F = frmFile

F.Filter = "All Files        *.*|*.*|Hypertext Files        *.htm|*.htm|Plain Text Files        *.txt|*.txt"
F.FilterIndex = 1
F.Action = 1

F.Init

End Sub

Private Sub mnuWinArrange_Click()

frmMain.Arrange 3

End Sub

Private Sub mnuWinCascade_Click()

frmMain.Arrange 0

End Sub

Private Sub mnuWinHTile_Click()

frmMain.Arrange 1

End Sub



Private Sub mnuWinVTile_Click()

frmMain.Arrange 2

End Sub

Private Sub Toolbar_ButtonClick(ByVal Button As Button)

'Resolve which button was clicked
Select Case Button.Key

Case "OpenDoc"
    mnuFileOpen_Click
Case "NewDoc"
    mnuFileNew_Click
Case "SaveDoc"
    mnuFileSave_Click
Case "EditCut"
    mnuEditCut_Click
Case "EditCopy"
    mnuEditCopy_Click
Case "EditPaste"
    mnuEditPaste_Click
Case "Find"
    mnuEditFind_Click
Case "Cascade"
    mnuWinCascade_Click
Case "Tile"
    mnuWinVTile_Click
Case "Stop"
    If Button.Image = "StopOn" Then
        frmMain.UserMsgChoice = "Cancel"
        Button.Image = "StopOff"
    End If
End Select


End Sub