home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD94688312000.psc / UserControl1.ctl (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2000-08-31  |  9.2 KB  |  234 lines
  1. VERSION 5.00
  2. Begin VB.UserControl EL 
  3.    BackColor       =   &H00FFC0C0&
  4.    CanGetFocus     =   0   'False
  5.    ClientHeight    =   735
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   735
  9.    InvisibleAtRuntime=   -1  'True
  10.    Picture         =   "UserControl1.ctx":0000
  11.    ScaleHeight     =   735
  12.    ScaleWidth      =   735
  13.    ToolboxBitmap   =   "UserControl1.ctx":1B44
  14. Attribute VB_Name = "EL"
  15. Attribute VB_GlobalNameSpace = False
  16. Attribute VB_Creatable = True
  17. Attribute VB_PredeclaredId = False
  18. Attribute VB_Exposed = True
  19. Option Explicit
  20. 'Property Variables:
  21. '   This is what I called
  22. '   My control, so be sure
  23. '   to change this to yours
  24. Private objeL As EL
  25. '   this will Initialize the
  26. '   Class
  27. Private cM As New cWinMinMax
  28. '   Var's
  29. Dim m_MinHeight As Integer
  30. Dim m_MinWidth As Integer
  31. Dim m_MaxHeight As Integer
  32. Dim m_MaxWidth As Integer
  33. Dim m_EnableLimiter As Boolean
  34. Dim m_frmCenter As Boolean
  35. Dim m_FormInQuestion As Object
  36. 'Default Property Values:
  37. Const m_def_MinHeight = 0
  38. Const m_def_MinWidth = 0
  39. Const m_def_MaxHeight = 0
  40. Const m_def_MaxWidth = 0
  41. Const m_def_EnableLimiter = 0
  42. Const m_def_frmCenter = 0
  43. 'Win32 api
  44. Private Type RECT
  45.     Left As Long
  46.     Top As Long
  47.     Right As Long
  48.     Bottom As Long
  49. End Type
  50. 'Win32 API Function declarations
  51. Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  52. Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
  53. 'Win32 API Constant declarations
  54. Private Const BF_BOTTOM = &H8
  55. Private Const BF_LEFT = &H1
  56. Private Const BF_RIGHT = &H4
  57. Private Const BF_TOP = &H2
  58. Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
  59. Private Const BDR_RAISED = &H5
  60. '==================================================================
  61. '                  00:16      Date: 08/31/00
  62. 'NOTE:  Using Api make it look like a button
  63. '==================================================================
  64. Private Sub UserControl_Paint()
  65.     On Error Resume Next
  66.     Dim rct As RECT
  67.     GetClientRect UserControl.hwnd, rct
  68.     DrawEdge UserControl.hdc, rct, BDR_RAISED, BF_RECT
  69. End Sub
  70. '==================================================================
  71. '                  00:17      Date: 08/31/00
  72. 'NOTE:  This Kinda makes it look like a button
  73. '==================================================================
  74. Private Sub UserControl_Resize()
  75.     On Error Resume Next
  76.     UserControl.Size 48 * Screen.TwipsPerPixelX, 48 * _
  77.     Screen.TwipsPerPixelY
  78. End Sub
  79. '==================================================================
  80. '                  00:17      Date: 08/31/00
  81. 'NOTE:  Load property values from storage
  82. '==================================================================
  83. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  84.     On Error Resume Next
  85.     Set m_FormInQuestion = PropBag.ReadProperty("FormInQuestion", Nothing)
  86.     m_EnableLimiter = PropBag.ReadProperty("EnableLimiter", m_def_EnableLimiter)
  87.     m_frmCenter = PropBag.ReadProperty("CenterOnLoad", m_def_frmCenter)
  88.     m_MinHeight = PropBag.ReadProperty("MinHeight", m_def_MinHeight)
  89.     m_MinWidth = PropBag.ReadProperty("MinWidth", m_def_MinWidth)
  90.     m_MaxHeight = PropBag.ReadProperty("MaxHeight", m_def_MaxHeight)
  91.     m_MaxWidth = PropBag.ReadProperty("MaxWidth", m_def_MaxWidth)
  92. End Sub
  93. '==================================================================
  94. '                  00:18      Date: 08/31/00
  95. 'NOTE:  CleanUp  (This is IMPORTANT)
  96. '==================================================================
  97. Private Sub UserControl_Terminate()
  98.     On Error Resume Next
  99.     cM.Detach
  100. End Sub
  101. '==================================================================
  102. '                  00:18      Date: 08/31/00
  103. 'NOTE:  Write property values to storage
  104. '==================================================================
  105. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  106.     On Error Resume Next
  107.     Call PropBag.WriteProperty("FormInQuestion", m_FormInQuestion, Nothing)
  108.     Call PropBag.WriteProperty("CenterOnLoad", m_frmCenter, m_def_frmCenter)
  109.     Call PropBag.WriteProperty("EnableLimiter", m_EnableLimiter, m_def_EnableLimiter)
  110.     Call PropBag.WriteProperty("MinHeight", m_MinHeight, m_def_MinHeight)
  111.     Call PropBag.WriteProperty("MinWidth", m_MinWidth, m_def_MinWidth)
  112.     Call PropBag.WriteProperty("MaxHeight", m_MaxHeight, m_def_MaxHeight)
  113.     Call PropBag.WriteProperty("MaxWidth", m_MaxWidth, m_def_MaxWidth)
  114. End Sub
  115. '==================================================================
  116. '                  00:18      Date: 08/31/00
  117. 'NOTE:  Initialize Properties for User Control
  118. '   ZERO's will prevent Errors
  119. '==================================================================
  120. Private Sub UserControl_InitProperties()
  121.     On Error Resume Next
  122.     m_EnableLimiter = m_def_EnableLimiter
  123.     m_MinHeight = m_def_MinHeight
  124.     m_MinWidth = m_def_MinWidth
  125.     m_MaxHeight = m_def_MaxHeight
  126.     m_MaxWidth = m_def_MaxWidth
  127. End Sub
  128. '==================================================================
  129. '                  00:19      Date: 08/31/00
  130. 'NOTE:  Min Height
  131. '==================================================================
  132. Public Property Get MinHeight() As Integer
  133.     On Error Resume Next
  134.     MinHeight = m_MinHeight
  135.     cM.MinTrackHeight = m_MinHeight
  136. End Property
  137. Public Property Let MinHeight(ByVal New_MinHeight As Integer)
  138.     On Error Resume Next
  139.     m_MinHeight = New_MinHeight
  140.     PropertyChanged "MinHeight"
  141.     cM.MinTrackHeight = m_MinHeight
  142. End Property
  143. '==================================================================
  144. '                  00:19      Date: 08/31/00
  145. 'NOTE:  Min Width
  146. '==================================================================
  147. Public Property Get MinWidth() As Integer
  148.     On Error Resume Next
  149.     MinWidth = m_MinWidth
  150. End Property
  151. Public Property Let MinWidth(ByVal New_MinWidth As Integer)
  152.     On Error Resume Next
  153.     m_MinWidth = New_MinWidth
  154.     PropertyChanged "MinWidth"
  155.     cM.MinTrackWidth = m_MinWidth
  156. End Property
  157. '==================================================================
  158. '                  00:19      Date: 08/31/00
  159. 'NOTE:  Max Height
  160. '==================================================================
  161. Public Property Get MaxHeight() As Integer
  162.     On Error Resume Next
  163.     MaxHeight = m_MaxHeight
  164. End Property
  165. Public Property Let MaxHeight(ByVal New_MaxHeight As Integer)
  166.     On Error Resume Next
  167.     m_MaxHeight = New_MaxHeight
  168.     PropertyChanged "MaxHeight"
  169.     cM.MaxTrackHeight = m_MaxHeight
  170. End Property
  171. '==================================================================
  172. '                  00:19      Date: 08/31/00
  173. 'NOTE:  Max Width
  174. '==================================================================
  175. Public Property Get MaxWidth() As Integer
  176.     On Error Resume Next
  177.     MaxWidth = m_MaxWidth
  178. End Property
  179. Public Property Let MaxWidth(ByVal New_MaxWidth As Integer)
  180.     On Error Resume Next
  181.     m_MaxWidth = New_MaxWidth
  182.     PropertyChanged "MaxWidth"
  183.     cM.MaxTrackWidth = m_MaxWidth
  184. End Property
  185. '==================================================================
  186. '                  00:20      Date: 08/31/00
  187. 'NOTE:  Ive got this here cause i use it alot
  188. '==================================================================
  189. Public Property Let CenterOnLoad(ByVal New_CenterOnLoad As Boolean)
  190.     On Error Resume Next
  191.     m_frmCenter = New_CenterOnLoad
  192.     PropertyChanged "frmCenter"
  193.     If m_frmCenter = True Then
  194.         UserControl.Extender.Parent.Refresh
  195.         CenterForm m_FormInQuestion
  196.         Else
  197.         DoEvents
  198.     End If
  199. End Property
  200. '==================================================================
  201. '                  00:21      Date: 08/31/00
  202. 'NOTE:  Need to get Form Name   ( Initially I used the
  203. '     Usercontrol property but I got alot of STRANGE error)
  204. '==================================================================
  205. Public Property Let FormInQuestion(ByVal New_FormInQuestion As Object)
  206.     On Error Resume Next
  207.     Set m_FormInQuestion = New_FormInQuestion
  208.     PropertyChanged "FormInQuestion"
  209. End Property
  210. '==================================================================
  211. '                  00:21      Date: 08/31/00
  212. 'NOTE:  Turn on subclassing
  213. '==================================================================
  214. Public Property Let EnableLimiter(ByVal New_EnableLimiter As Boolean)
  215.     On Error Resume Next
  216.     m_EnableLimiter = New_EnableLimiter
  217.     PropertyChanged "EnableLimiter"
  218.     If m_FormInQuestion Is Nothing Then
  219.         Exit Property
  220.         Else
  221.         cM.Attach m_FormInQuestion.hwnd
  222.         End If
  223. End Property
  224. '==================================================================
  225. '                  00:22      Date: 08/31/00
  226. 'NOTE:   Load your own but hey I wouldnt mind
  227. '      a little recognition?!?!
  228. '==================================================================
  229. Public Sub About()
  230. Attribute About.VB_UserMemId = -552
  231.     On Error Resume Next
  232.     frmAbout.Show 1
  233. End Sub
  234.