frmword.frm

文本编辑器 简介|特点|游戏截图简介|特点|游戏截图简介|特点|游戏截图

Private Sub Command3_Click()
On Error GoTo dd
Cmdc.Filter = "Rich Text Format (*.RTF)|*.rtf|Text Document (*.TXT)|*.txt"
Cmdc.DialogTitle = "Open a Rich Text File "
Cmdc.FilterIndex = 0
Cmdc.ShowOpen
PrintX.Text = ""
If Cmdc.FilterIndex = 1 Then
  PrintX.LoadFile Cmdc.FileName, 0
ElseIf Cmdc.FilterIndex = 2 Then
  PrintX.LoadFile Cmdc.FileName, 1
End If
  
dd:

End Sub

Private Sub Command4_Click()
On Error GoTo dd
Cmdc.ShowPrinter
PrintX.SelPrint Printer.hDC, True
dd:

End Sub

Private Sub Fontnames_Change()
  Text2.FontName = Fonter(Fontnames.ListIndex + 1)
  Text2.Visible = True
  Timer1.Enabled = True
End Sub

Private Sub Fontnames_Click()
On Error Resume Next
Text2.FontName = Fonter(Fontnames.ListIndex + 1)
Text2.Visible = True
Timer1.Enabled = True
If Fontnames.ListIndex > 0 Then PrintX.SelFontName = Fonter(Fontnames.ListIndex - 1)
End Sub

Private Sub FontSizeX_Click()
On Error Resume Next
If FontSizeX.ListIndex > 0 Then PrintX.SelFontSize = FontSizeX.ListIndex + 7
End Sub

Private Sub Form_Activate()
  
  PrintX.SetFocus
  PrintX_SelChange
End Sub

Private Sub Form_Load()
On Error Resume Next

PrintX.LoadFile App.Path + "\content.rtf", 0
FontSizeX.Clear
FontSizeX.AddItem "[Miexd Size]"
FontSizeX.AddItem "8"

For I = 1 To 17
  Load mnusize(I)
  mnusize(I).Caption = LTrim(RTrim(Str(I + 8)))
  FontSizeX.AddItem LTrim(RTrim(Str(I + 8)))
Next I

Fontnames.Clear
Fontnames.AddItem "[Mixed Fonts]"
Fonter(0) = Printer.Fonts(0)
mnufonts(0).Caption = Printer.Fonts(0)
Fontnames.AddItem Printer.Fonts(0)

For I = 1 To Printer.FontCount - 1
  Load mnufonts(I)
  Fonter(I) = Printer.Fonts(I)
  mnufonts(I).Caption = Fonter(I)
  Fontnames.AddItem Printer.Fonts(I)
Next I


End Sub

Private Sub Form_Resize()
If frmword.Height < 5000 Then
  frmword.Height = 5000
End If
If frmword.Width < Frame1.Width Then
  frmword.Width = Frame1.Width + 100
Else
  PrintX.Top = Tol.Top + Tol.Height + 20
  PrintX.Left = 5
  PrintX.Width = frmword.ScaleWidth
  PrintX.Height = frmword.Height - (Tol.Top + Tol.Height + (Frame1.Height * 2.2))
  Frame1.Left = 5
  Frame1.Top = PrintX.Top + PrintX.Height + 20
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
For I = 1 To 17
  Unload mnusize(I)
Next I
For I = 1 To Printer.FontCount - 1
  Unload mnufonts(I)
Next I

End Sub



Private Sub Label2_Click()
On Error GoTo dd

Cmdc.Color = Label2.BackColor
Cmdc.ShowColor
Label2.BackColor = Cmdc.Color
PrintX.SelColor = Cmdc.Color
dd:
'if cancel
End Sub

Private Sub Label3_Click()

End Sub

Private Sub mnubold_Click()
If mnubold.Checked = False Then
  PrintX.SelBold = True
Else
  PrintX.SelBold = False
End If
  PrintX_SelChange
End Sub

Private Sub mnuedit_Click()
Dim temp As String


For I = 0 To Printer.FontCount - 1
  mnufonts(I).Checked = False
Next I

If PrintX.SelFontName <> "" Then
  temp = PrintX.SelFontName
  
  For I = 0 To Printer.FontCount - 1
    If Fonter(I) = temp Then
      mnufonts(I).Checked = True
    End If
  Next I
End If

If PrintX.SelBold = True Then
  mnubold.Checked = True
Else
  mnubold.Checked = False
End If
If PrintX.SelUnderline = True Then
  mnuunderline.Checked = True
Else
  mnuunderline.Checked = False
