Programming Tool Box/SIMS_2.iso/vb_code2/x_tal4/demodll2.frm

Text File | 1993-08-28 | 5KB | 171 lines

VERSION 2.00
Begin Form frmReadDescriptions
   AutoRedraw      =   -1  'True
   Caption         =   "Read Report Descriptions"
   ClientHeight    =   3960
   ClientLeft      =   495
   ClientTop       =   1080
   ClientWidth     =   7365
   Height          =   4365
   Left            =   435
   LinkTopic       =   "Form1"
   ScaleHeight     =   3960
   ScaleWidth      =   7365
   Top             =   735
   Width           =   7485
   Begin ListBox lstComments
      Height          =   420
      Left            =   765
      TabIndex        =   2
      Top             =   3900
      Visible         =   0   'False
      Width           =   1785
   End
   Begin CommonDialog CMDialog1
      CancelError     =   -1  'True
      DialogTitle     =   "Select Directory"
      Left            =   165
      Top             =   3900
   End
   Begin ListBox lstTitles
      Height          =   2175
      Left            =   90
      TabIndex        =   1
      Top             =   690
      Width           =   7125
   End
   Begin CommandButton Command1
      Caption         =   "Select Report Directory..."
      Height          =   360
      Left            =   105
      TabIndex        =   0
      Top             =   105
      Width           =   2400
   End
   Begin Label Label1
      Caption         =   "Comment for item selected:"
      Height          =   480
      Left            =   210
      TabIndex        =   4
      Top             =   3060
      Width           =   1200
      WordWrap        =   -1  'True
   End
   Begin Label lblComment
      BorderStyle     =   1  'Fixed Single
      Height          =   720
      Left            =   1560
      TabIndex        =   3
      Top             =   3045
      Width           =   5670
      WordWrap        =   -1  'True
   End
End
Option Explicit

Sub Command1_Click ()

    Dim saveErr As Integer
    Dim Filename As String
    Dim Filetitle As String
    Dim p As Integer
    Dim reportPath As String
    Dim errcode As Integer
    Dim allReports As String
    Dim nextFileTitle As String
    Dim reportTitle As String
    Dim reportComment As String
    Dim reportTitleTemp As String
    Dim reportCommentTemp As String

    cmdialog1.DialogTitle = "Select Report Directory"
    cmdialog1.Filename = ""
    cmdialog1.Filter = "Reports (*.rpt) | *.rpt "
    cmdialog1.FilterIndex = 1
    cmdialog1.Flags = OFN_PATHMUSTEXIST Or OFN_READONLY
    On Error Resume Next
        cmdialog1.Action = DLG_FILE_OPEN
        saveErr = Err
    On Error GoTo 0
    If saveErr <> 0 Then Exit Sub

    mousepointer = 11
    lstTitles.Clear
    lstComments.Clear
    lblComment.Caption = ""

    Filename = cmdialog1.Filename
    Filetitle = cmdialog1.Filetitle
    p = InStr(Filename, Filetitle)
    reportPath = Left$(Filename, p - 1)
    If Right$(reportPath, 1) <> "\" Then
       reportPath = reportPath & "\"
    End If

    allReports = reportPath + "*.rpt"
    reportTitle = Space$(512) 'Maximum 512. No terminating null character.
    reportComment = Space$(1024)  'Maximum 1024. No terminating null character.

    nextFileTitle = Dir(allReports)
    While Len(nextFileTitle)
        GetreportTitle reportPath & nextFileTitle, reportTitle, reportComment, errcode
        If errcode <> 0 Then
           MsgBox "Error code:" & Str$(errcode)
        End If

        'Note: no terminating null character to check:
        reportTitleTemp = Trim$(reportTitle)
        reportCommentTemp = Trim$(reportComment)

        If errcode = 0 Then
           If Len(reportTitleTemp) Then
              lstTitles.AddItem nextFileTitle & "  :  " & reportTitleTemp
           Else
              lstTitles.AddItem nextFileTitle & "  :  No Description"
           End If

           If Len(reportCommentTemp) Then
              lstComments.AddItem reportCommentTemp
           Else
              lstComments.AddItem "No Comment."
           End If
        End If
        nextFileTitle = Dir

    Wend
    mousepointer = 0

End Sub

Sub lstTitles_Click ()
ShowComment
End Sub

Sub lstTitles_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
   ShowComment
End If

End Sub

Sub lstTitles_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
   ShowComment
End If

End Sub

Sub ShowComment ()

         Dim comment As String
         If lstTitles.ListIndex <> -1 Then
            comment = lstComments.List(lstTitles.ListIndex)
            If comment <> lblComment.Caption Then
                lblComment.Caption = comment
                lblComment.Refresh
            End If
         End If

End Sub