Super Net 1/SUPERNET_1.iso/PC/OTROS/EXTRAS/WINWAIS/VB/VIEW.FRM

Visual Basic Form | 1994-02-07 | 24.0 KB | 759 lines

VERSION 2.00
Begin Form view_form
   AutoRedraw      =   -1  'True
   BackColor       =   &H00FFFFFF&
   Caption         =   "View"
   ClientHeight    =   3990
   ClientLeft      =   30
   ClientTop       =   945
   ClientWidth     =   9525
   DrawMode        =   6  'Invert
   FontBold        =   0   'False
   FontItalic      =   0   'False
   FontName        =   "Terminal"
   FontSize        =   9
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   4680
   Left            =   -30
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MinButton       =   0   'False
   ScaleHeight     =   3990
   ScaleWidth      =   9525
   Top             =   315
   Width           =   9645
   Begin PictureBox corner_fill
      BackColor       =   &H00808080&
      FillColor       =   &H00808080&
      FillStyle       =   0  'Solid
      Height          =   255
      Left            =   9270
      ScaleHeight     =   225
      ScaleWidth      =   225
      TabIndex        =   14
      Top             =   3720
      Width           =   255
   End
   Begin HScrollBar horiz_scroll
      Height          =   270
      Left            =   -30
      TabIndex        =   13
      Top             =   3720
      Width           =   9315
   End
   Begin SSPanel button_frame
      Align           =   1  'Align Top
      BackColor       =   &H00808080&
      Font3D          =   1  'Raised w/light shading
      ForeColor       =   &H00000000&
      Height          =   555
      Left            =   0
      Outline         =   -1  'True
      TabIndex        =   1
      Top             =   0
      Width           =   9525
      Begin SSCommand map_bbox
         AutoSize        =   1  'Adjust Picture Size To Button
         BevelWidth      =   1
         Font3D          =   0  'None
         Height          =   405
         Left            =   5160
         Picture         =   VIEW.FRX:0000
         TabIndex        =   12
         Top             =   90
         Width           =   420
      End
      Begin SSCommand telnet_bbox
         AutoSize        =   1  'Adjust Picture Size To Button
         BevelWidth      =   1
         Font3D          =   0  'None
         Height          =   420
         Left            =   4680
         Picture         =   VIEW.FRX:0182
         TabIndex        =   11
         Top             =   90
         Width           =   450
      End
      Begin SSCommand add_section_bbox
         AutoSize        =   1  'Adjust Picture Size To Button
         BevelWidth      =   1
         Font3D          =   0  'None
         Height          =   420
         Left            =   4110
         Picture         =   VIEW.FRX:0304
         TabIndex        =   10
         Top             =   90
         Width           =   450
      End
      Begin SSCommand copy_bbox
         AutoSize        =   1  'Adjust Picture Size To Button
         BevelWidth      =   1
         Font3D          =   0  'None
         Height          =   390
         Left            =   3570
         Picture         =   VIEW.FRX:0486
         TabIndex        =   9
         Top             =   90
         Width           =   420
      End
      Begin SSCommand prev_in_order_bbox
         AutoSize        =   1  'Adjust Picture Size To Button
         BevelWidth      =   1
         Font3D          =   0  'None
         Height          =   390
         Left            =   3030
         Picture         =   VIEW.FRX:0608
         TabIndex        =   8
         Top             =   90
         Width           =   420
      End
      Begin SSCommand prev_listed_bbox
         AutoSize        =   1  'Adjust Picture Size To Button
         BevelWidth      =   1
         Font3D          =   0  'None
         Height          =   390
         Left            =   2610
         Picture         =   VIEW.FRX:078A
         TabIndex        =   7
         Top             =   90
         Width           =   420
      End
      Begin SSCommand next_in_order_bbox
         AutoSize        =   1  'Adjust Picture Size To Button
         BevelWidth      =   1
         Font3D          =   0  'None
         Height          =   390
         Left            =   2130
         Picture         =   VIEW.FRX:090C
         TabIndex        =   6
         Top             =   90
         Width           =   420
      End
      Begin SSCommand next_listed_bbox
         AutoSize        =   1  'Adjust Picture Size To Button
         BevelWidth      =   1
         Font3D          =   0  'None
         Height          =   390
         Left            =   1710
         Picture         =   VIEW.FRX:0A8E
         TabIndex        =   5
         Top             =   90
         Width           =   420
      End
      Begin SSCommand find_bbox
         AutoSize        =   1  'Adjust Picture Size To Button
         BevelWidth      =   1
         Font3D          =   0  'None
         Height          =   390
         Left            =   1140
         Picture         =   VIEW.FRX:0C10
         TabIndex        =   4
         Top             =   90
         Width           =   420
      End
      Begin SSCommand print_bbox
         AutoSize        =   1  'Adjust Picture Size To Button
         BevelWidth      =   1
         Font3D          =   0  'None
         Height          =   390
         Left            =   570
         Picture         =   VIEW.FRX:0D92
         TabIndex        =   3
         Top             =   90
         Width           =   420
      End
      Begin SSCommand save_bbox
         AutoSize        =   1  'Adjust Picture Size To Button
         BevelWidth      =   1
         Font3D          =   0  'None
         Height          =   390
         Left            =   120
         Picture         =   VIEW.FRX:0F14
         TabIndex        =   2
         Top             =   90
         Width           =   420
      End
   End
   Begin VScrollBar view_scroll
      Height          =   3195
      Left            =   9270
      TabIndex        =   0
      Top             =   540
      Width           =   255
   End
   Begin Menu file_menu
      Caption         =   "&File"
      Begin Menu menu_save
         Caption         =   "&Save as..."
      End
      Begin Menu menu_print
         Caption         =   "&Print"
      End
      Begin Menu s1
         Caption         =   "-"
      End
      Begin Menu menu_done
         Caption         =   "&Done"
         Shortcut        =   {F3}
      End
   End
   Begin Menu menu_edit
      Caption         =   "&Edit"
      Begin Menu menu_find_key
         Caption         =   "&Find key"
         Shortcut        =   {F5}
      End
      Begin Menu s2
         Caption         =   "-"
      End
      Begin Menu menu_next
         Caption         =   "View &next document"
         Begin Menu menu_next_in_order
            Caption         =   "&In order"
            Shortcut        =   {F8}
         End
         Begin Menu menu_next_listed
            Caption         =   "&Listed in questions"
            Shortcut        =   +{F8}
         End
      End
      Begin Menu menu_prev
         Caption         =   "View &prev document"
         Begin Menu menu_prev_in_order
            Caption         =   "&In order"
            Shortcut        =   {F7}
         End
         Begin Menu menu_prev_listed
            Caption         =   "&Listed in questions"
            Shortcut        =   +{F7}
         End
      End
      Begin Menu s3
         Caption         =   "-"
      End
      Begin Menu menu_copy
         Caption         =   "&Copy"
         Shortcut        =   +{F6}
      End
      Begin Menu s4
         Caption         =   "-"
      End
      Begin Menu menu_add_section
         Caption         =   "&Add section"
         Shortcut        =   {F6}
      End
   End
   Begin Menu link_menu
      Caption         =   "&Link to..."
      Begin Menu link_menu_name
         Caption         =   "xxxx"
      End
   End
   Begin Menu map_menu
      Caption         =   "&Show Map..."
   End
