frmmain.frm

用VB做的

   End
   Begin VB.Menu mnuEdit 
      Caption         =   "&Edit"
      Begin VB.Menu mnuFont 
         Caption         =   "&Font"
         Shortcut        =   ^F
      End
      Begin VB.Menu mnuEditBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuEditCut 
         Caption         =   "Cu&t"
      End
      Begin VB.Menu mnuEditCopy 
         Caption         =   "&Copy"
      End
      Begin VB.Menu mnuEditPaste 
         Caption         =   "&Paste"
      End
   End
   Begin VB.Menu mnuAbout 
      Caption         =   "&About"
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim Margin As Integer

Private Sub Form_Load()
    Load frmMain
    Load frmAbout
    frmAbout.Hide
    frmMain.Hide
    Load frmSplash
    frmSplash.Show
    frmMain.Icon = LoadPicture(App.Path & "\FlagScot.ico")
    
        'Set up margins
    Margin = 500
    RichTextBox1.SelStart = 0
    RichTextBox1.SelLength = Len(RichTextBox1.Text)
    RichTextBox1.SelIndent = (Margin)
    RichTextBox1.SelRightIndent = (Margin)
    'Set up text and ruler sizing
    RichTextBox1.Height = frmMain.ScaleHeight - 1000
    RichTextBox1.Width = frmMain.ScaleWidth
    GLRuler1.Width = frmMain.ScaleWidth
    Refresh     'force an update on display

End Sub

Private Sub GLRuler1_Click(lXPositionInTwips As Long, dblXPositionInInches As Variant)
    'Update margins from ruler settings
    Margin = lXPositionInTwips
    RichTextBox1.SelStart = 0
    RichTextBox1.SelLength = Len(RichTextBox1.Text)
    RichTextBox1.SelIndent = (Margin)
    RichTextBox1.SelRightIndent = (Margin)
    Refresh
    RichTextBox1.SetFocus
    Refresh
End Sub

Private Sub Form_Resize()
    'Set up text and ruler sizing
    RichTextBox1.Height = frmMain.ScaleHeight - 1000
    RichTextBox1.Width = frmMain.ScaleWidth
    GLRuler1.Width = frmMain.ScaleWidth
    Refresh     'force an update on display
Refresh
End Sub

Private Sub mnuAbout_Click()
frmAbout.Show       ' Command the display of the About box
End Sub

Private Sub mnuFont_Click()
    ' Set Cancel to True.
    CommonDialog1.CancelError = True
    On Error GoTo ErrHandler    'set trap for user cancel option selection
    ' Set the Flags property, this setting picks the printer and screen fonts.
    CommonDialog1.Flags = cdlCFBoth Or cdlCFEffects
    ' Display the Font dialog box.
    CommonDialog1.ShowFont
    ' Set text properties according to user's
    ' selections.
    RichTextBox1.SelFontName = CommonDialog1.FontName
    RichTextBox1.SelFontSize = CommonDialog1.FontSize
    RichTextBox1.SelBold = CommonDialog1.FontBold
    RichTextBox1.SelItalic = CommonDialog1.FontItalic
    RichTextBox1.SelUnderline = CommonDialog1.FontUnderline
    RichTextBox1.SelStrikeThru = CommonDialog1.FontStrikethru
    RichTextBox1.SelColor = CommonDialog1.Color
    Exit Sub
ErrHandler:
    ' User pressed Cancel button.
    Exit Sub

End Sub


Private Sub RichTextBox1_GotFocus()
    ' Ignore errors for controls without the TabStop property.
    On Error Resume Next
    ' Switch off the change of focus when pressing TAB, this allows the user
    ' to use the tab function without using Ctrl+TAB combination, ie, use TAB alone.
    For Each Control In Controls
        Control.TabStop = False
    Next Control
End Sub
    
Private Sub tbToolBar_ButtonClick(ByVal Button As ComctlLib.Button)

    Select Case Button.Key

        Case "New"
            mnuFileNew_Click
        Case "New"
            mnuFileNew_Click
        Case "Open"
            mnuFileOpen_Click
        Case "Save"
            mnuFileSave_Click
        Case "Print"
            mnuFilePrint_Click
        Case "Cut"
            mnuEditCut_Click
        Case "Copy"
            mnuEditCopy_Click
        Case "Paste"
            mnuEditPaste_Click
        
        Case "Bold"
            'check current bold state and alternate
            If RichTextBox1.SelBold = True Then
                RichTextBox1.SelBold = False
                RichTextBox1.SetFocus   'move cursor back to text box
            Else
                RichTextBox1.SelBold = True
                RichTextBox1.SetFocus   'move cursor back to text box
            End If

        Case "Italic"
            'check current italic state and alternate
            If RichTextBox1.SelItalic = True Then
                RichTextBox1.SelItalic = False
                RichTextBox1.SetFocus   'move cursor back to text box
            Else
                RichTextBox1.SelItalic = True
                RichTextBox1.SetFocus   'move cursor back to text box
            End If
            
        Case "Underline"
        'check current underline state and alternate
        If RichTextBox1.SelUnderline = True Then
            RichTextBox1.SelUnderline = False
            RichTextBox1.SetFocus   'move cursor back to text box
        Else
            RichTextBox1.SelUnderline = True
            RichTextBox1.SetFocus   'move cursor back to text box
        End If
            
        Case "Left"
        RichTextBox1.SelAlignment = 0   'left alignment
            RichTextBox1.SetFocus   'move cursor back to text box
            
        Case "Center"
        RichTextBox1.SelAlignment = 2   'center alignment
            RichTextBox1.SetFocus   'move cursor back to text box
            
        Case "Right"
        RichTextBox1.SelAlignment = 1   'right alignment
            RichTextBox1.SetFocus   'move cursor back to text box
            
    End Select
