Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/vqstrg/vqdemo.frm

Visual Basic Form | 1995-12-05 | 15.2 KB | 486 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "VqString Demonstration"
   ClientHeight    =   4140
   ClientLeft      =   1050
   ClientTop       =   2280
   ClientWidth     =   7860
   ControlBox      =   0   'False
   Height          =   4830
   Left            =   990
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4140
   ScaleWidth      =   7860
   Top             =   1650
   Width           =   7980
   Begin PictureBox Picture1
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   1575
      Left            =   5040
      Picture         =   VQDEMO.FRX:0000
      ScaleHeight     =   1575
      ScaleWidth      =   2535
      TabIndex        =   8
      Top             =   1200
      Width           =   2535
   End
   Begin Frame Frame1
      Caption         =   "VqString Viewer/Editor"
      Height          =   2715
      Left            =   360
      TabIndex        =   7
      Top             =   660
      Width           =   4395
      Begin HScrollBar HScroll1
         Enabled         =   0   'False
         Height          =   375
         LargeChange     =   100
         Left            =   240
         Max             =   8192
         Min             =   1
         TabIndex        =   6
         Top             =   1980
         Value           =   1
         Width           =   3795
      End
      Begin TextBox Text2
         Enabled         =   0   'False
         Height          =   315
         Left            =   3240
         TabIndex        =   3
         Top             =   840
         Width           =   795
      End
      Begin TextBox Text1
         Enabled         =   0   'False
         Height          =   315
         Left            =   300
         ScrollBars      =   2  'Vertical
         TabIndex        =   1
         Top             =   840
         Width           =   2715
      End
      Begin Label Label1
         Caption         =   "S&croll"
         Height          =   255
         Left            =   240
         TabIndex        =   5
         Top             =   1680
         Width           =   675
      End
      Begin Label Label5
         Height          =   315
         Left            =   300
         TabIndex        =   4
         Top             =   1200
         Width           =   3735
      End
      Begin Label Label3
         Caption         =   "&Select"
         Height          =   255
         Left            =   3240
         TabIndex        =   2
         Top             =   540
         Width           =   615
      End
      Begin Label Label2
         Caption         =   "&Edit"
         Height          =   255
         Left            =   300
         TabIndex        =   0
         Top             =   540
         Width           =   555
      End
   End
   Begin Menu Demo
      Caption         =   "&Demonstration"
      Begin Menu VarLenStr
         Caption         =   "&Variable Length Strings"
         Shortcut        =   ^V
      End
      Begin Menu FixLenStr
         Caption         =   "&Fixed Length Strings"
         Shortcut        =   ^F
      End
      Begin Menu Separator1
         Caption         =   "-"
      End
      Begin Menu ExitProgram
         Caption         =   "E&xit"
         Shortcut        =   ^X
      End
   End
   Begin Menu Help
      Caption         =   "&Help"
      Begin Menu Contents
         Caption         =   "&Contents"
         Shortcut        =   {F1}
      End
      Begin Menu Search
         Caption         =   "&Search"
      End
      Begin Menu Separator2
         Caption         =   "-"
      End
      Begin Menu About
         Caption         =   "&About"
      End
   End
Sub About_Click ()
Dim WinFlags As Long
Dim Mode As String, Processor As String
'------  Get current Windows configuration
WinFlags = GetWinFlags()
CRLF$ = Chr$(13) + Chr$(10)
If WinFlags And WF_ENHANCED Then Mode = "386 Enhanced" Else Mode = "Standard"
Temp$ = "VqString Demonstration " + CRLF$
Temp$ = Temp$ + "Vi Qual Software" + CRLF$
Temp$ = Temp$ + "Version 1.0" + CRLF$ + CRLF$
Temp$ = Temp$ + "by Robert B. Heberger" + CRLF$ + CRLF$
Temp$ = Temp$ + "Mode: " + Mode + CRLF$
Temp$ = Temp$ + "Free Memory: " + Format$(GetFreeSpace(0) \ 1024) + " KB"
MsgBox Temp$, 64, "VqStrings"
End Sub
Sub Contents_Click ()
numData& = 1
TempNum% = WinHelp(hWnd, "vqstring.hlp", HELP_CONTEXT, ByVal numData&)
End Sub
Sub ExitProgram_Click ()
'------ Erase VqString arrays
x& = VqFixLenStr(Test, 1, 0, VqEraseString)
x& = VqVarLenStr(Test, 1, 0, VqEraseString)
End Sub
Sub FixLenStr_Click ()
On Error GoTo FixedDemoError
CR$ = Chr$(13) + Chr$(10)
Msg$ = "A huge array of 8,192 fixed length strings will be built," + CR$
Msg$ = Msg$ + "for a total of 131,072 bytes, or 128K of string space." + CR$ + CR$
Msg$ = Msg$ + "The string length is limited to 16 characters." + CR$ + CR$
Msg$ = Msg$ + "They will be stored in a VqString Array." + CR$ + CR$
Msg$ = Msg$ + "Most of the time will be used by Visual Basic to build" + CR$
Msg$ = Msg$ + "the strings."
Response% = MsgBox(Msg$, 65, "Fixed Length Strings")
Form1.Refresh
If Response% = IDCANCEL Then Exit Sub
Text1.Text = ""
Label5.Caption = ""
Text2.Text = ""
Text1.Refresh
Mode = 0
HScroll1.Value = 1
Mode = FixedMode
Elements = 8192
StrSize = 16
'------ Initialize fixed length VqString array
x& = VqFixLenStr(Test, 1, Elements, StrSize)
If x& < 0 Then
    Beep
    MsgBox "Can't allocate buffer", 64, "Error"
    Exit Sub