Const FORM_OFFSET = 3 ' offset from top of form for button bar
Dim rec As String * MAX_TEXT_LENGTH
Dim tmp_handle As Integer
Dim recno As Integer
Dim doc_lines As Integer
Dim lines_per_page As Integer
Dim line_size As Single
Dim wdno As Integer
Dim box_top As Single
Dim box_bottom As Single
Dim box_drawn As Integer
Dim button_down As Integer
Dim form_cancelled As Integer
Sub add_section_bbox_Click ()
    menu_add_section_click
End Sub
Sub copy_bbox_Click ()
    menu_copy_click
End Sub
Sub find_bbox_Click ()
    menu_find_key_click
End Sub
Sub Form_Load ()
    tmp_handle = FreeFile
    Open temp_path + "\WAIS.$$$" For Random As tmp_handle Len = MAX_TEXT_LENGTH
    form_cancelled = False
    If question_form.max_displays.Checked Then
      view_form.WindowState = MAXIMIZED
    End If
    Caption = viewed_headline
    link_menu.Visible = False
    link_menu.Enabled = False
    telnet_bbox.Enabled = False
    map_menu.Visible = False
    map_menu.Enabled = False
    map_bbox.Enabled = False
    init_find = False
    doc_selected = NONE
    doc_lines = LOF(tmp_handle) / MAX_TEXT_LENGTH
    If viewed_docno <> CURRDOC Then
      If viewed_docno = 0 Then
        menu_prev_listed.Enabled = False
        prev_listed_bbox.Enabled = False
      End If
      If viewed_docno > question_form.title.ListCount - 2 Then
        menu_next_listed.Enabled = False
        next_listed_bbox.Enabled = False
      End If
    End If
    line_size = TextHeight("A")
    lines_per_page = view_form.ScaleHeight / line_size - 7
    view_scroll.LargeChange = lines_per_page
    view_scroll.Min = 1
    If doc_lines <= lines_per_page Then
        view_scroll.Max = 1
    Else
        view_scroll.Max = doc_lines - lines_per_page
    End If
    horiz_scroll.Min = 1
    horiz_scroll.LargeChange = view_form.ScaleWidth / TextWidth("A")
    horiz_scroll.Max = MAX_TEXT_LENGTH - horiz_scroll.LargeChange
    box_top = -1
    box_drawn = False
    button_down = False
    recno = 1
    For x = 1 To doc_lines
      Get tmp_handle, x, rec
      link_wk$ = LCase$(Trim$(rec))
      If Left$(link_wk$, 7) = "minimum" Then
        If Mid$(link_wk$, 9, 8) = "latitude" Then
          minlat$ = Trim$(Right$(link_wk$, Len(link_wk$) - 17))
        ElseIf Mid$(link_wk$, 9, 9) = "longitude" Then
          minlon$ = Trim$(Right$(link_wk$, Len(link_wk$) - 18))
        End If
      ElseIf Left$(link_wk$, 7) = "maximum" Then
        If Mid$(link_wk$, 9, 8) = "latitude" Then
          maxlat$ = Trim$(Right$(link_wk$, Len(link_wk$) - 17))
        ElseIf Mid$(link_wk$, 9, 9) = "longitude" Then
          maxlon$ = LTrim$(Right$(link_wk$, Len(link_wk$) - 18))
        End If
      ElseIf Left$(link_wk$, 7) = "catalog" And Mid$(link_wk$, 9, 4) = "link" Then
        link_menu_name.Caption = Trim$(Right$(link_wk$, Len(link_wk$) - 13))
        link_menu.Enabled = True
        link_menu.Visible = True
        telnet_bbox.Enabled = True
      End If
    Next x
    If minlat$ <> "" And minlon$ <> "" And maxlat$ <> "" And maxlon$ <> "" Then

      map_menu.Enabled = True
      map_menu.Visible = True
      map_bbox.Enabled = True
      spat_loc$ = maxlat$ + "," + maxlon$ + " "
      spat_loc$ = spat_loc$ + maxlat$ + "," + minlon$ + " "
      spat_loc$ = spat_loc$ + minlat$ + "," + minlon$ + " "
      spat_loc$ = spat_loc$ + minlat$ + "," + maxlon$ + " "
      spat_loc$ = spat_loc$ + maxlat$ + "," + maxlon$ + " "
      sign = 1
      in_point = 0
      For x = 1 To Len(spat_loc$)
        ch$ = LCase$(Mid$(spat_loc$, x, 1))
        Select Case ch$
          Case "-", ".", "0" To "9"
            num$ = num$ + ch$
          Case "n", "e"
            sign = 1
          Case "s", "w"
            sign = -1
          Case ","
            in_location(in_point, 0) = Val(num$) * sign
            num$ = ""
            sign = 1
          Case " ", ")"
            in_location(in_point, 1) = Val(num$) * sign
            num$ = ""
            in_point = in_point + 1
            sign = 1
        End Select
      Next x

    End If
