home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / b8_GS_-_Gr2056783292007.psc / b8Controls4 / b8DataPicker.ctl < prev    next >
Text File  |  2006-09-23  |  22KB  |  759 lines
  1. VERSION 5.00
  2. Begin VB.UserControl b8DataPicker 
  3.    BackStyle       =   0  'Transparent
  4.    ClientHeight    =   405
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   4290
  8.    BeginProperty Font 
  9.       Name            =   "Tahoma"
  10.       Size            =   8.25
  11.       Charset         =   0
  12.       Weight          =   400
  13.       Underline       =   0   'False
  14.       Italic          =   0   'False
  15.       Strikethrough   =   0   'False
  16.    EndProperty
  17.    ScaleHeight     =   27
  18.    ScaleMode       =   3  'Pixel
  19.    ScaleWidth      =   286
  20.    Begin VB.CommandButton cmdClear 
  21.       DisabledPicture =   "b8DataPicker.ctx":0000
  22.       Height          =   345
  23.       Left            =   3150
  24.       Picture         =   "b8DataPicker.ctx":058A
  25.       Style           =   1  'Graphical
  26.       TabIndex        =   2
  27.       Top             =   30
  28.       Width           =   345
  29.    End
  30.    Begin VB.CommandButton cmdPicker 
  31.       DisabledPicture =   "b8DataPicker.ctx":0B14
  32.       Height          =   345
  33.       Left            =   2790
  34.       Picture         =   "b8DataPicker.ctx":109E
  35.       Style           =   1  'Graphical
  36.       TabIndex        =   1
  37.       Top             =   30
  38.       Width           =   345
  39.    End
  40.    Begin VB.TextBox txtDisplay 
  41.       Height          =   345
  42.       Left            =   60
  43.       Locked          =   -1  'True
  44.       TabIndex        =   0
  45.       Top             =   30
  46.       Width           =   2715
  47.    End
  48. End
  49. Attribute VB_Name = "b8DataPicker"
  50. Attribute VB_GlobalNameSpace = False
  51. Attribute VB_Creatable = True
  52. Attribute VB_PredeclaredId = False
  53. Attribute VB_Exposed = True
  54. Option Explicit
  55.  
  56. 'constant
  57. Private Const mDefAutoConnect As Boolean = True
  58. 'members
  59.  
  60. Private mSQLFields As String
  61. Private mSQLTable As String
  62. Private mSQLWhere As String
  63. Private mSQLWhereFields As String
  64. Private mSQLGroupBy As String
  65. Private mSQLOrderBy As String
  66. Private mSQLFilterString As String
  67. Private mSQLWhereSeparator As String
  68. Private mBoundFieldIndex As Integer
  69. Private mDisplayFieldIndex As Integer
  70. Private mAutoConnect As Boolean
  71.  
  72. Private mRecCount As Long
  73. Private mBoundData As String
  74.  
  75. Private mForeColor As OLE_COLOR
  76.  
  77. Private Type udtColumn
  78.     EditCtrl As Object
  79.     dCustomWidth As Single
  80.     nAlignment As Integer
  81.     nSortOrder As lgSortTypeEnum
  82.     nType As Integer
  83.     lWidth As Long
  84.     lX As Long
  85.     MoveControl As Integer
  86.     bVisible As Boolean
  87.     sCaption As String
  88.     sFormat As String
  89.     sTag As String
  90. End Type
  91.  
  92.  
  93. 'public vars
  94. Public DropDBCon As New ADODB.Connection
  95. Public DropRS As New ADODB.Recordset
  96. Public DropGrid As LynxGrid3
  97. Private mCols() As udtColumn
  98.  
  99. 'events
  100. Public Event BeforeDropDown()
  101. Public Event Change()
  102. 'Default Property Values:
  103. Const m_def_DropCaption = "Select Entry"
  104. Const m_def_DropWinWidth = 6735
  105. Const m_def_DropWinHeight = 3510
  106. 'Property Variables:
  107. Dim m_DropCaption As String
  108. Dim m_DropWinWidth As Integer
  109. Dim m_DropWinHeight As Integer
  110.  
  111.  
  112. Private Function GetHeight() As Integer
  113.     GetHeight = UserControl.Height / Screen.TwipsPerPixelY
  114. End Function
  115.  
  116. Private Function GetWidth() As Integer
  117.     GetWidth = UserControl.Width / Screen.TwipsPerPixelX
  118. End Function
  119.  
  120.  
  121. Private Sub cmdClear_Click()
  122.     Call ClearCurData
  123. End Sub
  124.  
  125. Private Sub cmdPicker_Click()
  126.     
  127.     Dim sDT As String
  128.     Dim sBT As String
  129.     Dim OldBT As String
  130.     
  131.     RaiseEvent BeforeDropDown
  132.     
  133.     'clear custom search
  134.     mSQLFilterString = ""
  135.     
  136.     'Call LoadData
  137.     'Call LoadColumnHeaders
  138.     
  139.     If frmDataPicker.ShowPicker(UserControl.Parent, Me, sBT, sDT) = True Then
  140.         
  141.         OldBT = mBoundData
  142.         
  143.         txtDisplay.Text = sDT
  144.         mBoundData = sBT
  145.         
  146.         If mBoundData <> OldBT Then
  147.             RaiseEvent Change
  148.         End If
  149.     End If
  150.  
  151. End Sub
  152.  
  153. Public Sub LoadColumnHeaders()
  154.     
  155.     Dim li As Long
  156.     
  157.     For li = 0 To UBound(mCols)
  158.         frmDataPicker.listEntries.AddColumn mCols(li).sCaption, CSng(mCols(li).lWidth), CLng(mCols(li).nAlignment), CLng(mCols(li).nType), CStr(mCols(li).sFormat)
  159.     Next
  160.     
  161. End Sub
  162.  
  163. Private Sub UserControl_Initialize()
  164.         ReDim mCols(0)
  165.         Load frmDataPicker
  166.         Set DropGrid = frmDataPicker.listEntries
  167.  
  168. End Sub
  169.  
  170. Private Sub UserControl_Resize()
  171.     
  172.     If GetWidth < 58 Then
  173.         UserControl.Width = 58 * 15
  174.     End If
  175.     If GetHeight < 21 Then
  176.         UserControl.Height = 21 * 15
  177.     End If
  178.     
  179.     txtDisplay.Move 0, 1, GetWidth - cmdClear.Width - cmdPicker.Width - 4, GetHeight - 1
  180.     cmdPicker.Move GetWidth - cmdPicker.Width - cmdClear.Width - 2, 0, cmdPicker.Width, GetHeight - 1
  181.     cmdClear.Move GetWidth - cmdClear.Width, 0, cmdClear.Width, GetHeight - 1
  182.  
  183. End Sub
  184.  
  185.  
  186. Public Property Get SQLFields() As String
  187.     SQLFields = mSQLFields
  188. End Property
  189. Public Property Let SQLFields(ByVal NewValue As String)
  190.     mSQLFields = NewValue
  191. End Property
  192.  
  193. Public Property Get SQLTable() As String
  194.     SQLTable = mSQLTable
  195. End Property
  196. Public Property Let SQLTable(ByVal NewValue As String)
  197.     mSQLTable = NewValue
  198. End Property
  199.  
  200. Public Property Get SQLWhereFields() As String
  201.     SQLWhereFields = mSQLWhereFields
  202. End Property
  203. Public Property Let SQLWhereFields(ByVal NewValue As String)
  204.     mSQLWhereFields = NewValue
  205. End Property
  206.  
  207.  
  208. Public Property Get SQLGroupBy() As String
  209.     SQLGroupBy = mSQLGroupBy
  210. End Property
  211. Public Property Let SQLGroupBy(ByVal NewValue As String)
  212.     mSQLGroupBy = NewValue
  213.     PropertyChanged "SQLGroupBy"
  214. End Property
  215.  
  216. Public Property Get SQLOrderBy() As String
  217.     SQLOrderBy = mSQLOrderBy
  218. End Property
  219. Public Property Let SQLOrderBy(ByVal NewValue As String)
  220.     mSQLOrderBy = NewValue
  221.     PropertyChanged "SQLOrderBy"
  222. End Property
  223.  
  224. Public Property Get SQLWhereSeparator() As String
  225.     SQLWhereSeparator = mSQLWhereSeparator
  226. End Property
  227. Public Property Let SQLWhereSeparator(ByVal NewValue As String)
  228.     mSQLWhereSeparator = NewValue
  229.     PropertyChanged "SQLWhereSeparator"
  230. End Property
  231.  
  232. Public Property Get SQLFilterString() As String
  233.     SQLFilterString = mSQLFilterString
  234. End Property
  235. Public Property Let SQLFilterString(ByVal NewValue As String)
  236.     mSQLFilterString = NewValue
  237.     PropertyChanged "SQLFilterString"
  238. End Property
  239.  
  240. Public Property Get SQLWhere() As String
  241.     SQLWhere = mSQLWhere
  242. End Property
  243. Public Property Let SQLWhere(ByVal NewValue As String)
  244.     mSQLWhere = NewValue
  245.     PropertyChanged "SQLWhere"
  246. End Property
  247.  
  248. Public Property Get BoundFieldIndex() As Integer
  249.     BoundFieldIndex = mBoundFieldIndex
  250. End Property
  251. Public Property Let BoundFieldIndex(ByVal NewValue As Integer)
  252.     mBoundFieldIndex = NewValue
  253.     PropertyChanged "BoundFieldIndex"
  254. End Property
  255.  
  256. Public Property Get DisplayFieldIndex() As Integer
  257.     DisplayFieldIndex = mDisplayFieldIndex
  258. End Property
  259. Public Property Let DisplayFieldIndex(ByVal NewValue As Integer)
  260.     mDisplayFieldIndex = NewValue
  261.     PropertyChanged "DisplayFieldIndex"
  262. End Property
  263.  
  264. Public Property Get hwnd() As Long
  265.     hwnd = UserControl.hwnd
  266. End Property
  267.  
  268. Public Property Get Font() As StdFont
  269.     Set Font = txtDisplay.Font
  270. End Property
  271. Public Property Set Font(ByVal NewValue As StdFont)
  272.     Set txtDisplay.Font = NewValue
  273.     PropertyChanged "Font"
  274. End Property
  275.  
  276. Public Property Get BoundData() As String
  277.     BoundData = mBoundData
  278. End Property
  279. Public Property Let BoundData(ByVal NewValue As String)
  280.     mBoundData = NewValue
  281. End Property
  282.  
  283. Public Property Get DisplayData() As String
  284.     DisplayData = txtDisplay.Text
  285. End Property
  286. Public Property Let DisplayData(ByVal NewValue As String)
  287.     txtDisplay.Text = NewValue
  288. End Property
  289.  
  290.  
  291.  
  292.  
  293. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  294.     
  295.     mSQLFields = PropBag.ReadProperty("SQLFields", "")
  296.     mSQLTable = PropBag.ReadProperty("SQLTable", "")
  297.     mSQLWhere = PropBag.ReadProperty("SQLWhere", "")
  298.     mSQLWhereFields = PropBag.ReadProperty("SQLWhereFields", "")
  299.     mSQLGroupBy = PropBag.ReadProperty("SQLGroupBy", "")
  300.     mSQLOrderBy = PropBag.ReadProperty("SQLOrderBy", "")
  301.  
  302.     mSQLWhereSeparator = PropBag.ReadProperty("SQLWhereSeparator", ",")
  303.     
  304.     
  305.     mBoundFieldIndex = PropBag.ReadProperty("BoundFieldIndex", 0)
  306.     mDisplayFieldIndex = PropBag.ReadProperty("DisplayFieldIndex", 0)
  307.  
  308.     Set txtDisplay.Font = PropBag.ReadProperty("Font", Ambient.Font)
  309.     cmdClear.Enabled = PropBag.ReadProperty("ClearEnabled", True)
  310.     cmdPicker.Enabled = PropBag.ReadProperty("DropEnabled", True)
  311.     Set Picture = PropBag.ReadProperty("ClearIcon", Nothing)
  312.     Set Picture = PropBag.ReadProperty("DropIcon", Nothing)
  313.     txtDisplay.Locked = PropBag.ReadProperty("TextLocked", True)
  314.     m_DropWinWidth = PropBag.ReadProperty("DropWinWidth", m_def_DropWinWidth)
  315.     m_DropWinHeight = PropBag.ReadProperty("DropWinHeight", m_def_DropWinHeight)
  316.     txtDisplay.BackColor = PropBag.ReadProperty("BackColor", &H80000005)
  317.     txtDisplay.Locked = PropBag.ReadProperty("Locked", True)
  318.     UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  319.     m_DropCaption = PropBag.ReadProperty("DropCaption", m_def_DropCaption)
  320. End Sub
  321.  
  322.  
  323.  
  324. Private Sub UserControl_Terminate()
  325.     On Error Resume Next
  326.     Unload frmDataPicker
  327.     Err.Clear
  328. End Sub
  329.  
  330. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  331.  
  332.     Call PropBag.WriteProperty("SQLFields", mSQLFields, "")
  333.     Call PropBag.WriteProperty("SQLTable", mSQLTable, "")
  334.     Call PropBag.WriteProperty("SQLWhere", mSQLWhere, "")
  335.     Call PropBag.WriteProperty("SQLWhereFields", mSQLWhereFields, "")
  336.     Call PropBag.WriteProperty("SQLGroupBy", mSQLGroupBy, "")
  337.     Call PropBag.WriteProperty("SQLOrderBy", mSQLOrderBy, "")
  338.     Call PropBag.WriteProperty("SQLWhereSeparator", mSQLWhereSeparator, ",")
  339.     
  340.     Call PropBag.WriteProperty("BoundFieldIndex", mBoundFieldIndex, 0)
  341.     Call PropBag.WriteProperty("DisplayFieldIndex", mDisplayFieldIndex, 0)
  342.     Call PropBag.WriteProperty("Font", txtDisplay.Font, Ambient.Font)
  343.     Call PropBag.WriteProperty("ClearEnabled", cmdClear.Enabled, True)
  344.     Call PropBag.WriteProperty("DropEnabled", cmdPicker.Enabled, True)
  345.     Call PropBag.WriteProperty("ClearIcon", Picture, Nothing)
  346.     Call PropBag.WriteProperty("DropIcon", Picture, Nothing)
  347.     Call PropBag.WriteProperty("TextLocked", txtDisplay.Locked, True)
  348.     Call PropBag.WriteProperty("DropWinWidth", m_DropWinWidth, m_def_DropWinWidth)
  349.     Call PropBag.WriteProperty("DropWinHeight", m_DropWinHeight, m_def_DropWinHeight)
  350.     Call PropBag.WriteProperty("BackColor", txtDisplay.BackColor, &H80000005)
  351.     Call PropBag.WriteProperty("Locked", txtDisplay.Locked, True)
  352.     Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  353.     Call PropBag.WriteProperty("DropCaption", m_DropCaption, m_def_DropCaption)
  354. End Sub
  355.  
  356.  
  357. Public Function AddColumn(Optional Caption As String, Optional Width As Single, Optional Alignment As lgAlignmentEnum = lgAlignLeftCenter, Optional DataType As lgDataTypeEnum = lgString, Optional Format As String) As Long
  358.  
  359.     Dim lNewCol As Long
  360.     
  361.     If mCols(0).nAlignment <> 0 Then
  362.         lNewCol = UBound(mCols) + 1
  363.         ReDim Preserve mCols(lNewCol)
  364.     End If
  365.  
  366.     With mCols(lNewCol)
  367.         .sCaption = Caption
  368.         .dCustomWidth = Width
  369.         .lWidth = ScaleX(.dCustomWidth, vbPixels, vbPixels)
  370.         .nAlignment = Alignment
  371.         .nSortOrder = lgSTAscending
  372.         .nType = DataType
  373.         .sFormat = Format
  374.         
  375.         .bVisible = True
  376.     End With
  377.     AddColumn = lNewCol
  378.     
  379. End Function
  380.  
  381.  
  382. Public Function LoadData() As Boolean
  383.  
  384.     'default
  385.     LoadData = False
  386.     mRecCount = 0
  387.     
  388.     DropGrid.Redraw = False
  389.     DropGrid.Clear
  390.  
  391.     'generate and validate
  392.     If Len(Trim(GenSQLCon)) < 1 Then
  393.         GoTo RAE
  394.     End If
  395.         
  396.     'connect
  397.     If ConRS(DropDBCon, DropRS, GenSQLCon) = False Then
  398.         GoTo RAE
  399.     End If
  400.     
  401.     If AnyRecExist(DropRS) = False Then
  402.         LoadData = True
  403.     End If
  404.     
  405.     'fill
  406.     mRecCount = GetRecCount(DropRS)
  407.     
  408.     If mRecCount < 1 Then
  409.         GoTo RAE
  410.     End If
  411.     
  412.     'return success
  413.     LoadData = True
  414.     
  415. RAE:
  416.     DropGrid.Redraw = True
  417.     DropGrid.Refresh
  418. End Function
  419.  
  420. Private Function GenSQLCon() As String
  421.     
  422.     Dim sNewWhere As String
  423.     
  424.     sNewWhere = GenSQLWhere
  425.     
  426.     If Len(Trim(sNewWhere)) > 1 Then
  427.         sNewWhere = " WHERE " & sNewWhere
  428.     Else
  429.         sNewWhere = ""
  430.     End If
  431.  
  432.     GenSQLCon = "SELECT " & mSQLFields & " " & _
  433.                 " FROM " & mSQLTable & " " & _
  434.                 sNewWhere & " " & _
  435.                 mSQLGroupBy & " " & _
  436.                 GenSQLOrderBy
  437.                 
  438. End Function
  439.  
  440. Private Function GenSQLOrderBy() As String
  441.     
  442.     'default
  443.     GenSQLOrderBy = ""
  444.     
  445.     If Len(Trim(mSQLOrderBy)) > 0 Then
  446.         GenSQLOrderBy = "ORDER BY " & mSQLOrderBy
  447.     End If
  448.     
  449. End Function
  450.  
  451. Private Function GenSQLWhere() As String
  452.     
  453.     Dim sNewWhere As String
  454.     Dim i As Integer
  455.     
  456.     If Len(Trim(mSQLFilterString)) > 1 Then
  457.         
  458.         sNewWhere = Replace(mSQLWhereFields, mSQLWhereSeparator, " " & Chr(Asc("&")) & " ") & _
  459.                 " like '%" & Trim(mSQLFilterString) & "%'"
  460.         
  461.     End If
  462.     
  463.         
  464.     If Len(Trim(mSQLWhere)) > 0 Then
  465.         If Len(Trim(sNewWhere)) > 0 Then
  466.             'add 'AND'
  467.             sNewWhere = sNewWhere & " AND "
  468.         End If
  469.         
  470.         sNewWhere = sNewWhere & "(" & mSQLWhere & ")"
  471.     End If
  472.     
  473.     GenSQLWhere = Trim(sNewWhere)
  474.  
  475. End Function
  476.  
  477.  
  478. Public Function GetCellTextToDisplay(ByVal lRow As Long, ByVal lCol As Long, ByRef sNewValue As String)
  479.  
  480.     Dim lDif As Long
  481.     
  482.     lDif = (DropRS.AbsolutePosition - 1) - lRow
  483.     
  484.     If lDif > 0 Then
  485.         DropRS.MoveFirst
  486.         DropRS.Move lRow
  487.     ElseIf lDif < 0 Then
  488.         DropRS.Move 0 - lDif
  489.     End If
  490.     
  491.     sNewValue = ReadField(DropRS.Fields(lCol))
  492. End Function
  493.  
  494. Public Function GetCurRecCount() As Long
  495.     GetCurRecCount = mRecCount
  496. End Function
  497.  
  498. Public Sub ClearCurData()
  499.     txtDisplay.Text = ""
  500.     mBoundData = ""
  501.     RaiseEvent Change
  502. End Sub
  503.  
  504. Public Sub FocusedDropButton()
  505.     cmdPicker.SetFocus
  506. End Sub
  507.  
  508. Public Sub FocusedClearButton()
  509.     cmdClear.SetFocus
  510. End Sub
  511. Private Function ConRS(ByRef vDB As ADODB.Connection, ByRef vRS As ADODB.Recordset, sSQL As String) As Boolean
  512.     
  513.     'default
  514.     ConRS = False
  515.     
  516.     On Error GoTo Errh
  517.     
  518.     Set vRS = Nothing
  519.     Set vRS = New ADODB.Recordset
  520.  
  521.     vRS.Open sSQL, vDB, adOpenStatic, adLockOptimistic
  522.     ConRS = True
  523.  
  524. Errh:
  525.  
  526. End Function
  527.  
  528.  
  529. Public Function AnyRecExist(ByRef vRS As ADODB.Recordset) As Boolean
  530.     
  531.     If vRS.State = adStateClosed Then
  532.         AnyRecExist = False
  533.         Exit Function
  534.     End If
  535.         
  536.     vRS.Requery
  537.     
  538.     If (vRS.BOF = True) And (vRS.EOF = True) Then
  539.         AnyRecExist = False
  540.     Else
  541.         On Error GoTo Errh
  542.         vRS.MoveFirst
  543.         AnyRecExist = True
  544.     End If
  545.  
  546.     Exit Function
  547.     '--------------------------
  548.     
  549. Errh:
  550.     AnyRecExist = False
  551. End Function
  552.  
  553.  
  554. Private Function ReadField(ByRef vField As Field) As Variant
  555.     
  556.     On Error GoTo Errh
  557.  
  558.     If Not IsNull(vField.Value) Then
  559.         ReadField = vField.Value
  560.     Else
  561.         Select Case vField.Type
  562.             Case adBigInt
  563.                 ReadField = 0
  564.             Case adBinary
  565.                 ReadField = 0
  566.             Case adBoolean
  567.                 ReadField = False
  568.             'Case adByRef 'temp
  569.             '    ReadField = 0
  570.             Case adBSTR
  571.                 ReadField = ""
  572.             Case adChar
  573.                 ReadField = ""
  574.             Case adCurrency
  575.                 ReadField = 0
  576.             Case adDate
  577.                 ReadField = CDate(0)
  578.             Case adDBDate
  579.                 ReadField = CDate(0)
  580.             Case adDBTime
  581.                 ReadField = FormatDateTime(CDate(0), vbLongTime)
  582.             Case adDBTimeStamp
  583.                 ReadField = CDate(0)
  584.             Case adDecimal
  585.                 ReadField = 0
  586.             Case adDouble
  587.                 ReadField = 0
  588.             Case adEmpty 'temp
  589.                 ReadField = ""
  590.             Case adError
  591.                 ReadField = 0
  592.             Case adNumeric
  593.                 ReadField = 0
  594.             Case adDouble
  595.                 ReadField = 0
  596.             Case Else
  597.                 ReadField = ""
  598.             End Select
  599.     End If
  600.     
  601.     Exit Function
  602.     
  603. Errh:
  604.     ReadField = ""
  605. End Function
  606.  
  607.  
  608. Private Function GetRecCount(ByRef vRS As ADODB.Recordset) As Long
  609.     If AnyRecExist(vRS) Then
  610.         vRS.Requery
  611.         vRS.MoveLast
  612.         GetRecCount = vRS.RecordCount
  613.     Else
  614.         GetRecCount = 0
  615.     End If
  616. End Function
  617.  
  618.  
  619.  
  620. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  621. 'MappingInfo=cmdClear,cmdClear,-1,Enabled
  622. Public Property Get ClearEnabled() As Boolean
  623. Attribute ClearEnabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  624.     ClearEnabled = cmdClear.Enabled
  625. End Property
  626.  
  627. Public Property Let ClearEnabled(ByVal New_ClearEnabled As Boolean)
  628.     cmdClear.Enabled() = New_ClearEnabled
  629.     PropertyChanged "ClearEnabled"
  630. End Property
  631.  
  632. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  633. 'MappingInfo=cmdPicker,cmdPicker,-1,Enabled
  634. Public Property Get DropEnabled() As Boolean
  635. Attribute DropEnabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  636.     DropEnabled = cmdPicker.Enabled
  637. End Property
  638.  
  639. Public Property Let DropEnabled(ByVal New_DropEnabled As Boolean)
  640.     cmdPicker.Enabled() = New_DropEnabled
  641.     PropertyChanged "DropEnabled"
  642. End Property
  643.  
  644. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  645. 'MappingInfo=cmdClear,cmdClear,-1,Picture
  646. Public Property Get ClearIcon() As Picture
  647. Attribute ClearIcon.VB_Description = "Returns/sets a graphic to be displayed in a CommandButton, OptionButton or CheckBox control, if Style is set to 1."
  648.     Set ClearIcon = cmdClear.Picture
  649. End Property
  650.  
  651. Public Property Set ClearIcon(ByVal New_ClearIcon As Picture)
  652.     Set cmdClear.Picture = New_ClearIcon
  653.     PropertyChanged "ClearIcon"
  654. End Property
  655.  
  656. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  657. 'MappingInfo=cmdPicker,cmdPicker,-1,Picture
  658. Public Property Get DropIcon() As Picture
  659. Attribute DropIcon.VB_Description = "Returns/sets a graphic to be displayed in a CommandButton, OptionButton or CheckBox control, if Style is set to 1."
  660.     Set DropIcon = cmdPicker.Picture
  661. End Property
  662.  
  663. Public Property Set DropIcon(ByVal New_DropIcon As Picture)
  664.     Set cmdPicker.Picture = New_DropIcon
  665.     PropertyChanged "DropIcon"
  666. End Property
  667.  
  668. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  669. 'MappingInfo=txtDisplay,txtDisplay,-1,Locked
  670. Public Property Get TextLocked() As Boolean
  671. Attribute TextLocked.VB_Description = "Determines whether a control can be edited."
  672.     TextLocked = txtDisplay.Locked
  673. End Property
  674.  
  675. Public Property Let TextLocked(ByVal New_TextLocked As Boolean)
  676.     txtDisplay.Locked() = New_TextLocked
  677.     PropertyChanged "TextLocked"
  678. End Property
  679.  
  680. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  681. 'MemberInfo=7,0,0,5000
  682. Public Property Get DropWinWidth() As Integer
  683.     DropWinWidth = m_DropWinWidth
  684. End Property
  685.  
  686. Public Property Let DropWinWidth(ByVal New_DropWinWidth As Integer)
  687.     m_DropWinWidth = New_DropWinWidth
  688.     PropertyChanged "DropWinWidth"
  689. End Property
  690.  
  691. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  692. 'MemberInfo=7,0,0,500
  693. Public Property Get DropWinHeight() As Integer
  694.     DropWinHeight = m_DropWinHeight
  695. End Property
  696.  
  697. Public Property Let DropWinHeight(ByVal New_DropWinHeight As Integer)
  698.     m_DropWinHeight = New_DropWinHeight
  699.     PropertyChanged "DropWinHeight"
  700. End Property
  701.  
  702. 'Initialize Properties for User Control
  703. Private Sub UserControl_InitProperties()
  704.     m_DropWinWidth = m_def_DropWinWidth
  705.     m_DropWinHeight = m_def_DropWinHeight
  706.     m_DropCaption = m_def_DropCaption
  707. End Sub
  708.  
  709. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  710. 'MappingInfo=txtDisplay,txtDisplay,-1,BackColor
  711. Public Property Get BackColor() As OLE_COLOR
  712. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  713.     BackColor = txtDisplay.BackColor
  714. End Property
  715.  
  716. Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  717.     txtDisplay.BackColor() = New_BackColor
  718.     PropertyChanged "BackColor"
  719. End Property
  720.  
  721. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  722. 'MappingInfo=txtDisplay,txtDisplay,-1,Locked
  723. Public Property Get Locked() As Boolean
  724. Attribute Locked.VB_Description = "Determines whether a control can be edited."
  725.     Locked = txtDisplay.Locked
  726. End Property
  727.  
  728. Public Property Let Locked(ByVal New_Locked As Boolean)
  729.     txtDisplay.Locked() = New_Locked
  730.     PropertyChanged "Locked"
  731. End Property
  732.  
  733. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  734. 'MappingInfo=UserControl,UserControl,-1,Enabled
  735. Public Property Get Enabled() As Boolean
  736. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  737.     Enabled = UserControl.Enabled
  738. End Property
  739.  
  740. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  741.     txtDisplay.Enabled = New_Enabled
  742.     cmdPicker.Enabled = New_Enabled
  743.     cmdClear.Enabled = New_Enabled
  744.     UserControl.Enabled() = New_Enabled
  745.     PropertyChanged "Enabled"
  746. End Property
  747.  
  748. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  749. 'MemberInfo=13,0,0,Select Entry
  750. Public Property Get DropCaption() As String
  751.     DropCaption = m_DropCaption
  752. End Property
  753.  
  754. Public Property Let DropCaption(ByVal New_DropCaption As String)
  755.     m_DropCaption = New_DropCaption
  756.     PropertyChanged "DropCaption"
  757. End Property
  758.  
  759.