frmtickers.frm

英文版Access数据库编程

      Width           =   1335
   End
   Begin VB.Label Label1 
      Caption         =   "Message Title:"
      Height          =   255
      Left            =   120
      TabIndex        =   19
      Top             =   3960
      Width           =   1335
   End
   Begin VB.Label Label2 
      Caption         =   "Message:"
      Height          =   255
      Left            =   120
      TabIndex        =   18
      Top             =   4560
      Width           =   1335
   End
   Begin VB.Shape Shape1 
      BackColor       =   &H00FF8080&
      BackStyle       =   1  'Opaque
      BorderStyle     =   0  'Transparent
      Height          =   855
      Left            =   0
      Top             =   0
      Width           =   10095
   End
End
Attribute VB_Name = "frmTickers"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Type tTicker
    title As String
    message As String
    id As String
    dc As String
    mc As String
    yc As String
    user As String
    isspec As Boolean
    dt As String
    mt As String
    yt As String
End Type
Private currQuery As String
Dim tmpTick As tTicker

Public Sub getTickers(ByVal tSQL As String)
Dim tRS As Recordset
currQuery = tSQL
With lvTicker
    .ColumnHeaders.Clear
    .ListItems.Clear
    
    .ColumnHeaders.add , , "Date Created"
    .ColumnHeaders.add , , "Title"
    .ColumnHeaders.add , , "Message"
    .ColumnHeaders.add , , "Publish Date"
    .ColumnHeaders.add , , "User"
    
    RSOpen tRS, tSQL, dbOpenSnapshot
    While Not tRS.EOF
        .ListItems.add , , tRS("dateCreated")
        .ListItems(.ListItems.Count).SubItems(1) = tRS("msgTitle")
        .ListItems(.ListItems.Count).SubItems(2) = tRS("msgText")
        .ListItems(.ListItems.Count).SubItems(3) = IIf(IsNull(tRS("dateToBeShown")), "", tRS("dateToBeShown"))
        .ListItems(.ListItems.Count).SubItems(4) = tRS("username")
        .ListItems(.ListItems.Count).Tag = tRS("tickerID")
        tRS.MoveNext
    Wend
    tRS.Close
    Set tRS = Nothing
End With
ErrHandler:
If Err.Number <> 0 Then
    'Check if table does not exist or syntax errors
    ErrorNotifier Err.Number, Err.description
    Exit Sub
End If
End Sub

Private Sub setFormMode(ByVal tMode As ModeStatus)
Select Case tMode
    Case Editing
        lvTicker.Enabled = False
        txtTitle.Enabled = True
        txtMsg.Enabled = True
        created(0).Enabled = True
        created(1).Enabled = True
        created(2).Enabled = True
        cmbUser.Enabled = True
        chkSpec.Enabled = True
        dd.Enabled = True
        mm.Enabled = True
        yyyy.Enabled = True
        Frame1.Enabled = True
        cmdEdit.Visible = False
        cmdClose.Visible = False
        cmdDelete.Visible = False
    Case Viewing
        lvTicker.Enabled = True
        txtTitle.Enabled = False
        txtMsg.Enabled = False
        created(0).Enabled = False
        created(1).Enabled = False
        created(2).Enabled = False
        cmbUser.Enabled = False
        chkSpec.Enabled = False
        dd.Enabled = False
        mm.Enabled = False
        yyyy.Enabled = False
        Frame1.Enabled = False
        cmdEdit.Visible = True
        cmdClose.Visible = True
        cmdDelete.Visible = True
End Select
End Sub

Private Sub chkSpec_Click()
If chkSpec.Value = vbChecked Then
    Frame1.Enabled = True
Else
    Frame1.Enabled = False
End If
End Sub

Private Sub cmdCancel_Click()
setFormMode Viewing
created(0).Text = tmpTick.dc
created(1).Text = tmpTick.mc
created(2).Text = tmpTick.yc
lblhidden.Caption = tmpTick.id
txtTitle.Text = tmpTick.title
txtMsg.Text = tmpTick.message
cmbUser.Text = tmpTick.user
If tmpTick.dt = "" Then
    dd.ListIndex = 0
Else
    dd.Text = tmpTick.dt
End If
If tmpTick.mt = "" Then
    mm.ListIndex = 0
Else
    mm.Text = tmpTick.mt
End If
If tmpTick.yt = "" Then
    yyyy.ListIndex = 0
Else
    yyyy.Text = tmpTick.yt