End Sub
Sub Form_MouseDown (Button As Integer, Shift As Integer, x As Single, Y As Single)
    If Y < line_size * (FORM_OFFSET + 1) Then
      Exit Sub
    End If
    button_down = True
    If box_drawn Then
        view_form.Line (0, box_top)-(view_form.ScaleWidth, box_bottom), , BF
        box_drawn = False
    End If
    box_top = Int(Y / line_size) * line_size
End Sub
Sub Form_MouseMove (Button As Integer, Shift As Integer, x As Single, Y As Single)
    If button_down Then
        If box_drawn Then
            view_form.Line (0, box_top)-(view_form.ScaleWidth, box_bottom), , BF
        End If
        box_bottom = Int(Y / line_size) * line_size + line_size
        view_form.Line (0, box_top)-(view_form.ScaleWidth, box_bottom), , BF
        box_drawn = True
    End If
End Sub
Sub form_MouseUp (Button As Integer, Shift As Integer, x As Single, Y As Single)
    button_down = False
End Sub
Sub form_resize ()
    If Not form_cancelled Then
      view_scroll.Height = view_form.Height - button_frame.Height - horiz_scroll.Height - 625
      view_scroll.Left = view_form.Width - 325
      horiz_scroll.Top = view_form.Height - 925
      horiz_scroll.Width = view_form.Width - 300
      corner_fill.Top = horiz_scroll.Top
      corner_fill.Left = view_scroll.Left
      lines_per_page = view_form.ScaleHeight / line_size - 7
      view_scroll.LargeChange = lines_per_page
      view_scroll.Min = 1
      If doc_lines <= lines_per_page Then
        view_scroll.Max = 1
      Else
        view_scroll.Max = doc_lines - lines_per_page
      End If
      horiz_scroll.Min = 1
      horiz_scroll.LargeChange = view_form.ScaleWidth / TextWidth("A")
      horiz_scroll.Max = MAX_TEXT_LENGTH - horiz_scroll.LargeChange

      z = show_page()
    End If
