home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / tile / tiles.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-01-21  |  8.3 KB  |  240 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "Bitmap Tiling Example"
  5.    ClientHeight    =   4575
  6.    ClientLeft      =   2580
  7.    ClientTop       =   2625
  8.    ClientWidth     =   5745
  9.    Height          =   4980
  10.    Left            =   2520
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   4575
  13.    ScaleWidth      =   5745
  14.    Top             =   2280
  15.    Width           =   5865
  16.    Begin Label Label1 
  17.       Alignment       =   2  'Center
  18.       BackColor       =   &H00FFFFFF&
  19.       BackStyle       =   0  'Transparent
  20.       Caption         =   "Drag the tiles above onto the background to form connecting tunnels.  To remove a tile, double-click over it."
  21.       ForeColor       =   &H00000000&
  22.       Height          =   495
  23.       Left            =   240
  24.       TabIndex        =   0
  25.       Top             =   4020
  26.       Width           =   5295
  27.    End
  28.    Begin Image imgTileA 
  29.       Height          =   675
  30.       Index           =   5
  31.       Left            =   4800
  32.       Picture         =   TILES.FRX:0000
  33.       Top             =   3180
  34.       Width           =   675
  35.    End
  36.    Begin Image imgTileA 
  37.       Height          =   675
  38.       Index           =   4
  39.       Left            =   3900
  40.       Picture         =   TILES.FRX:04B2
  41.       Top             =   3180
  42.       Width           =   675
  43.    End
  44.    Begin Shape shpHolder 
  45.       BackColor       =   &H0080FF80&
  46.       BackStyle       =   1  'Opaque
  47.       Height          =   795
  48.       Index           =   5
  49.       Left            =   4740
  50.       Top             =   3120
  51.       Width           =   795
  52.    End
  53.    Begin Shape shpHolder 
  54.       BackColor       =   &H0080FF80&
  55.       BackStyle       =   1  'Opaque
  56.       Height          =   795
  57.       Index           =   4
  58.       Left            =   3840
  59.       Top             =   3120
  60.       Width           =   795
  61.    End
  62.    Begin Image imgTileA 
  63.       Height          =   675
  64.       Index           =   3
  65.       Left            =   3000
  66.       Picture         =   TILES.FRX:0964
  67.       Top             =   3180
  68.       Width           =   675
  69.    End
  70.    Begin Image imgTileA 
  71.       Height          =   675
  72.       Index           =   2
  73.       Left            =   2100
  74.       Picture         =   TILES.FRX:0E16
  75.       Top             =   3180
  76.       Width           =   675
  77.    End
  78.    Begin Image imgTileA 
  79.       Height          =   675
  80.       Index           =   1
  81.       Left            =   1200
  82.       Picture         =   TILES.FRX:12C8
  83.       Top             =   3180
  84.       Width           =   675
  85.    End
  86.    Begin Shape shpHolder 
  87.       BackColor       =   &H0080FF80&
  88.       BackStyle       =   1  'Opaque
  89.       Height          =   795
  90.       Index           =   3
  91.       Left            =   2940
  92.       Top             =   3120
  93.       Width           =   795
  94.    End
  95.    Begin Shape shpHolder 
  96.       BackColor       =   &H0080FF80&
  97.       BackStyle       =   1  'Opaque
  98.       Height          =   795
  99.       Index           =   2
  100.       Left            =   2040
  101.       Top             =   3120
  102.       Width           =   795
  103.    End
  104.    Begin Shape shpHolder 
  105.       BackColor       =   &H0080FF80&
  106.       BackStyle       =   1  'Opaque
  107.       Height          =   795
  108.       Index           =   1
  109.       Left            =   1140
  110.       Top             =   3120
  111.       Width           =   795
  112.    End
  113.    Begin Image imgTileA 
  114.       Height          =   675
  115.       Index           =   0
  116.       Left            =   300
  117.       Picture         =   TILES.FRX:177A
  118.       Top             =   3180
  119.       Width           =   675
  120.    End
  121.    Begin Shape shpHolder 
  122.       BackColor       =   &H0080FF80&
  123.       BackStyle       =   1  'Opaque
  124.       Height          =   795
  125.       Index           =   0
  126.       Left            =   240
  127.       Top             =   3120
  128.       Width           =   795
  129.    End
  130.    Begin Shape shpBox 
  131.       BackColor       =   &H0080FF80&
  132.       BackStyle       =   1  'Opaque
  133.       Height          =   2700
  134.       Left            =   180
  135.       Top             =   180
  136.       Width           =   5400
  137.    End
  138. Option Explicit
  139. '--------------------------------------------------
  140. ' TILES.FRM
  141. '--------------------------------------------------
  142. ' There's one base tile for each tile picture.
  143. Const LAST_BASE_TILE = 5
  144. ' Boolean indicating if we're currently dragging
  145. ' an object.
  146. Dim Dragging As Integer
  147. ' Used while dragging an object.
  148. Dim Ofs As tPoint
  149. ' The index of the next image to be created in
  150. ' the imgTile control array.
  151. Dim NextImage As Integer
  152. Sub CenterXY (Ctrl As Control, APoint As tPoint)
  153. '--------------------------------------------------
  154. ' Find the center coordinates for this control.
  155. '--------------------------------------------------
  156.     APoint.X = (Ctrl.Width / 2) + Ctrl.Left
  157.     APoint.Y = (Ctrl.Height / 2) + Ctrl.Top
  158. End Sub
  159. Sub Form_Load ()
  160. '--------------------------------------------------
  161. ' Initialize the next image counter, used to
  162. ' load tile controls on the fly.
  163. '--------------------------------------------------
  164.     NextImage = LAST_BASE_TILE + 1
  165. End Sub
  166. Sub imgTileA_DblClick (Index As Integer)
  167. '--------------------------------------------------
  168. ' Double-clicking on a placed tile makes it
  169. ' disappear.  We do this by simply unloading
  170. ' the control.
  171. '--------------------------------------------------
  172.     ' Don't unload a base tile!
  173.     If Index > LAST_BASE_TILE Then
  174.         Unload imgTileA(Index)
  175.     End If
  176. End Sub
  177. Sub imgTileA_MouseDown (Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  178. '--------------------------------------------------
  179. ' If the mouse is held down over an object, prepare
  180. ' to drag that object.
  181. '--------------------------------------------------
  182.     If Index > LAST_BASE_TILE Then Exit Sub
  183.     Dragging = True
  184.     Ofs.X = X
  185.     Ofs.Y = Y
  186. End Sub
  187. Sub imgTileA_MouseMove (Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  188. '--------------------------------------------------
  189. ' Drag an object if the mouse is clicked and
  190. ' dragged over it.
  191. '--------------------------------------------------
  192.     If Index > LAST_BASE_TILE Then Exit Sub
  193.     If Dragging Then
  194.         imgTileA(Index).Move imgTileA(Index).Left + (X - Ofs.X), imgTileA(Index).Top + (Y - Ofs.Y)
  195.     End If
  196. End Sub
  197. Sub imgTileA_MouseUp (Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  198. '--------------------------------------------------
  199. ' End the drag process and create and position
  200. ' the new tile.
  201. '--------------------------------------------------
  202. Dim Center As tPoint
  203.     If Index > LAST_BASE_TILE Then Exit Sub
  204.     Dragging = False
  205.     ' Calculate the center coordinates for the tile.
  206.     CenterXY imgTileA(Index), Center
  207.     ' If the user has placed the tile inside the background,
  208.     ' then create a new tile control and place it on the
  209.     ' background.
  210.     If InsideControl(shpBox, Center) Then
  211.         ' Create a new image control to drop at this location
  212.         Load imgTileA(NextImage)
  213.         imgTileA(NextImage).Picture = imgTileA(Index).Picture
  214.         
  215.         ' Adjust the control's position so that it "jumps"
  216.         ' to the nearest tile boundary.
  217.         imgTileA(NextImage).Left = shpBox.Left + (imgTileA(Index).Width * (Center.X \ imgTileA(Index).Width))
  218.         imgTileA(NextImage).Top = shpBox.Top + (imgTileA(Index).Height * (Center.Y \ imgTileA(Index).Height))
  219.         imgTileA(NextImage).Visible = True
  220.         ' Make sure the tile is on top of the background,
  221.         ' not hiding underneath it!
  222.         imgTileA(NextImage).ZOrder 0
  223.         NextImage = NextImage + 1
  224.     End If
  225.     ' Move the base tile back to its holding position.
  226.     imgTileA(Index).Left = shpHolder(Index).Left + 60
  227.     imgTileA(Index).Top = shpHolder(Index).Top + 60
  228. End Sub
  229. Function InsideControl (Ctrl As Control, APoint As tPoint)
  230. '--------------------------------------------------
  231. ' Is the point Apoint inside Control Ctrl?
  232. '--------------------------------------------------
  233.     InsideControl = False
  234.     If (APoint.X >= Ctrl.Left) And (APoint.X <= (Ctrl.Left + Ctrl.Width)) Then
  235.         If (APoint.Y >= Ctrl.Top) And (APoint.Y <= (Ctrl.Top + Ctrl.Height)) Then
  236.             InsideControl = True
  237.         End If
  238.     End If
  239. End Function
  240.