End If
If dd.Text <> "" Then
    chkSpec.Value = vbChecked
Else
    chkSpec.Value = vbUnchecked
End If
End Sub

Private Sub cmdClose_Click()
Unload Me
End Sub

Private Sub cmdDelete_Click()
If lblhidden.Caption <> "" Then
    If MsgBox("Are you sure you want to delete this ticker message.", vbYesNo + vbQuestion, "Delete message") = vbYes Then
        Dim tempSQL As String
        tempSQL = "DELETE FROM Ticker WHERE tickerID=" & lblhidden.Caption & ";"
        MySynonDatabase.Execute tempSQL
        InfoMsg "The ticker has been deleted.", "Ticker deleted"
        getTickers currQuery
        If lvTicker.ListItems.Count > 0 Then
            lvTicker.ListItems(lvTicker.ListItems.Count).Selected = True
        Else
            txtTitle.Text = ""
            txtMsg.Text = ""
            cmbUser.Text = ""
            dd.Text = ""
            mm.Text = ""
            yyyy.Text = ""
            created(0).Text = ""
            created(1).Text = ""
            created(2).Text = ""
            chkSpec.Value = Unchecked
            
        End If
    End If
End If
End Sub

Private Sub cmdEdit_Click()
If txtTitle.Text <> "" Then
    setFormMode Editing
    tmpTick.dc = created(0).Text
    tmpTick.mc = created(1).Text
    tmpTick.yc = created(2).Text
    tmpTick.id = lblhidden.Caption
    tmpTick.title = txtTitle.Text
    tmpTick.message = txtMsg.Text
    tmpTick.user = cmbUser.Text
    If chkSpec.Value = vbUnchecked Then
        tmpTick.dt = ""
        tmpTick.mt = ""
        tmpTick.yt = ""
    Else
        tmpTick.dt = dd.Text
        tmpTick.mt = mm.Text
        tmpTick.yt = yyyy.Text
    End If
Else
    InfoMsg "Please select a ticker to be edited.", "Missing selection"
    lvTicker.SetFocus
End If
End Sub

Private Sub Form_Load()
lblNotes.Caption = "Use the ticker manager to add messages to remind you of your personal daily task." & vbCrLf & "Also a useful tool for administrators to communicate with other users publicly."
Dim i As Integer
yyyy.addItem ""
For i = 0 To 5
    yyyy.addItem Format$(Year(Now()) + i, "0000")
    created(2).addItem Format$(Year(Now()) - 2 + i, "0000")
Next i
cmbUser.addItem "", 0
cmbUser.addItem "GENERAL"
FillCombo cmbUser, "SELECT Username FROM Users", "Username"
setFormMode Viewing
If CurrentUser.prvlgAdmin = True Then
    getTickers "SELECT * FROM Ticker WHERE username='" & CurrentUser.strUsername & "' OR username='GENERAL';"
Else
    getTickers "SELECT * FROM Ticker WHERE username='" & CurrentUser.strUsername & "';"
    cmbUser.Locked = True
End If
End Sub

Private Sub Form_Resize()
Shape1.width = Me.width
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set frmTickers = Nothing
End Sub

Private Sub lvTicker_ItemClick(ByVal Item As MSComctlLib.ListItem)
With Item
    If .Selected Then
        txtTitle.Text = .SubItems(1)
        txtMsg.Text = .SubItems(2)
        created(0).Text = Left$(.Text, 2)
        created(1).Text = Right$(Left$(.Text, 5), 2)
        created(2).Text = Right$(.Text, 4)
        lblhidden.Caption = .Tag
        If .SubItems(3) = "" Then
            chkSpec.Value = vbUnchecked
            dd.ListIndex = 0
            mm.ListIndex = 0
            yyyy.ListIndex = 0
        Else
            chkSpec.Value = vbChecked
            dd.Text = Left$(.SubItems(3), 2)
            mm.Text = Right$(Left$(.SubItems(3), 5), 2)
            yyyy.Text = Right$(.SubItems(3), 4)
        End If
        cmbUser.Text = .SubItems(4)
    End If
End With
End Sub

Private Sub txtMsg_GotFocus()
SelText txtMsg
End Sub

Private Sub txtMsg_KeyPress(KeyAscii As Integer)
OnlyAlpha KeyAscii
End Sub

Private Sub txtTitle_GotFocus()
SelText txtTitle
End Sub

Private Sub txtTitle_KeyPress(KeyAscii As Integer)
OnlyAlpha KeyAscii
End Sub