home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / axpcklst / axpicker.ctl < prev    next >
Encoding:
Visual Basic user-defined control file  |  1998-08-01  |  13.4 KB  |  419 lines
  1. VERSION 5.00
  2. Begin VB.UserControl axPicker 
  3.    ClientHeight    =   2130
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   6000
  7.    ScaleHeight     =   142
  8.    ScaleMode       =   3  'Pixel
  9.    ScaleWidth      =   400
  10.    ToolboxBitmap   =   "axPicker.ctx":0000
  11.    Begin VB.Frame fraButtons 
  12.       Appearance      =   0  'Flat
  13.       BackColor       =   &H00C0C0C0&
  14.       BorderStyle     =   0  'None
  15.       ForeColor       =   &H80000008&
  16.       Height          =   1635
  17.       Left            =   2790
  18.       TabIndex        =   4
  19.       Top             =   360
  20.       Width           =   465
  21.       Begin axPicklistControl.axDataButton axButton 
  22.          Height          =   405
  23.          Index           =   1
  24.          Left            =   0
  25.          Top             =   405
  26.          Width           =   450
  27.          _ExtentX        =   794
  28.          _ExtentY        =   714
  29.          Picture         =   "axPicker.ctx":0312
  30.       End
  31.       Begin axPicklistControl.axDataButton axButton 
  32.          Height          =   405
  33.          Index           =   2
  34.          Left            =   0
  35.          Top             =   810
  36.          Width           =   450
  37.          _ExtentX        =   794
  38.          _ExtentY        =   714
  39.          Picture         =   "axPicker.ctx":0664
  40.       End
  41.       Begin axPicklistControl.axDataButton axButton 
  42.          Height          =   405
  43.          Index           =   3
  44.          Left            =   0
  45.          Top             =   1215
  46.          Width           =   450
  47.          _ExtentX        =   794
  48.          _ExtentY        =   714
  49.          Picture         =   "axPicker.ctx":09B6
  50.       End
  51.       Begin axPicklistControl.axDataButton axButton 
  52.          Height          =   405
  53.          Index           =   0
  54.          Left            =   0
  55.          Top             =   0
  56.          Width           =   450
  57.          _ExtentX        =   794
  58.          _ExtentY        =   714
  59.          Picture         =   "axPicker.ctx":0D08
  60.       End
  61.    End
  62.    Begin VB.ListBox lstAvailable 
  63.       DragIcon        =   "axPicker.ctx":105A
  64.       Height          =   1620
  65.       Left            =   135
  66.       MultiSelect     =   2  'Extended
  67.       TabIndex        =   1
  68.       Top             =   360
  69.       Width           =   2535
  70.    End
  71.    Begin VB.ListBox lstSelected 
  72.       DragIcon        =   "axPicker.ctx":1364
  73.       Height          =   1620
  74.       Left            =   3330
  75.       MultiSelect     =   2  'Extended
  76.       TabIndex        =   0
  77.       Top             =   360
  78.       Width           =   2535
  79.    End
  80.    Begin VB.Label lblSelected 
  81.       Caption         =   "Selected Items:"
  82.       Height          =   195
  83.       Left            =   3375
  84.       TabIndex        =   3
  85.       Top             =   135
  86.       Width           =   1095
  87.    End
  88.    Begin VB.Label lblAvailable 
  89.       Caption         =   "Available Items:"
  90.       Height          =   195
  91.       Left            =   180
  92.       TabIndex        =   2
  93.       Top             =   135
  94.       Width           =   1140
  95.    End
  96. End
  97. Attribute VB_Name = "axPicker"
  98. Attribute VB_GlobalNameSpace = False
  99. Attribute VB_Creatable = True
  100. Attribute VB_PredeclaredId = False
  101. Attribute VB_Exposed = True
  102. Const m_def_BorderStyle = 2
  103.  
  104. Dim m_BorderStyle As Integer, iLast As Integer
  105.  
  106. Public Enum AxBorderStyles
  107.     [No Border] = 0
  108.     [Single] = 1
  109.     [Thin Raised] = 2
  110.     [Thick Raised] = 3
  111.     [Thin Inset] = 4
  112.     [Thick Inset] = 5
  113.     [Etched] = 6
  114.     [Bump] = 7
  115. End Enum
  116.  
  117. Private Sub axButton_Click(index As Integer)
  118. iLast = -1
  119. Select Case index
  120. Case 0
  121.   For i = 0 To lstAvailable.ListCount - 1
  122.     lstSelected.AddItem lstAvailable.List(i)
  123.   Next
  124.   lstAvailable.Clear
  125.  
  126. Case 1
  127.   If lstAvailable.ListIndex = -1 Then Exit Sub
  128.   For i = lstAvailable.ListCount - 1 To 0 Step -1
  129.     If lstAvailable.Selected(i) = True Then
  130.       iLast = i
  131.       lstSelected.AddItem lstAvailable.List(i)
  132.       lstAvailable.RemoveItem i
  133.     End If
  134.   Next
  135.   
  136.   If lstAvailable.ListCount And iLast >= 0 Then
  137.     If lstAvailable.ListCount - 1 < iLast Then
  138.       lstAvailable.Selected(lstAvailable.ListCount - 1) = True
  139.     Else
  140.       lstAvailable.Selected(iLast) = True
  141.     End If
  142.   End If
  143.  
  144. Case 2
  145.   If lstSelected.ListIndex = -1 Then Exit Sub
  146.   For i = lstSelected.ListCount - 1 To 0 Step -1
  147.     If lstSelected.Selected(i) = True Then
  148.       iLast = i
  149.       lstAvailable.AddItem lstSelected.List(i)
  150.       lstSelected.RemoveItem i
  151.     End If
  152.   Next
  153.  
  154.   If lstSelected.ListCount And iLast >= 0 Then
  155.     If lstSelected.ListCount - 1 < iLast Then
  156.       lstSelected.Selected(lstSelected.ListCount - 1) = True
  157.     Else
  158.       lstSelected.Selected(iLast) = True
  159.     End If
  160.   End If
  161.  
  162. Case 3
  163.   For i = 0 To lstSelected.ListCount - 1
  164.     lstAvailable.AddItem lstSelected.List(i)
  165.   Next
  166.   lstSelected.Clear
  167.  
  168. End Select
  169.  
  170. End Sub
  171.  
  172.  
  173. Private Sub lstAvailable_DblClick()
  174.   If lstAvailable.ListIndex = -1 Then Exit Sub
  175.   iLast = lstAvailable.ListIndex
  176.   lstSelected.AddItem lstAvailable.List(lstAvailable.ListIndex)
  177.   lstAvailable.RemoveItem lstAvailable.ListIndex
  178.   
  179.   If lstAvailable.ListCount Then
  180.     If lstAvailable.ListCount - 1 < iLast Then
  181.       lstAvailable.Selected(lstAvailable.ListCount - 1) = True
  182.     Else
  183.       lstAvailable.Selected(iLast) = True
  184.     End If
  185.   End If
  186. End Sub
  187.  
  188.  
  189. Private Sub lstSelected_DblClick()
  190.   If lstSelected.ListIndex = -1 Then Exit Sub
  191.   iLast = lstSelected.ListIndex
  192.   lstAvailable.AddItem lstSelected.List(lstSelected.ListIndex)
  193.   lstSelected.RemoveItem lstSelected.ListIndex
  194.   
  195.   If lstSelected.ListCount Then
  196.     If lstSelected.ListCount - 1 < iLast Then
  197.       lstSelected.Selected(lstSelected.ListCount - 1) = True
  198.     Else
  199.       lstSelected.Selected(iLast) = True
  200.     End If
  201.   End If
  202. End Sub
  203.  
  204. Private Sub UserControl_Initialize()
  205.   UserControl.Height = 2130: UserControl.Width = 6135
  206. End Sub
  207.  
  208. Private Sub UserControl_InitProperties()
  209.     m_BorderStyle = m_def_BorderStyle
  210.  
  211. End Sub
  212.  
  213. Private Sub UserControl_Resize()
  214.   'If lstAvailable.Height + lstAvailable.Top + 10 > 142 Then UserControl.ScaleHeight = lstAvailable.Height + lstAvailable.Top + 10
  215.  
  216.   lstAvailable.Height = UserControl.ScaleHeight - lstAvailable.Top - 10
  217.   lstAvailable.Width = IIf(UserControl.ScaleWidth > 0, Int((UserControl.ScaleWidth - 60) / 2), 0)
  218.   
  219.   lstSelected.Height = UserControl.ScaleHeight - lstAvailable.Top - 10
  220.   lstSelected.Width = IIf(UserControl.ScaleWidth > 0, Int((UserControl.ScaleWidth - 60) / 2), 0)
  221.   lstSelected.Left = lstAvailable.Left + lstAvailable.Width + 40
  222.   lblSelected.Left = lstAvailable.Left + lstAvailable.Width + 42
  223.   
  224.   fraButtons.Left = lstAvailable.Left + lstAvailable.Width + 5
  225.     
  226.   'UserControl.ScaleHeight = lstAvailable.Height + lstAvailable.Top + 10
  227.   If UserControl.Height < 2130 Then
  228.     UserControl.Height = 2130
  229.   Else
  230.     UserControl.Height = (lstAvailable.Height + lstAvailable.Top + 10) * Screen.TwipsPerPixelY
  231.   End If
  232.   
  233.  '   UserControl.ScaleHeight = lstAvailable.Height + lstAvailable.Top + 10
  234.   
  235.   UserControl.Cls
  236.   UserControl_Paint
  237.   
  238.   
  239. End Sub
  240.  
  241. Public Sub AddItemA(item As String, Optional index As Integer)
  242. Attribute AddItemA.VB_Description = "Add item to available listbox"
  243.   If IsMissing(index) Then
  244.     lstAvailable.AddItem item
  245.   Else
  246.     lstAvailable.AddItem item, index
  247.   End If
  248. End Sub
  249. Public Sub AddItemS(item As String, Optional index As Integer)
  250. Attribute AddItemS.VB_Description = "Add item to selected listbox"
  251.   If IsMissing(index) Then
  252.     lstSelected.AddItem item
  253.   Else
  254.     lstSelected.AddItem item, index
  255.   End If
  256. End Sub
  257.  
  258. Public Sub RemoveItemA(ByVal index As Integer)
  259. Attribute RemoveItemA.VB_Description = "Remove item from available listbox"
  260.   lstAvailable.RemoveItem index
  261. End Sub
  262. Public Sub RemoveItemS(ByVal index As Integer)
  263. Attribute RemoveItemS.VB_Description = "Remove item from selected listbox"
  264.   lstSelected.RemoveItem index
  265. End Sub
  266. Public Sub ClearA()
  267. Attribute ClearA.VB_Description = "Clear available listbox"
  268.   lstAvailable.Clear
  269. End Sub
  270. Public Sub ClearS()
  271. Attribute ClearS.VB_Description = "Clear selected listbox"
  272.   lstSelected.Clear
  273. End Sub
  274.  
  275. Public Property Get ListIndexA() As Integer
  276. Attribute ListIndexA.VB_Description = "Currently selected item in available listbox"
  277. Attribute ListIndexA.VB_MemberFlags = "400"
  278.     ListIndexA = lstAvailable.ListIndex
  279. End Property
  280. Public Property Get ListCountA() As Integer
  281. Attribute ListCountA.VB_Description = "Count of items in available listbox"
  282. Attribute ListCountA.VB_MemberFlags = "400"
  283.   ListCountA = lstAvailable.ListCount
  284. End Property
  285. Public Property Get ListA(ByVal index As Integer) As String
  286. Attribute ListA.VB_Description = "String array of items in available listbox"
  287. Attribute ListA.VB_MemberFlags = "400"
  288.   ListA = lstAvailable.List(index)
  289. End Property
  290.  
  291. Public Property Get ListIndexS() As Integer
  292. Attribute ListIndexS.VB_Description = "Current selected item in selected listbox"
  293. Attribute ListIndexS.VB_MemberFlags = "400"
  294.     ListIndexS = lstSelected.ListIndex
  295. End Property
  296. Public Property Get ListCountS() As Integer
  297. Attribute ListCountS.VB_Description = "Count of items in selected listbox"
  298. Attribute ListCountS.VB_MemberFlags = "400"
  299.   ListCountS = lstSelected.ListCount
  300. End Property
  301. Public Property Get ListS(ByVal index As Integer) As String
  302. Attribute ListS.VB_Description = "String array of items in selected listbox"
  303. Attribute ListS.VB_MemberFlags = "400"
  304.   ListS = lstSelected.List(index)
  305. End Property
  306.  
  307. Public Sub ShowAbout()
  308. Attribute ShowAbout.VB_Description = "Show about box for control"
  309. Attribute ShowAbout.VB_UserMemId = -552
  310.   frmAbout.Show vbModal
  311. End Sub
  312. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  313. 'MappingInfo=UserControl,UserControl,-1,Enabled
  314. Public Property Get Enabled() As Boolean
  315. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  316.     Enabled = UserControl.Enabled
  317. End Property
  318.  
  319. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  320.     UserControl.Enabled() = New_Enabled
  321.     PropertyChanged "Enabled"
  322. End Property
  323.  
  324. 'Public Property Get MultiSelect() As Boolean
  325. '    MultiSelect = m_MultiSelect
  326. 'End Property
  327.  
  328. 'Public Property Let MultiSelect(ByVal New_MultiSelect As Boolean)
  329. '    lstAvailable.MultiSelect = IIf(New_MultiSelect, 2, 0)
  330. '    lstSelected.MultiSelect = IIf(New_MultiSelect, 2, 0)
  331. '    m_MultiSelect = New_MultiSelect
  332. '    PropertyChanged "MultiSelect"
  333. 'End Property
  334.  
  335. 'Load property values from storage
  336. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  337.  
  338.     UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  339.     m_BorderStyle = PropBag.ReadProperty("BorderStyle", m_def_BorderStyle)
  340.     m_MultiSelect = PropBag.ReadProperty("MultiSelect", False)
  341. End Sub
  342.  
  343. 'Write property values to storage
  344. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  345.  
  346.     Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  347.     Call PropBag.WriteProperty("BorderStyle", m_BorderStyle, m_def_BorderStyle)
  348.     Call PropBag.WriteProperty("MultiSelect", m_MultiSelect, False)
  349. End Sub
  350.  
  351. Public Property Get BorderStyle() As AxBorderStyles
  352. Attribute BorderStyle.VB_Description = "Set border style for control"
  353.     BorderStyle = m_BorderStyle
  354. End Property
  355.  
  356. Public Property Let BorderStyle(ByVal New_BorderStyle As AxBorderStyles)
  357.     If Not (m_BorderStyle = New_BorderStyle) Then
  358.         m_BorderStyle = New_BorderStyle
  359.         UserControl.Cls
  360.         UserControl_Paint
  361.     End If
  362.     PropertyChanged "BorderStyle"
  363. End Property
  364.  
  365. Private Sub UserControl_Paint()
  366.     Dim di As Long
  367.     Dim rc As RECT
  368.     
  369.     'draw outside border
  370.         
  371.     Select Case m_BorderStyle
  372.         Case [No Border]
  373.         
  374.         Case [Single]
  375.             di = GetClientRect(UserControl.hwnd, rc)
  376.             di = DrawEdge(UserControl.hDC, rc, BDR_RAISEDOUTER, BF_RECT Or BF_MONO)
  377.         
  378.         Case [Thin Raised]
  379.             di = GetClientRect(UserControl.hwnd, rc)
  380.             di = DrawEdge(UserControl.hDC, rc, BDR_RAISEDINNER, BF_TOPLEFT)
  381.             di = DrawEdge(UserControl.hDC, rc, BDR_RAISEDOUTER, BF_BOTTOMRIGHT)
  382.         
  383.         Case [Thick Raised]
  384.             di = GetClientRect(UserControl.hwnd, rc)
  385.             di = DrawEdge(UserControl.hDC, rc, EDGE_RAISED, BF_TOPLEFT)
  386.             di = DrawEdge(UserControl.hDC, rc, EDGE_RAISED, BF_BOTTOMRIGHT)
  387.     
  388.         Case [Thin Inset]
  389.             di = GetClientRect(UserControl.hwnd, rc)
  390.             di = DrawEdge(UserControl.hDC, rc, BDR_SUNKENINNER, BF_TOPLEFT)
  391.             di = DrawEdge(UserControl.hDC, rc, BDR_SUNKENOUTER, BF_BOTTOMRIGHT)
  392.         
  393.         Case [Thick Inset]
  394.             di = GetClientRect(UserControl.hwnd, rc)
  395.             di = DrawEdge(UserControl.hDC, rc, EDGE_SUNKEN, BF_TOPLEFT)
  396.             di = DrawEdge(UserControl.hDC, rc, EDGE_SUNKEN, BF_BOTTOMRIGHT)
  397.         
  398.         Case [Etched]
  399.             di = GetClientRect(UserControl.hwnd, rc)
  400.             di = DrawEdge(UserControl.hDC, rc, EDGE_ETCHED, BF_TOPLEFT)
  401.             di = DrawEdge(UserControl.hDC, rc, EDGE_ETCHED, BF_BOTTOMRIGHT)
  402.     
  403.         Case [Bump]
  404.             di = GetClientRect(UserControl.hwnd, rc)
  405.             di = DrawEdge(UserControl.hDC, rc, EDGE_BUMP, BF_TOPLEFT)
  406.             di = DrawEdge(UserControl.hDC, rc, EDGE_BUMP, BF_BOTTOMRIGHT)
  407.             
  408.     End Select
  409.         
  410. End Sub
  411.  
  412. 'MappingInfo=UserControl,UserControl,-1,Ambient
  413. Public Property Get Ambient() As AmbientProperties
  414.   Set Ambient = UserControl.Ambient
  415. End Property
  416.  
  417.  
  418.  
  419.