home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / maypro1a / mayprogr.ctl next >
Encoding:
Visual Basic user-defined control file  |  1999-02-03  |  6.3 KB  |  228 lines
  1. VERSION 5.00
  2. Object = "{0BA686C6-F7D3-101A-993E-0000C0EF6F5E}#1.0#0"; "threed32.ocx"
  3. Begin VB.UserControl MayProgress 
  4.    Alignable       =   -1  'True
  5.    ClientHeight    =   720
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   6150
  9.    ClipControls    =   0   'False
  10.    ScaleHeight     =   720
  11.    ScaleWidth      =   6150
  12.    Begin VB.VScrollBar Scroll 
  13.       Height          =   165
  14.       Left            =   5880
  15.       Max             =   0
  16.       TabIndex        =   2
  17.       Top             =   120
  18.       Width           =   135
  19.    End
  20.    Begin Threed.SSPanel Barra 
  21.       Height          =   165
  22.       Index           =   0
  23.       Left            =   720
  24.       TabIndex        =   0
  25.       Top             =   120
  26.       Visible         =   0   'False
  27.       Width           =   5055
  28.       _Version        =   65536
  29.       _ExtentX        =   8916
  30.       _ExtentY        =   291
  31.       _StockProps     =   15
  32.       BackColor       =   12632256
  33.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  34.          Name            =   "Garamond"
  35.          Size            =   8.25
  36.          Charset         =   0
  37.          Weight          =   400
  38.          Underline       =   0   'False
  39.          Italic          =   0   'False
  40.          Strikethrough   =   0   'False
  41.       EndProperty
  42.       BevelOuter      =   1
  43.       RoundedCorners  =   0   'False
  44.       FloodType       =   1
  45.    End
  46.    Begin VB.Label lbl 
  47.       AutoSize        =   -1  'True
  48.       Caption         =   "Tarea 1"
  49.       BeginProperty Font 
  50.          Name            =   "Garamond"
  51.          Size            =   8.25
  52.          Charset         =   0
  53.          Weight          =   400
  54.          Underline       =   0   'False
  55.          Italic          =   0   'False
  56.          Strikethrough   =   0   'False
  57.       EndProperty
  58.       Height          =   180
  59.       Index           =   0
  60.       Left            =   120
  61.       TabIndex        =   1
  62.       Top             =   120
  63.       Visible         =   0   'False
  64.       Width           =   480
  65.    End
  66. End
  67. Attribute VB_Name = "MayProgress"
  68. Attribute VB_GlobalNameSpace = False
  69. Attribute VB_Creatable = True
  70. Attribute VB_PredeclaredId = False
  71. Attribute VB_Exposed = False
  72. Option Explicit
  73. Dim colClaves As New Collection
  74. Dim colBarras As New Collection
  75. Dim colLbls As New Collection
  76. Dim colValores As New Collection
  77.  
  78. Dim lClave As Double
  79.  
  80. Const MODO_UNILINEA As Integer = 1
  81. Const MODO_MULTILINEA As Integer = 2
  82. Dim iModo As Integer
  83.  
  84.  
  85. Property Let Valor(lClave As Long, lValor As Long)
  86.     Dim sClave As String
  87.     sClave = "T" & lClave
  88.     colValores.Remove sClave
  89.     colValores.Add lValor, sClave
  90.     colBarras(sClave).FloodPercent = colValores(sClave) * 100 / CLng(colBarras(sClave).Tag)
  91. End Property
  92.  
  93. Public Sub Incrementa(lClave As Long)
  94.     On Error Resume Next
  95.     Dim sClave As String
  96.     sClave = "T" & lClave
  97.     Dim l As Long
  98.     l = colValores(sClave)
  99.     colValores.Remove sClave
  100.     l = l + 1
  101.     colValores.Add l, sClave
  102.     colBarras(sClave).FloodPercent = colValores(sClave) * 100 / CLng(colBarras(sClave).Tag)
  103. End Sub
  104.  
  105. Public Function MostrarProgreso(sCaption As String, lMaximo As Long) As Long
  106.     lClave = lClave + 1
  107.     Dim i As Integer
  108.     i = lbl.UBound + 1
  109.     Load lbl(i)
  110.     Load Barra(i)
  111.     Height = Height + Barra(0).Height
  112.     If sCaption = "" Then
  113.         lbl(i).Caption = " Tarea " & lClave & " "
  114.     Else
  115.         lbl(i).Caption = " " & sCaption & " "
  116.     End If
  117.     lbl(i).Top = lbl(i - 1).Top + Barra(0).Height
  118.     Barra(i).Top = Barra(i - 1).Top + Barra(0).Height
  119.     Barra(i).Tag = lMaximo
  120.     Barra(i).FloodPercent = 0
  121.     Barra(i).Visible = True
  122.     lbl(i).Visible = True
  123.     colBarras.Add Barra(i), "T" & lClave
  124.     colLbls.Add lbl(i), "T" & lClave
  125.     colValores.Add 0, "T" & lClave
  126.     Redibuja
  127.     MostrarProgreso = lClave
  128.  
  129. End Function
  130.  
  131. Public Function TerminarProgreso(lId As Long) As Boolean
  132.     On Error Resume Next
  133.     If lId < 1 Then Exit Function
  134.     Unload colBarras("T" & lId)
  135.     Unload colLbls("T" & lId)
  136.     colBarras.Remove "T" & lId
  137.     colLbls.Remove "T" & lId
  138.     colValores.Remove "T" & lId
  139.     Redibuja
  140. End Function
  141.  
  142.  
  143.  
  144.  
  145.  
  146. Private Sub Redibuja()
  147.     Dim i As Integer
  148.     Dim sw As Single
  149.     Dim bl As Single
  150.     If colLbls.Count > 0 Then
  151.         If Scroll.Value > colLbls.Count - 1 Then Scroll.Value = colLbls.Count - 1
  152.         Scroll.Max = colLbls.Count - 1
  153.     Else
  154.         Scroll.Value = 0
  155.         Scroll.Max = 0
  156.     End If
  157.     
  158.     Select Case iModo
  159.     Case MODO_MULTILINEA
  160.         Height = colLbls.Count * Barra(0).Height
  161.         Scroll.Visible = False
  162.         sw = 0
  163.         For i = 1 To colLbls.Count
  164.           bl = IIf(colLbls(i).Width > 2000, colLbls(i).Width, 2000)
  165.           colLbls(i).Left = 0
  166.           colBarras(i).Left = bl
  167.           colBarras(i).Width = Width - bl - sw
  168.           colBarras(i).Top = (i - 1) * Barra(0).Height
  169.           colLbls(i).Top = (i - 1) * Barra(0).Height
  170.         Next
  171.     Case MODO_UNILINEA
  172.         Height = Barra(0).Height
  173.         If colLbls.Count > 1 Then
  174.           sw = Scroll.Width
  175.           Scroll.Visible = True
  176.         Else
  177.           sw = 0
  178.           Scroll.Visible = False
  179.         End If
  180.         Scroll.Left = Width - sw
  181.         For i = 1 To colLbls.Count
  182.           bl = IIf(colLbls(i).Width > 2000, colLbls(i).Width, 2000)
  183.           colLbls(i).Left = 0
  184.           colBarras(i).Left = bl
  185.           colBarras(i).Width = Width - bl - sw
  186.           colBarras(i).Top = (i - 1 - Scroll.Value) * Barra(0).Height
  187.           colLbls(i).Top = (i - 1 - Scroll.Value) * Barra(0).Height
  188.         Next
  189.     End Select
  190. End Sub
  191.  
  192. Private Sub Barra_Click(Index As Integer)
  193.     If iModo = MODO_MULTILINEA Then
  194.        iModo = MODO_UNILINEA
  195.     Else
  196.        iModo = MODO_MULTILINEA
  197.     End If
  198.     Redibuja
  199. End Sub
  200.  
  201. Private Sub Scroll_Change()
  202.     Redibuja
  203. End Sub
  204.  
  205. Private Sub UserControl_Initialize()
  206.     iModo = MODO_MULTILINEA
  207.     lbl(0).Top = -Barra(0).Height
  208.     Barra(0).Top = -Barra(0).Height
  209.     Height = 0
  210.     Scroll.Top = 0
  211. End Sub
  212.  
  213.  
  214. Private Sub UserControl_Resize()
  215. Redibuja
  216. End Sub
  217.  
  218. Private Sub UserControl_Terminate()
  219.   Dim i As Integer
  220.   For i = 1 To colLbls.Count
  221.     Unload colLbls(i)
  222.     Unload colBarras(i)
  223.   Next
  224.   Set colBarras = Nothing
  225.   Set colLbls = Nothing
  226.   Set colValores = Nothing
  227. End Sub
  228.