home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / mouscrol / mouscrol.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-05-07  |  6.5 KB  |  195 lines
  1. VERSION 2.00
  2. Begin Form frmMousScrol 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Mouse Scrolling"
  6.    ClientHeight    =   4740
  7.    ClientLeft      =   2445
  8.    ClientTop       =   1545
  9.    ClientWidth     =   4140
  10.    Height          =   5145
  11.    Icon            =   MOUSCROL.FRX:0000
  12.    Left            =   2385
  13.    LinkTopic       =   "Form1"
  14.    ScaleHeight     =   4740
  15.    ScaleWidth      =   4140
  16.    Top             =   1200
  17.    Width           =   4260
  18.    Begin CommandButton cmdExit 
  19.       Caption         =   "E&xit"
  20.       FontBold        =   0   'False
  21.       FontItalic      =   0   'False
  22.       FontName        =   "MS Sans Serif"
  23.       FontSize        =   8.25
  24.       FontStrikethru  =   0   'False
  25.       FontUnderline   =   0   'False
  26.       Height          =   400
  27.       Left            =   1620
  28.       TabIndex        =   1
  29.       Top             =   4140
  30.       Width           =   1000
  31.    End
  32.    Begin PictureBox pic 
  33.       BorderStyle     =   0  'None
  34.       Height          =   3060
  35.       Left            =   500
  36.       ScaleHeight     =   3060
  37.       ScaleWidth      =   3135
  38.       TabIndex        =   0
  39.       Top             =   500
  40.       Width           =   3135
  41.       Begin Image img 
  42.          Height          =   4305
  43.          Left            =   0
  44.          Picture         =   MOUSCROL.FRX:0302
  45.          Top             =   0
  46.          Width           =   6600
  47.       End
  48.    End
  49. Option Explicit
  50. Dim MouseDownX, MouseDownY As Integer
  51. Dim NewLeft, NewTop As Integer
  52. Dim VScrollMax, HScrollMax  As Integer
  53. Dim VScrollMin, HScrollMin  As Integer
  54. ' Shift parameter masks
  55. Const SHIFT_MASK = 1
  56. Const CTRL_MASK = 2
  57. Const ALT_MASK = 4
  58. ' Button parameter masks
  59. Const LEFT_BUTTON = 1
  60. Const RIGHT_BUTTON = 2
  61. Const MIDDLE_BUTTON = 4
  62. 'Colors
  63. Const G_BLACK = 0
  64. Const G_BLUE = 1
  65. Const G_GREEN = 2
  66. Const G_CYAN = 3
  67. Const G_RED = 4
  68. Const G_MAGENTA = 5
  69. Const G_BROWN = 6
  70. Const G_LIGHT_GRAY = 7
  71. Const G_DARK_GRAY = 8
  72. Const G_LIGHT_BLUE = 9
  73. Const G_LIGHT_GREEN = 10
  74. Const G_LIGHT_CYAN = 11
  75. Const G_LIGHT_RED = 12
  76. Const G_LIGHT_MAGENTA = 13
  77. Const G_YELLOW = 14
  78. Const G_WHITE = 15
  79. Const G_AUTOBW = 16
  80. Sub cmdExit_Click ()
  81.     End
  82. End Sub
  83. Sub DrawFrameOn (TopLeftControl As Control, BottomRightControl As Control, Style As String, FrameOffset As Integer, Color As Integer, TopLeftEdges As Integer, BottomRightEdges As Integer)
  84.     Dim SaveDrawWidth, SaveFillStyle, SaveScaleMode
  85.     Dim Offset, TWIPS As Integer
  86.     Dim xx, yy As Integer
  87.     Dim x1, y1, x2, y2 As Integer
  88.     Dim FrameLeft, FrameTop, FrameWidth, FrameHeight
  89.     SaveDrawWidth = DrawWidth
  90.     SaveFillStyle = FillStyle
  91.     SaveScaleMode = ScaleMode
  92.     DrawWidth = 1
  93.     FillStyle = 1
  94.     ScaleMode = 1
  95.     TWIPS = screen.TwipsPerPixelX
  96.     Offset = FrameOffset * TWIPS
  97.     FrameLeft = TopLeftControl.Left
  98.     FrameTop = TopLeftControl.Top
  99.     FrameWidth = BottomRightControl.Left + BottomRightControl.Width
  100.     FrameHeight = BottomRightControl.Top + BottomRightControl.Height
  101.     ' Draw a colored box the same size as the largest Frame.
  102.     x1 = FrameLeft - Offset
  103.     y1 = FrameTop - Offset
  104.     x2 = FrameWidth + Offset - TWIPS
  105.     y2 = FrameHeight + Offset - TWIPS
  106.     Line (x1, y1)-(x2, y2), QBColor(Color), BF
  107.     ' Raised or inset shading
  108.     If UCase$(Left$(Style, 1)) = "R" Then
  109.         xx = TopLeftEdges
  110.         yy = BottomRightEdges
  111.     Else
  112.         xx = BottomRightEdges
  113.         yy = TopLeftEdges
  114.     End If
  115.     ' Bottom-left to Top-left line
  116.     x1 = FrameLeft - Offset
  117.     y1 = FrameHeight + Offset - TWIPS
  118.     x2 = FrameLeft - Offset
  119.     y2 = FrameTop - Offset - TWIPS
  120.     Line (x1, y1)-(x2, y2), QBColor(xx)
  121.     ' Top-left to Top-Right line
  122.     x1 = FrameLeft - Offset
  123.     y1 = FrameTop - Offset
  124.     x2 = FrameWidth + Offset
  125.     y2 = FrameTop - Offset
  126.     Line (x1, y1)-(x2, y2), QBColor(xx)
  127.     ' Top-Right to Bottom-Right line
  128.     x1 = FrameWidth + Offset - TWIPS
  129.     y1 = FrameTop - Offset
  130.     x2 = FrameWidth + Offset - TWIPS
  131.     y2 = FrameHeight + Offset
  132.     Line (x1, y1)-(x2, y2), QBColor(yy)
  133.     ' Bottom-Right to Bottom-Left line
  134.     x1 = FrameWidth + Offset - TWIPS
  135.     y1 = FrameHeight + Offset - TWIPS
  136.     x2 = FrameLeft - Offset - TWIPS
  137.     y2 = FrameHeight + Offset - TWIPS
  138.     Line (x1, y1)-(x2, y2), QBColor(yy)
  139.     DrawWidth = SaveDrawWidth
  140.     FillStyle = SaveFillStyle
  141.     ScaleMode = SaveScaleMode
  142. End Sub
  143. Sub Form_Load ()
  144.     Show
  145.     HScrollMax = -(img.Width - pic.Width)
  146.     VScrollMax = -(img.Height - pic.Height)
  147.     HScrollMin = 0
  148.     VScrollMin = 0
  149.     ' Center the image inside the picture box on program start
  150.     img.Left = HScrollMax / 2
  151.     img.Top = VScrollMax / 2
  152.     ' Color Constants to be used in DrawFrameOn
  153.     'G_BLACK              G_WHITE
  154.     'G_BLUE               G_LIGHT_BLUE
  155.     'G_GREEN              G_LIGHT_GREEN
  156.     'G_CYAN               G_LIGHT_CYAN
  157.     'G_RED                G_LIGHT_RED
  158.     'G_MAGENTA            G_LIGHT_MAGENTA
  159.     'G_BROWN              G_YELLOW
  160.     'G_LIGHT_GRAY         G_DARK_GRAY
  161.     ' DrawFrameOn TopLeftControl, BottomRightControl, Style, FrameOffset
  162.     ' Box Color, Top and Left Lines Color, Bottom and Right Lines Color
  163.     DrawFrameOn pic, pic, "Raised", 24, G_RED, G_BLACK, G_BLACK
  164.     DrawFrameOn pic, pic, "Raised", 23, G_RED, G_WHITE, G_DARK_GRAY
  165.     DrawFrameOn pic, pic, "Raised", 22, G_RED, G_WHITE, G_DARK_GRAY
  166.     DrawFrameOn pic, pic, "Raised", 21, G_RED, G_BLACK, G_BLACK
  167.     DrawFrameOn pic, pic, "Raised", 11, G_LIGHT_GRAY, G_DARK_GRAY, G_WHITE
  168.     DrawFrameOn pic, pic, "Raised", 10, G_YELLOW, G_BLACK, G_BLACK
  169.     DrawFrameOn pic, pic, "Raised", 7, G_LIGHT_GRAY, G_BLACK, G_BLACK
  170.     DrawFrameOn pic, pic, "Raised", 6, G_GREEN, G_WHITE, G_DARK_GRAY
  171.     DrawFrameOn pic, pic, "Raised", 1, G_LIGHT_GRAY, G_BLACK, G_WHITE
  172. End Sub
  173. Sub img_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
  174.     Select Case Button
  175.         Case RIGHT_BUTTON
  176.             MouseDownX = X
  177.             MouseDownY = Y
  178.     End Select
  179.         
  180. End Sub
  181. Sub img_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
  182.     If Button = RIGHT_BUTTON Then
  183.         NewLeft = img.Left - (MouseDownX - X)
  184.         If NewLeft > HScrollMax And NewLeft < 0 Then
  185.             img.Left = NewLeft
  186.         End If
  187.         
  188.         NewTop = img.Top - (MouseDownY - Y)
  189.         If NewTop > VScrollMax And NewTop < 0 Then
  190.             img.Top = NewTop
  191.         End If
  192.         
  193.     End If
  194. End Sub
  195.