End Sub


Private Sub mnuEditCopy_Click()
    'Clear the clipboard
    Clipboard.Clear
    'Transfer selection to clipboard
    Clipboard.SetText RichTextBox1.SelText
    
End Sub


Private Sub mnuEditCut_Click()
    'Clear the clipboard
    Clipboard.Clear
    'transfer selection to clipboard
    Clipboard.SetText RichTextBox1.SelText
    'replace the selected text with nothing
    RichTextBox1.SelText = ""
End Sub


Private Sub mnuEditPaste_Click()
    'Copy Clipboard contents to position or to replace selected text
    RichTextBox1.SelRTF = Clipboard.GetText()
End Sub


Private Sub mnuFileOpen_Click()
    Close #1        'close any open file before proceeding (just insurance)
    Dim LFCR      ' Define the wrap character to tack on to the end of each string
    LFCR = Chr(13) + Chr(10)
    ' Set Cancel to True, enable escape trap
    CommonDialog1.CancelError = True
On Error GoTo ErrHandler
    CommonDialog1.Filter = "RTF Files (*.rtf)|*.rtf|TXT Files (*.txt)|*.txt"
    CommonDialog1.ShowOpen
    If CommonDialog1.filename <> "" Then                     ' Verify user entered filename
        Open CommonDialog1.filename For Input As #1    ' Open user's file name
        Do Until EOF(1)                                                  ' Read string until end of file
        Line Input #1, LineOfText$                                   ' Temp storage of each new line
        AllText$ = AllText$ + LineOfText$ + LFCR            ' Dump strings to AllText$ and LFCR
    Loop
        RichTextBox1.TextRTF = AllText$                        'Dump final collection in text box
 Else
    'Do nothing, go to normal exit
 End If
    Exit Sub
ErrHandler:
    ' User pressed Cancel button.
    Exit Sub
End Sub


Private Sub mnuFileClose_Click()
    Close #1    'close any open file before proceeding (just insurance)
    RichTextBox1.Text = ""
End Sub

Private Sub mnuFileSave_Click()
    'To Do
    Close #1    'close any open file before proceeding (just insurance)
    ' Set Cancel to True, enables escape option
    CommonDialog1.CancelError = True
On Error GoTo ErrHandler
    'note: the entire file is stored in a string
    CommonDialog1.Filter = "RTF Files (*.rtf)|*.rtf|TXT Files (*.txt)|*.txt"
    CommonDialog1.ShowSave                                        ' display Save dialog
    If CommonDialog1.filename <> "" Then                        ' verify user entered a name
        Open CommonDialog1.filename For Output As #1    ' open file with user's name
        Print #1, RichTextBox1.TextRTF                             ' save string to open file
        Close #1                                                               ' closes file
    End If
    Exit Sub
ErrHandler:
    ' User pressed Cancel button.
    Exit Sub

End Sub


Private Sub mnuFileSaveAs_Click()
    'To Do
    Close #1    'close any open file before proceeding (just insurance)
    ' Set Cancel to True, enables escape option
    CommonDialog1.CancelError = True
On Error GoTo ErrHandler
    'note: the entire file is stored in a string
    CommonDialog1.Filter = "RTF Files (*.rtf)|*.rtf|TXT Files (*.txt)|*.txt"
    CommonDialog1.ShowSave                                        ' display Save dialog
    If CommonDialog1.filename <> "" Then                        ' verify user entered a name
        Open CommonDialog1.filename For Output As #1    ' open file with user's name
        Print #1, RichTextBox1.TextRTF                             ' save string to open file
        Close #1                                                               ' closes file
    End If
    Exit Sub
ErrHandler:
    ' User pressed Cancel button.
    Exit Sub
End Sub

Private Sub mnuFilePrint_Click()
    'Set Cancel to True, enable cancel escape trap
    CommonDialog1.CancelError = True
On Error GoTo ErrHandler
    CommonDialog1.Flags = cdlPDReturnDC + cdlPDNoPageNums
    If RichTextBox1.SelLength = 0 Then
        CommonDialog1.Flags = CommonDialog1.Flags + cdlPDAllPages
    Else
        CommonDialog1.Flags = CommonDialog1.Flags + cdlPDSelection
    End If
    CommonDialog1.ShowPrinter
    Printer.Print ""        ' Prepares the printer before printing
    RichTextBox1.SelPrint CommonDialog1.hDC     ' Commands print job to start
    Exit Sub
ErrHandler:
    'User pressed Cancel button.
    Exit Sub
End Sub


Private Sub mnuFileExit_Click()
    'unload the form
    Unload Me
    End
End Sub

Private Sub mnuFileNew_Click()
    Close #1    'close any open file before proceeding (just insurance)
    RichTextBox1.Text = ""
End Sub