home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / teddy-1a / form4.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-09-21  |  9.6 KB  |  283 lines

  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    BorderStyle     =   0  'None
  4.    Caption         =   "Form1"
  5.    ClientHeight    =   3225
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   4530
  9.    Icon            =   "Form4.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   3225
  14.    ScaleWidth      =   4530
  15.    ShowInTaskbar   =   0   'False
  16.    StartUpPosition =   2  'CenterScreen
  17.    Begin VB.Timer Timer1 
  18.       Interval        =   1
  19.       Left            =   0
  20.       Top             =   0
  21.    End
  22.    Begin VB.Shape Shape9 
  23.       BackColor       =   &H00000000&
  24.       BackStyle       =   1  'Opaque
  25.       Height          =   615
  26.       Left            =   1680
  27.       Shape           =   2  'Oval
  28.       Top             =   2400
  29.       Width           =   1215
  30.    End
  31.    Begin VB.Shape Shape8 
  32.       BackColor       =   &H00800080&
  33.       BackStyle       =   1  'Opaque
  34.       Height          =   435
  35.       Left            =   1920
  36.       Shape           =   2  'Oval
  37.       Tag             =   "1"
  38.       Top             =   1680
  39.       Width           =   495
  40.    End
  41.    Begin VB.Shape Shape12 
  42.       BackColor       =   &H00400000&
  43.       BackStyle       =   1  'Opaque
  44.       Height          =   195
  45.       Left            =   2580
  46.       Shape           =   2  'Oval
  47.       Tag             =   "1"
  48.       Top             =   1440
  49.       Width           =   195
  50.    End
  51.    Begin VB.Shape Shape11 
  52.       BackColor       =   &H00400000&
  53.       BackStyle       =   1  'Opaque
  54.       Height          =   195
  55.       Left            =   1500
  56.       Shape           =   2  'Oval
  57.       Tag             =   "1"
  58.       Top             =   1440
  59.       Width           =   195
  60.    End
  61.    Begin VB.Shape Shape7 
  62.       BackColor       =   &H00FF0000&
  63.       BackStyle       =   1  'Opaque
  64.       Height          =   435
  65.       Left            =   2460
  66.       Shape           =   2  'Oval
  67.       Tag             =   "1"
  68.       Top             =   1200
  69.       Width           =   495
  70.    End
  71.    Begin VB.Shape Shape6 
  72.       BackColor       =   &H00FF0000&
  73.       BackStyle       =   1  'Opaque
  74.       Height          =   435
  75.       Left            =   1380
  76.       Shape           =   2  'Oval
  77.       Tag             =   "1"
  78.       Top             =   1200
  79.       Width           =   495
  80.    End
  81.    Begin VB.Shape Shape5 
  82.       BackColor       =   &H000080FF&
  83.       BackStyle       =   1  'Opaque
  84.       Height          =   675
  85.       Left            =   3480
  86.       Shape           =   2  'Oval
  87.       Tag             =   "1"
  88.       Top             =   300
  89.       Width           =   735
  90.    End
  91.    Begin VB.Shape Shape1 
  92.       BackColor       =   &H000080FF&
  93.       BackStyle       =   1  'Opaque
  94.       Height          =   675
  95.       Left            =   300
  96.       Shape           =   2  'Oval
  97.       Tag             =   "1"
  98.       Top             =   300
  99.       Width           =   735
  100.    End
  101.    Begin VB.Shape Shape3 
  102.       BackColor       =   &H00004080&
  103.       BackStyle       =   1  'Opaque
  104.       Height          =   1215
  105.       Left            =   3180
  106.       Shape           =   2  'Oval
  107.       Top             =   0
  108.       Width           =   1335
  109.    End
  110.    Begin VB.Shape Shape14 
  111.       BackColor       =   &H000000C0&
  112.       BackStyle       =   1  'Opaque
  113.       BorderColor     =   &H000000C0&
  114.       Height          =   1575
  115.       Left            =   1080
  116.       Shape           =   2  'Oval
  117.       Tag             =   "1"
  118.       Top             =   1560
  119.       Width           =   2415
  120.    End
  121.    Begin VB.Shape Shape4 
  122.       BackColor       =   &H00000080&
  123.       BackStyle       =   1  'Opaque
  124.       Height          =   2595
  125.       Left            =   660
  126.       Shape           =   2  'Oval
  127.       Top             =   600
  128.       Width           =   3255
  129.    End
  130.    Begin VB.Shape Shape10 
  131.       BackColor       =   &H00000080&
  132.       BackStyle       =   1  'Opaque
  133.       BorderStyle     =   0  'Transparent
  134.       Height          =   1395
  135.       Left            =   1320
  136.       Shape           =   2  'Oval
  137.       Tag             =   "1"
  138.       Top             =   1320
  139.       Width           =   2055
  140.    End
  141.    Begin VB.Shape Shape2 
  142.       BackColor       =   &H00004080&
  143.       BackStyle       =   1  'Opaque
  144.       FillColor       =   &H00004080&
  145.       Height          =   1215
  146.       Left            =   0
  147.       Shape           =   2  'Oval
  148.       Top             =   60
  149.       Width           =   1335
  150.    End
  151. Attribute VB_Name = "frmMain"
  152. Attribute VB_GlobalNameSpace = False
  153. Attribute VB_Creatable = False
  154. Attribute VB_PredeclaredId = True
  155. Attribute VB_Exposed = False
  156. Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  157. '   ^ used for AlwaysOnTop sub
  158. Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
  159. Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
  160. Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  161. Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  162. Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
  163. '   ^ sets windows regions
  164. Private Type POINTAPI
  165.     X As Long
  166.     Y As Long
  167. End Type
  168. '   ^ an XY type
  169. Const Shape_Rectange = 0
  170. Const Shape_Square = 1
  171. Const Shape_Oval = 2
  172. Const Shape_Circle = 3
  173. Const Shape_RndRectange = 4
  174. Const Shape_RndSquare = 4
  175. '   ^ shape constants
  176. Const conHwndTopmost = -1
  177. Const conHwndNoTopmost = -2
  178. '   ^ top-most constants
  179. Const RGN_AND = 1
  180. Const RGN_COPY = 5
  181. Const RGN_DIFF = 4
  182. Const RGN_OR = 2
  183. Const RGN_XOR = 3
  184. '   ^ region drawing constants
  185. Public UD As Integer
  186. Public LR As Integer
  187. '   ^ variables used in the bouncing timer
  188. Dim MousePos As POINTAPI
  189. Dim Dp As POINTAPI
  190. '   ^ lets you to use the XY type
  191. Dim DoDrag As Boolean
  192. '   ^ is the teddy being dragged?
  193. Private Sub Form_DblClick()
  194.     Unload Me
  195.     '   ^ exit when double clicked
  196. End Sub
  197. Private Sub Form_KeyPress(KeyAscii As Integer)
  198.     Unload Me
  199.     '   ^ exit when keyboard button is pressed
  200. End Sub
  201. Private Sub Form_Load()
  202.     UD = -60
  203.     LR = -60
  204.     '   ^ sets the initial bounce direction
  205.     AlwaysOnTop True
  206.     '   ^ makes sure no other object can be placed over...
  207.     '     ...the teddy
  208.     Dim t, elipHnd(999999) As Long
  209.     Dim n As Integer, eod As Integer
  210.     '   ^ this bit is the variables needed for auto...
  211.     '     ...drawing the forms new regions.
  212.     n = -1
  213.     eod = 0
  214.     '   ^ sets their default value
  215.     For Each t In frmMain
  216.         If ((TypeOf t Is Shape) Or (t.Tag = "3")) And (t.Tag <> "1") Then
  217.             n = n + 1
  218.             eod = eod + 1
  219.             Select Case t
  220.                 Case Shape_Rectange: elipHnd(n) = CreateRectRgn(t.Left / 15, t.Top / 15, (t.Left + t.Width) / 15, (t.Top + t.Height) / 15)
  221.                 Case Shape_Oval: elipHnd(n) = CreateEllipticRgn(t.Left / 15, t.Top / 15, (t.Left + t.Width) / 15, (t.Top + t.Height) / 15)
  222.                 Case Shape_RndRectange: elipHnd(n) = CreateRoundRectRgn(t.Left / 15, t.Top / 15, (t.Left + t.Width) / 15, (t.Top + t.Height) / 15, 10, 10)
  223.              End Select
  224.             If (eod = 2) And (n = 1) Then
  225.                 CombineRgn elipHnd(0), elipHnd(1), elipHnd(0), RGN_OR
  226.                 eod = 0
  227.             End If
  228.             If (eod = 1) And (n <> 0) Then
  229.                 CombineRgn elipHnd(n - 2), elipHnd(n - 1), elipHnd(n), RGN_OR
  230.                 CombineRgn elipHnd(0), elipHnd(0), elipHnd(n - 2), RGN_OR
  231.                 eod = 0
  232.             End If
  233.         End If
  234.     Next t
  235.     SetWindowRgn Me.hwnd, elipHnd(0), True
  236.     '   ^ the best bit! This does the hard work and...
  237.     '     ...creates the regions
  238. End Sub
  239. Private Sub AlwaysOnTop(TOF As Boolean)
  240.     If TOF = True Then
  241.         SetWindowPos hwnd, conHwndTopmost, 0, 0, 0, 0, 3
  242.         '   ^ Turn on the TopMost attribute.
  243.     Else
  244.         SetWindowPos hwnd, conHwndNoTopmost, 0, 0, 0, 0, 3
  245.         '   ^ Turn off the TopMost attribute.
  246.     End If
  247. End Sub
  248. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  249.     If Button = 1 Then
  250.         Me.MousePointer = vbSizePointer
  251.         Dp.X = X
  252.         Dp.Y = Y
  253.         DoDrag = True
  254.     Else
  255.         Unload Me
  256.     End If
  257.     '   ^ the dragging bit!
  258. End Sub
  259. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  260.     If DoDrag Then Me.Move Me.Left + X - Dp.X, Me.Top + Y - Dp.Y
  261.     '   ^ ...and more dragging...
  262. End Sub
  263. Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  264.     DoDrag = False
  265.     Me.MousePointer = Default
  266.     '   ^ the last of the dragging bit!
  267. End Sub
  268. Private Sub Timer1_Timer()
  269.     Me.Top = Me.Top + UD
  270.     Me.Left = Me.Left + LR
  271.     '   ^ move the teddy bare!
  272.     If (Me.Top <= 0) Or (Me.Top + Me.Height >= Screen.Height) Then
  273.         UD = UD - (UD * 2)
  274.         Beep
  275.     End If
  276.     '   ^ bounce if on left or right edge
  277.     If (Me.Left <= 0) Or (Me.Left + Me.Width >= Screen.Width) Then
  278.         LR = LR - (LR * 2)
  279.         Beep
  280.     End If
  281.     '   ^ bounce if on top or bottem edge
  282. End Sub
  283.