End If
'------ Fill fixed length VqString array
MousePointer = HourGlass
For i& = 1 To 8192
    Temp$ = Space$(5)
    LSet Temp$ = Str$(i&)
    Test = "Test String" + Temp$
    If VqFixLenStr(Test, 1, i&, VqPutString) < 0 Then Error Abs(VqError)
MousePointer = Default
Text1.Enabled = True
Text2.Enabled = True
HScroll1.Enabled = True
Frame1.Caption = "Fixed Length Strings"
Test = Space$(16)
If VqFixLenStr(Test, 1, 1, VqGetString) < 0 Then Error Abs(VqError)
Text1.Text = Test
SaveText1Text = Text1.Text
SaveHScroll1Value = HScroll1.Value
Label5.Caption = Space$(Len(Text1.Text)) + "|"
Text2.Text = LTrim$(Str$(1))
Exit Sub
FixedDemoError:
MsgBox Error$, 0, "Error"
End Sub
Sub Form_Load ()
Text1.FontName = "Terminal"
Text1.FontBold = False
Text2.FontName = "Terminal"
Text2.FontBold = False
Label5.FontName = "Terminal"
Label5.FontBold = False
LastControl = TextOne
SaveHScroll1Value = HScroll1.Value
End Sub
Sub HelpIndex_Click ()
numData& = 1
TempNum% = WinHelp(hWnd, "c:\vb\hugestr\vqstring.hlp", HELP_CONTEXT, ByVal numData&)
End Sub
Sub HScroll1_Change ()
On Error GoTo HScroll1ChangeError
CR$ = Chr$(13) + Chr$(10)
ScrollEvent = True
Index& = HScroll1.Value
Select Case Mode
    Case VariableMode
        Temp$ = SaveText1Text
        If VqPutVarString(Temp$, 1, CLng(SaveHScroll1Value)) < 0 Then Error Abs(VqError)
        If VqGetVarString(Test, 1, Index&) < 0 Then Error Abs(VqError)
    Case FixedMode
        Temp$ = Space$(16)
        LSet Temp$ = SaveText1Text
        If VqFixLenStr(Temp$, 1, CLng(SaveHScroll1Value), VqPutString) < 0 Then Error Abs(VqError)
        If VqFixLenStr(Test, 1, Index&, VqGetString) < 0 Then Error Abs(VqError)
End Select
Text1.Text = Test
If Mode = FixedMode Then Label5.Caption = Space$(Len(Text1.Text)) + "|"
Text2.Text = LTrim$(Str$(Index&))
Exit Sub
HScroll1ChangeError:
If Mode = VariableMode And VqError = OutOfStringSpace Then
    Beep
    Msg$ = "Out of string space." + CR$
    Msg$ = Msg$ + "There is a limit of 131,072" + CR$
    Msg$ = Msg$ + "bytes in this array."
    MsgBox Msg$, 64, "Out of String Space"
    Test = "Test String" + Str$(SaveHScroll1Value)
    Text1.Text = Test
    SaveText1Text = Test
    Resume Next
