master.frm

一个用vb谢的编辑文本的工具

Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub asd_Click()
End Sub

Private Sub CheckBold_Click()
  CheckBold.Checked = Not CheckBold.Checked
  ChildForms(frm).Text1.SelBold = CheckBold.Checked
End Sub

Private Sub CheckItalic_Click()
  CheckItalic.Checked = Not CheckItalic.Checked
  ChildForms(frm).Text1.SelItalic = CheckItalic.Checked
End Sub

Private Sub CheckStrikeLine_Click()
  CheckStrikeLine.Checked = Not CheckStrikeLine.Checked
  ChildForms(frm).Text1.SelUnderline = CheckStrikeLine.Checked
End Sub

Private Sub Command1_Click()
End Sub

Private Sub CoolBar2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then PopupMenu mnuview
End Sub

Private Sub CoolBar3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then PopupMenu mnuview
End Sub

Private Sub List1_Click()
ChildForms(frm).Text1.SelFontName = List1.List(List1.ListIndex)
End Sub

Private Sub List2_Click()
ChildForms(frm).Text1.SelFontSize = List2.List(List2.ListIndex)
End Sub

Private Sub MDIForm_Load()
  DocNum = 1: Docs = 0: DocTemp = 0
  mnunew_Click
  
  MDIForm1.StatusBar1.Panels(1).Width = 3500
  MDIForm1.StatusBar1.Panels(1).Text = "Loading Fonts ... Please Wait"

  MDIForm1.StatusBar1.Panels.Add (2)
  MDIForm1.StatusBar1.Panels(2).Width = 900

  MDIForm1.StatusBar1.Panels.Add (3)
  MDIForm1.StatusBar1.Panels(3).Width = 900

  MDIForm1.StatusBar1.Panels.Add (4)
  MDIForm1.StatusBar1.Panels(4).Width = 7000
  
  ret = frm
  Debug.Print ret
  For X = 1 To Screen.FontCount
   List1.AddItem Screen.Fonts(X)
  Next
  For X = 5 To 72: List2.AddItem Str$(X): Next
  For X = 0 To List1.ListCount - 1
    If ChildForms(ret).Text1.SelFontName = List1.List(X) Then
      List1.ListIndex = X
      Exit For
    End If
  Next
  For X = 0 To List2.ListCount - 1
  If Int(Val(ChildForms(ret).Text1.SelFontSize)) = Val(List2.List(X)) Then
  List2.ListIndex = 5
  Exit For
  End If
  Next
  
  MDIForm1.StatusBar1.Panels(1).Text = "Welcome to XtremePad."
End Sub

Private Sub mnu_config_Click()
form5.Show
End Sub

Private Sub mnu_may_Click()
Clipboard.SetText ChildForms(frm).Text1.SelText
ChildForms(frm).Text1.SelText = UCase(Clipboard.GetText)
End Sub

Private Sub mnu_min_Click()
Clipboard.SetText ChildForms(frm).Text1.SelText
ChildForms(frm).Text1.SelText = LCase(Clipboard.GetText)
End Sub

Private Sub mnuabout_Click()
Form4.Show vbModal
End Sub

Private Sub mnuArrHoriz_Click()
  MDIForm1.Arrange 1
End Sub

Private Sub mnuArrIcons_Click()
  MDIForm1.Arrange 3
End Sub

Private Sub mnuArrVert_Click()
  MDIForm1.Arrange 2
End Sub

Private Sub mnucalc_Click()
calculator.Show vbModal
End Sub

Private Sub mnuCascade_Click()
  MDIForm1.Arrange 0
End Sub

Private Sub mnuClose_Click()
  Dim ret As Integer
  ret = frm
  Unload ChildForms(ret)
  Set ChildForms(ret) = Nothing
  UnAvail(ret) = False
End Sub

Private Sub mnuCloseAll_Click()
  For X = 1 To 30
    If UnAvail(X) = True Then
      Unload ChildForms(X)
      Set ChildForms(X) = Nothing
      UnAvail(X) = False
    End If
  Next
End Sub

Private Sub mnuconfig_Click()
form5.Show
End Sub

Private Sub mnuCopy_Click()
  Clipboard.SetText ChildForms(frm).Text1.SelText
End Sub

