start.frm

***** 展会管理系统 V1.1 共享版 ************** 一、安装 1.运行setup.exe文件； 2.如果不同意默认安装目录

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{00025600-0000-0000-C000-000000000046}#4.6#0"; "CRYSTL32.OCX"
Begin VB.Form start 
   AutoRedraw      =   -1  'True
   Caption         =   "展会监视系统...."
   ClientHeight    =   3255
   ClientLeft      =   60
   ClientTop       =   630
   ClientWidth     =   4680
   Icon            =   "start.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3255
   ScaleWidth      =   4680
   StartUpPosition =   2  '屏幕中心
   Begin Crystal.CrystalReport ReportName 
      Left            =   1665
      Top             =   3285
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   262150
   End
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   285
      Left            =   120
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   -2000
      Visible         =   0   'False
      Width           =   1140
   End
   Begin MSFlexGridLib.MSFlexGrid Grid1 
      Height          =   1575
      Left            =   195
      TabIndex        =   3
      Top             =   525
      Width           =   4290
      _ExtentX        =   7567
      _ExtentY        =   2778
      _Version        =   393216
      Rows            =   6
      Cols            =   5
      ForeColor       =   12582912
      ForeColorFixed  =   128
      BackColorSel    =   4227327
      ForeColorSel    =   16777215
      BackColorBkg    =   12632256
      AllowBigSelection=   0   'False
      FocusRect       =   0
      ScrollBars      =   2
      SelectionMode   =   1
      AllowUserResizing=   1
   End
   Begin VB.Frame Frame1 
      Height          =   810
      Left            =   240
      TabIndex        =   4
      Top             =   2250
      Width           =   4215
      Begin VB.CommandButton Command3 
         Caption         =   "打印(&P)"
         Height          =   480
         Left            =   150
         TabIndex        =   0
         Top             =   225
         Width           =   1230
      End
      Begin VB.CommandButton Command1 
         Caption         =   "确认(&O)"
         Height          =   480
         Left            =   1485
         TabIndex        =   1
         Top             =   225
         Width           =   1230
      End
      Begin VB.CommandButton Command2 
         Cancel          =   -1  'True
         Caption         =   "关闭(&C)"
         Height          =   480
         Left            =   2835
         TabIndex        =   2
         Top             =   225
         Width           =   1230
      End
   End
   Begin VB.Label Label1 
      Caption         =   "下列展会即将展出:"
      Height          =   240
      Left            =   270
      TabIndex        =   5
      Top             =   225
      Width           =   1725
   End
   Begin VB.Menu MenuPrint 
      Caption         =   "打印"
      Begin VB.Menu PrintName 
         Caption         =   "打印所有到期展会名称"
         Shortcut        =   ^N
      End
      Begin VB.Menu PrintContent 
         Caption         =   "打印所有到期展会内容"
         Shortcut        =   ^C
      End
   End
End
Attribute VB_Name = "start"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Okstr As String
Private Sub Command1_Click()
Dim Os As Integer
   Os = MsgBox("按确定之后，监视程序将不在提示该展会。(Y/N)", vbYesNo + 48, "不需要提示...")
If Os <> 6 Then
   Exit Sub
End If
Dim InNum As Integer, FileName As String
Dim Db As Database, Ef As Recordset, TempStr  As String
    Set Db = OpenDatabase(BrowseR + "Fair.MDB")
        TempStr = "Update Fair set 通知=(-1) Where " & Okstr
        Db.Execute TempStr
        Db.Close
   InNum = FreeFile
   FileName = BrowseR + "trans.sys"
   On Error GoTo NoFile
   Open FileName For Output As #InNum
   Write #InNum, "yusilong"
   Close #InNum
   Unload Me
   Exit Sub
NoFile:
   Exit Sub
End Sub

Private Sub Command2_Click()
Dim InNum As Integer, FileName As String
   InNum = FreeFile
   FileName = BrowseR + "trans.sys"
   On Error GoTo NoFile
   Open FileName For Output As #InNum
   Write #InNum, "yusilong"
   Close #InNum
   Unload Me
   Exit Sub
NoFile:
   Exit Sub
End Sub

Private Sub Command3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
   PopupMenu MenuPrint, 0
End If
End Sub

Private Sub Form_Load()
Dim BrowseR As String, Ts As Integer
MenuPrint.Visible = False
If App.PrevInstance = True Then
   MsgBox "监视程序已经启动，请按 Alt+Tab 切换！", vbOKOnly + 48, "警告..."
   Dim InNum As Integer, FileName As String
   InNum = FreeFile
   FileName = BrowseR + "trans.sys"
   On Error Resume Next
   Open FileName For Output As #InNum
   Write #InNum, "yusilong"
   Close #InNum
   Unload Me
   Exit Sub
