home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / More_Silly196232142006.psc / Slides / FrmMain.frm next >
Text File  |  2006-01-04  |  7KB  |  239 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    BackColor       =   &H00000000&
  4.    BorderStyle     =   0  'None
  5.    Caption         =   "Form1"
  6.    ClientHeight    =   9225
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   10440
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   9225
  12.    ScaleWidth      =   10440
  13.    StartUpPosition =   2  'CenterScreen
  14.    WindowState     =   2  'Maximized
  15.    Begin VB.PictureBox PicRange 
  16.       Appearance      =   0  'Flat
  17.       AutoRedraw      =   -1  'True
  18.       AutoSize        =   -1  'True
  19.       BackColor       =   &H00000000&
  20.       BorderStyle     =   0  'None
  21.       ForeColor       =   &H00000000&
  22.       Height          =   1695
  23.       Index           =   2
  24.       Left            =   300
  25.       Picture         =   "FrmMain.frx":0000
  26.       ScaleHeight     =   1695
  27.       ScaleWidth      =   2580
  28.       TabIndex        =   5
  29.       Top             =   7320
  30.       Visible         =   0   'False
  31.       Width           =   2580
  32.    End
  33.    Begin VB.Timer Timer1 
  34.       Interval        =   3000
  35.       Left            =   8940
  36.       Top             =   660
  37.    End
  38.    Begin VB.CommandButton Command1 
  39.       BackColor       =   &H00FFFFFF&
  40.       Caption         =   "End"
  41.       Height          =   555
  42.       Left            =   7380
  43.       Style           =   1  'Graphical
  44.       TabIndex        =   4
  45.       Top             =   8100
  46.       Width           =   1575
  47.    End
  48.    Begin VB.PictureBox Canvas 
  49.       Appearance      =   0  'Flat
  50.       BackColor       =   &H00000000&
  51.       BorderStyle     =   0  'None
  52.       Enabled         =   0   'False
  53.       FillColor       =   &H00FFFFFF&
  54.       ForeColor       =   &H00FFFFFF&
  55.       Height          =   1695
  56.       Left            =   180
  57.       Picture         =   "FrmMain.frx":E406
  58.       ScaleHeight     =   1695
  59.       ScaleWidth      =   2625
  60.       TabIndex        =   3
  61.       Top             =   120
  62.       Width           =   2625
  63.    End
  64.    Begin VB.PictureBox PicRange 
  65.       Appearance      =   0  'Flat
  66.       AutoRedraw      =   -1  'True
  67.       AutoSize        =   -1  'True
  68.       BackColor       =   &H80000005&
  69.       BorderStyle     =   0  'None
  70.       FillColor       =   &H00FFFFFF&
  71.       ForeColor       =   &H00FFFFFF&
  72.       Height          =   1695
  73.       Index           =   0
  74.       Left            =   60
  75.       Picture         =   "FrmMain.frx":1D9B4
  76.       ScaleHeight     =   1695
  77.       ScaleWidth      =   2775
  78.       TabIndex        =   2
  79.       Top             =   3780
  80.       Visible         =   0   'False
  81.       Width           =   2775
  82.    End
  83.    Begin VB.PictureBox PicOutPut 
  84.       Appearance      =   0  'Flat
  85.       AutoRedraw      =   -1  'True
  86.       AutoSize        =   -1  'True
  87.       BackColor       =   &H80000005&
  88.       BorderStyle     =   0  'None
  89.       FillColor       =   &H00FFFFFF&
  90.       ForeColor       =   &H00FFFFFF&
  91.       Height          =   1695
  92.       Left            =   60
  93.       Picture         =   "FrmMain.frx":2CF62
  94.       ScaleHeight     =   1695
  95.       ScaleWidth      =   2775
  96.       TabIndex        =   1
  97.       Top             =   1980
  98.       Visible         =   0   'False
  99.       Width           =   2775
  100.    End
  101.    Begin VB.PictureBox PicRange 
  102.       Appearance      =   0  'Flat
  103.       AutoRedraw      =   -1  'True
  104.       AutoSize        =   -1  'True
  105.       BackColor       =   &H00000000&
  106.       BorderStyle     =   0  'None
  107.       ForeColor       =   &H00000000&
  108.       Height          =   1695
  109.       Index           =   1
  110.       Left            =   60
  111.       Picture         =   "FrmMain.frx":3C510
  112.       ScaleHeight     =   1695
  113.       ScaleWidth      =   1710
  114.       TabIndex        =   0
  115.       Top             =   5520
  116.       Visible         =   0   'False
  117.       Width           =   1710
  118.    End
  119. End
  120. Attribute VB_Name = "Form1"
  121. Attribute VB_GlobalNameSpace = False
  122. Attribute VB_Creatable = False
  123. Attribute VB_PredeclaredId = True
  124. Attribute VB_Exposed = False
  125. Option Explicit
  126.  
  127.  
  128. 'NOTE:  YOU CAN HAVE AS MANY DIFERANT PICTURES AS YOU WANT, JUST ADD MORE CONTROLS TO THE PICRANGE CONTROL
  129. '       ARRAY AND LOAD EM UP WITH YOUR PICTURES. THE PROGRAM AUTOMATICALLY COMPENSATES FOR HOW MANY PICTURES
  130. '       YOU HAVE. EG    PicRange(0), PicRange(1), PicRange(2), PicRange(3), PicRange(4)
  131.  
  132.  
  133. Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
  134. Private Declare Function SetPixelV Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal Color As Long) As Byte
  135.  
  136. 'View Mode Variables
  137. Private Mode As Single
  138. Private ChangeView As Boolean
  139. Private Steps As Single
  140.  
  141.  
  142.  
  143. Private Sub Command1_Click()
  144.     
  145.     'EErrrrr
  146.     End
  147.     
  148. End Sub
  149.  
  150. Private Sub SlideIcons()
  151.     
  152.     Dim Movement As Single
  153.     Movement = 5
  154.     
  155.     If ChangeView = True Then Exit Sub
  156.     
  157.     ChangeView = True
  158.     
  159.     Dim LP  As Single
  160.     Dim Start As Single
  161.     
  162.     Mode = Mode + 1
  163.     
  164.     
  165.     If Mode > PicRange.UBound Then Mode = 0
  166.     
  167.     Dim X As Long, Y As Long, Rep As Long
  168.     
  169.     'Move Slide Out
  170.     For Start = 0 To Steps - 1
  171.         For Rep = 0 To T2P(Canvas.Width) Step Movement
  172.             For Y = Start To T2P(Canvas.Height) Step Steps
  173.                 For X = 0 To T2P(Canvas.Width) - Rep
  174.                     SetPixelV Canvas.hDC, X, Y, GetPixel(PicOutPut.hDC, X + Rep, Y)
  175.                 Next X
  176.             Next Y
  177.             DoEvents
  178.         Next Rep
  179.     Next Start
  180.     
  181.     
  182.     
  183.     
  184.     'Move The Canvas
  185.     Canvas.Picture = LoadPicture("")
  186.     Canvas.Top = ((Screen.Height - Canvas.Height) * Rnd)
  187.     Canvas.Left = ((Screen.Width - Canvas.Width) * Rnd)
  188.     
  189.     'Adjusting The Steps Variable Adjusts How The Trasition Sweeps In\Out
  190.     Steps = (Int(T2P(Canvas.Height) / 2) * Rnd) + 1
  191.     
  192.     'Move Next Slide In
  193.     For Start = 0 To Steps - 1
  194.         For Rep = 0 To T2P(Canvas.Width) Step Movement
  195.             For Y = Start To T2P(Canvas.Height) Step Steps
  196.                 For X = 0 To Rep
  197.                     SetPixelV Canvas.hDC, T2P(Canvas.Width) - Rep + X, Y, GetPixel(PicRange(Mode).hDC, X, Y)
  198.                 Next X
  199.             Next Y
  200.             DoEvents
  201.         Next Rep
  202.     Next Start
  203.     
  204.     
  205.     
  206.     PicOutPut.Picture = PicRange(Mode).Picture
  207.     Canvas.Picture = PicRange(Mode).Picture
  208.     
  209.     ChangeView = False
  210.     
  211. End Sub
  212.  
  213. Private Function T2P(Twip As Long) As Long
  214.     
  215.     'Convert Twip To Pixel For Graphics Routines
  216.     T2P = Int(Twip / 15)
  217.  
  218. End Function
  219.  
  220. Private Sub Form_Load()
  221.  
  222. Randomize Timer
  223.  
  224.     Steps = (20 * Rnd) + 1
  225.     
  226.     Command1.Top = Screen.Height - Command1.Height - 100
  227.     Command1.Left = Screen.Width - Command1.Width - 100
  228.     
  229. End Sub
  230.  
  231. Private Sub Timer1_Timer()
  232.  
  233.     SlideIcons
  234.     
  235. End Sub
  236.  
  237.  
  238.  
  239.