PC Plus SuperCD (UK) 1999 October/pcp156b.iso/handson/files/copyvbwk.exe/examples/te1.frm

Visual Basic Form | 1999-06-29 | 9.1 KB | 315 lines

VERSION 5.00
Object = "{8AE029D0-08E3-11D1-BAA2-444553540000}#3.0#0"; "VSFLEX3.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   6510
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   7185
   HelpContextID   =   1
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   ScaleHeight     =   6510
   ScaleWidth      =   7185
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command2
      Caption         =   "Command2"
      Height          =   735
      HelpContextID   =   2
      Left            =   3000
      TabIndex        =   1
      Top             =   840
      WhatsThisHelpID =   2
      Width           =   1695
   End
   Begin VB.CommandButton Command1
      Caption         =   "Command1"
      Height          =   735
      HelpContextID   =   1
      Left            =   960
      TabIndex        =   0
      Top             =   840
      WhatsThisHelpID =   1
      Width           =   1575
   End
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   600
      Top             =   2520
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin vsFlexLib.vsFlexString vsFlexString1
      Left            =   2520
      Top             =   2520
      _Version        =   196608
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
   End
   Begin VB.Menu mnuFile
      Caption         =   "File"
      Begin VB.Menu mnuOpen
         Caption         =   "Open"
      End
      Begin VB.Menu mnuSave
         Caption         =   "Save"
      End
      Begin VB.Menu x
         Caption         =   "-"
      End
      Begin VB.Menu mnuRecentFile
         Caption         =   ""
         Enabled         =   0   'False
         Index           =   0
         Visible         =   0   'False
      End
      Begin VB.Menu mnuRecentFile
         Caption         =   ""
         Enabled         =   0   'False
         Index           =   1
         Visible         =   0   'False
      End
      Begin VB.Menu mnuRecentFile
         Caption         =   ""
         Enabled         =   0   'False
         Index           =   2
         Visible         =   0   'False
      End
      Begin VB.Menu mnuRecentFile
         Caption         =   ""
         Enabled         =   0   'False
         Index           =   3
         Visible         =   0   'False
      End
   End
   Begin VB.Menu mnuEdit
      Caption         =   "Edit"
      Begin VB.Menu mnuFind
         Caption         =   "Find"
      End
      Begin VB.Menu mnuReplace
         Caption         =   "Replace"
      End
      Begin VB.Menu mnuGotoLine
         Caption         =   "Goto Line"
      End
   End
   Begin VB.Menu mnuFont
      Caption         =   "Font"
   End
   Begin VB.Menu mnuHelp
      Caption         =   "Help"
      NegotiatePosition=   3  'Right
   End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const HH_DISPLAY_TOPIC = &H0