End If
MsgBox Error$, 0, "Error"
End Sub
Sub HScroll1_GotFocus ()
On Error GoTo HScroll1GotFocusError
CR$ = Chr$(13) + Chr$(10)
Select Case Mode
    Case FixedMode
        Temp$ = Space$(16)
        LSet Temp$ = SaveText1Text
        If VqFixLenStr(Temp$, 1, CLng(SaveHScroll1Value), VqPutString) < 0 Then Error Abs(VqError)
    Case VariableMode
        Temp$ = SaveText1Text
        If VqPutVarString(Temp$, 1, CLng(SaveHScroll1Value)) < 0 Then Error Abs(VqError)
End Select
Exit Sub
HScroll1GotFocusError:
If Mode = VariableMode And VqError = OutOfStringSpace Then
    Beep
    Msg$ = "Out of string space." + CR$
    Msg$ = Msg$ + "There is a limit of 131,072" + CR$
    Msg$ = Msg$ + "bytes in this array."
    MsgBox Msg$, 64, "Out of String Space"
    Test = "Test String" + Str$(SaveHScroll1Value)
    Text1.Text = Test
    SaveText1Text = Test
    Resume Next
End If
MsgBox Error$, 0, "Error"
End Sub
Sub Pause (Seconds%)
Start! = Timer
Finish = Start + Seconds
While Timer < Finish! And DoEvents()
End Sub
Sub Search_Click ()
numData& = 1
TempNum% = WinHelp(hWnd, "vqstring.hlp", HELP_CONTEXT, ByVal numData&)
Pause (1)
SendKeys ("%s"), True
End Sub
Sub Text1_Change ()
If Not ScrollEvent Then
    SaveText1Text = Text1.Text
    SaveHScroll1Value = HScroll1.Value
End If
ScrollEvent = False
End Sub
Sub Text1_GotFocus ()
LastControl = TextOne
SaveHScroll1Value = HScroll1.Value
SaveText1Text = Text1.Text
End Sub
Sub Text1_KeyDown (KeyCode As Integer, Shift As Integer)
If Mode = FixedMode Then Label5.Caption = Space$(Len(Text1.Text)) + "|"
End Sub
Sub Text1_KeyPress (KeyAscii As Integer)
On Error GoTo Text1KeyPressError
CR$ = Chr$(13) + Chr$(10)
If KeyAscii = 13 Then
    KeyAscii = 0
    Select Case Mode
        Case FixedMode
            Temp$ = Space$(16)
            LSet Temp$ = Text1.Text
            If VqFixLenStr(Temp$, 1, CLng(HScroll1.Value), VqPutString) < 0 Then Error Abs(VqError)
        Case VariableMode
            Temp$ = Text1.Text
            If VqPutVarString(Temp$, 1, CLng(HScroll1.Value)) < 0 Then Error Abs(VqError)
    End Select
    If HScroll1.Value < 8192 Then HScroll1.Value = HScroll1.Value + 1
ElseIf KeyAscii <> 8 And Mode = FixedMode And Len(Text1.Text) = 16 Then
    KeyAscii = 0
    Beep
End If
Exit Sub
Text1KeyPressError:
If Mode = VariableMode And VqError = OutOfStringSpace Then
    Beep
    Msg$ = "Out of string space." + CR$
    Msg$ = Msg$ + "There is a limit of 131,072" + CR$
    Msg$ = Msg$ + "bytes in this array."
    MsgBox Msg$, 64, "Out of String Space"
    Test = "Test String" + Str$(SaveHScroll1Value)
    Text1.Text = Test
    SaveText1Text = Test
    Resume Next
End If
MsgBox Error$, 0, "Error"
End Sub
Sub Text1_KeyUp (KeyCode As Integer, Shift As Integer)
If Mode = FixedMode Then Label5.Caption = Space$(Len(Text1.Text)) + "|"
End Sub
Sub Text1_LostFocus ()
On Error GoTo Text1LostFocusError
CR$ = Chr$(13) + Chr$(10)
Select Case Mode
    Case FixedMode
        Temp$ = Space$(16)
        LSet Temp$ = Text1.Text
        If VqFixLenStr(Temp$, 1, CLng(HScroll1.Value), VqPutString) < 0 Then Error Abs(VqError)
    Case VariableMode
        Temp$ = Text1.Text
        If VqPutVarString(Temp$, 1, CLng(HScroll1.Value)) < 0 Then Error Abs(VqError)
End Select
Exit Sub
Text1LostFocusError:
If Mode = VariableMode And VqError = OutOfStringSpace Then
    Beep
    Msg$ = "Out of string space." + CR$
    Msg$ = Msg$ + "There is a limit of 131,072" + CR$
    Msg$ = Msg$ + "bytes in this array."
    MsgBox Msg$, 64, "Out of String Space"
    Test = "Test String" + Str$(SaveHScroll1Value)
    Text1.Text = Test
    SaveText1Text = Test
    Text2.SetFocus
    Resume Next