End Sub
Sub Form_Unload (Cancel As Integer)
    form_cancelled = True
    If doc_selected = NORMAL Then
      doc_selected = NONE
    End If
    Close (tmp_handle)
End Sub
Sub horiz_scroll_Change ()
  z = show_page()
End Sub
Sub link_menu_name_click ()
Dim ln As String * 80
Dim link_name As String
Dim link_address As String
Dim link_found As Integer
  For x = 0 To 9
    fn$ = "Link" + Trim$(Str$(x + 1))
    lnsz = GetINIString("Links", fn$, "", ln, 80, "wais.ini")
    If lnsz > 0 Then
      c = InStr(ln, " ")
      If c > 1 Then
        link_name$ = LCase$(Left$(ln, c - 1))
        link_address$ = LCase$(LTrim$(Mid$(ln, c + 1, lnsz - c)))
        If link_menu_name.Caption = link_name Then
          link_found = True
          Exit For
        End If
      End If
    End If
  Next x
  If link_found = False Then
    msg$ = "Cannot find link file entry for " + link_name
    MsgBox msg$, MB_WARN
    Exit Sub
  End If
  z = Shell("vttelnet " + link_address, 1)
  z = show_page()
End Sub
Sub map_bbox_Click ()
    map_menu_click
End Sub
Sub map_menu_click ()
    map_form.Show 1
    Unload map_form
    z = show_page()
End Sub
Sub menu_add_section_click ()
Dim DocID As REF
    If box_top < 0 Then
        MsgBox "You haven't selected a section to add", MB_INFO
        Exit Sub
    End If
    z = get_docid(viewed_docno, DocID)
    refno = question_form.reference.ListCount
    ref_doc_size(refno) = DocID.doc_size
    ref_doc_bytes(refno) = Left$(DocID.doc_bytes, DocID.doc_size)
    ref_type(refno) = DocID.type
    ref_start(refno) = Int(box_top / line_size) + recno - FORM_OFFSET - 1
    ref_end(refno) = Int(box_bottom / line_size) + recno - (FORM_OFFSET + 2)
    ref_line$ = "[" + LTrim$(Str$(ref_start(refno))) + "," + LTrim$(Str$(ref_end(refno))) + "]" + viewed_headline
    question_form.reference.AddItem ref_line$
    view_form.DrawMode = 7
    view_form.Line (0, box_top)-(view_form.ScaleWidth, box_bottom), &HFFFF&, BF
    view_form.DrawMode = 6
    box_drawn = False
    box_top = -1
    box_bottom = 0