Const HH_SET_WIN_TYPE = &H4
Const HH_GET_WIN_TYPE = &H5
Const HH_GET_WIN_HANDLE = &H6
Const HH_DISPLAY_TEXT_POPUP = &HE
Const HH_HELP_CONTEXT = &HF
Const HH_TP_HELP_CONTEXTMENU = &H10
Const HH_TP_HELP_WM_HELP = &H11
Private fn(3) As String
Private Declare Function WritePrivateProfileString Lib _
    "kernel32" Alias "WritePrivateProfileStringA" _
    (ByVal lpApplicationName As String, _
     ByVal lpKeyName As Any, _
     ByVal lpString As Any, _
     ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib _
    "kernel32" Alias "GetPrivateProfileStringA" _
    (ByVal lpApplicationName As String, _
     ByVal lpKeyName As Any, _
     ByVal lpDefault As String, _
     ByVal lpReturnedString As String, _
     ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function HtmlHelp Lib "hhctrl.ocx" Alias "HtmlHelpA" _
  (ByVal hwndCaller As Long, ByVal pszFile As String, _
  ByVal uCommand As Long, ByVal dwData As Long) As Long
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
Dim r As Long
If KeyCode = vbKeyF1 Then
   r = HtmlHelp(Me.ActiveControl.hWnd, _
   App.Path & "\vbhelptest.chm", HH_HELP_CONTEXT, Me.ActiveControl.HelpContextID)
End If
End Sub
Private Sub Form_Load()
Dim r As Long, s As String
s = String(255, 0)
r = GetPrivateProfileString("VBMenu", "File0", "", s, 255, "menu.ini")
If r <> 0 Then
    mnuRecentFile(0).Caption = s
    fn(0) = s
    mnuRecentFile(0).Enabled = True
    mnuRecentFile(0).Visible = True
End If
r = GetPrivateProfileString("VBMenu", "File1", "", s, 255, "menu.ini")
If r <> 0 Then
    mnuRecentFile(1).Caption = s
    fn(1) = s
    mnuRecentFile(1).Enabled = True
    mnuRecentFile(1).Visible = True
End If
r = GetPrivateProfileString("VBMenu", "File2", "", s, 255, "menu.ini")
If r <> 0 Then
    mnuRecentFile(2).Caption = s
    fn(2) = s
    mnuRecentFile(2).Enabled = True
    mnuRecentFile(2).Visible = True
End If
r = GetPrivateProfileString("VBMenu", "File3", "", s, 255, "menu.ini")
If r <> 0 Then
    mnuRecentFile(3).Caption = s
    fn(3) = s
    mnuRecentFile(3).Enabled = True
    mnuRecentFile(3).Visible = True
End If
RTE1.HandleMouse
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim r As Long
If fn(0) <> "" Then
    r = WritePrivateProfileString("VBmenu", "File0", fn(0), "menu.ini")
End If
If fn(1) <> "" Then
    r = WritePrivateProfileString("VBmenu", "File1", fn(1), "menu.ini")
End If
If fn(2) <> "" Then
    r = WritePrivateProfileString("VBmenu", "File2", fn(2), "menu.ini")
End If
If fn(3) <> "" Then
    r = WritePrivateProfileString("VBmenu", "File3", fn(3), "menu.ini")
End If
End Sub
Private Sub mnuFind_Click()
Dim r As Long
FindDialog.Show vbModal
If FindDialog.SearchText <> "" Then
    vsFlexString1.Pattern = FindDialog.SearchText
    vsFlexString1.Text = RTE1.Text
    If vsFlexString1.MatchCount > 0 Then
        vsFlexString1.MatchIndex = 0
        r = RTE1.HighlightText(vsFlexString1.MatchStart, Len(FindDialog.SearchText))
    Else
        MsgBox "String not found!"
    End If
End If
End Sub
Private Sub mnuFont_Click()
RTE1.Font = ""
End Sub
Private Sub mnuGotoLine_Click()
Dim x As Long, Lines As Long, posn As Long, r As Long
GotoLineDialog.Show vbModal
x = GotoLineDialog.LineNumber
' this is a quick way of finding the number of lines
'r = SendMessage(RTE1.hWnd, EM_GETLINECOUNT, 0, 0)
If x > 1 Then
    vsFlexString1.Pattern = Chr(13)
    vsFlexString1.Text = RTE1.Text
    If x > vsFlexString1.MatchCount + 1 Then
        MsgBox "not enough lines!"
    Else
        ' Flex is zero based  ...
        ' ... so we have to adjust a little
        vsFlexString1.MatchIndex = x - 2
        posn = vsFlexString1.MatchStart + 1
        r = RTE1.HighlightText(posn, 0)
    End If
ElseIf x = 1 Then
' the first line is offset zero
    r = RTE1.HighlightText(0, 0)
End If
End Sub
Private Sub mnuHelp_Click()
Dim hwndHelp As Long
hwndHelp = HtmlHelp(hWnd, App.Path & "\vbhelptest.chm", HH_DISPLAY_TOPIC, 0)
If hwndHelp = 0 Then
    MsgBox "No help!"
End If
End Sub
Private Sub mnuOpen_Click()
Dim s As String, t As String, u As String
On Error GoTo ExitSub
CommonDialog1.CancelError = True
CommonDialog1.ShowOpen
s = CommonDialog1.filename
Open s For Input As #1
Do Until EOF(1)
    Line Input #1, t
    u = u + t + Chr(13)
Close #1
RTE1.Text = u
ExitSub:
End Sub
Private Sub mnuRecentFile_Click(Index As Integer)
Dim s As String, t As String, u As String
On Error GoTo Error1
s = mnuRecentFile(Index).Caption
Open s For Input As #1
Do Until EOF(1)
    Line Input #1, t
    u = u + t + Chr(13)
Close #1
RTE1.Text = u
Exit Sub
Error1:
MsgBox "File " & s & " not found"
End Sub
Private Sub mnuReplace_Click()
Dim r As Long
ReplaceDialog.Show vbModal
If ReplaceDialog.SearchText <> "" Then
    vsFlexString1.Text = RTE1.Text
    vsFlexString1.Pattern = ReplaceDialog.SearchText
    If vsFlexString1.MatchCount > 0 Then
        vsFlexString1.Replace = ReplaceDialog.ReplaceText
        RTE1.Text = vsFlexString1.Text
    Else
        MsgBox "String not found!"
    End If
End If
End Sub
Private Sub mnuSave_Click()
Dim s As String, u As String
On Error GoTo ExitSub
CommonDialog1.CancelError = True
CommonDialog1.ShowSave
s = CommonDialog1.filename
Open s For Output As #1
u = RTE1.Text
Print #1, u
Close #1
'fixup recently used file menus
fn(3) = fn(2)
fn(2) = fn(1)
fn(1) = fn(0)
fn(0) = s
If fn(0) <> "" Then
    UpdateMenu 0
End If
If fn(1) <> "" Then
    UpdateMenu 1
End If
If fn(2) <> "" Then
    UpdateMenu 2
End If
If fn(3) <> "" Then
    UpdateMenu 3
End If
ExitSub:
End Sub
Sub UpdateMenu(i As Integer)
    mnuRecentFile(i).Caption = fn(i)
    mnuRecentFile(i).Enabled = True
    mnuRecentFile(i).Visible = True
End Sub