home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / Create_AVI192143852005.psc / ClsProgressBar2.cls < prev    next >
Text File  |  2005-08-01  |  10KB  |  395 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "ClsProgressBar2"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15. 'Tracked this down to
  16. '__merlin__
  17. 'ProgressBar2Class (8 DrawDirections, XOR Caption,Time2End Display)
  18. 'http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=23431&lngWId=1
  19. '
  20. 'all I have done is a bit of Code Fixer tidying up
  21. 'Version 2
  22. 'added Left, Centre & Right options for the caption of the prog bar
  23. '
  24. Private PicBoxObj            As PictureBox
  25. Private PrintCharTemp        As String
  26. Private x1Temp               As Long
  27. Private y1Temp               As Long
  28. Public Enum eDrawDirection
  29.   Left2Right = 0
  30.   Right2Left = 1
  31.   Top2Bottom = 2
  32.   Bottom2Top = 3
  33.   Left2RightReverse = 4
  34.   Right2LeftReverse = 5
  35.   Top2Bottomreverse = 6
  36.   Bottom2TopReverse = 7
  37. End Enum
  38. #If False Then 'Trick preserves Case of Enums when typing in IDE
  39. Private Left2Right, Right2Left, Top2Bottom, Bottom2Top, Left2RightReverse, Right2LeftReverse, Top2Bottomreverse, Bottom2TopReverse
  40. #End If
  41. Public Enum eCaptionMode
  42.   ShowPercentChange = 0
  43.   ShowCaptionC = 1
  44.   ShowCaptionL = 2
  45.   ShowCaptionR = 3
  46.   ShowNothing = 4
  47. End Enum
  48. #If False Then 'Trick preserves Case of Enums when typing in IDE
  49. Private ShowPercentChange, ShowCaptionC, ShowCaptionL, ShowCaptionR, ShowNothing
  50. #End If
  51. Private m_DrawDirection      As eDrawDirection
  52. Private m_Min                As Double
  53. Private m_Max                As Double
  54. Private m_Value              As Double
  55. Private m_DoEvents           As Boolean
  56. Private m_Caption            As String
  57. Private m_CaptionMode        As eCaptionMode
  58. Private m_Timer              As Double
  59.  
  60.  
  61. Private Sub CalcParam(ByRef dblMin As Double, _
  62.                       ByRef dblMax As Double, _
  63.                       ByRef dblValue As Double)
  64.  
  65.   dblMax = m_Max - m_Min
  66.   dblValue = m_Value - m_Min
  67.   dblMin = 0
  68.  
  69. End Sub
  70.  
  71. Public Property Get Caption() As String
  72.  
  73.   Caption = m_Caption
  74.  
  75. End Property
  76.  
  77. Public Property Let Caption(ByVal Char As String)
  78.  
  79.   m_Caption = Char
  80.  
  81. End Property
  82.  
  83. Public Property Get CaptionMode() As eCaptionMode
  84.  
  85.   CaptionMode = m_CaptionMode
  86.  
  87. End Property
  88.  
  89. Public Property Let CaptionMode(ByVal Mode As eCaptionMode)
  90.  
  91.   m_CaptionMode = Mode
  92.  
  93. End Property
  94.  
  95. Public Property Get CurrentTime() As String
  96.  
  97.   CurrentTime = Time2String(Int(Timer - m_Timer))
  98.  
  99. End Property
  100.  
  101. Public Property Get DoEventsByChange() As Boolean
  102.  
  103.   DoEventsByChange = m_DoEvents
  104.  
  105. End Property
  106.  
  107. Public Property Let DoEventsByChange(ByVal blnValue As Boolean)
  108.  
  109.   m_DoEvents = blnValue
  110.  
  111. End Property
  112.  
  113. Public Property Get DrawDirection() As eDrawDirection
  114.  
  115.   DrawDirection = m_DrawDirection
  116.  
  117. End Property
  118.  
  119. Public Property Let DrawDirection(ByVal drwValue As eDrawDirection)
  120.  
  121.   m_DrawDirection = drwValue
  122.  
  123. End Property
  124.  
  125. Public Property Get Max() As Double
  126.  
  127.   Max = m_Max
  128.  
  129. End Property
  130.  
  131. Public Property Let Max(ByVal dblValue As Double)
  132.  
  133.   m_Max = dblValue
  134.  
  135. End Property
  136.  
  137. Public Property Get Min() As Double
  138.  
  139.   Min = m_Min
  140.  
  141. End Property
  142.  
  143. Public Property Let Min(ByVal dblValue As Double)
  144.  
  145.   m_Min = dblValue
  146.  
  147. End Property
  148.  
  149. Public Property Get PictureBoxObjekt() As PictureBox
  150.  
  151.   Set PictureBoxObjekt = PicBoxObj
  152.  
  153. End Property
  154.  
  155. Public Property Set PictureBoxObjekt(PropVal As PictureBox)
  156.  
  157.   Set PicBoxObj = PropVal
  158.  
  159. End Property
  160.  
  161. Public Sub SetParamFast(ByVal dblMin As Double, _
  162.                         ByVal dblMax As Double, _
  163.                         ByVal DrawDirection As eDrawDirection, _
  164.                         ByVal DoEventsByChange As Boolean, _
  165.                         ByVal CaptionMode As eCaptionMode)
  166.  
  167.   m_Min = dblMin
  168.   m_Max = dblMax
  169.   m_DrawDirection = DrawDirection
  170.   m_DoEvents = DoEventsByChange
  171.   m_CaptionMode = CaptionMode
  172.  
  173. End Sub
  174.  
  175. Public Property Let SetPictureBox(ByVal PBO As Variant)
  176.  
  177.   Set PicBoxObj = PBO
  178.   With PicBoxObj
  179.     .AutoRedraw = True
  180.     .ScaleMode = 3
  181.     .BackColor = vbWhite
  182.   End With 'PictureBoxObjekt
  183.  
  184. End Property
  185.  
  186. Public Sub ShowBar()
  187.  
  188.  
  189.   Dim Change     As Boolean
  190.   Dim StrCaption As String
  191.   Dim LMax       As Double
  192.   Dim Value      As Double
  193.   Dim x          As Long
  194.   Dim y          As Long
  195.   Dim x1         As Long
  196.   Dim y1         As Long
  197.  
  198. 'Dim Min       As Double
  199.   CalcParam 0, LMax, Value
  200.   If Value Then
  201.     If LMax Then
  202.       Select Case m_DrawDirection
  203. 'Left2Right
  204.        Case 0
  205.         x1 = PicBoxObj.ScaleWidth / 100 * (Value / LMax * 100)
  206.         y1 = PicBoxObj.ScaleHeight
  207.         If x1Temp <> x1 Then
  208.           Change = True
  209.         End If
  210.         x1Temp = x1
  211. 'Right2Left
  212.        Case 1
  213.         x = PicBoxObj.ScaleWidth
  214.         y = PicBoxObj.ScaleHeight
  215.         x1 = x - (PicBoxObj.ScaleWidth / 100 * (Value / LMax * 100))
  216.         If x1Temp <> x1 Then
  217.           Change = True
  218.         End If
  219.         x1Temp = x1
  220. 'Top2Bottom
  221.        Case 2
  222.         x1 = PicBoxObj.ScaleWidth
  223.         y1 = PicBoxObj.ScaleHeight / 100 * (Value / LMax * 100)
  224.         If y1Temp <> y1 Then
  225.           Change = True
  226.         End If
  227.         y1Temp = y1
  228. 'Bottom2Top
  229.        Case 3
  230.         x = PicBoxObj.ScaleWidth
  231.         y = PicBoxObj.ScaleHeight
  232.         y1 = y - (PicBoxObj.ScaleHeight / 100 * (Value / LMax * 100))
  233.         If y1Temp <> y1 Then
  234.           Change = True
  235.         End If
  236.         y1Temp = y1
  237. 'Left2RightReverse
  238.        Case 4
  239.         x = PicBoxObj.ScaleWidth
  240.         y = PicBoxObj.ScaleHeight
  241.         x1 = PicBoxObj.ScaleWidth / 100 * (Value / LMax * 100)
  242.         If x1Temp <> x1 Then
  243.           Change = True
  244.         End If
  245.         x1Temp = x1
  246. 'Right2LeftReverse
  247.        Case 5
  248.         x1 = PicBoxObj.ScaleWidth - (PicBoxObj.ScaleWidth / 100 * (Value / LMax * 100))
  249.         y1 = PicBoxObj.ScaleHeight
  250.         If x1Temp <> x1 Then
  251.           Change = True
  252.         End If
  253.         x1Temp = x1
  254. 'Top2BottomReverse
  255.        Case 6
  256.         x = PicBoxObj.ScaleWidth
  257.         y = PicBoxObj.ScaleHeight
  258.         y1 = (PicBoxObj.ScaleHeight / 100 * (Value / LMax * 100))
  259.         If y1Temp <> y1 Then
  260.           Change = True
  261.         End If
  262.         y1Temp = y1
  263. 'Bottom2TopReverse
  264.        Case 7
  265.         x1 = PicBoxObj.ScaleWidth
  266.         y1 = PicBoxObj.ScaleHeight - (PicBoxObj.ScaleHeight / 100 * (Value / LMax * 100))
  267.         If y1Temp <> y1 Then
  268.           Change = True
  269.         End If
  270.         y1Temp = y1
  271.       End Select
  272. '--------------------------
  273.       Select Case m_CaptionMode
  274.        Case ShowPercentChange
  275.         StrCaption = Int(Value / LMax * 100) & " %"
  276.         If StrCaption <> PrintCharTemp Then
  277.           Change = True
  278.         End If
  279.         PrintCharTemp = StrCaption
  280.        Case ShowCaptionC, ShowCaptionR, ShowCaptionL
  281.         StrCaption = m_Caption
  282.         If StrCaption <> PrintCharTemp Then
  283.           Change = True
  284.         End If
  285.         PrintCharTemp = StrCaption
  286.       End Select
  287.       If Change Then
  288.         If m_CaptionMode <> ShowNothing Then
  289.           With PicBoxObj
  290.             .Cls
  291.             Select Case m_CaptionMode ' alternate positions
  292.              Case ShowPercentChange, ShowCaptionC
  293.               .CurrentX = (.ScaleWidth / 2) - (.TextWidth(StrCaption) / 2)
  294.              Case ShowCaptionL
  295.               .CurrentX = 0
  296.              Case ShowCaptionR
  297.               .CurrentX = .ScaleWidth - .TextWidth(StrCaption)
  298.             End Select
  299.             .CurrentY = (.ScaleHeight / 2) - (.TextHeight(StrCaption) / 2)
  300.             .DrawMode = 10 'vbMaskPenNot '13
  301.             PicBoxObj.Print StrCaption
  302.             .DrawMode = 10
  303.             PicBoxObj.Line (x, y)-(x1, y1), vbRed, BF
  304.           End With 'PictureBoxObjekt
  305.          Else
  306.           With PicBoxObj
  307.             .Cls
  308.             .DrawMode = 13
  309.             PicBoxObj.Line (x, y)-(x1, y1), , BF
  310.           End With 'PictureBoxObjekt
  311.         End If
  312.         If m_DoEvents Then
  313.           DoEvents
  314.         End If
  315.       End If
  316.     End If
  317.   End If
  318.  
  319. End Sub
  320.  
  321. Public Sub StartTimer()
  322.  
  323.   m_Timer = Timer
  324.  
  325. End Sub
  326.  
  327. Public Property Get Time2End() As String
  328.  
  329.   Dim Max   As Double
  330.   Dim Min   As Double
  331.   Dim Value As Double
  332.   Dim Temp  As Long
  333.  
  334.   CalcParam Min, Max, Value
  335.   On Error Resume Next
  336.   Temp = Int(Max / Value * (Timer - m_Timer) - (Timer - m_Timer))
  337.   If LenB(Time2String(Temp)) Then
  338.     Time2End = Time2String(Temp)
  339.   End If
  340.   On Error GoTo 0
  341.  
  342. End Property
  343.  
  344. Private Function Time2String(ByVal Seconds As Long) As String
  345.  
  346.   Dim sTemp As String
  347.   Dim lTemp As Long
  348.  
  349.   If Seconds >= 31536000 Then
  350.     sTemp = sTemp & Int(Seconds / 31536000) & " Year"
  351.     sTemp = IIf(Int(Seconds / 31536000) > 1, sTemp & "s ", sTemp & " ")
  352.     Seconds = Seconds Mod 31536000
  353.     lTemp = lTemp + 1
  354.   End If
  355.   If Seconds >= 86400 Then
  356.     sTemp = sTemp & Int(Seconds / 86400) & " Day"
  357.     sTemp = IIf(Int(Seconds / 86400) > 1, sTemp & "s ", sTemp & " ")
  358.     Seconds = Seconds Mod 86400
  359.     lTemp = lTemp + 1
  360.   End If
  361.   If Seconds >= 3600 And lTemp < 2 Then
  362.     sTemp = sTemp & Int(Seconds / 3600) & " Hour"
  363.     sTemp = IIf(Int(Seconds / 3600) > 1, sTemp & "s ", sTemp & " ")
  364.     Seconds = Seconds Mod 3600
  365.     lTemp = lTemp + 1
  366.   End If
  367.   If Seconds >= 60 And lTemp < 2 Then
  368.     sTemp = sTemp & Int(Seconds / 60) & " Minute"
  369.     sTemp = IIf(Int(Seconds / 60) > 1, sTemp & "s ", sTemp & " ")
  370.     Seconds = Seconds Mod 60
  371.     lTemp = lTemp + 1
  372.   End If
  373.   If Seconds >= 1 And lTemp < 2 Then
  374.     sTemp = sTemp & Seconds & " Seconds"
  375.   End If
  376.   Time2String = Trim$(sTemp)
  377.  
  378. End Function
  379.  
  380. Public Property Get Value() As Double
  381.  
  382.   Value = m_Value
  383.  
  384. End Property
  385.  
  386. Public Property Let Value(ByVal dblValue As Double)
  387.  
  388.   m_Value = dblValue
  389.  
  390. End Property
  391.  
  392. ':)Code Fixer V4.0.0 (Saturday, 30 July 2005 22:45:36) 38 + 329 = 367 Lines Thanks Ulli for inspiration and lots of code.
  393. ':)SETTINGS DUMP: 13330232222333323|3333202222222222222222222222222|1112222|2221222|222222222233|111111111111|1222222222220|333333|
  394.  
  395.