home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
vb_code2
/
x_tal4
/
demodll2.frm
< prev
next >
Wrap
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