home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / pixelc1a / main.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-07-30  |  11.0 KB  |  328 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    Caption         =   "
  4. 1999 RL Collision Detection"
  5.    ClientHeight    =   4665
  6.    ClientLeft      =   4170
  7.    ClientTop       =   3210
  8.    ClientWidth     =   6615
  9.    LinkTopic       =   "Form1"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    ScaleHeight     =   4665
  13.    ScaleWidth      =   6615
  14.    StartUpPosition =   2  'CenterScreen
  15.    Begin VB.PictureBox Picture1 
  16.       AutoSize        =   -1  'True
  17.       BorderStyle     =   0  'None
  18.       Height          =   645
  19.       Left            =   4800
  20.       Picture         =   "Main.frx":0000
  21.       ScaleHeight     =   645
  22.       ScaleWidth      =   1710
  23.       TabIndex        =   14
  24.       Top             =   120
  25.       Width           =   1710
  26.    End
  27.    Begin VB.PictureBox picBlank 
  28.       AutoRedraw      =   -1  'True
  29.       AutoSize        =   -1  'True
  30.       Height          =   540
  31.       Left            =   6720
  32.       Picture         =   "Main.frx":0B6C
  33.       ScaleHeight     =   32
  34.       ScaleMode       =   3  'Pixel
  35.       ScaleWidth      =   61
  36.       TabIndex        =   13
  37.       Top             =   3300
  38.       Width           =   975
  39.    End
  40.    Begin VB.PictureBox picCD 
  41.       AutoSize        =   -1  'True
  42.       Height          =   540
  43.       Left            =   5160
  44.       Picture         =   "Main.frx":0EDC
  45.       ScaleHeight     =   32
  46.       ScaleMode       =   3  'Pixel
  47.       ScaleWidth      =   61
  48.       TabIndex        =   8
  49.       Top             =   1440
  50.       Width           =   975
  51.    End
  52.    Begin VB.PictureBox PicBakGnd1 
  53.       AutoRedraw      =   -1  'True
  54.       AutoSize        =   -1  'True
  55.       Height          =   2925
  56.       Left            =   6720
  57.       Picture         =   "Main.frx":124C
  58.       ScaleHeight     =   191
  59.       ScaleMode       =   3  'Pixel
  60.       ScaleWidth      =   302
  61.       TabIndex        =   6
  62.       Top             =   60
  63.       Width           =   4590
  64.    End
  65.    Begin VB.Frame Frame2 
  66.       Height          =   1215
  67.       Left            =   6840
  68.       TabIndex        =   2
  69.       Top             =   4500
  70.       Width           =   2835
  71.       Begin VB.PictureBox picMask 
  72.          AutoRedraw      =   -1  'True
  73.          AutoSize        =   -1  'True
  74.          Height          =   540
  75.          Left            =   1440
  76.          Picture         =   "Main.frx":1867
  77.          ScaleHeight     =   32
  78.          ScaleMode       =   3  'Pixel
  79.          ScaleWidth      =   61
  80.          TabIndex        =   10
  81.          Top             =   240
  82.          Width           =   975
  83.       End
  84.       Begin VB.PictureBox picCharacter 
  85.          AutoRedraw      =   -1  'True
  86.          AutoSize        =   -1  'True
  87.          Height          =   540
  88.          Index           =   0
  89.          Left            =   120
  90.          Picture         =   "Main.frx":1C31
  91.          ScaleHeight     =   32
  92.          ScaleMode       =   3  'Pixel
  93.          ScaleWidth      =   61
  94.          TabIndex        =   3
  95.          Top             =   240
  96.          Width           =   975
  97.       End
  98.    End
  99.    Begin VB.Frame Frame1 
  100.       Height          =   1215
  101.       Left            =   7860
  102.       TabIndex        =   1
  103.       Top             =   3180
  104.       Width           =   2955
  105.       Begin VB.PictureBox picMask1 
  106.          AutoRedraw      =   -1  'True
  107.          AutoSize        =   -1  'True
  108.          Height          =   540
  109.          Left            =   1380
  110.          Picture         =   "Main.frx":2247
  111.          ScaleHeight     =   32
  112.          ScaleMode       =   3  'Pixel
  113.          ScaleWidth      =   61
  114.          TabIndex        =   12
  115.          Top             =   240
  116.          Width           =   975
  117.       End
  118.       Begin VB.PictureBox picCharacter 
  119.          AutoRedraw      =   -1  'True
  120.          AutoSize        =   -1  'True
  121.          Height          =   540
  122.          Index           =   2
  123.          Left            =   180
  124.          Picture         =   "Main.frx":2610
  125.          ScaleHeight     =   480
  126.          ScaleWidth      =   915
  127.          TabIndex        =   11
  128.          Top             =   240
  129.          Width           =   975
  130.       End
  131.    End
  132.    Begin VB.PictureBox picBack 
  133.       AutoRedraw      =   -1  'True
  134.       AutoSize        =   -1  'True
  135.       Height          =   2925
  136.       Left            =   120
  137.       Picture         =   "Main.frx":2C27
  138.       ScaleHeight     =   191
  139.       ScaleMode       =   3  'Pixel
  140.       ScaleWidth      =   302
  141.       TabIndex        =   0
  142.       Top             =   60
  143.       Width           =   4590
  144.    End
  145.    Begin VB.Label Label7 
  146.       Caption         =   $"Main.frx":3242
  147.       Height          =   675
  148.       Left            =   120
  149.       TabIndex        =   17
  150.       Top             =   3960
  151.       Width           =   6435
  152.    End
  153.    Begin VB.Label Label6 
  154.       Caption         =   $"Main.frx":332A
  155.       Height          =   495
  156.       Left            =   120
  157.       TabIndex        =   16
  158.       Top             =   3420
  159.       Width           =   6435
  160.    End
  161.    Begin VB.Label Label5 
  162.       Caption         =   "Hold down the right mouse button inside the pisture and move it around. "
  163.       Height          =   315
  164.       Left            =   120
  165.       TabIndex        =   15
  166.       Top             =   3060
  167.       Width           =   6375
  168.    End
  169.    Begin VB.Label Label4 
  170.       BeginProperty Font 
  171.          Name            =   "MS Sans Serif"
  172.          Size            =   12
  173.          Charset         =   0
  174.          Weight          =   700
  175.          Underline       =   0   'False
  176.          Italic          =   0   'False
  177.          Strikethrough   =   0   'False
  178.       EndProperty
  179.       ForeColor       =   &H000000FF&
  180.       Height          =   255
  181.       Left            =   5160
  182.       TabIndex        =   9
  183.       Top             =   2280
  184.       Width           =   1215
  185.    End
  186.    Begin VB.Label Label3 
  187.       BeginProperty Font 
  188.          Name            =   "MS Sans Serif"
  189.          Size            =   12
  190.          Charset         =   0
  191.          Weight          =   700
  192.          Underline       =   0   'False
  193.          Italic          =   0   'False
  194.          Strikethrough   =   0   'False
  195.       EndProperty
  196.       ForeColor       =   &H000000FF&
  197.       Height          =   255
  198.       Left            =   5160
  199.       TabIndex        =   7
  200.       Top             =   1080
  201.       Width           =   1215
  202.    End
  203.    Begin VB.Label Label2 
  204.       Caption         =   "Pixel"
  205.       Height          =   315
  206.       Left            =   5160
  207.       TabIndex        =   5
  208.       Top             =   2040
  209.       Width           =   555
  210.    End
  211.    Begin VB.Label Label1 
  212.       Caption         =   "Extend"
  213.       Height          =   195
  214.       Left            =   5160
  215.       TabIndex        =   4
  216.       Top             =   840
  217.       Width           =   840
  218.    End
  219.    Begin VB.Menu mnuFile 
  220.       Caption         =   "File"
  221.       Begin VB.Menu mnuExit 
  222.          Caption         =   "Exit"
  223.       End
  224.    End
  225.    Begin VB.Menu mnuHelp 
  226.       Caption         =   "Help"
  227.       Begin VB.Menu mnuAbout 
  228.          Caption         =   "About"
  229.       End
  230.    End
  231. Attribute VB_Name = "frmMain"
  232. Attribute VB_GlobalNameSpace = False
  233. Attribute VB_Creatable = False
  234. Attribute VB_PredeclaredId = True
  235. Attribute VB_Exposed = False
  236. Option Explicit
  237. '============================================================
  238. '== Author  : Richard Lowe
  239. '== Date    : July 99
  240. '== Contact : riklowe@hotmail.com
  241. '============================================================
  242. '== Desciption
  243. '== This program demonstrates how to performs accurate pixel
  244. '== Collisions
  245. '============================================================
  246. '== Version History
  247. '============================================================
  248. '== 1.0  28-July-99  RL  Initial Release.
  249. '============================================================
  250. '------------------------------------------------------------
  251. 'Dimension variables
  252. '------------------------------------------------------------
  253. Dim lTask As Long
  254. Dim MDown As Boolean
  255. Dim bkg(64, 64) As Byte
  256. Dim dwn%
  257. Dim Iwidth As Integer
  258. Dim IHeight As Integer
  259. Dim iMPx As Integer
  260. Dim iMPy As Integer
  261. Private Sub Form_Load()
  262. '------------------------------------------------------------
  263. 'Initialise variables
  264. '------------------------------------------------------------
  265.     Iwidth = picCharacter(0).ScaleWidth
  266.     IHeight = picCharacter(0).ScaleHeight
  267.     iMPx = 100
  268.     iMPy = 50
  269. '------------------------------------------------------------
  270. 'Initialise display
  271. '------------------------------------------------------------
  272.     BitBlt picBack.hdc, 0, 0, PicBakGnd1.Width, PicBakGnd1.Height, PicBakGnd1.hdc, 0, 0, vbSrcCopy
  273.     BitBlt picBack.hdc, iMPx, iMPy, Iwidth, IHeight, picMask1.hdc, 0, 0, vbSrcAnd
  274.     BitBlt picBack.hdc, iMPx, iMPy, Iwidth, IHeight, picCharacter(2).hdc, 0, 0, vbSrcPaint
  275. End Sub
  276. Private Sub mnuAbout_Click()
  277.     frmAbout.Show vbModal
  278. End Sub
  279. Private Sub mnuExit_Click()
  280.     Unload Me
  281. End Sub
  282. Private Sub picBack_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  283.     MDown = True
  284. End Sub
  285. Private Sub picBack_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  286. '------------------------------------------------------------
  287. 'This sub perform the crude BUT FAST extent collision detection.
  288. 'Once this has been detected, the Pixel colision detection
  289. 'function is called.
  290. '------------------------------------------------------------
  291.     If MDown Then
  292. '------------------------------------------------------------
  293. 'Create display
  294. '------------------------------------------------------------
  295.         BitBlt picBack.hdc, 0, 0, PicBakGnd1.Width, PicBakGnd1.Height, PicBakGnd1.hdc, 0, 0, vbSrcCopy
  296.         
  297.         BitBlt picBack.hdc, iMPx, iMPy, Iwidth, IHeight, picMask1.hdc, 0, 0, vbSrcAnd
  298.         BitBlt picBack.hdc, iMPx, iMPy, Iwidth, IHeight, picCharacter(2).hdc, 0, 0, vbSrcPaint
  299.                 
  300.         BitBlt picBack.hdc, x, y, Iwidth, IHeight, picMask.hdc, 0, 0, vbSrcAnd
  301.         BitBlt picBack.hdc, x, y, Iwidth, IHeight, picCharacter(0).hdc, 0, 0, vbSrcPaint
  302.         
  303. '------------------------------------------------------------
  304. 'Detect Extent collisions, and call pixel collision detect function
  305. '------------------------------------------------------------
  306.         If (x + Iwidth > iMPx) And (x < iMPx + Iwidth) And (y + IHeight > iMPy) And (y < iMPy + IHeight) Then
  307.             Label3 = "Collision"
  308.             If CollisionDetect(x, y, picMask, iMPx, iMPy, picMask1, picBlank) Then
  309.                 Label4 = "Collision"
  310.             Else
  311.                 Label4 = ""
  312.             End If
  313.         Else
  314.             BitBlt picCD.hdc, 0, 0, picBlank.ScaleWidth, picBlank.ScaleHeight, picBlank.hdc, 0, 0, vbNotSrcCopy
  315.             Label3 = ""
  316.             Label4 = ""
  317.         End If
  318.         
  319.         picBack.Refresh
  320.     End If
  321. End Sub
  322. Private Sub picBack_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  323.     MDown = False
  324. End Sub
  325. Private Sub Picture1_Click()
  326.     frmAbout.Show vbModal
  327. End Sub
  328.