vbAccelerator - Contents of code file: frmMiddleScroller.frm

VERSION 5.00
Begin VB.Form frmMiddleScrollDemo 
   Caption         =   "vbAccelerator Middle Scroller Development Demo"
   ClientHeight    =   6450
   ClientLeft      =   3315
   ClientTop       =   3195
   ClientWidth     =   6585
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmMiddleScroller.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   6450
   ScaleWidth      =   6585
   Begin VB.TextBox txtSample 
      BeginProperty Font 
         Name            =   "Lucida Console"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2955
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   2
      Text            =   "frmMiddleScroller.frx":45A2
      Top             =   3420
      Width           =   6375
   End
   Begin VB.PictureBox picVirtualGrid 
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000005&
      Height          =   2595
      Left            =   120
      ScaleHeight     =   169
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   421
      TabIndex        =   0
      Top             =   360
      Width           =   6375
   End
   Begin VB.Label lblTextBox 
      Caption         =   " Standard Text Box:"
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   3120
      Width           =   6375
   End
   Begin VB.Label lblCustomWindow 
      Caption         =   " Custom Window:"
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   60
      Width           =   6375
   End
End
Attribute VB_Name = "frmMiddleScrollDemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' Virtual "grid":
Private m_iCols As Long
Private m_iRows As Long
Private m_iColWidth As Long
Private m_iRowHeight As Long
Private WithEvents m_cScroll As cScrollBars
Attribute m_cScroll.VB_VarHelpID = -1

' Middle scroller
Private m_cMiddleScroller As cMiddleButtonScroller

Private Sub Form_Load()
      
   ' Create the middle button scroller
   Set m_cMiddleScroller = New cMiddleButtonScroller
      
   ' Create a virtual scroll area in pic
   ' Set up scroll bars:
   Set m_cScroll = New cScrollBars
   m_cScroll.Create picVirtualGrid.hwnd
   ' Set up the grid:
   m_iRows = 512
   m_iCols = 24
   m_iColWidth = 84
   m_iRowHeight = 16
   m_cScroll.SmallChange(efsHorizontal) = 48
   m_cScroll.SmallChange(efsVertical) = 16
   picVirtualGrid_Resize
   
   
   ' Load an amount of text:
   Dim iFile As Integer
   iFile = FreeFile
   Dim sPath As String
   sPath = App.Path
   If (right(sPath, 1) <> "\") Then sPath = sPath & "\"
   sPath = sPath & "\article.xml"
   Open sPath For Binary Access Read Lock Write As #iFile
   Dim sBuf As String
   sBuf = Space(LOF(iFile))
   Get #iFile, , sBuf
   Close #iFile
   
   txtSample.Text = sBuf
   
   
End Sub

Private Sub DrawGrid()
Dim lCol As Long
Dim lRow As Long
Dim lStartCol As Long
Dim lX As Long
Dim lStartX As Long
Dim lY As Long

   '
   ' NOTE: This grid will need *some* work if you want it to work
   ' properly!  You will need to eliminate the flicker by drawing
   ' rows onto a hidden picture box and then using PaintPicture to
   ' load them into the view.
   ' Use API calls rather than VB drawing code to improve speed.
   '
   With picVirtualGrid
      ' Erase backdrop:
      picVirtualGrid.Line (0, 0)-(.ScaleWidth, .ScaleHeight), .BackColor, BF
      ' Draw the grid:
      lCol = 1
      lRow = 1
      If (m_cScroll.Visible(efsHorizontal)) Then
         lX = -m_cScroll.Value(efsHorizontal)
      End If
      If (m_cScroll.Visible(efsVertical)) Then
         lY = -m_cScroll.Value(efsVertical)
      End If
      lStartX = lX
      Do
         If (lY + m_iRowHeight > 0) Then
            Do
               If (lX + m_iColWidth > 0) Then
                  If (lStartCol = 0) Then
                     lStartCol = lCol
                     lStartX = lX
                  End If
                  picVirtualGrid.Line (lX, lY)-(lX + m_iColWidth, lY +
                   m_iRowHeight), vbButtonFace, B
                  picVirtualGrid.CurrentX = lX + 3
                  picVirtualGrid.CurrentY = lY
                  picVirtualGrid.Print "Row:" & lRow & ",Col:" & lCol
               End If
               lCol = lCol + 1
               lX = lX + m_iColWidth
            Loop While lCol <= m_iCols And lX < .ScaleWidth
            lCol = lStartCol
            lX = lStartX
         End If
         lRow = lRow + 1
         lY = lY + m_iRowHeight
      Loop While lRow <= m_iRows And lY < .ScaleHeight
   End With
   
   picVirtualGrid.Refresh
   
End Sub

Private Sub Form_Resize()
On Error Resume Next
   picVirtualGrid.Move picVirtualGrid.left, picVirtualGrid.top, _
      Me.ScaleWidth - picVirtualGrid.left * 2
   DrawGrid
   txtSample.Move picVirtualGrid.left, txtSample.top, _
      Me.ScaleWidth - txtSample.left * 2, _
      Me.ScaleHeight - txtSample.top - 2 * Screen.TwipsPerPixelY
   
End Sub

Private Sub m_cScroll_Change(eBar As EFSScrollBarConstants)
   m_cScroll_Scroll eBar
End Sub

Private Sub m_cScroll_Scroll(eBar As EFSScrollBarConstants)
   DrawGrid
End Sub

Private Sub picVirtualGrid_Paint()
   DrawGrid
End Sub

Private Sub picVirtualGrid_Resize()
Dim lHeight As Long
Dim lWidth As Long
Dim lProportion As Long
   
   ' Pixels are the minimum change size for a screen object.
   ' Therefore we set the scroll bars in pixels.
   
   lHeight = (m_iRows * m_iRowHeight - picVirtualGrid.ScaleHeight)
   If (lHeight > 0) Then
      lProportion = lHeight \ picVirtualGrid.ScaleHeight + 1
      m_cScroll.LargeChange(efsVertical) = lHeight \ lProportion
      m_cScroll.Max(efsVertical) = lHeight
      m_cScroll.Visible(efsVertical) = True
   Else
      m_cScroll.Visible(efsVertical) = False
   End If
   
   lWidth = (m_iCols * m_iColWidth - picVirtualGrid.ScaleWidth)
   If (lWidth > 0) Then
      lProportion = lWidth \ picVirtualGrid.ScaleWidth + 1
      m_cScroll.LargeChange(efsHorizontal) = lWidth \ lProportion
      m_cScroll.Max(efsHorizontal) = lWidth
      m_cScroll.Visible(efsHorizontal) = True
   Else
      m_cScroll.Visible(efsHorizontal) = False
   End If

End Sub

Private Sub picVirtualGrid_MouseDown(Button As Integer, Shift As Integer, X As
 Single, Y As Single)
   If (Button = vbMiddleButton) Then
      With m_cMiddleScroller
         .HorizontalMode = ePixelBased
         .VerticalMode = ePixelBased
         .StartMiddleScroll picVirtualGrid.hwnd
      End With
   End If
End Sub

Private Sub txtSample_MouseDown(Button As Integer, Shift As Integer, X As
 Single, Y As Single)
   If (Button = vbMiddleButton) Then
      With m_cMiddleScroller
         .HorizontalMode = ePixelBased
         .VerticalMode = eLineBased
         .StartMiddleScroll txtSample.hwnd
      End With
   End If
End Sub