home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / ucCanvas_+1795879202004.psc / ucCanvas.ctl < prev   
Text File  |  2004-09-16  |  6KB  |  187 lines
  1. VERSION 5.00
  2. Begin VB.UserControl ucCanvas 
  3.    BorderStyle     =   1  'Fixed Single
  4.    ClientHeight    =   2220
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   3060
  8.    ClipBehavior    =   0  'None
  9.    ClipControls    =   0   'False
  10.    BeginProperty Font 
  11.       Name            =   "Tahoma"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   400
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    KeyPreview      =   -1  'True
  20.    LockControls    =   -1  'True
  21.    MousePointer    =   99  'Custom
  22.    ScaleHeight     =   148
  23.    ScaleMode       =   3  'Pixel
  24.    ScaleWidth      =   204
  25. End
  26. Attribute VB_Name = "ucCanvas"
  27. Attribute VB_GlobalNameSpace = False
  28. Attribute VB_Creatable = True
  29. Attribute VB_PredeclaredId = False
  30. Attribute VB_Exposed = False
  31. '================================================
  32. ' User control:  ucCanvas.ctl (simplified)
  33. ' Author:        Carles P.V.
  34. ' Dependencies:  cDIB.cls
  35. ' Last revision: 2004.09.15
  36. '================================================
  37.  
  38. Option Explicit
  39.  
  40. '-- API:
  41.  
  42. Private Type POINTAPI
  43.     x As Long
  44.     y As Long
  45. End Type
  46.  
  47. Private Const RGN_DIFF As Long = 4
  48.  
  49. Private Declare Function CreateRectRgn Lib "gdi32" (ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
  50. Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
  51. Private Declare Function FillRgn Lib "gdi32" (ByVal hDC As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
  52. Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  53. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  54. Private Declare Function TranslateColor Lib "olepro32" Alias "OleTranslateColor" (ByVal Clr As OLE_COLOR, ByVal Palette As Long, Col As Long) As Long
  55.  
  56. '//
  57.  
  58. '-- Public Enums.:
  59. Public Enum eWorkModeCts
  60.     [cnvScrollMode]
  61.     [cnvUserMode]
  62. End Enum
  63.  
  64. '-- Property Variables:
  65. Private m_Zoom      As Long
  66. Private m_WorkMode  As eWorkModeCts
  67. Private m_FitMode   As Boolean
  68. Private m_Enabled   As Boolean
  69. Private m_BackColor As OLE_COLOR
  70.  
  71. '-- Private Variables:
  72. Private m_Width     As Long
  73. Private m_Height    As Long
  74. Private m_Left      As Long
  75. Private m_Top       As Long
  76. Private m_hPos      As Long
  77. Private m_hMax      As Long
  78. Private m_vPos      As Long
  79. Private m_vMax      As Long
  80. Private m_lsthPos   As Single
  81. Private m_lstvPos   As Single
  82. Private m_lsthMax   As Single
  83. Private m_lstvMax   As Single
  84. Private m_Down      As Boolean
  85. Private m_Pt        As POINTAPI
  86.  
  87. '-- Event Declarations:
  88. Public Event Click()
  89. Public Event DblClick()
  90. Public Event KeyDown(KeyCode As Integer, Shift As Integer)
  91. Public Event KeyPress(KeyAscii As Integer)
  92. Public Event KeyUp(KeyCode As Integer, Shift As Integer)
  93. Public Event MouseDown(Button As Integer, Shift As Integer, x As Long, y As Long)
  94. Public Event MouseMove(Button As Integer, Shift As Integer, x As Long, y As Long)
  95. Public Event MouseUp(Button As Integer, Shift As Integer, x As Long, y As Long)
  96. Public Event Scroll()
  97. Public Event Resize()
  98.  
  99. '-- Public objects:
  100. Public DIB As cDIB ' DIB section
  101.  
  102.  
  103.  
  104. '========================================================================================
  105. ' UserControl
  106. '========================================================================================
  107.  
  108. Private Sub UserControl_Initialize()
  109.  
  110.     '-- Initialize DIB
  111.     Set Me.DIB = New cDIB
  112.     
  113.     '-- Default values
  114.     m_Zoom = 1
  115.     m_WorkMode = [cnvScrollMode]
  116. End Sub
  117.  
  118. Private Sub UserControl_Terminate()
  119.  
  120.     '-- Destroy DIB
  121.     Set Me.DIB = Nothing
  122. End Sub
  123.  
  124. '//
  125.  
  126. Private Sub UserControl_Resize()
  127.  
  128.     '-- Resize and refresh
  129.     Call pvResizeCanvas
  130.     Call pvRefreshCanvas
  131.     
  132.     RaiseEvent Resize
  133. End Sub
  134.  
  135. Private Sub UserControl_Paint()
  136.  
  137.     '-- Refresh Canvas
  138.     Call pvRefreshCanvas
  139. End Sub
  140.  
  141. '//
  142.  
  143. Private Sub UserControl_Click()
  144.     RaiseEvent Click
  145. End Sub
  146.  
  147. Private Sub UserControl_DblClick()
  148.     RaiseEvent DblClick
  149. End Sub
  150.  
  151. Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
  152.     RaiseEvent KeyDown(KeyCode, Shift)
  153. End Sub
  154.  
  155. Private Sub UserControl_KeyPress(KeyAscii As Integer)
  156.     RaiseEvent KeyPress(KeyAscii)
  157. End Sub
  158.  
  159. Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
  160.     RaiseEvent KeyUp(KeyCode, Shift)
  161. End Sub
  162.  
  163. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  164.     
  165.     '-- Mouse down flag / Store values
  166.     m_Down = (Button = vbLeftButton)
  167.     m_Pt.x = x
  168.     m_Pt.y = y
  169.     
  170.     RaiseEvent MouseDown(Button, Shift, pvDIBx(x), pvDIBy(y))
  171. End Sub
  172.  
  173. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  174.         
  175.     If (m_Down And m_WorkMode = [cnvScrollMode]) Then
  176.     
  177.         '-- Apply offsets
  178.         m_hPos = m_hPos + (m_Pt.x - x)
  179.         m_vPos = m_vPos + (m_Pt.y - y)
  180.         '-- Check margins
  181.         If (m_hPos < 0) Then m_hPos = 0 Else If (m_hPos > m_hMaxyrollMode])reer, ShifKeyAsciiVM SingleBBBBBBBBBBElse If (m_hPos > m_hMaxyBBBElse If (m_hPos > m_hMaB>(m_hPos > m_ThPos = 0 Else If (mvPos = m_vPosElse  u= m_vPosElse  u= m_vPosEPxyri
  182.  
  183.     '-- InitEpvDIBx.e m_vPosE0n Ai
  184.  
  185.     'lem_hPos > m_ThPos =0n Ai
  186.  
  187.  sa m_vaeMoThPos =0n ==============ym