xxzb.frm

自动排版程序

   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "信息内容："
      Height          =   180
      Left            =   180
      TabIndex        =   23
      Top             =   1140
      Width           =   900
   End
   Begin VB.Label Label2 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "信息出处："
      ForeColor       =   &H80000008&
      Height          =   180
      Left            =   180
      TabIndex        =   21
      Top             =   750
      Width           =   900
   End
   Begin VB.Line Line1 
      BorderWidth     =   3
      X1              =   5040
      X2              =   5040
      Y1              =   60
      Y2              =   7500
   End
   Begin VB.Label Label1 
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "信息标题："
      ForeColor       =   &H80000008&
      Height          =   180
      Left            =   180
      TabIndex        =   0
      Top             =   270
      Width           =   900
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim boolModified As Boolean
Dim intModNum As Integer

Private Sub cmdDel_Click()
Dim Number As Integer
On Error GoTo ErrHandle

    Number = Me.lstTitles.ListIndex
    If Me.lstTitles.ListIndex < 0 Or Me.lstTitles.ListCount = 0 Then Exit Sub
    Call DelOne(Number)
    Me.lstTitles.RemoveItem (Number)
    Exit Sub
    
ErrHandle:
MsgBox "发生错误！" & vbCrLf & Err.Description

End Sub

Private Sub cmdDown_Click()
Dim Number As Integer
On Error GoTo ErrHandle

    Number = Me.lstTitles.ListIndex
    If Me.lstTitles.ListIndex = Me.lstTitles.ListCount - 1 Or _
        Me.lstTitles.ListCount = 0 Then Exit Sub
    Call MoveDown(Number)
    Me.lstTitles.List(Number) = strTitles(Number) & "----" & strClass(Number)
    Me.lstTitles.List(Number + 1) = strTitles(Number + 1) & "----" & strClass(Number + 1)
    Me.lstTitles.ListIndex = Number + 1
    Exit Sub
    
ErrHandle:
MsgBox "发生错误！" & vbCrLf & Err.Description
    
End Sub

Private Sub cmdEdit_Click()
On Error GoTo ErrHandle

    
    intModNum = Me.lstTitles.ListIndex
    If intModNum < 0 Or Me.lstTitles.ListCount = 0 Then Exit Sub
    Form1.txtTitle = strTitles(intModNum)
    Form1.txtSource = strSource(intModNum)
    Form1.rtxtWord = strContents(intModNum)
    Select Case strClass(intModNum)
        Case "宏观动向"
            Me.optHGDX.Value = True
        Case "企业纵横"
            Me.optQYZH.Value = True
        Case "市场动态"
            Me.optSCDT.Value = True
        Case "综合报道"
            Me.optZHBD.Value = True
        Case "综信采撷"
            Me.optZXCX.Value = True
    End Select
    
    boolModified = True
    
'    Form2.Show
'    Form1.Visible = False
    Exit Sub
    
ErrHandle:
MsgBox "发生错误！" & vbCrLf & Err.Description

End Sub

Private Sub cmdEXIT_Click()
If MsgBox("是否要退出本程序？", vbInformation + vbOKCancel) = vbOK Then
    End
End If
End Sub


Private Sub cmdInFile_Click()
On Error GoTo ErrHandle
    
    Me.CommonDialog1.Filter = "*.owd|*.owd"
    Me.CommonDialog1.ShowOpen
         
        If Me.CommonDialog1.filename <> "" Then
            InFile (Me.CommonDialog1.filename)
        End If
    
    Exit Sub
    
ErrHandle:
If Err.Number = 32755 Then Exit Sub
MsgBox "发生错误！" & vbCrLf & Err.Description

End Sub

Private Sub cmdOutWord_Click()
Dim postNoHZ As String      '第XX期
Dim postNoSum As String    '总第XXX期
Dim postYear As String     '出刊日期-年
Dim postMonth As String    '出刊日期-月
Dim postDay As String      '出刊日期-日

On Error GoTo ErrHandle


postNoHZ = Me.txtNoHZ
postNoSum = Me.txtNoSum
postYear = Me.cboYear.Text
postMonth = Me.cboMonth.Text
postDay = Me.cboDay.Text
    
    Call OutWord(postNoHZ, postNoSum, postYear, postMonth, postDay)

    Exit Sub
    
ErrHandle:
MsgBox "发生错误！" & vbCrLf & Err.Description

End Sub

Private Sub cmdQC_Click()
On Error GoTo ErrHandle
  
    
    Me.txtTitle.Text = ""
    Me.txtSource.Text = ""
    Me.rtxtWord = ""
    
    Me.optHGDX.Value = False
    Me.optQYZH.Value = False
    Me.optSCDT.Value = False
    Me.optZHBD.Value = False
    Me.optZXCX.Value = False
    
    Exit Sub
    
ErrHandle:
MsgBox "发生错误！" & vbCrLf & Err.Description

End Sub

Private Sub cmdSave_Click()
Dim bolPass As Boolean

