公用.bas

一个用能在网页上运行的老虎机flash源程序

Attribute VB_Name = "公用"


'与我发表的老虎机不同的是使用了BitBlt绘图,
'应该说比我的那个还要好,
'

                                'zfc775 07.1.30
                    '有话直接留言 zfc775.ys168.com
 


Option Explicit
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As RasterOpConstants) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Public SCREEN_WIDTH As Integer
Public SCREEN_HEIGHT As Integer
Public Const TILE_WIDTH = 66
Public Const TILE_HEIGHT = 65
Public BackBuffer As Long
Public Map1() As Long
Private Type rect2
left As Integer
bottom As Integer
top As Integer
right As Integer
End Type
Private Type 转圈的参数
  X As Integer
  Y As Integer

End Type
Public Weizhi(23) As 转圈的参数  '这里的23 是 一圈 共24个 格子 ，0-23  =24个



Public Sub 设置参数()
  
    SCREEN_HEIGHT = 390   '这里的 数字 表示 要绘制的总区域大小
    SCREEN_WIDTH = 530
    ReDim Map1(1)
  Dim i As Integer
  Dim j As Integer
    '下面你可以参照实际的图片 算出在哪个位置截图
    '我已经算好了，你不需要改动
   For i = 0 To 7
     Weizhi(i).X = TILE_WIDTH * i
     Weizhi(i).Y = 0
   Next
    j = 0
    For i = 7 To 0 Step -1
     Weizhi(i + 12).X = TILE_WIDTH * j
     Weizhi(i + 12).Y = TILE_HEIGHT * 5
     j = j + 1
    Next
     For i = 1 To 4
     Weizhi(i + 7).Y = TILE_HEIGHT * i
     Weizhi(i + 7).X = TILE_WIDTH * 7
     Next
     j = 1
     For i = 3 To 0 Step -1
     Weizhi(i + 20).Y = TILE_HEIGHT * j
     Weizhi(i + 20).X = 0
     j = j + 1
     Next
 
End Sub

Public Sub 初始内存区()
    
    Dim old As Long
    Dim BackBufferBmp As Long
    Dim FileName As String
     
    Map1(0) = CreateCompatibleDC(Form1.hdc)  '创造兼容的DC
    FileName = App.Path & "\" & "zhutu.bmp"
    old = SelectObject(Map1(0), LoadPicture(FileName))
    'old = 0 表示装载失败,这里应该有个失败处理，我没写，其实很难发生失败的。
    Map1(1) = CreateCompatibleDC(Form1.hdc)
    FileName = App.Path & "\" & "futu.bmp"
    old = SelectObject(Map1(1), LoadPicture(FileName))
   
    '创造一个空的800,600大小的绘图区，所有图片先画到BackBuffer，再把BackBuffer画到屏幕，
    '可以避免闪烁，浪费一点速度.
    BackBuffer = CreateCompatibleDC(Form1.hdc)
    BackBufferBmp = CreateCompatibleBitmap(Form1.hdc, SCREEN_WIDTH, SCREEN_HEIGHT)
    old = SelectObject(BackBuffer, BackBufferBmp)

End Sub

Public Sub 释放内存区()
 Dim i As Integer
  '释放掉创建的图片内存区，（不写也不会发生错误,清扫自己创建的内存垃圾是一种公德)
  For i = 0 To 1
    DeleteDC Map1(i)
  Next
  DeleteDC BackBuffer

End Sub


Public Sub 绘制1层()

Dim k As Boolean, j As Integer, i As Integer, a As Integer, b As Integer, X As Integer, Y As Integer, c As Integer
Dim intX As Integer, intY As Integer
Dim rectTile As rect2

 Static 现在位置 '这个参数其实就是要求拷贝哪张彩色图（亮起来）
                '你完全可以通过控制这个参数达到控制 老虎机 哪个灯亮的目的
 现在位置 = 现在位置 + 1
 If 现在位置 > 23 Then 现在位置 = 0

  
 BitBlt BackBuffer, 0, 0, 530, 390, Map1(0), 0, 0, vbSrcCopy  '把黑白的主图先画上
 BitBlt BackBuffer, Weizhi(现在位置).X + 4, Weizhi(现在位置).Y + 4, TILE_WIDTH - 6, TILE_HEIGHT - 8, Map1(1), Weizhi(现在位置).X + 4, Weizhi(现在位置).Y + 4, vbSrcCopy
 
 
 BitBlt Form1.hdc, 0, 0, SCREEN_WIDTH, SCREEN_HEIGHT, BackBuffer, 0, 0, vbSrcCopy

 DoEvents
 
 '到这里你大概明白委身摸灯 会 转起来了吧， 其实就是在
 '先把一张黑白图片zhutu.bmp 拷贝到屏幕，再把一个futu.bmp 彩色的水果方块,拷贝到
 '相应位置，那摸看起来就 转起来了/
 '我一直有心升级一下老虎机，可没精力了
 '希望你早日写出个 更好的老虎机来。
End Sub