Private Sub mnuCut_Click()
  UndoText(frm) = ChildForms(frm).Text1.Text
  JustChanged = True
  Clipboard.Clear
  Clipboard.SetText ChildForms(frm).Text1.SelText
  ChildForms(frm).Text1.SelText = ""
End Sub

Private Sub mnudate_Click()
form7.Show vbModal
End Sub

Private Sub mnuDecryptBinary_Click()
  Dim EncStr As String
  Dim EncKey As String, TempEncKey As String
  Dim EncLen As Integer
  Dim EncPos As Integer
  Dim EncKeyPos As Integer
  Dim tempChar As String
  Dim TA As Integer, TB As Integer, TC As Integer

  UndoText(frm) = ChildForms(frm).Text1.Text
  JustChanged = True

  TempEncKey = InputBox("Enter the Decryption Key. This key was typed for Encryption.", "Desencriptar")
  If TempEncKey = "" Then Exit Sub
  EncStr = ""
  EncPos = 1
  EncKeyPos = 1
  For X = 1 To Len(TempEncKey)
    EncKey = EncKey & Asc(Mid$(TempEncKey, X, 1))
  Next
  EncLen = Len(EncKey)

  For X = 1 To Len(ChildForms(frm).Text1.Text) Step 8
    TB = Asc(Mid$(EncKey, EncKeyPos, 1))
    EncKeyPos = EncKeyPos + 1
    If EncKeyPos > EncLen Then EncKeyPos = 1
    tempChar = Mid$(ChildForms(frm).Text1.Text, X, 8)
    TA = BintoDec(tempChar)
    TC = TB Xor TA
    EncStr = EncStr & Chr$(TC)
  Next
  ChildForms(frm).Text1.Text = EncStr
End Sub

Private Sub mnuDecryptHex_Click()
  Dim EncStr As String
  Dim EncKey As String, TempEncKey As String
  Dim EncLen As Integer
  Dim EncPos As Integer
  Dim EncKeyPos As Integer
  Dim tempChar As String
  Dim TA As Integer, TB As Integer, TC As Integer

  UndoText(frm) = ChildForms(frm).Text1.Text
  JustChanged = True

  TempEncKey = InputBox("Enter the Decryption Key. This key was typed for Encryption.", "Desencriptar")
  If TempEncKey = "" Then Exit Sub
  EncStr = ""
  EncPos = 1
  EncKeyPos = 1
  For X = 1 To Len(TempEncKey)
    EncKey = EncKey & Asc(Mid$(TempEncKey, X, 1))
  Next
  EncLen = Len(EncKey)

  For X = 1 To Len(ChildForms(frm).Text1.Text) Step 2
    TB = Asc(Mid$(EncKey, EncKeyPos, 1))
    EncKeyPos = EncKeyPos + 1
    If EncKeyPos > EncLen Then EncKeyPos = 1
    tempChar = Mid$(ChildForms(frm).Text1.Text, X, 2)
    TA = Val("&H" + tempChar)
    TC = TB Xor TA
    EncStr = EncStr & Chr$(TC)
  Next
  ChildForms(frm).Text1.Text = EncStr
End Sub

Private Sub mnuDelete_Click()
  UndoText(frm) = ChildForms(frm).Text1.Text
  JustChanged = True
  ChildForms(frm).Text1.SelText = ""
End Sub

Private Sub mnuEncryptBinary_Click()
  Dim EncStr As String
  Dim EncKey As String, TempEncKey As String
  Dim EncLen As Integer
  Dim EncPos As Integer
  Dim EncKeyPos As Integer
  Dim tempChar As String
  Dim TA As Integer, TB As Integer, TC As Integer

  UndoText(frm) = ChildForms(frm).Text1.Text
  JustChanged = True

  TempEncKey = InputBox("Enter the Encryption Key. This Key will be vital for decrypting the text later.", "Encriptar")
  If TempEncKey = "" Then Exit Sub
  EncStr = ""
  EncPos = 1
  EncKeyPos = 1

  For X = 1 To Len(TempEncKey)
    EncKey = EncKey & Asc(Mid$(TempEncKey, X, 1))
  Next

  EncLen = Len(EncKey)

  For X = 1 To Len(ChildForms(frm).Text1.Text)
    TB = Asc(Mid$(EncKey, EncKeyPos, 1))
    EncKeyPos = EncKeyPos + 1
    If EncKeyPos > EncLen Then EncKeyPos = 1
    TA = Asc(Mid$(ChildForms(frm).Text1.Text, X, 1))
    TC = TB Xor TA
    tempChar = GetBinary(TC)
    EncStr = EncStr & tempChar
  Next
  ChildForms(frm).Text1.Text = EncStr
