frmtext.frm

数据同步工具

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmText 
   Caption         =   "提示信息"
   ClientHeight    =   6435
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10275
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmText.frx":0000
   LinkTopic       =   "Form1"
   MinButton       =   0   'False
   ScaleHeight     =   6435
   ScaleWidth      =   10275
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdClear 
      Caption         =   "清除(&C)"
      Height          =   300
      Left            =   7320
      TabIndex        =   3
      Top             =   6075
      Width           =   1452
   End
   Begin VB.TextBox txt1 
      Height          =   5880
      Left            =   36
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   72
      Width           =   10200
   End
   Begin MSComDlg.CommonDialog CD1 
      Left            =   3615
      Top             =   6015
      _ExtentX        =   688
      _ExtentY        =   688
      _Version        =   393216
   End
   Begin VB.CommandButton cmdSaveAs 
      Caption         =   "另存为(&S)..."
      Height          =   300
      Left            =   5835
      TabIndex        =   2
      Top             =   6075
      Width           =   1452
   End
   Begin VB.CommandButton cmdExit 
      Cancel          =   -1  'True
      Caption         =   "关闭(ESC)"
      Height          =   300
      Left            =   8805
      TabIndex        =   1
      Top             =   6060
      Width           =   1452
   End
End
Attribute VB_Name = "frmText"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public Sub Clear()
    txt1.Text = ""
End Sub

Public Sub AddText(pstrText As String, Optional pblnAddTime As Boolean = False)
    Dim S As String
    If pblnAddTime Then
        S = Format(Now, "yyyy-mm-dd hh:Nn:Ss") & "  " & pstrText
    Else
        S = pstrText
    End If
    If txt1.Text = "" Then
        txt1.Text = S
    Else
        txt1.Text = txt1.Text & vbCrLf & S
    End If
    On Error Resume Next
    txt1.SelStart = Len(txt1.Text)
End Sub

Private Sub cmdClear_Click()
    txt1.Text = ""
End Sub

Private Sub cmdExit_Click()
    Me.Hide
End Sub

Private Sub cmdSaveAs_Click()
    CD1.CancelError = True
    On Error GoTo Err1
    Dim strFileName As String
    Dim ts
    
    CD1.DialogTitle = "文本内容另存为"
    CD1.Filter = "文本文件(*.txt)|*.txt|其它文件(*.*)|*.*"
    CD1.FilterIndex = 1
    CD1.ShowSave
    strFileName = CD1.FileName
    If strFileName = "" Then Exit Sub
    If gFSO.FileExists(strFileName) Then
        If XF_MsgQ("要保存的文件已存在，覆盖吗?") = False Then Exit Sub
    End If
    On Error GoTo Err2
    Set ts = gFSO.CreateTextFile(strFileName, True)
    ts.Write txt1.Text
    ts.Close
    Exit Sub
Err1:
    Exit Sub
Err2:
    XF_ShowErr "保存文本内容时出错", Err
End Sub


Private Sub Form_Resize()
    Dim I As Integer
    cmdExit.Top = Me.ScaleHeight - cmdExit.Height - 100
    cmdExit.Left = Me.ScaleWidth - cmdExit.Width - 100
    cmdClear.Top = cmdExit.Top
    cmdClear.Left = cmdExit.Left - cmdClear.Width - 20
    cmdSaveAs.Top = cmdExit.Top
    cmdSaveAs.Left = cmdClear.Left - cmdSaveAs.Width - 20
    txt1.Top = Me.ScaleTop
    txt1.Left = Me.ScaleLeft
    txt1.Width = Me.ScaleWidth
    I = cmdExit.Top - txt1.Top - 100
    If I < 0 Then I = 0
    txt1.Height = I
End Sub