home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 6 / mastvb6.iso / ch_code / appx_c / wipes / twipes / wipes.frm (.txt) next >
Encoding:
Visual Basic Form  |  1998-07-03  |  13.7 KB  |  414 lines
  1. VERSION 5.00
  2. Begin VB.Form WipesForm 
  3.    Caption         =   "Image Wipes"
  4.    ClientHeight    =   5985
  5.    ClientLeft      =   1770
  6.    ClientTop       =   2295
  7.    ClientWidth     =   9600
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   5985
  10.    ScaleWidth      =   9600
  11.    Begin VB.CheckBox ClearDestination 
  12.       Caption         =   "Clear destination before wipe"
  13.       BeginProperty Font 
  14.          Name            =   "MS Sans Serif"
  15.          Size            =   9.75
  16.          Charset         =   0
  17.          Weight          =   400
  18.          Underline       =   0   'False
  19.          Italic          =   0   'False
  20.          Strikethrough   =   0   'False
  21.       EndProperty
  22.       Height          =   210
  23.       Left            =   4950
  24.       TabIndex        =   12
  25.       Top             =   60
  26.       Width           =   3030
  27.    End
  28.    Begin VB.CommandButton Exit 
  29.       Caption         =   "E X I T"
  30.       BeginProperty Font 
  31.          Name            =   "MS Sans Serif"
  32.          Size            =   9.75
  33.          Charset         =   0
  34.          Weight          =   400
  35.          Underline       =   0   'False
  36.          Italic          =   0   'False
  37.          Strikethrough   =   0   'False
  38.       EndProperty
  39.       Height          =   390
  40.       Left            =   7380
  41.       TabIndex        =   9
  42.       Top             =   5400
  43.       Width           =   2055
  44.    End
  45.    Begin VB.CommandButton Vertical 
  46.       Caption         =   "Vertical Blinds"
  47.       BeginProperty Font 
  48.          Name            =   "MS Sans Serif"
  49.          Size            =   9.75
  50.          Charset         =   0
  51.          Weight          =   400
  52.          Underline       =   0   'False
  53.          Italic          =   0   'False
  54.          Strikethrough   =   0   'False
  55.       EndProperty
  56.       Height          =   390
  57.       Left            =   7380
  58.       TabIndex        =   11
  59.       Top             =   4635
  60.       Width           =   2055
  61.    End
  62.    Begin VB.CommandButton WipeRight 
  63.       Caption         =   "Wipe From Right"
  64.       BeginProperty Font 
  65.          Name            =   "MS Sans Serif"
  66.          Size            =   9.75
  67.          Charset         =   0
  68.          Weight          =   400
  69.          Underline       =   0   'False
  70.          Italic          =   0   'False
  71.          Strikethrough   =   0   'False
  72.       EndProperty
  73.       Height          =   390
  74.       Left            =   240
  75.       TabIndex        =   10
  76.       Top             =   4635
  77.       Width           =   1935
  78.    End
  79.    Begin VB.CommandButton WipeRightLeft 
  80.       Caption         =   "Wipe Right && Left"
  81.       BeginProperty Font 
  82.          Name            =   "MS Sans Serif"
  83.          Size            =   9.75
  84.          Charset         =   0
  85.          Weight          =   400
  86.          Underline       =   0   'False
  87.          Italic          =   0   'False
  88.          Strikethrough   =   0   'False
  89.       EndProperty
  90.       Height          =   390
  91.       Left            =   2580
  92.       TabIndex        =   8
  93.       Top             =   4185
  94.       Width           =   1935
  95.    End
  96.    Begin VB.CommandButton WipeUpDown 
  97.       Caption         =   "Wipe Up && Down"
  98.       BeginProperty Font 
  99.          Name            =   "MS Sans Serif"
  100.          Size            =   9.75
  101.          Charset         =   0
  102.          Weight          =   400
  103.          Underline       =   0   'False
  104.          Italic          =   0   'False
  105.          Strikethrough   =   0   'False
  106.       EndProperty
  107.       Height          =   390
  108.       Left            =   2580
  109.       TabIndex        =   7
  110.       Top             =   4635
  111.       Width           =   1935
  112.    End
  113.    Begin VB.CommandButton WipeCenter 
  114.       Caption         =   "Wipe From Center"
  115.       BeginProperty Font 
  116.          Name            =   "MS Sans Serif"
  117.          Size            =   9.75
  118.          Charset         =   0
  119.          Weight          =   400
  120.          Underline       =   0   'False
  121.          Italic          =   0   'False
  122.          Strikethrough   =   0   'False
  123.       EndProperty
  124.       Height          =   390
  125.       Left            =   2580
  126.       TabIndex        =   6
  127.       Top             =   5070
  128.       Width           =   1935
  129.    End
  130.    Begin VB.CommandButton StretchBottom 
  131.       Caption         =   "Stretch From Bottom"
  132.       BeginProperty Font 
  133.          Name            =   "MS Sans Serif"
  134.          Size            =   9.75
  135.          Charset         =   0
  136.          Weight          =   400
  137.          Underline       =   0   'False
  138.          Italic          =   0   'False
  139.          Strikethrough   =   0   'False
  140.       EndProperty
  141.       Height          =   390
  142.       Left            =   4935
  143.       TabIndex        =   5
  144.       Top             =   4635
  145.       Width           =   2085
  146.    End
  147.    Begin VB.CommandButton Horizontal 
  148.       Caption         =   "Horizontal Blinds"
  149.       BeginProperty Font 
  150.          Name            =   "MS Sans Serif"
  151.          Size            =   9.75
  152.          Charset         =   0
  153.          Weight          =   400
  154.          Underline       =   0   'False
  155.          Italic          =   0   'False
  156.          Strikethrough   =   0   'False
  157.       EndProperty
  158.       Height          =   390
  159.       Left            =   7380
  160.       TabIndex        =   4
  161.       Top             =   4185
  162.       Width           =   2055
  163.    End
  164.    Begin VB.CommandButton WipeLeft 
  165.       Caption         =   "Wipe From Left"
  166.       BeginProperty Font 
  167.          Name            =   "MS Sans Serif"
  168.          Size            =   9.75
  169.          Charset         =   0
  170.          Weight          =   400
  171.          Underline       =   0   'False
  172.          Italic          =   0   'False
  173.          Strikethrough   =   0   'False
  174.       EndProperty
  175.       Height          =   390
  176.       Left            =   240
  177.       TabIndex        =   3
  178.       Top             =   4185
  179.       Width           =   1935
  180.    End
  181.    Begin VB.CommandButton StretchRight 
  182.       Caption         =   "Stretch From Right"
  183.       BeginProperty Font 
  184.          Name            =   "MS Sans Serif"
  185.          Size            =   9.75
  186.          Charset         =   0
  187.          Weight          =   400
  188.          Underline       =   0   'False
  189.          Italic          =   0   'False
  190.          Strikethrough   =   0   'False
  191.       EndProperty
  192.       Height          =   390
  193.       Left            =   4935
  194.       TabIndex        =   2
  195.       Top             =   4185
  196.       Width           =   2085
  197.    End
  198.    Begin VB.PictureBox Picture2 
  199.       Height          =   3735
  200.       Left            =   4950
  201.       ScaleHeight     =   245
  202.       ScaleMode       =   3  'Pixel
  203.       ScaleWidth      =   297
  204.       TabIndex        =   1
  205.       Top             =   345
  206.       Width           =   4515
  207.    End
  208.    Begin VB.PictureBox Picture1 
  209.       AutoSize        =   -1  'True
  210.       Height          =   3705
  211.       Left            =   240
  212.       Picture         =   "wipes.frx":0000
  213.       ScaleHeight     =   243
  214.       ScaleMode       =   3  'Pixel
  215.       ScaleWidth      =   278
  216.       TabIndex        =   0
  217.       Top             =   360
  218.       Width           =   4230
  219.    End
  220. Attribute VB_Name = "WipesForm"
  221. Attribute VB_GlobalNameSpace = False
  222. Attribute VB_Creatable = False
  223. Attribute VB_PredeclaredId = True
  224. Attribute VB_Exposed = False
  225. Private Declare Function timeGetTime Lib "winmm" () As Long
  226. Private StartTime As Long
  227. Private TotalDuration As Integer
  228. Private Sub Exit_Click()
  229.     End
  230. End Sub
  231. Private Sub Vertical_Click()
  232. Dim Stripes As Integer
  233. Dim i As Integer, j As Integer
  234. Dim StripeHeight As Integer
  235. Dim mseconds As Integer
  236.     Picture2.Cls
  237.     stripewidth = 20
  238.     Stripes = Picture1.ScaleWidth / stripewidth
  239.     On Error Resume Next
  240.     mseconds = TotalDuration / stripewidth
  241.     For j = 1 To stripewidth
  242.         StartDelay
  243.         For i = 0 To Stripes
  244.             Picture2.PaintPicture Picture1.Picture, i * stripewidth, 0, _
  245.                 j, Picture1.ScaleHeight, _
  246.                 i * stripewidth, 0, _
  247.                 j, Picture1.ScaleHeight, &HCC0020
  248.         Next
  249.         EndDelay (mseconds)
  250.     Next
  251. End Sub
  252. Private Sub Form_Load()
  253.     Picture2.Width = Picture1.Width
  254.     Picture2.Height = Picture1.Height
  255.     Picture2.Top = Picture1.Top
  256.     TotalDuration = 2000
  257. End Sub
  258. Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  259.     If Button <> 2 Then Exit Sub
  260.     CommonDialog1.Filter = "Images|*.BMP;*.GIF;*.JPG"
  261.     CommonDialog1.Action = 1
  262.     If CommonDialog1.FileName = "" Then Exit Sub
  263.     Picture1.Picture = LoadPicture(CommonDialog1.FileName)
  264.     Picture2.Width = Picture1.Width
  265.     Picture2.Height = Picture1.Height
  266. End Sub
  267. Private Sub Picture2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  268.     If Button <> 2 Then Exit Sub
  269.     CommonDialog1.Filter = "Images|*.BMP;*.GIF;*.JPG"
  270.     CommonDialog1.Action = 1
  271.     If CommonDialog1.FileName = "" Then Exit Sub
  272.     Picture2.Picture = LoadPicture(CommonDialog1.FileName)
  273. End Sub
  274. Private Sub StretchRight_Click()
  275. Dim X As Integer
  276.     If ClearDestination.Value Then Picture2.Picture = LoadPicture()
  277.     For X = 1 To Picture1.ScaleWidth Step 3
  278.         Picture2.PaintPicture Picture1.Picture, 0, 0, _
  279.         Picture1.ScaleWidth, Picture1.ScaleHeight, 0, 0, X, _
  280.         Picture1.ScaleHeight, &HCC0020
  281.     Next
  282. End Sub
  283. Private Sub WipeLeft_Click()
  284. Dim X As Integer
  285. Dim mseconds As Integer
  286.     If ClearDestination.Value Then Picture2.Picture = LoadPicture()
  287.     mseconds = TotalDuration / Picture1.ScaleWidth
  288.     For X = 1 To Picture1.ScaleWidth
  289.         StartDelay
  290.         Picture2.PaintPicture Picture1.Picture, 0, 0, _
  291.         X, Picture1.ScaleHeight, 0, 0, X, _
  292.         Picture1.ScaleHeight, &HCC0020
  293.         EndDelay (mseconds)
  294.     Next
  295. End Sub
  296. Private Sub StretchBottom_Click()
  297. Dim X As Integer
  298.     If ClearDestination.Value Then Picture2.Picture = LoadPicture()
  299.     For X = 1 To Picture1.ScaleHeight Step 3
  300.         Picture2.PaintPicture Picture1.Picture, 0, 0, _
  301.         Picture1.ScaleWidth, Picture1.ScaleHeight, 0, 0, _
  302.         Picture1.ScaleWidth, X, &HCC0020
  303.     Next
  304. End Sub
  305. Private Sub WipeCenter_Click()
  306. Dim PWidth As Integer, PHeight As Integer
  307. Dim i As Integer
  308. Dim mseconds As Integer
  309.     If ClearDestination.Value Then Picture2.Picture = LoadPicture()
  310.     If Picture1.ScaleWidth > Picture1.ScaleHeight Then
  311.         PWidth = Picture1.ScaleWidth - Picture1.ScaleHeight
  312.         PHeight = 1
  313.     ElseIf Picture1.ScaleWidth < Picture1.ScaleHeight Then
  314.         PWidth = 1
  315.         PHeight = Picture1.ScaleHeight - Picture1.ScaleWidth
  316.     Else
  317.         PWidth = 1
  318.         PHeight = 1
  319.     End If
  320.     mseconds = TotalDuration / (Picture1.ScaleWidth - PWidth)
  321.     For i = 1 To Picture1.ScaleWidth - PWidth
  322.         StartDelay
  323.         Picture2.PaintPicture Picture1.Picture, _
  324.         Int((Picture1.ScaleWidth - PWidth) / 2), Int((Picture1.ScaleHeight - PHeight) / 2), _
  325.         PWidth, PHeight, _
  326.         Int((Picture1.ScaleWidth - PWidth) / 2), Int((Picture1.ScaleHeight - PHeight) / 2), _
  327.         PWidth, PHeight, &HCC0020
  328.         PWidth = PWidth + 1
  329.         PHeight = Height + 1
  330.         EndDelay (mseconds)
  331.     Next
  332. End Sub
  333. Private Sub Horizontal_Click()
  334. Dim Stripes As Integer
  335. Dim i As Integer, j As Integer
  336. Dim StripeHeight As Integer
  337. Dim mseconds As Integer
  338.     If ClearDestination.Value Then Picture2.Picture = LoadPicture()
  339.     StripeHeight = 20
  340.     Stripes = Fix(Picture1.ScaleHeight / StripeHeight)
  341.     On Error Resume Next
  342.     mseconds = TotalDuration / StripeHeight
  343.     For j = 1 To StripeHeight
  344.         StartDelay
  345.         For i = 0 To Stripes
  346.             Picture2.PaintPicture Picture1.Picture, 0, i * StripeHeight, _
  347.             Picture1.ScaleWidth, j, _
  348.             0, i * StripeHeight, _
  349.             Picture1.ScaleWidth, j, &HCC0020
  350.         Next
  351.         EndDelay (mseconds)
  352.     Next
  353. End Sub
  354. Private Sub WipeRight_Click()
  355. Dim X As Integer
  356. Dim mseconds As Integer
  357.     If ClearDestination.Value Then Picture2.Picture = LoadPicture()
  358.     mseconds = TotalDuration / Picture1.ScaleWidth
  359.     For X = 1 To Picture1.ScaleWidth
  360.         StartDelay
  361.         Picture2.PaintPicture Picture1.Picture, _
  362.         Picture1.ScaleWidth - X, 0, _
  363.         X, Picture1.ScaleHeight, _
  364.         Picture1.ScaleWidth - X, 0, _
  365.         X, Picture1.ScaleHeight, &HCC0020
  366.         EndDelay mseconds
  367.     Next
  368. End Sub
  369. Private Sub WipeUpDown_Click()
  370. Dim PWidth As Integer, PHeight As Integer
  371. Dim i As Integer
  372. Dim mseconds As Integer
  373.     If ClearDestination.Value Then Picture2.Picture = LoadPicture()
  374.     PWidth = Picture1.ScaleWidth
  375.     PHeight = 1
  376.     mseconds = TotalDuration / (Picture1.ScaleHeight / 2)
  377.     For i = 1 To Picture1.ScaleHeight / 2
  378.         StartDelay
  379.         Picture2.PaintPicture Picture1.Picture, _
  380.         0, (Picture1.ScaleHeight - PHeight) / 2, _
  381.         PWidth, PHeight, _
  382.         0, (Picture1.ScaleHeight - PHeight) / 2, _
  383.         PWidth, PHeight, &HCC0020
  384.         PHeight = PHeight + 2
  385.         EndDelay (mseconds)
  386.     Next
  387. End Sub
  388. Private Sub WipeRightLeft_Click()
  389. Dim PWidth As Integer, PHeight As Integer
  390. Dim i As Integer
  391. Dim mseconds As Integer
  392.     If ClearDestination.Value Then Picture2.Picture = LoadPicture()
  393.     PWidth = 1
  394.     PHeight = Picture1.ScaleHeight
  395.     mseconds = TotalDuration / (Picture1.ScaleWidth / 2)
  396.     For i = 1 To Picture1.ScaleWidth / 2
  397.         StartDelay
  398.         Picture2.PaintPicture Picture1.Picture, _
  399.         (Picture1.ScaleWidth - PWidth) / 2, 0, _
  400.         PWidth, PHeight, _
  401.         (Picture1.ScaleWidth - PWidth) / 2, 0, _
  402.         PWidth, PHeight, &HCC0020
  403.         PWidth = PWidth + 2
  404.         EndDelay (mseconds)
  405.     Next
  406. End Sub
  407. Sub StartDelay()
  408.     StartTime = timeGetTime()
  409. End Sub
  410. Sub EndDelay(N As Integer)
  411.     While timeGetTime() - StartTime < N
  412.     Wend
  413. End Sub
  414.