End Sub
Sub menu_copy_click ()
    If box_top < 0 Then
        MsgBox "You haven't selected a section to copy to the clipboard", MB_INFO
        Exit Sub
    End If
    REF = question_form.reference.ListCount
    title = question_form.title.ListIndex
    first_line = Int(box_top / line_size) + recno
    last_line = Int(box_bottom / line_size) + recno
    view_form.DrawMode = 6
    view_form.Line (0, box_top)-(view_form.ScaleWidth, box_bottom), &HFFFF&, BF
    view_form.DrawMode = 6
    box_drawn = False
    box_top = -1
    box_bottom = 0
    For x = first_line To last_line
        Get #1, x, rec
        cliptext$ = cliptext$ + RTrim$(rec) + Chr$(10) + Chr$(13)
    Next x
    clipboard.SetText cliptext$, 1
End Sub
Sub menu_done_Click ()
    doc_selected = NONE
    view_form.Hide
End Sub
Sub menu_find_key_click ()
    If word(0) = "" Then
        MsgBox "No key words were used for this search", MB_INFO
    End If
    If doc_lines <= lines_per_page Then
        Exit Sub
    End If
    If view_scroll.Value >= doc_lines - lines_per_page Then
        Exit Sub
    End If
    recno = recno + lines_per_page
    While Not show_page()
        recno = recno + lines_per_page
    Wend
    If doc_lines - lines_per_page > recno Then
        view_scroll.Value = recno
    Else
        view_scroll.Value = doc_lines - lines_per_page
    End If
    view_scroll.Refresh
End Sub
Sub menu_next_in_order_click ()
    doc_selected = DOC_NEXT_INORDER
    view_form.Hide
End Sub
Sub menu_next_listed_click ()
    doc_selected = DOC_NEXT_LISTED
    view_form.Hide
End Sub
Sub menu_prev_in_order_click ()
    doc_selected = DOC_PREV_INORDER
    view_form.Hide
End Sub
Sub menu_prev_listed_click ()
    doc_selected = DOC_PREV_LISTED
    view_form.Hide
End Sub
Sub menu_print_click ()
    Dim rec As String * MAX_TEXT_LENGTH
    question_form.file_dialog.CancelError = True
    question_form.file_dialog.FilterIndex = 1
    question_form.file_dialog.Flags = PD_HIDEPRINTTOFILE Or PD_NOPAGENUMS
    On Error Resume Next
    question_form.file_dialog.Action = 5
    Select Case Err
      Case 0
        mousepointer = HOURGLASS
        linecnt = 99
        pagecnt = 0
        For x = 1 To doc_lines
            If linecnt > 55 Then
                GoSub header
            End If
            Get #1, x, rec
            printer.Print RTrim$(rec)
        Next x
        printer.EndDoc
        Close (2)
        mousepointer = DEFAULT
      Case 32755
        z = show_page()
        Exit Sub
      Case Else
        msg$ = "Print failed with code" + Str$(Err) + ", print cancelled."
        MsgBox msg$, MB_WARN
    End Select
    z = show_page()
Exit Sub
header:
    printer.NewPage
    heading$ = Right$(question_form.title.List(view_docno), Len(question_form.title.List(docno)) - 17)
    If Len(heading$) > xx Then
        heading$ = Left$(heading$, xx)
    End If
    pagecnt = pagecnt + 1
    linecnt = 0
    printer.Print heading$; Format$(Now, "ddddd tttt"); "Page"; Str$(pagecnt)
    printer.Print
Return
End Sub
Sub menu_save_click ()
Dim rec As String * MAX_TEXT_LENGTH
    cur_dir$ = CurDir$

    On Error Resume Next
    question_form.file_dialog.Action = 2
    Select Case Err
      Case 0
        mousepointer = HOURGLASS
        save_handle = FreeFile
        Open question_form.file_dialog.Filename For Output As save_handle
        For x = 1 To doc_lines
          Get #tmp_handle, x, rec
          Print #save_handle, RTrim$(rec)
        Next x
        Close (save_handle)
        mousepointer = DEFAULT
      Case 32755
        z = show_page()
        Exit Sub
      Case Else
        msg$ = "Save failed with code" + Str$(Err) + ", save cancelled."
        MsgBox msg$, MB_WARN
    End Select
    ChDir cur_dir$
    z = show_page()
