home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / ttlps / ttlphoto.ctl (.txt) < prev   
Encoding:
Visual Basic Form  |  1999-08-17  |  15.9 KB  |  404 lines
  1. VERSION 5.00
  2. Begin VB.UserControl TTLSlide 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00808080&
  5.    ClientHeight    =   2505
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   2505
  9.    ClipControls    =   0   'False
  10.    EditAtDesignTime=   -1  'True
  11.    FillColor       =   &H00808080&
  12.    FillStyle       =   0  'Solid
  13.    KeyPreview      =   -1  'True
  14.    ScaleHeight     =   2505
  15.    ScaleWidth      =   2505
  16.    ToolboxBitmap   =   "TTLPHO~1.ctx":0000
  17.    Begin VB.Frame FrameView 
  18.       BackColor       =   &H00808080&
  19.       BorderStyle     =   0  'None
  20.       Height          =   3855
  21.       Left            =   0
  22.       TabIndex        =   0
  23.       ToolTipText     =   "TTL Slide Frame"
  24.       Top             =   0
  25.       Visible         =   0   'False
  26.       Width           =   3855
  27.       Begin VB.Image Image2 
  28.          BorderStyle     =   1  'Fixed Single
  29.          Height          =   255
  30.          Left            =   5280
  31.          Top             =   5880
  32.          Width           =   255
  33.       End
  34.       Begin VB.Image Image1 
  35.          BorderStyle     =   1  'Fixed Single
  36.          Height          =   2775
  37.          Left            =   -120
  38.          Top             =   5760
  39.          Visible         =   0   'False
  40.          Width           =   135
  41.       End
  42.    End
  43. Attribute VB_Name = "TTLSlide"
  44. Attribute VB_GlobalNameSpace = False
  45. Attribute VB_Creatable = True
  46. Attribute VB_PredeclaredId = False
  47. Attribute VB_Exposed = False
  48. Option Explicit
  49. 'Default Property Values:
  50. Const m_def_ToolTipText = ""
  51. 'Const m_def_ForeColor = 0
  52. Const m_def_Enabled = 0
  53. Const m_def_BackStyle = 0
  54. Const m_def_BorderStyle = 0
  55. 'Const m_def_ToolTipText = ""
  56. Const m_def_WhatsThisHelpID = 0
  57. 'Property Variables:
  58. Dim m_ToolTipText As String
  59. 'Dim m_ForeColor As Long
  60. Dim m_Enabled As Boolean
  61. Dim m_BackStyle As Integer
  62. Dim m_BorderStyle As Integer
  63. 'Dim m_ToolTipText As String
  64. Dim m_WhatsThisHelpID As Long
  65. Dim isSlide As Boolean
  66. 'Event Declarations:
  67. Event Click() 'MappingInfo=Image2,Image2,-1,Click
  68. Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
  69. Event DblClick() 'MappingInfo=Image2,Image2,-1,DblClick
  70. Attribute DblClick.VB_Description = "Occurs when the user presses and releases a mouse button and then presses and releases it again over an object."
  71. Event KeyDown(KeyCode As Integer, Shift As Integer)
  72. Attribute KeyDown.VB_Description = "Occurs when the user presses a key while an object has the focus."
  73. Event KeyPress(KeyAscii As Integer)
  74. Attribute KeyPress.VB_Description = "Occurs when the user presses and releases an ANSI key."
  75. Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyUp
  76. Attribute KeyUp.VB_Description = "Occurs when the user releases a key while an object has the focus."
  77. Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Image2,Image2,-1,MouseDown
  78. Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while an object has the focus."
  79. Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Image2,Image2,-1,MouseMove
  80. Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
  81. Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  82. Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."
  83. Event Show() 'MappingInfo=UserControl,UserControl,-1,Show
  84. Attribute Show.VB_Description = "Occurs when the control's Visible property changes to True."
  85. Private Sub TTLSlide_Resize()
  86.     Dim iW As Double, iH As Double
  87.     FrameView.Top = 0
  88.     FrameView.Left = 0
  89.     If Width > Height Then
  90.         FrameView.Width = Height
  91.     Else
  92.         FrameView.Width = Width
  93.     End If
  94.         
  95.     FrameView.Height = FrameView.Width
  96.     Width = FrameView.Width
  97.     Height = FrameView.Height
  98.                 
  99. End Sub         '** TTLSlide_Resize
  100. Public Function LoadImage(strImg As String, bSlide As Boolean) As Boolean
  101.     Dim iW As Double, iH As Double, iRespond As Integer
  102.     LoadImage = True
  103.     isSlide = bSlide
  104.     '** User load nothing
  105.     If strImg = "" Then
  106.         Image1.Picture = Nothing
  107.         Image2.Picture = Nothing
  108.         Image1.Visible = False
  109.         Image2.Visible = False
  110.         Exit Function
  111.     End If
  112.     If Not FrameView.Visible Then
  113.         FrameView.Visible = True
  114.     End If
  115.     On Error GoTo ImageChoiceErr
  116.     If FrameView.Width <> Width Or FrameView.Height <> Height Then
  117.         TTLSlide_Resize
  118.     End If
  119.     '** Check which image to be use
  120.     If Image1.Visible Then
  121.         Image2.Stretch = False
  122.         Image2.Picture = LoadPicture(strImg)
  123.         Image2.ToolTipText = strImg
  124.         iW = Image2.Picture.Width
  125.         iH = Image2.Picture.Height
  126.         '** Resize Image to fit in frame View
  127.         ImgResize 2, iW, iH
  128.     Else
  129.         Image1.Stretch = False
  130.         Image1.Picture = LoadPicture(strImg)
  131.         Image1.ToolTipText = strImg
  132.         iW = Image1.Picture.Width
  133.         iH = Image1.Picture.Height
  134.         ImgResize 1, iW, iH
  135.     End If
  136.     Exit Function
  137. ImageChoiceErr:
  138.     LoadImage = False
  139.     MsgBox "Photo Slide can not display this type of image." & Chr(13) & _
  140.             "Please check the image's format.", vbCritical, "Error Loading Image"
  141.     Exit Function
  142. End Function        '** LoadImage
  143. Private Sub ImgResize(imgNum, iW, iH)
  144.     Dim iMove As Double, iLeft As Double
  145.     If imgNum = 1 Then
  146.         Image1.Visible = False                          '** Hide while resize
  147.         Image1.Stretch = True
  148.                         
  149.         '** Calculate Width and Height
  150.         If iW > iH Then
  151.             Image1.Width = FrameView.Width * 0.9
  152.             Image1.Height = (Image1.Width * (iH / iW))
  153.             Image1.Left = FrameView.Width * 0.05
  154.             Image1.Top = (FrameView.Height - Image1.Height) / 2
  155.         Else
  156.             Image1.Height = FrameView.Width * 0.9
  157.             Image1.Width = (Image1.Height * (iW / iH))
  158.             Image1.Top = FrameView.Width * 0.05
  159.             Image1.Left = (FrameView.Width - Image1.Width) / 2
  160.         End If
  161.         
  162.         Image1.Visible = True
  163.         '** If image view in normal size, then use slide in feature
  164.         If isSlide Then
  165.             If Width < 7400 Then
  166.                 iLeft = Image1.Left
  167.                 iMove = Width
  168.                 Do While iMove > 0
  169.                     iMove = iMove - 50
  170.                     
  171.                     Image1.Left = iMove
  172.                     If Image1.Left < iLeft Then
  173.                         Image1.Left = iLeft
  174.                         Exit Do
  175.                     End If
  176.                 Loop
  177.             End If
  178.         End If
  179.         '***************************
  180.         Image2.Visible = False
  181.         
  182.     Else
  183.         Image2.Visible = False                          '** Hide while resize
  184.         Image2.Stretch = True
  185.         
  186.         '** Calculate Width and Height
  187.         If iW > iH Then
  188.             Image2.Width = FrameView.Width * 0.9
  189.             Image2.Height = (Image2.Width * (iH / iW))
  190.             Image2.Left = FrameView.Width * 0.05
  191.             Image2.Top = (FrameView.Height - Image2.Height) / 2
  192.         Else
  193.             Image2.Height = FrameView.Height * 0.9
  194.             Image2.Width = (Image2.Height * (iW / iH))
  195.             Image2.Top = FrameView.Width * 0.05
  196.             Image2.Left = (FrameView.Width - Image2.Width) / 2
  197.         End If
  198.         Image2.Visible = True
  199.             
  200.         '** If image view in normal size, then use slide in feature
  201.         If isSlide Then
  202.             If Width < 7400 Then
  203.                 iLeft = Image2.Left
  204.                 iMove = -Image2.Left
  205.                 
  206.                 Do While iMove <= iLeft
  207.                     iMove = iMove + 50
  208.                     Image2.Left = iMove
  209.                     
  210.                     If Image2.Left > iLeft Then
  211.                         
  212.                         Image2.Left = iLeft
  213.                         Exit Do
  214.                     
  215.                     End If
  216.                 Loop
  217.             End If
  218.         End If
  219.             
  220.         Image1.Visible = False
  221.         
  222.     End If
  223. End Sub         '** ImgResize
  224. ''WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  225. ''MappingInfo=FrameView,FrameView,-1,BackColor
  226. 'Public Property Get BackColor() As OLE_COLOR
  227. '    BackColor = FrameView.BackColor
  228. 'End Property
  229. 'Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  230. '    FrameView.BackColor() = New_BackColor
  231. '    PropertyChanged "BackColor"
  232. 'End Property
  233. 'Public Property Get ForeColor() As Long
  234. '    ForeColor = m_ForeColor
  235. 'End Property
  236. 'Public Property Let ForeColor(ByVal New_ForeColor As Long)
  237. '    m_ForeColor = New_ForeColor
  238. '    PropertyChanged "ForeColor"
  239. 'End Property
  240. Public Property Get Enabled() As Boolean
  241. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  242.     Enabled = m_Enabled
  243. End Property
  244. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  245.     m_Enabled = New_Enabled
  246.     PropertyChanged "Enabled"
  247. End Property
  248. Public Property Get BackStyle() As Integer
  249. Attribute BackStyle.VB_Description = "Indicates whether a Label or the background of a Shape is transparent or opaque."
  250.     BackStyle = m_BackStyle
  251. End Property
  252. Public Property Let BackStyle(ByVal New_BackStyle As Integer)
  253.     m_BackStyle = New_BackStyle
  254.     PropertyChanged "BackStyle"
  255. End Property
  256. Public Property Get BorderStyle() As Integer
  257. Attribute BorderStyle.VB_Description = "Returns/sets the border style for an object."
  258.     BorderStyle = m_BorderStyle
  259. End Property
  260. Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)
  261.     m_BorderStyle = New_BorderStyle
  262.     PropertyChanged "BorderStyle"
  263. End Property
  264. Public Sub Refresh()
  265. Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
  266.     Dim iW As Double, iH As Double
  267.     TTLSlide_Resize
  268.     If Image1.Visible Then
  269.         If Not Image1.Picture = Empty Then
  270.             With Image1
  271.                 
  272.                 .Visible = False                          '** Hide while resize
  273.                                 
  274.                 iW = .Picture.Width
  275.                 iH = .Picture.Height
  276.                 '** Calculate Width and Height
  277.                 If iW > iH Then
  278.                     .Width = FrameView.Width * 0.9
  279.                     .Height = (.Width * (iH / iW))
  280.                     .Left = FrameView.Width * 0.05
  281.                     .Top = (FrameView.Height - .Height) / 2
  282.                 Else
  283.                     .Height = FrameView.Width * 0.9
  284.                     .Width = (.Height * (iW / iH))
  285.                     .Top = FrameView.Width * 0.05
  286.                     .Left = (FrameView.Width - .Width) / 2
  287.                 End If
  288.                 
  289.                 .Visible = True
  290.             
  291.             End With
  292.         End If
  293.     Else
  294.         If Not Image2.Picture = Empty Then
  295.             With Image2
  296.                 
  297.                 .Visible = False                          '** Hide while resize
  298.                 
  299.                 iW = .Picture.Width
  300.                 iH = .Picture.Height
  301.                 '** Calculate Width and Height
  302.                 If iW > iH Then
  303.                     .Width = FrameView.Width * 0.9
  304.                     .Height = (.Width * (iH / iW))
  305.                     .Left = FrameView.Width * 0.05
  306.                     .Top = (FrameView.Height - .Height) / 2
  307.                 Else
  308.                     .Height = FrameView.Height * 0.9
  309.                     .Width = (.Height * (iW / iH))
  310.                     .Top = FrameView.Width * 0.05
  311.                     .Left = (FrameView.Width - .Width) / 2
  312.                 End If
  313.                 
  314.                 .Visible = True
  315.                     
  316.             End With
  317.         End If
  318.     End If
  319. End Sub
  320. 'Private Sub Image2_Click()
  321. '    RaiseEvent Click
  322. 'End Sub
  323. 'Private Sub Image2_DblClick()
  324. '    RaiseEvent DblClick
  325. 'End Sub
  326. Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
  327.     RaiseEvent KeyUp(KeyCode, Shift)
  328. End Sub
  329. 'Private Sub Image2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  330. '    RaiseEvent MouseDown(Button, Shift, X, Y)
  331. 'End Sub
  332. 'Private Sub Image2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  333. 'End Sub
  334. Private Sub UserControl_Show()
  335.     RaiseEvent Show
  336. End Sub
  337. 'Public Property Get ToolTipText() As String
  338. '    ToolTipText = m_ToolTipText
  339. 'End Property
  340. 'Public Property Let ToolTipText(ByVal New_ToolTipText As String)
  341. '    m_ToolTipText = New_ToolTipText
  342. '    PropertyChanged "ToolTipText"
  343. 'End Property
  344. Public Property Get WhatsThisHelpID() As Long
  345. Attribute WhatsThisHelpID.VB_Description = "Returns/sets an associated context number for an object."
  346.     WhatsThisHelpID = m_WhatsThisHelpID
  347. End Property
  348. Public Property Let WhatsThisHelpID(ByVal New_WhatsThisHelpID As Long)
  349.     m_WhatsThisHelpID = New_WhatsThisHelpID
  350.     PropertyChanged "WhatsThisHelpID"
  351. End Property
  352. 'Initialize Properties for User Control
  353. Private Sub UserControl_InitProperties()
  354. '    m_ForeColor = m_def_ForeColor
  355.     m_Enabled = m_def_Enabled
  356.     m_BackStyle = m_def_BackStyle
  357.     m_BorderStyle = m_def_BorderStyle
  358. '    m_ToolTipText = m_def_ToolTipText
  359.     m_WhatsThisHelpID = m_def_WhatsThisHelpID
  360.     m_ToolTipText = m_def_ToolTipText
  361. End Sub
  362. 'Load property values from storage
  363. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  364.     FrameView.BackColor = PropBag.ReadProperty("BackColor", &H8000000C)
  365. '    m_ForeColor = PropBag.ReadProperty("ForeColor", m_def_ForeColor)
  366.     m_Enabled = PropBag.ReadProperty("Enabled", m_def_Enabled)
  367.     m_BackStyle = PropBag.ReadProperty("BackStyle", m_def_BackStyle)
  368.     m_BorderStyle = PropBag.ReadProperty("BorderStyle", m_def_BorderStyle)
  369. '    m_ToolTipText = PropBag.ReadProperty("ToolTipText", m_def_ToolTipText)
  370.     m_WhatsThisHelpID = PropBag.ReadProperty("WhatsThisHelpID", m_def_WhatsThisHelpID)
  371.     UserControl.BackColor = PropBag.ReadProperty("BackColor", &H808080)
  372.     m_ToolTipText = PropBag.ReadProperty("ToolTipText", m_def_ToolTipText)
  373. End Sub
  374. 'Write property values to storage
  375. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  376.     Call PropBag.WriteProperty("BackColor", FrameView.BackColor, &H8000000C)
  377. '    Call PropBag.WriteProperty("ForeColor", m_ForeColor, m_def_ForeColor)
  378.     Call PropBag.WriteProperty("Enabled", m_Enabled, m_def_Enabled)
  379.     Call PropBag.WriteProperty("BackStyle", m_BackStyle, m_def_BackStyle)
  380.     Call PropBag.WriteProperty("BorderStyle", m_BorderStyle, m_def_BorderStyle)
  381. '    Call PropBag.WriteProperty("ToolTipText", m_ToolTipText, m_def_ToolTipText)
  382.     Call PropBag.WriteProperty("WhatsThisHelpID", m_WhatsThisHelpID, m_def_WhatsThisHelpID)
  383.     Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H808080)
  384.     Call PropBag.WriteProperty("ToolTipText", m_ToolTipText, m_def_ToolTipText)
  385. End Sub
  386. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  387. 'MappingInfo=UserControl,UserControl,-1,BackColor
  388. Public Property Get BackColor() As OLE_COLOR
  389. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  390.     BackColor = UserControl.BackColor
  391. End Property
  392. Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  393.     UserControl.BackColor() = New_BackColor
  394.     PropertyChanged "BackColor"
  395. End Property
  396. Public Property Get ToolTipText() As String
  397. Attribute ToolTipText.VB_Description = "Returns/sets the text displayed when the mouse is paused over the control."
  398.     ToolTipText = m_ToolTipText
  399. End Property
  400. Public Property Let ToolTipText(ByVal New_ToolTipText As String)
  401.     m_ToolTipText = New_ToolTipText
  402.     PropertyChanged "ToolTipText"
  403. End Property
  404.