home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD643.psc / KillerButtonV2.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-08-27  |  12.2 KB  |  332 lines
  1. VERSION 5.00
  2. Begin VB.Form frmKillerButton 
  3.    BackColor       =   &H80000018&
  4.    BorderStyle     =   0  'None
  5.    Caption         =   "Form1"
  6.    ClientHeight    =   3705
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   5520
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   3705
  14.    ScaleWidth      =   5520
  15.    StartUpPosition =   2  'CenterScreen
  16.    Begin VB.CommandButton cmdNoBut 
  17.       Caption         =   "no"
  18.       BeginProperty Font 
  19.          Name            =   "MS Serif"
  20.          Size            =   6
  21.          Charset         =   0
  22.          Weight          =   400
  23.          Underline       =   0   'False
  24.          Italic          =   0   'False
  25.          Strikethrough   =   0   'False
  26.       EndProperty
  27.       Height          =   255
  28.       Left            =   3540
  29.       TabIndex        =   1
  30.       Top             =   2100
  31.       Width           =   375
  32.    End
  33.    Begin VB.Timer tmrFollow 
  34.       Enabled         =   0   'False
  35.       Interval        =   1
  36.       Left            =   3540
  37.       Top             =   2460
  38.    End
  39.    Begin VB.CommandButton cmdYesBut 
  40.       Caption         =   "Yes!  I love this program!"
  41.       BeginProperty Font 
  42.          Name            =   "MS Sans Serif"
  43.          Size            =   9.75
  44.          Charset         =   0
  45.          Weight          =   700
  46.          Underline       =   0   'False
  47.          Italic          =   0   'False
  48.          Strikethrough   =   0   'False
  49.       EndProperty
  50.       Height          =   1095
  51.       Left            =   1500
  52.       Style           =   1  'Graphical
  53.       TabIndex        =   0
  54.       Top             =   1860
  55.       Width           =   1575
  56.    End
  57.    Begin VB.Image Up_LeftPic 
  58.       Height          =   570
  59.       Left            =   4320
  60.       Picture         =   "KILLER~3.frx":0000
  61.       Top             =   0
  62.       Visible         =   0   'False
  63.       Width           =   555
  64.    End
  65.    Begin VB.Image LeftPic 
  66.       Height          =   570
  67.       Left            =   3780
  68.       Picture         =   "KILLER~3.frx":0432
  69.       Top             =   0
  70.       Visible         =   0   'False
  71.       Width           =   555
  72.    End
  73.    Begin VB.Image Down_LeftPic 
  74.       Height          =   570
  75.       Left            =   3240
  76.       Picture         =   "KILLER~3.frx":086D
  77.       Top             =   0
  78.       Visible         =   0   'False
  79.       Width           =   555
  80.    End
  81.    Begin VB.Image DownPic 
  82.       Height          =   570
  83.       Left            =   2700
  84.       Picture         =   "KILLER~3.frx":0CA5
  85.       Top             =   0
  86.       Visible         =   0   'False
  87.       Width           =   555
  88.    End
  89.    Begin VB.Image Down_RightPic 
  90.       Height          =   570
  91.       Left            =   2160
  92.       Picture         =   "KILLER~3.frx":10DD
  93.       Top             =   0
  94.       Visible         =   0   'False
  95.       Width           =   555
  96.    End
  97.    Begin VB.Image RightPic 
  98.       Height          =   570
  99.       Left            =   1620
  100.       Picture         =   "KILLER~3.frx":150F
  101.       Top             =   0
  102.       Visible         =   0   'False
  103.       Width           =   555
  104.    End
  105.    Begin VB.Image Up_RightPic 
  106.       Height          =   570
  107.       Left            =   1080
  108.       Picture         =   "KILLER~3.frx":194A
  109.       Top             =   0
  110.       Visible         =   0   'False
  111.       Width           =   555
  112.    End
  113.    Begin VB.Image UpPic 
  114.       Height          =   570
  115.       Left            =   540
  116.       Picture         =   "KILLER~3.frx":1D82
  117.       Top             =   0
  118.       Visible         =   0   'False
  119.       Width           =   555
  120.    End
  121.    Begin VB.Image FacePic 
  122.       Height          =   570
  123.       Left            =   0
  124.       Picture         =   "KILLER~3.frx":21B7
  125.       Top             =   0
  126.       Visible         =   0   'False
  127.       Width           =   555
  128.    End
  129.    Begin VB.Label Label1 
  130.       BackStyle       =   0  'Transparent
  131.       Caption         =   "Would you like to Register me?"
  132.       Height          =   255
  133.       Left            =   1680
  134.       TabIndex        =   2
  135.       Top             =   1440
  136.       Width           =   2295
  137.    End
  138. Attribute VB_Name = "frmKillerButton"
  139. Attribute VB_GlobalNameSpace = False
  140. Attribute VB_Creatable = False
  141. Attribute VB_PredeclaredId = True
  142. Attribute VB_Exposed = False
  143. Option Explicit
  144. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  145.     'Get the current cursor Hot-Spot position
  146. Private Type POINTAPI
  147.         X As Long
  148.         Y As Long
  149. End Type
  150. Const a_Radius = 30 'Acceptable Radius the cursor can be
  151.                 'within for the button to 'grab' the cursor
  152. Const HWND_TOPMOST = -1
  153. Dim XnY As POINTAPI, ExitDo As Boolean
  154. Private Sub cmdNoBut_Click()
  155.     cmdYesBut.ZOrder 0  'Set the follower button to infront
  156.     cmdYesBut.Font.Size = 8
  157.     cmdYesBut.Caption = "Grrrr!" & Chr(13) & Chr(10) & "Register now!!"
  158.     cmdYesBut.Picture = FacePic.Picture
  159.     tmrFollow.Enabled = True  'Start the button moving!
  160. End Sub
  161. Private Sub cmdYesBut_Click()
  162.     ExitDo = True
  163.     'Stop the Do..Loop from running, though you don't need
  164.     'this if you're going to unload the form like this
  165.     tmrFollow.Enabled = False
  166.     MsgBox "                 Why thankyou! :)" & Chr(13) & Chr(10) & _
  167.         "Killer Button and Images made By GEEZA" & Chr(13) & Chr(10) & _
  168.         "                GEEZA1@aol.com", vbApplicationModal + vbInformation, "hehe!"
  169.     Unload Me
  170.     End
  171. End Sub
  172. Private Sub DirectionPic(ByVal LeftRight As Integer, UpDown As Integer)
  173.     If UpDown = 0 Then
  174.         If LeftRight = 1 Then
  175.             cmdYesBut.Picture = LeftPic.Picture
  176.         Else
  177.             cmdYesBut.Picture = RightPic.Picture
  178.         End If
  179.     ElseIf UpDown = 1 Then
  180.         If LeftRight = 0 Then
  181.             cmdYesBut.Picture = UpPic.Picture
  182.         ElseIf LeftRight = 1 Then
  183.             cmdYesBut.Picture = Up_LeftPic.Picture
  184.         Else
  185.             cmdYesBut.Picture = Up_RightPic.Picture
  186.         End If
  187.     Else
  188.         If LeftRight = 0 Then
  189.             cmdYesBut.Picture = DownPic.Picture
  190.         ElseIf LeftRight = 1 Then
  191.             cmdYesBut.Picture = Down_LeftPic.Picture
  192.         Else
  193.             cmdYesBut.Picture = Down_RightPic.Picture
  194.         End If
  195.     End If
  196. End Sub
  197. Private Sub tmrFollow_Timer()
  198.     Dim Direction As Integer
  199.     DoEvents
  200.     GetCursorPos XnY
  201.     XnY.X = ScaleX(XnY.X, vbPixels, vbTwips) 'Change the dimensions from Pixels
  202.     XnY.Y = ScaleY(XnY.Y, vbPixels, vbTwips) 'to Twips
  203.     If (cmdYesBut.Left + cmdYesBut.Width / 2 + Me.Left > XnY.X + a_Radius) Or (cmdYesBut.Left + cmdYesBut.Width / 2 + Me.Left < XnY.X - a_Radius) Then
  204.         'Movement in X
  205.         If cmdYesBut.Left < 0 Then
  206.             cmdYesBut.Left = 0
  207.             Me.Left = Me.Left - 15  'push window
  208.             Direction = 1 'left
  209.         ElseIf cmdYesBut.Left + cmdYesBut.Width > Me.Width Then
  210.             cmdYesBut.Left = Me.Width - cmdYesBut.Width
  211.             Me.Left = Me.Left + 15  'push window
  212.             Direction = 2 'right
  213.         Else
  214.             If cmdYesBut.Left + cmdYesBut.Width / 2 + Me.Left < XnY.X Then
  215.                 cmdYesBut.Left = cmdYesBut.Left + 30
  216.                 Direction = 2
  217.             Else
  218.                 cmdYesBut.Left = cmdYesBut.Left - 30
  219.                 Direction = 1
  220.             End If
  221.         End If
  222.     End If
  223.         
  224.     If Not (cmdYesBut.Top + cmdYesBut.Height / 2 + Me.Top > XnY.Y - a_Radius) Or (cmdYesBut.Top + cmdYesBut.Height / 2 + Me.Top > XnY.Y + a_Radius) Then
  225.         If cmdYesBut.Top < 0 Then
  226.             cmdYesBut.Top = 0
  227.             Me.Top = Me.Top - 15
  228.             Call DirectionPic(Direction, 1)
  229.         ElseIf cmdYesBut.Top + cmdYesBut.Height > Me.Height Then
  230.             cmdYesBut.Top = Me.Height - cmdYesBut.Height
  231.             Me.Top = Me.Top + 15
  232.             Call DirectionPic(Direction, 2)
  233.         Else
  234.             If cmdYesBut.Top + cmdYesBut.Height / 2 + Me.Top < XnY.Y Then
  235.                 cmdYesBut.Top = cmdYesBut.Top + 30
  236.                 Call DirectionPic(Direction, 2)
  237.             Else
  238.                 cmdYesBut.Top = cmdYesBut.Top - 30
  239.                 Call DirectionPic(Direction, 1)
  240.             End If
  241.         End If
  242.     ElseIf Direction = 0 Then
  243.         'Within a_Radius twips of the center
  244.         '(pretty long IF statements huh?!)
  245.         tmrFollow.Enabled = False
  246.         Call StickButton(Me, cmdYesBut, cmdYesBut.Width / 2, cmdYesBut.Height / 2)
  247.     Else: Call DirectionPic(Direction, 0)
  248.     End If
  249. End Sub
  250. Private Sub StickButton(ByVal Form As Form, ByVal Button As CommandButton, DpX As Long, DpY As Long)
  251.     Do
  252.         DoEvents    'So it doesn't 'Hang' the program
  253.         GetCursorPos XnY
  254.         XnY.X = ScaleX(XnY.X, vbPixels, vbTwips)
  255.         XnY.Y = ScaleY(XnY.Y, vbPixels, vbTwips)
  256.         
  257.         If XnY.X - DpX <= Form.Left Then
  258.             Button.Left = 0
  259.             Me.Left = Me.Left - 15
  260.             If XnY.Y - DpY <= Form.Top Then
  261.                 Button.Top = 0
  262.                 Me.Top = Me.Top - 15
  263.                 Button.Picture = Up_LeftPic.Picture
  264.             ElseIf XnY.Y + (Button.Height - DpY) >= Form.Top + Form.Height Then
  265.                 Button.Top = Form.Height - Button.Height
  266.                 Me.Top = Me.Top + 15
  267.                 Button.Picture = Down_LeftPic.Picture
  268.             Else
  269.                 Button.Top = XnY.Y - DpY - Form.Top
  270.                 Button.Picture = LeftPic.Picture
  271.             End If
  272.         ElseIf XnY.X + Button.Width - DpX >= Form.Left + Form.Width Then
  273.             Button.Left = Form.Width - Button.Width
  274.             Me.Left = Me.Left + 15
  275.             If XnY.Y - DpY <= Form.Top Then
  276.                 Button.Top = 0
  277.                 Me.Top = Me.Top - 15
  278.                 Button.Picture = Up_RightPic.Picture
  279.             ElseIf XnY.Y + (Button.Height - DpY) >= Form.Top + Form.Height Then
  280.                 Button.Top = Form.Height - Button.Height
  281.                 Me.Top = Me.Top + 15
  282.                 Button.Picture = Down_RightPic.Picture
  283.             Else
  284.                 Button.Top = XnY.Y - DpY - Form.Top
  285.                 Button.Picture = RightPic.Picture
  286.             End If
  287.         Else
  288.             Button.Left = XnY.X - DpX - Form.Left
  289.             If XnY.Y - DpY <= Form.Top Then
  290.                 Button.Top = 0
  291.                 Me.Top = Me.Top - 15
  292.                 Button.Picture = UpPic.Picture
  293.             ElseIf XnY.Y + (Button.Height - DpY) >= Form.Top + Form.Height Then
  294.                 Button.Top = Form.Height - Button.Height
  295.                 Me.Top = Me.Top + 15
  296.                 Button.Picture = DownPic.Picture
  297.             Else
  298.                 Button.Top = XnY.Y - DpY - Form.Top
  299.                 Button.Picture = FacePic.Picture
  300.             End If
  301.         End If
  302.         If ExitDo Then Exit Do
  303.     Loop  'Stick the button to the cursor until ExitDo is true
  304.     'And they wont be able to click anything else on the form!! hehe!
  305. End Sub
  306. 'Ok, if the user clicks the 'No' button, then the killer
  307. 'button awakens, and goes after your cursor!
  308. 'When it finally gets the cursor, it grabs hold and wont
  309. 'let you click anything else on the form.
  310. 'It does seem a bit wrong, now that the button is always
  311. 'confined to the form due to graphical buttons not working
  312. 'well with no parents (0, well how would you feel? lol)
  313. 'So you can either use both parts, or just one by modifying
  314. 'some of the lines of code, and removing parts
  315. 'Well, i hope you like it!  i know everyone laughed when
  316. 'i showed them version 1 i made in college!
  317. 'All i ask is that you please put a reference to me
  318. 'into any projects you use this with e.g. in your about
  319. 'boxes, or even better in any message box that comes up
  320. 'after clicking the KilerButton
  321. '('Killer button written by GEEZA!  GEEZA1@aol.com, the caffine junkie!')
  322. 'Oh and maybe change the pictures if you have time,
  323. 'everyone's projects have to be a little different :)
  324. 'this has taken me ages to write,
  325. 'and a lot of swearing too :)
  326. 'i'll have to improve the engines sometime though...
  327. 'Anyone have any ideas about merging the Java 'Eyes' effect
  328. 'into the project, for the face?
  329. 'Ok, it's 3am, i'm gonna go before i pass out,
  330. 'and computer keyboards arn't comfy, trust me!
  331. 'night Y 'all!
  332.