End If
If PrintX.SelItalic = True Then
  muitalics.Checked = True
Else
  muitalics.Checked = False
End If
For I = 0 To mnusize.Count - 1
  mnusize(I).Checked = False
Next I
If PrintX.SelFontSize <> "" Then mnusize(Int(PrintX.SelFontSize) - 8).Checked = True
End Sub

Private Sub mnufonts_Click(Index As Integer)

For I = 0 To Printer.FontCount - 1
  mnufonts(I).Checked = False
Next I
  
PrintX.SelFontName = Fonter(Index)

mnufonts(Index).Checked = True
  
  PrintX_SelChange
End Sub

Private Sub mnuunderline_Click()
If mnuunderline.Checked = True Then
  PrintX.SelUnderline = False
Else
  PrintX.SelUnderline = True
End If
  PrintX_SelChange
End Sub

Private Sub muitalics_Click()
If muitalics.Checked = True Then
  PrintX.SelItalic = False
Else
  PrintX.SelItalic = True
End If
  PrintX_SelChange

End Sub

Private Sub PrintX_MouseDown(Button As Integer, Shift As Integer, X As Single, y As Single)
If Button = 2 Then
  If Shift = 1 Then
    PopupMenu mnuedit
  Else
    PrintX.AutoVerbMenu = True
  End If
End If
End Sub

Private Sub mnusize_Click(Index As Integer)
PrintX.SelFontSize = 8 + Index
  PrintX_SelChange
End Sub

Private Sub PrintX_SelChange()
Dim temp As String

If PrintX.SelFontName <> "" Then
  temp = PrintX.SelFontName
  
  For I = 0 To Printer.FontCount - 1
    If Fonter(I) = temp Then
      Fontnames.ListIndex = I + 1
    End If
  Next I
Else
  Fontnames.ListIndex = 0
End If

For I = 0 To mnusize.Count - 1
  mnusize(I).Checked = False
Next I

If PrintX.SelFontSize <> "" Then
  mnusize(Int(PrintX.SelFontSize) - 8).Checked = True
  FontSizeX.ListIndex = (Int(PrintX.SelFontSize) - 8) + 1
Else
  FontSizeX.ListIndex = 0
End If
If PrintX.SelBold = True Then
  Tol.Buttons.Item(2).Value = tbrPressed
Else
  Tol.Buttons.Item(2).Value = tbrUnpressed
End If

If PrintX.SelItalic = True Then
  Tol.Buttons.Item(4).Value = tbrPressed
Else
  Tol.Buttons.Item(4).Value = tbrUnpressed
End If

If PrintX.SelUnderline = True Then
  Tol.Buttons.Item(6).Value = tbrPressed
Else
  Tol.Buttons.Item(6).Value = tbrUnpressed
End If
Ali0.Value = False
Ali1.Value = False
Ali2.Value = False
If PrintX.SelAlignment <> "" Then
Select Case PrintX.SelAlignment
  Case 0
    Ali0.Value = True
  Case 1
    Ali1.Value = True
  Case 2
    Ali2.Value = True
End Select
End If
If PrintX.SelBullet <> "" Then
  If PrintX.SelBullet = True Then
    Bulletx.Value = True
  Else
    Bulletx.Value = False
  End If
End If

If PrintX.SelColor <> "" Then
  Label2.BackColor = PrintX.SelColor
Else
  Label2.BackColor = QBColor(15)
End If

End Sub

Private Sub ToggleButton5_Click()

End Sub

Private Sub ToggleButton3_Click()

End Sub

Private Sub Timer1_Timer()
Timer1.Enabled = False
Text2.Visible = False
End Sub

Private Sub Tol_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
  Case "Bold"
    If Tol.Buttons.Item(2).Value = tbrPressed Then
      PrintX.SelBold = False
      Tol.Buttons.Item(2).Value = tbrUnpressed
    Else
      PrintX.SelBold = True
      Tol.Buttons.Item(2).Value = tbrPressed
    End If
  Case "Italics"
    If Tol.Buttons.Item(4).Value = tbrPressed Then
      PrintX.SelItalic = False
      Tol.Buttons.Item(4).Value = tbrUnpressed
    Else
      PrintX.SelItalic = True
      Tol.Buttons.Item(4).Value = tbrPressed
    End If
  Case "Underline"
    If Tol.Buttons.Item(6).Value = tbrPressed Then
      PrintX.SelUnderline = False
      Tol.Buttons.Item(6).Value = tbrUnpressed
    Else
      PrintX.SelUnderline = True
      Tol.Buttons.Item(6).Value = tbrPressed
    End If
End Select
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)

End Sub