On Error GoTo ErrHandle

    Me.CommonDialog1.Filter = "*.owd|*.owd"
    Me.CommonDialog1.ShowSave
    If Me.CommonDialog1.filename <> "" Then
        If CheckFile(Me.CommonDialog1.filename) = True Then
            OutFile (Me.CommonDialog1.filename)
        End If
    Else
        MsgBox "没有输入文件名"
    End If
    Exit Sub
    
ErrHandle:
If Err.Number = 32755 Then Exit Sub
MsgBox "发生错误！" & vbCrLf & Err.Description

End Sub

Private Sub cmdTJ_Click()
Dim postTitle As String     '信息标题
Dim postSource As String    '信息来源
Dim postContent As String   '信息内容
Dim postClass As String     '信息分类
On Error GoTo ErrHandle

'必须输入信息类别
   If Form1.optHGDX.Value = False And _
        Form1.optQYZH.Value = False And _
        Form1.optSCDT.Value = False And _
        Form1.optZHBD.Value = False And _
        Form1.optZXCX.Value = False Then
            MsgBox "没有选择信息类别！"
            Exit Sub
    End If
If Me.rtxtWord = "" Then
    MsgBox "信息内容没有输入。请输入"
    Exit Sub
End If

'根据选择的信息类别定义归类
   If Form1.optHGDX.Value = True Then postClass = "宏观动向"
   If Form1.optQYZH.Value = True Then postClass = "企业纵横"
   If Form1.optSCDT.Value = True Then postClass = "市场动态"
   If Form1.optZHBD.Value = True Then postClass = "综合报道"
   If Form1.optZXCX.Value = True Then postClass = "综信采撷"

'确定信息标题
If Me.txtTitle = "" Then
    If MsgBox("没有输入信息标题，是否继续？", vbYesNo) = vbNo Then
        Exit Sub
    Else
        If Form1.optHGDX.Value = True Then postTitle = "宏观动向"
        If Form1.optQYZH.Value = True Then postTitle = "企业纵横"
        If Form1.optSCDT.Value = True Then postTitle = "市场动态"
        If Form1.optZHBD.Value = True Then postTitle = "综合报道"
        If Form1.optZXCX.Value = True Then postTitle = "综信采撷"
    End If
Else
    postTitle = Me.txtTitle.Text
End If

'确定信息来源
If Me.txtSource = "" Then
    If MsgBox("没有输入信息来源，是否继续？", vbYesNo) = vbNo Then
        Exit Sub
    Else
    
    End If
Else
    postSource = Me.txtSource.Text
End If

postContent = Me.rtxtWord.Text


If postContent <> "" And Mid(postContent, Len(postContent) - 1, 1) = Chr(13) Then
    postContent = Mid(postContent, 1, Len(postContent) - 2)
End If

If boolModified = False Then
    Call AddList(postTitle, postSource, postContent, postClass)

Else
   strTitles(intModNum) = postTitle
   strSource(intModNum) = postSource
   strContents(intModNum) = postContent
   strClass(intModNum) = postClass
   Me.lstTitles.List(intModNum) = postTitle & "----" & postClass
   boolModified = False
   
      
End If


Call cmdQC_Click
Me.txtTitle.SetFocus
Exit Sub

ErrHandle:

MsgBox "发生错误！" & vbCrLf & Err.Description
End Sub

Private Sub cmdUp_Click()
On Error GoTo ErrHandle

Dim Number As Integer
    Number = Me.lstTitles.ListIndex
    If Me.lstTitles.ListIndex = 0 Or Me.lstTitles.ListCount = 0 Then Exit Sub
    Call MoveUp(Number)
    Me.lstTitles.List(Number) = strTitles(Number) & "----" & strClass(Number)
    Me.lstTitles.List(Number - 1) = strTitles(Number - 1) & "----" & strClass(Number - 1)
    Me.lstTitles.ListIndex = Number - 1
    Exit Sub
    
ErrHandle:
MsgBox "发生错误！" & vbCrLf & Err.Description

End Sub

Private Sub Form_Load()
    boolModified = False
End Sub

Private Sub lstTitles_DblClick()
    Call cmdEdit_Click
End Sub

Private Sub lstTitles_GotFocus()
    Dim i As Integer

    Dim lens As Integer
    Dim pages As Integer
    
    
    lens = 0
    
    For i = 0 To intT - 1
        lens = lens + Len(strContents(i))
    Next i
    pages = ((lens / 29#) + intT) / 26 + 1
    Form1.Label13 = "预计输入WORD后共 " & Str(pages) & "  页"

End Sub

Private Sub lstTitles_LostFocus()
    Dim i As Integer

    Dim lens As Integer
    Dim pages As Integer
    
    
    lens = 0
    
    For i = 0 To intT - 1
        lens = lens + Len(strContents(i))
    Next i
    pages = ((lens / 29#) + intT) / 26 + 1
    Form1.Label13 = "预计输入WORD后共 " & Str(pages) & "  页"
End Sub
Private Sub rtxtWord_DblClick()
Form2.Show
Me.Visible = False
End Sub