End If
Ts = 30
Grid1.Cols = 3
Grid1.FormatString = "^ NO |^ 展会名称 |^ 时间 |^ 天数 "
Grid1.ColWidth(0) = 300
Grid1.ColWidth(1) = 1900
Grid1.ColWidth(2) = 1000
Grid1.ColWidth(3) = 1000

BrowseR = CurDir()

'Temp dir
'BrowseR = "f:\vb-nt\fair"
 
If Right(BrowseR, 1) <> "\" Then
   BrowseR = BrowseR + "\"
End If
Dim Db As Database, Ef As Recordset, TempStr As String
    Set Db = OpenDatabase(BrowseR + "Fair.MDB")
    Set Ef = Db.OpenRecordset("Fair", dbOpenTable)
        Grid1.Rows = Ef.RecordCount + 4
        TempStr = "展会时间<=#" & Date + Ts & "# and 展会时间>=date() and 通知=(0)"
        Okstr = TempStr
        TempStr = "Select * From Fair Where " & TempStr & ""
    Set Ef = Db.OpenRecordset(TempStr, dbOpenDynaset)
        HH = 1
        Do While Not Ef.EOF()
           Grid1.Row = HH
           Grid1.Col = 1
           Grid1.CellAlignment = 1
        If Not IsNull(Ef.Fields(0).Value) Then
           Grid1.Text = Ef.Fields(0).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 2
           Grid1.CellAlignment = 4
        If Not IsNull(Ef.Fields(2).Value) Then
           Grid1.Text = Ef.Fields(2).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 3
           Grid1.CellAlignment = 4
        If Not IsNull(Ef.Fields(10).Value) Then
           Grid1.Text = Ef.Fields(10).Value
        End If
          Ef.MoveNext
          HH = HH + 1
        Loop
 Db.Close
 For HH = 1 To Grid1.Rows - 1
    Grid1.Row = HH
    Grid1.Col = 0
    Grid1.Text = HH
    If Len(Grid1.Text) = 1 Then
     Grid1.Text = "0" + Grid1.Text
     End If
 Next
  Grid1.Row = 1
  Grid1.Col = 1
If Grid1.Text = "" Then
   Grid1.ColSel = 3
   Command3.Enabled = False
   Command1.Enabled = False
End If
End Sub

Private Sub Grid1_DblClick()
If Grid1.MouseCol = 0 Or Grid1.MouseRow = 0 Or Grid1.Text = "" Then Exit Sub
Dim InNum As Integer, FileName As String
   InNum = FreeFile
   FileName = BrowseR + "trans.sys"
   On Error GoTo NoFile
   Open FileName For Output As #InNum
   Write #InNum, Grid1.Text
   Close #InNum
   Dim Lmain As Long
   Lmain = Shell(BrowseR + "fairmain.exe", vbMaximizedFocus)
   If Lmain = 0 Then
      MsgBox "系统出现异常，请与程序设计者联系。", vbOKOnly + 16, "警告..."
   End If
   Exit Sub
NoFile:
   Exit Sub
   
End Sub

Private Sub PrintContent_Click()
On Error GoTo PrintErr
start.MousePointer = 11
Dim Db As Database, Ef As Recordset, TempStr As String
    Set Db = OpenDatabase(BrowseR + "Fair.MDB")
        TempStr = "Delete * From Fairprint"
        Db.Execute TempStr
        TempStr = "展会时间<=#" & Date + 30 & "# and 展会时间>=date() and 通知=(0)"
        TempStr = "Insert into Fairprint Select * From Fair Where " & TempStr & ""
        Db.Execute TempStr
        Db.Close
ReportName.ReportFileName = BrowseR + "FairAll.rpt"
ReportName.DataFiles(0) = BrowseR + "Fair.mdb"
ReportName.WindowState = crptMaximized
ReportName.PrintReport
start.MousePointer = 0
Exit Sub
PrintErr:
  MsgBox "打印错误！", vbOKOnly + 16, "警告！"
  start.MousePointer = 0
  Exit Sub
End Sub

Private Sub PrintName_Click()
start.MousePointer = 11
On Error GoTo PrintErr
Dim Db As Database, Ef As Recordset, TempStr As String
    Set Db = OpenDatabase(BrowseR + "Fair.MDB")
        TempStr = "Delete * From Fairprint"
        Db.Execute TempStr
        TempStr = "展会时间<=#" & Date + 30 & "# and 展会时间>=date() and 通知=(0)"
        TempStr = "Insert into Fairprint Select * From Fair Where " & TempStr & ""
        Db.Execute TempStr
        Db.Close
ReportName.ReportFileName = BrowseR + "Fairname.rpt"
ReportName.DataFiles(0) = BrowseR + "Fair.mdb"
ReportName.WindowState = crptMaximized
ReportName.PrintReport
start.MousePointer = 0
Exit Sub
PrintErr:
  MsgBox "打印错误！", vbOKOnly + 16, "警告！"
  start.MousePointer = 0
  Exit Sub
End Sub