article

Control Collection - No Errors

Email
Submitted on: 1/27/2018 4:26:29 PM
By: Quake 
Level: Intermediate
User Rating: By 2 Users
Compatibility: VB 6.0
Views: 2335
 
     Demonstrates how to grab the controls "INSIDE" a picturebox, or frame to Scroll. Any controls can be placed inside "Except" for certain controls Timer for 1, and Imagelist for 2 Demo is included besides Code. Added: Advanced Demo

This article has accompanying files

 
				'--[FORM]--------------------------------------------
Option Explicit
Dim sCol As New Collection
Dim LSV As Single
Dim Cntl As Control
Private Sub Add_sCol()
'On Error Resume Next
 For Each Cntl In Me.Controls
 
 '--[USE Typeof to Identify the control]------------------------------
 '--[Skip the control that is giving Error]---------------------------
 If Not (TypeOf Cntl Is Timer) And Not (TypeOf Cntl Is ImageList) Then
 '--[If Not (TypeOf Cntl Is Timer) Then 'ANOTHER EXAMPLE ]--------
 '--[If Not (TypeOf Cntl Is ImageList) Then 'ANOTHER EXAMPLE ]--------
'--[START GET PICTUREBOX or FRAME]-----------
If Cntl.Container.hWnd = Picture1.hWnd Then
'--[START SKIP VSCROLL ]-----------
'If Not Cntl.Name = "VScroll1" Then 'EXAMPLE
'--[You only need to use this]-----------
'--[if you put the VScroll in]-----------
'--[the Picturebox Container ]-----------
 '--[ADD ALL CONTROLS ]------------
 sCol.Add Cntl
 '--[END ALL CONTROLS]--------
'End If
'--[END SKIP VSCROLL]------------
End If
'--[END GET PICTUREBOX]----------------
 
 End If
 '--[END GET Typeof]----------------
 Next
End Sub
Private Sub Clean_sCol()
'On Error Resume Next
Dim i As Integer
 For i = sCol.Count - 1 To 0 Step -1
 sCol.Remove 1
 Next
End Sub
Private Sub Form_Load()
'On Error Resume Next
 
 Set img = picTile.Picture
 
 With Picture1
 .Left = 60
 .Top = 60
 .Height = 2465
 End With
 
 With VScroll1
 .Min = 0
 .Value = .Min
 .Max = Command1(11).Top / 15 - 136
 End With
 LSV = 0
 Add_sCol
 
Exit Sub
End Sub
Private Sub Form_Paint()
'On Error Resume Next
 Call Pic_Me(Me)
 Call Change_Me(Picture1)
Exit Sub
'--[USE THIS IF MULTIPLE PICTUREBOXES]----
'Dim zS As Integer
' For zS = 0 To Picture1.Count - 1
' Call Change_Me(Picture1(zS))
' Next zS
End Sub
Private Sub VScroll1_Change()
'On Error Resume Next
 For Each Cntl In sCol
 Cntl.Top = Cntl.Top + (LSV - VScroll1.Value) * Screen.TwipsPerPixelY
 Next
 LSV = VScroll1.Value
End Sub
Private Sub VScroll1_Scroll()
 VScroll1_Change
End Sub
'--[Module]-------------------------------------------------------
Option Explicit
Public img As StdPicture
Public Sub Change_Me(ByVal pic As PictureBox)
'On Error GoTo Err_Proc
Dim X As Integer
Dim Y As Integer
Dim w As Single
Dim h As Single
 If Not (img Is Nothing) Then
 w = pic.ScaleX(img.Width, vbHimetric, pic.ScaleMode)
 h = pic.ScaleY(img.Height, vbHimetric, pic.ScaleMode)
 For X = 0 To pic.Width Step w
For Y = 0 To pic.Height Step h
pic.PaintPicture img, X, Y
Next Y
 Next X
 End If
Exit Sub
Err_Proc:
 'Error Msgbox
End Sub
Public Sub Pic_Me(ByVal sFrm As Form)
'On Error GoTo Err_Proc
Dim X As Integer
Dim Y As Integer
Dim w As Single
Dim h As Single
 If Not (img Is Nothing) Then
 w = sFrm.ScaleX(img.Width, vbHimetric, sFrm.ScaleMode)
 h = sFrm.ScaleY(img.Height, vbHimetric, sFrm.ScaleMode)
 For X = 0 To sFrm.Width Step w
For Y = 0 To sFrm.Height Step h
sFrm.PaintPicture img, X, Y
Next Y
 Next X
 End If
Exit Sub
Err_Proc:
 'Error Msgbox
End Sub

winzip iconDownload article

Note: Due to the size or complexity of this submission, the author has submitted it as a .zip file to shorten your download time. Afterdownloading it, you will need a program like Winzip to decompress it.Virus note:All files are scanned once-a-day by Planet Source Code for viruses, but new viruses come out every day, so no prevention program can catch 100% of them. For your own safety, please:
  1. Re-scan downloaded files using your personal virus checker before using it.
  2. NEVER, EVER run compiled files (.exe's, .ocx's, .dll's etc.)--only run source code.
  3. Scan the source code with Minnow's Project Scanner

If you don't have a virus scanner, you can get one at many places on the net including:McAfee.com


Other 32 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this article (in the Intermediate category)?
(The article with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments

1/26/2018 10:11:33 AMBen

Neat little code and easy to understand I think this may come in usfull for a project I am working on. Thank you for shareing.
(If this comment was disrespectful, please report it.)

 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular article, please click here instead.)
 

To post feedback, first please login.