End If
MsgBox Error$, 0, "Error"
End Sub
Sub Text2_GotFocus ()
LastControl = TextTwo
SaveHScroll1Value = HScroll1.Value
SaveText1Text = Text1.Text
End Sub
Sub Text2_KeyPress (KeyAscii As Integer)
If KeyAscii = 13 Then
    If Val(Text2.Text) < 1 Or Val(Text2.Text) > 8192 Then
        KeyAscii = 0
        Beep
        MsgBox "Value must be between 1 and 8192", 64, "VqString"
        Exit Sub
    End If
    KeyAscii = 0
    HScroll1.Value = Val(Text2.Text)
End If
End Sub
Sub Text2_LostFocus ()
If Val(Text2.Text) < 1 Or Val(Text2.Text) > 8192 Then
    KeyAscii = 0
    Beep
    MsgBox "Value must be between 1 and 8192", 64, "VqString"
    Text2.SetFocus
    Exit Sub
End If
KeyAscii = 0
HScroll1.Value = Val(Text2.Text)
End Sub
Sub VarLenStr_Click ()
On Error GoTo VariableDemoError
CR$ = Chr$(13) + Chr$(10)
Msg$ = "A huge array of 8,192 variable length strings will be built," + CR$
Msg$ = Msg$ + "for a total of 129,965 bytes, with 1,107 bytes free." + CR$ + CR$
Msg$ = Msg$ + "They will be stored in a VqString Array." + CR$ + CR$
Msg$ = Msg$ + "Most of the time will be used by Visual Basic to build" + CR$
Msg$ = Msg$ + "the strings."
Response% = MsgBox(Msg$, 65, "Variable Length Strings")
Form1.Refresh
If Response% = IDCANCEL Then Exit Sub
Mode = 0
HScroll1.Value = 1
Mode = VariableMode
Text1.Text = ""
Text2.Text = ""
Label5.Caption = ""
Text1.Refresh
Label5.Refresh
Elements = 8192
Bufsize = 131072
'------ Initialize variable length VqString array
x& = VqVarLenStr(Test, 1, Elements, Bufsize)
If x& < 0 Then
    Beep
    MsgBox "Can't allocate buffer", 64, "Error"
    Exit Sub
End If
'------ Fill variable length VqString array
MousePointer = HourGlass
For i& = 1 To 8192
    Test = "Test String" + Str$(i&)
    If VqPutVarString(Test, 1, i&) < 0 Then Error Abs(VqError)
MousePointer = Default
Text1.Enabled = True
Text2.Enabled = True
HScroll1.Enabled = True
'x& = VqVarLenStr(Strng$, 1, 1, VqVarMemUsed)
'Print Str$(x&)
'x& = VqVarLenStr(Strng$, 1, 1, VqVarMemFree)
'Print Str$(x&)
Frame1.Caption = "Variable Length Strings"
If VqGetVarString(Test, 1, 1) < 0 Then Error Abs(VqError)
Text1.Text = Test
SaveText1Text = Text1.Text
SaveHScroll1Value = HScroll1.Value
Text2.Text = LTrim$(Str$(1))
Exit Sub
VariableDemoError:
MsgBox Error$, 0, "Error"
End Sub
Function VqGetVarString (Strng$, Handle%, Page&)
'------ Support function to get string from variable length
'------  VqString array.
x% = VqVarLenStr(Strng$, Handle%, Page&, VqVarGetSize)
If x% < 0 Then
    VqGetVarString = x%
    VqError = x%
    Exit Function
End If
Strng$ = Space$(x%)
x% = VqVarLenStr(Strng$, Handle%, Page&, VqGetString)
If x% < 0 Then
    VqGetVarString = x%
    VqError = x%
    Exit Function
End If
VqGetVarString = 0
VqError = 0
End Function
Function VqPutVarString (Strng$, Handle%, Page&)
'------ Support function to store string in variable length
'------  VqString array.
'------ Need to append Chr$(0) to end of string.
Strng$ = Strng$ + Chr$(0)
x% = VqVarLenStr(Strng$, Handle%, Page&, VqPutString)
If x% < 0 Then
    VqPutVarString = x%
    VqError = x%
    Exit Function
End If
VqPutVarString = 0
VqError = 0
End Function