End Sub

Private Sub mnuEncryptHex_Click()
  Dim EncStr As String
  Dim EncKey As String, TempEncKey As String
  Dim EncLen As Integer
  Dim EncPos As Integer
  Dim EncKeyPos As Integer
  Dim tempChar As String
  Dim TA As Integer, TB As Integer, TC As Integer

  UndoText(frm) = ChildForms(frm).Text1.Text
  JustChanged = True

  TempEncKey = InputBox("Enter the Encryption Key. This Key will be vital for decrypting the text later.", "Encriptar")
  If TempEncKey = "" Then Exit Sub
  EncStr = ""
  EncPos = 1
  EncKeyPos = 1

  For X = 1 To Len(TempEncKey)
    EncKey = EncKey & Asc(Mid$(TempEncKey, X, 1))
  Next

  EncLen = Len(EncKey)

  For X = 1 To Len(ChildForms(frm).Text1.Text)
    TB = Asc(Mid$(EncKey, EncKeyPos, 1))
    EncKeyPos = EncKeyPos + 1
    If EncKeyPos > EncLen Then EncKeyPos = 1
    TA = Asc(Mid$(ChildForms(frm).Text1.Text, X, 1))
    TC = TB Xor TA
    tempChar = Hex$(TC)
    If Len(tempChar) < 2 Then tempChar = "0" & tempChar
    EncStr = EncStr & tempChar
  Next
  ChildForms(frm).Text1.Text = EncStr
End Sub

Private Sub mnuestandar_Click()
If mnuestandar.Checked = True Then
CoolBar1.Visible = False
Toolbar1.Visible = False
mnuestandar.Checked = False
Else
CoolBar1.Visible = True
Toolbar1.Visible = True
mnuestandar.Checked = True
End If
End Sub

Private Sub mnuExit_Click()
End
End Sub

Private Sub mnuFind_Click()
  Form3.Show
End Sub

Private Sub mnuFindNext_Click()
If MatchCase = True Then
  Pos = InStr(Pos + 1, ChildForms(frm).Text1.Text, SearchStr)
Else
  Pos = InStr(Pos + 1, ChildForms(frm).Text1.Text, SearchStr, vbTextCompare)
End If
If Pos <> 0 Then
  ChildForms(frm).Text1.SelStart = Pos - 1
  ChildForms(frm).Text1.SelLength = Len(SearchStr)
  Exit Sub
Else
  MsgBox "Cannot Find " & Chr$(34) & SearchStr & Chr$(34)
End If
End Sub

Private Sub mnuFont_Click()
  Form2.Show 1
End Sub

Private Sub mnufont2_Click()
If mnufont2.Checked = True Then
Toolbar2.Visible = False
mnufont2.Checked = False
Else
Toolbar2.Visible = True
mnufont2.Checked = True
End If
End Sub

Private Sub mnuhtml_Click()
frmEditor.Show
MDIForm1.Hide
End Sub

Private Sub mnuInsertDateLong_Click()
  UndoText(frm) = ChildForms(frm).Text1.Text
  JustChanged = True
  ChildForms(frm).Text1.SelText = Format(Date$, "Long Date")
End Sub

Private Sub mnuInsertDateMedium_Click()
  UndoText(frm) = ChildForms(frm).Text1.Text
  JustChanged = True
  ChildForms(frm).Text1.SelText = Format(Date$, "Medium Date")
End Sub

Private Sub mnuInsertDateShort_Click()
  UndoText(frm) = ChildForms(frm).Text1.Text
  JustChanged = True
  ChildForms(frm).Text1.SelText = Format(Date$, "Short Date")
End Sub

Private Sub mnuInsertFileName_Click()
  UndoText(frm) = ChildForms(frm).Text1.Text
  JustChanged = True
  ChildForms(frm).Text1.SelText = file(frm)
End Sub

Private Sub mnuInsertPathAndFile_Click()
  UndoText(frm) = ChildForms(frm).Text1.Text