End Sub
Sub next_in_order_bbox_Click ()
    menu_next_in_order_click
End Sub
Sub next_listed_bbox_Click ()
    menu_next_listed_click
End Sub
Sub prev_in_order_bbox_Click ()
    menu_prev_in_order_click
End Sub
Sub prev_listed_bbox_Click ()
    menu_prev_listed_click
End Sub
Sub print_bbox_Click ()
    menu_print_click
End Sub
Sub save_bbox_Click ()
    menu_save_click
End Sub
Function show_page () As Integer
Static pos As Integer
    show_page = False
    If Not init_find Then
        GoSub first_find
    End If
    view_form.Cls
    For x = 0 To FORM_OFFSET
      view_form.Print
    Next x
    ln = x - 1
    For x = recno To recno + lines_per_page

      If x <= doc_lines Then

        Get #tmp_handle, x, rec
        rec = Right$(rec, MAX_TEXT_LENGTH - horiz_scroll.Value + 1)

        currentx = 0
        view_form.Print " "; rec
        ln = ln + 1

        If question_form.keywords.Text <> "" Then
          rec = LCase$(rec)

          For Y = 0 To wdno
            pos = 1
            While pos > 0
              pos = InStr(pos, rec, word(Y))
              If pos > 0 Then
                If test_for_word(word(Y), pos) Then
                  show_page = True
                  view_form.DrawMode = 9
                  wd_left = pos * view_form.TextWidth("A")
                  wd_right = (pos + Len(word(Y))) * view_form.TextWidth("A")
                  wd_top = ln * view_form.TextHeight("A")
                  wd_bottom = wd_top + view_form.TextHeight("A")
                  view_form.Line (wd_left, wd_top)-(wd_right, wd_bottom), &HFF00&, BF
                  view_form.DrawMode = 6
                End If
                pos = pos + Len(word(Y))
              End If
            Wend
          Next Y
        End If
      Else
        show_page = True
      End If
    Next x
Exit Function
first_find:
    For c1 = 0 To 19
      word(c1) = ""
    Next c1
    words$ = LCase$(question_form.keywords.Text)
    For c1 = 1 To Len(words$)
      letter$ = Mid$(words$, c1, 1)
      If letter$ < "0" Or (letter$ > "9" And letter$ < "a") Or (letter$ > "z") Then
        Mid$(words$, c1, 1) = " "
      End If
    Next c1
    c1 = 1
    For wdno = 0 To 19
        c2 = InStr(c1, words$, " ")
        If c2 = 0 Then
            word(wdno) = Trim$(Mid$(words$, c1, Len(words$) - c1 + 1))
            Exit For
        End If
        word(wdno) = Trim$(Mid$(words$, c1, c2 - c1))
        c1 = c2 + 1
        If word(wdno) = "and" Or word(wdno) = "" Or word(wdno) = Space$(Len(word(wdno))) Then
            wdno = wdno - 1
        End If
    Next wdno
    If word(wdno) = "" Then
      wdno = wdno - 1
    End If
    init_find = True
Return
End Function
Sub telnet_bbox_Click ()
    link_menu_name_click
End Sub
Function test_for_word (word As String, pos As Integer) As Integer
    If pos > 1 Then
      Select Case Mid$(rec, pos - 1, 1)
        Case "1" To "9"
          test_for_word = False
          Exit Function
        Case "a" To "z"
          test_for_word = False
          Exit Function
      End Select
    End If
    wdend = pos + Len(word)
    If wdend < 81 Then
      Select Case Mid$(rec, wdend, 1)
        Case "1" To "9"
          test_for_word = False
          Exit Function
        Case "a" To "z"
          test_for_word = False
          Exit Function
      End Select
    End If
    test_for_word = True
End Function
Sub view_scroll_Change ()
    If recno <> view_scroll.Value Then
        recno = view_scroll.Value
        z = show_page()
    End If
    box_drawn = False
    box_top = -1
    box_bottom = 0
End Sub