frmprint.frm

报警信息查询系统VB+ACESS 根据某啤酒厂出现故障不同（如系统错误、负亟接地、操作错误等）计算机系统进行报警

VERSION 5.00
Object = "{B0475000-7740-11D1-BDC3-0020AF9F8E6E}#6.0#0"; "TTF16.OCX"
Begin VB.Form FrmPrint 
   Caption         =   "打印记录"
   ClientHeight    =   7020
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10890
   Icon            =   "FrmPrint.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   7020
   ScaleWidth      =   10890
   StartUpPosition =   1  '所有者中心
   WindowState     =   2  'Maximized
   Begin VB.CheckBox Check1 
      Caption         =   "选择记录打印"
      Height          =   285
      Left            =   2790
      TabIndex        =   2
      Top             =   120
      Width           =   1605
   End
   Begin VB.CommandButton Command1 
      Caption         =   "打印"
      Height          =   315
      Index           =   1
      Left            =   30
      TabIndex        =   1
      Top             =   120
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "退出"
      Height          =   315
      Index           =   2
      Left            =   1290
      TabIndex        =   0
      Top             =   120
      Width           =   1095
   End
   Begin TTF160Ctl.F1Book RptDataGrid 
      Height          =   7605
      Left            =   90
      TabIndex        =   3
      Top             =   570
      Width           =   11115
      _ExtentX        =   19606
      _ExtentY        =   13414
      _0              =   $"FrmPrint.frx":030A
      _1              =   $"FrmPrint.frx":0713
      _2              =   $"FrmPrint.frx":0B1D
      _3              =   $"FrmPrint.frx":0F26
      _4              =   $"FrmPrint.frx":132F
      _count          =   5
      _ver            =   2
   End
End
Attribute VB_Name = "FrmPrint"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Sub PrintRpt()
On Error GoTo PrintErr
Dim i As Integer, j As Integer
j = 1
Screen.MousePointer = 11

RptDataGrid.InitTable
RptDataGrid.ReadEx App.Path & "\ini\datarpt.vts"

RptDataGrid.TextRC(3, 3) = Format$(Now, "YYYY年MM月DD日 HH时MM分")

For i = 0 To FrmMain.RecGrid.Rows - 1
    If Check1.Value = 0 Then
            If i > 0 Then
               '复制上一行的格式
               RptDataGrid.MaxRow = RptDataGrid.MaxRow + 1
               RptDataGrid.SetSelection i + 4, 2, i + 4, 6
               RptDataGrid.EditCopy
               RptDataGrid.SetSelection i + 5, 2, i + 5, 6
               RptDataGrid.EditPaste
            End If
            With RptDataGrid
               .TextRC(i + 4, 2) = FrmMain.RecGrid.TextMatrix(i, 0)
               .TextRC(i + 4, 3) = FrmMain.RecGrid.TextMatrix(i, 1)
               .TextRC(i + 4, 4) = FrmMain.RecGrid.TextMatrix(i, 2)
               .TextRC(i + 4, 5) = FrmMain.RecGrid.TextMatrix(i, 3)
               .TextRC(i + 4, 6) = FrmMain.RecGrid.TextMatrix(i, 4)
            End With
    Else
        If FrmMain.RecGrid.IsSelected(i) = True Then
                If j > 0 Then
                   '复制上一行的格式
                   RptDataGrid.MaxRow = RptDataGrid.MaxRow + 1
                   RptDataGrid.SetSelection j + 4, 2, j + 4, 6
                   RptDataGrid.EditCopy
                   RptDataGrid.SetSelection j + 5, 2, j + 5, 6
                   RptDataGrid.EditPaste
                End If
                With RptDataGrid
                    .TextRC(j + 4, 2) = FrmMain.RecGrid.TextMatrix(i, 0)
                    .TextRC(j + 4, 3) = FrmMain.RecGrid.TextMatrix(i, 1)
                    .TextRC(j + 4, 4) = FrmMain.RecGrid.TextMatrix(i, 2)
                    .TextRC(j + 4, 5) = FrmMain.RecGrid.TextMatrix(i, 3)
                    .TextRC(j + 4, 6) = FrmMain.RecGrid.TextMatrix(i, 4)
                End With
                j = j + 1
        End If
    End If
    
Next

Screen.MousePointer = 0

Exit Sub
PrintErr:
    MsgBox Err.Description, vbExclamation
    Screen.MousePointer = 0
    
End Sub


Private Sub Check1_Click()
PrintRpt
End Sub


Private Sub Command1_Click(Index As Integer)
Select Case Index
    Case 1
        On Error Resume Next
        RptDataGrid.FilePrintEx True, True
        
    Case 2
        Unload Me
    
End Select
End Sub


Private Sub Form_Load()
Me.Show
Form_Resize
PrintRpt

End Sub


Private Sub Form_Resize()
If Me.WindowState = 1 Then Exit Sub
RptDataGrid.Move RptDataGrid.Left, RptDataGrid.Top, Me.Width - 200, Me.Height - RptDataGrid.Top - 400
End Sub