home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD68586172000.psc / Form1.frm (.txt) next >
Encoding:
Visual Basic Form  |  2000-06-17  |  7.4 KB  |  213 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "SPECIAL FX BY SIMON PRICE"
  5.    ClientHeight    =   5616
  6.    ClientLeft      =   36
  7.    ClientTop       =   324
  8.    ClientWidth     =   6252
  9.    Icon            =   "Form1.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   468
  14.    ScaleMode       =   3  'Pixel
  15.    ScaleWidth      =   521
  16.    StartUpPosition =   2  'CenterScreen
  17.    Begin VB.ListBox List2 
  18.       Height          =   816
  19.       Left            =   2880
  20.       TabIndex        =   6
  21.       Top             =   720
  22.       Width           =   1092
  23.    End
  24.    Begin VB.PictureBox PB2 
  25.       AutoRedraw      =   -1  'True
  26.       AutoSize        =   -1  'True
  27.       BorderStyle     =   0  'None
  28.       Height          =   3600
  29.       Left            =   1920
  30.       ScaleHeight     =   300
  31.       ScaleMode       =   3  'Pixel
  32.       ScaleWidth      =   400
  33.       TabIndex        =   5
  34.       Top             =   4320
  35.       Visible         =   0   'False
  36.       Width           =   4800
  37.    End
  38.    Begin VB.PictureBox PB 
  39.       AutoRedraw      =   -1  'True
  40.       AutoSize        =   -1  'True
  41.       BackColor       =   &H00FFFFFF&
  42.       BorderStyle     =   0  'None
  43.       Height          =   3600
  44.       Left            =   2760
  45.       ScaleHeight     =   300
  46.       ScaleMode       =   3  'Pixel
  47.       ScaleWidth      =   508
  48.       TabIndex        =   4
  49.       Top             =   3120
  50.       Visible         =   0   'False
  51.       Width           =   6096
  52.    End
  53.    Begin VB.CommandButton cmdDoIt 
  54.       Caption         =   "Do It !"
  55.       Height          =   372
  56.       Left            =   4200
  57.       TabIndex        =   2
  58.       Top             =   1200
  59.       Width           =   1332
  60.    End
  61.    Begin VB.ListBox List1 
  62.       Height          =   816
  63.       ItemData        =   "Form1.frx":030A
  64.       Left            =   720
  65.       List            =   "Form1.frx":031D
  66.       TabIndex        =   1
  67.       Top             =   720
  68.       Width           =   1932
  69.    End
  70.    Begin VB.PictureBox Display 
  71.       AutoSize        =   -1  'True
  72.       BackColor       =   &H0000FFFF&
  73.       BorderStyle     =   0  'None
  74.       Height          =   3600
  75.       Left            =   720
  76.       ScaleHeight     =   300
  77.       ScaleMode       =   3  'Pixel
  78.       ScaleWidth      =   400
  79.       TabIndex        =   0
  80.       Top             =   1800
  81.       Width           =   4800
  82.    End
  83.    Begin VB.Label Label1 
  84.       Caption         =   "Choose an effect, choose a speed and then click the button to see it in action!"
  85.       Height          =   372
  86.       Left            =   720
  87.       TabIndex        =   3
  88.       Top             =   120
  89.       Width           =   4692
  90.    End
  91. Attribute VB_Name = "Form1"
  92. Attribute VB_GlobalNameSpace = False
  93. Attribute VB_Creatable = False
  94. Attribute VB_PredeclaredId = True
  95. Attribute VB_Exposed = False
  96. Private Type POINTAPI
  97.   x As Byte
  98.   y As Byte
  99. End Type
  100. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  101. Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
  102. Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
  103. Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  104. Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  105. Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
  106. Const HWAVE = 0
  107. Const VWAVE = 1
  108. Const HFLIP = 2
  109. Const VFLIP = 3
  110. Const ZOOM = 4
  111. Const PI = 3.1415
  112. Const PIdiv180 = PI / 180
  113. Dim PBWidth, PBHeight, HalfWidth, HalfHeight As Integer
  114. Dim i, x, y, x2, y2  As Integer
  115. Dim Color As Long
  116. Dim lpPoint As POINTAPI
  117. Dim yy, inc As Single
  118. Private Sub cmdDoIt_Click()
  119. PB.Cls
  120. Display.Cls
  121. Select Case List1.ListIndex
  122. Case HFLIP
  123.   DoFlip HFLIP
  124. Case VFLIP
  125.   DoFlip VFLIP
  126. Case ZOOM
  127.   DoZoom
  128. Case HWAVE
  129.   DoWave HWAVE
  130. Case VWAVE
  131.   DoWave VWAVE
  132. End Select
  133. End Sub
  134. Sub DoFlip(WhichWay As Byte)
  135. Select Case WhichWay
  136. Case HFLIP
  137.   For x = 0 To PBWidth Step List2.ListIndex + 1
  138.     PB.Cls
  139.     PB.Line (0, 0)-(PBWidth, PBHeight), vbWhite, BF
  140.     StretchBlt PB.hdc, x, 0, PBWidth - 2 * x, PBHeight, PB2.hdc, 0, 0, PBWidth, PBHeight, vbSrcCopy
  141.     BitBlt Display.hdc, 0, 0, PBWidth, PBHeight, PB.hdc, 0, 0, vbSrcCopy
  142.   Next
  143.   For x = PBWidth To 0 Step -List2.ListIndex
  144.     PB.Cls
  145.     StretchBlt PB.hdc, x, 0, PBWidth - 2 * x, PBHeight, PB2.hdc, 0, 0, PBWidth, PBHeight, vbSrcCopy
  146.     BitBlt Display.hdc, 0, 0, PBWidth, PBHeight, PB.hdc, 0, 0, vbSrcCopy
  147.   Next
  148. Case VFLIP
  149.   For y = 0 To PBHeight Step List2.ListIndex + 1
  150.     PB.Cls
  151.     PB.Line (0, 0)-(PBWidth, PBHeight), vbWhite, BF
  152.     StretchBlt PB.hdc, 0, y, PBWidth, PBHeight - 2 * y, PB2.hdc, 0, 0, PBWidth, PBHeight, vbSrcCopy
  153.     BitBlt Display.hdc, 0, 0, PBWidth, PBHeight, PB.hdc, 0, 0, vbSrcCopy
  154.   Next
  155.   For y = PBHeight To 0 Step -List2.ListIndex
  156.     PB.Cls
  157.     StretchBlt PB.hdc, 0, y, PBWidth, PBHeight - 2 * y, PB2.hdc, 0, 0, PBWidth, PBHeight, vbSrcCopy
  158.     BitBlt Display.hdc, 0, 0, PBWidth, PBHeight, PB.hdc, 0, 0, vbSrcCopy
  159.   Next
  160. End Select
  161. End Sub
  162. Sub DoZoom()
  163. inc = PBHeight / PBWidth * (List2.ListIndex + 1)
  164. yy = 0
  165.   For x = 0 To HalfWidth Step List2.ListIndex + 1
  166.     yy = yy + inc
  167.     StretchBlt PB.hdc, x, y, PBWidth - x * 2, PBHeight - 2 * yy, PB2.hdc, 0, 0, PBWidth, PBHeight, vbSrcCopy
  168.     BitBlt Display.hdc, 0, 0, PBWidth, PBHeight, PB.hdc, 0, 0, vbSrcCopy
  169.   Next
  170. yy = HalfHeight
  171.   For x = HalfWidth To 0 Step -List2.ListIndex - 1
  172.     yy = yy - inc
  173.     StretchBlt PB.hdc, x, y, PBWidth - x * 2, PBHeight - 2 * yy, PB2.hdc, 0, 0, PBWidth, PBHeight, vbSrcCopy
  174.     BitBlt Display.hdc, 0, 0, PBWidth, PBHeight, PB.hdc, 0, 0, vbSrcCopy
  175.   Next
  176. End Sub
  177. Sub DoWave(WhichWay As Byte)
  178. Select Case WhichWay
  179. Case HWAVE
  180. For y = 0 To (HalfHeight \ 3) * (List2.ListIndex + 1) Step List2.ListIndex + 1
  181.   For y2 = 0 To PBHeight
  182.     BitBlt PB.hdc, Sin((y2 + y) * PIdiv180) * 30, y2, PBWidth, 1, PB2.hdc, 0, y2, vbSrcCopy
  183.   Next
  184.   BitBlt Display.hdc, 0, 0, PBWidth, PBHeight, PB.hdc, 0, 0, vbSrcCopy
  185. Case VWAVE
  186. For x = 0 To (HalfWidth \ 4) * (List2.ListIndex + 1) Step List2.ListIndex + 1
  187.   For x2 = 0 To PBWidth
  188.     BitBlt PB.hdc, x2, Sin((x2 + x) * PIdiv180) * 30, 1, PBHeight, PB2.hdc, x2, 0, vbSrcCopy
  189.   Next
  190.   BitBlt Display.hdc, 0, 0, PBWidth, PBHeight, PB.hdc, 0, 0, vbSrcCopy
  191. End Select
  192. End Sub
  193. Private Sub Form_Load()
  194. 'load picture, you can change this if you want
  195. PB2 = LoadPicture(App.Path & "\SpecialFX.jpg")
  196. DoEvents
  197. 'copy pic into invisible pic
  198. PB = PB2
  199. 'remember size of pic
  200. PBWidth = PB.Width
  201. PBHeight = PB.Height
  202. HalfWidth = PBWidth \ 2
  203. HalfHeight = PBHeight \ 2
  204. 'fill speed listbox
  205. For i = 0 To 39
  206. List2.AddItem i + 1, i
  207. 'select defaults
  208. List1.ListIndex = HWAVE
  209. List2.ListIndex = 19
  210. 'press button
  211. 'cmdDoIt.Value = True
  212. End Sub
  213.