game.frm

VOD卡拉OK点歌系统源码

VERSION 5.00
Begin VB.Form game 
   BackColor       =   &H00008000&
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   5370
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   6960
   LinkTopic       =   "Form1"
   ScaleHeight     =   5370
   ScaleWidth      =   6960
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command4 
      Caption         =   "返回"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   2760
      MouseIcon       =   "game.frx":0000
      MousePointer    =   99  'Custom
      TabIndex        =   7
      Top             =   4680
      Width           =   1575
   End
   Begin VB.CommandButton Command3 
      Caption         =   "下页"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   4080
      MouseIcon       =   "game.frx":030A
      MousePointer    =   99  'Custom
      TabIndex        =   6
      Top             =   3960
      Width           =   1575
   End
   Begin VB.CommandButton Command2 
      Caption         =   "上页"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   1440
      MouseIcon       =   "game.frx":0614
      MousePointer    =   99  'Custom
      TabIndex        =   5
      Top             =   3960
      Width           =   1575
   End
   Begin VB.CommandButton Command1 
      BackColor       =   &H0000C000&
      Caption         =   "空中接龙"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   18
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Index           =   4
      Left            =   1440
      MaskColor       =   &H0080FFFF&
      MouseIcon       =   "game.frx":091E
      MousePointer    =   99  'Custom
      TabIndex        =   4
      Top             =   3120
      Width           =   4215
   End
   Begin VB.CommandButton Command1 
      BackColor       =   &H0000C000&
      Caption         =   "空中接龙"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   18
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Index           =   3
      Left            =   1440
      MaskColor       =   &H0080FFFF&
      MouseIcon       =   "game.frx":0C28
      MousePointer    =   99  'Custom
      TabIndex        =   3
      Top             =   2400
      Width           =   4215
   End
   Begin VB.CommandButton Command1 
      BackColor       =   &H0000C000&
      Caption         =   "空中接龙"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   18
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Index           =   2
      Left            =   1440
      MaskColor       =   &H0080FFFF&
      MouseIcon       =   "game.frx":0F32
      MousePointer    =   99  'Custom
      TabIndex        =   2
      Top             =   1680
      Width           =   4215
   End
   Begin VB.CommandButton Command1 
      BackColor       =   &H0000C000&
      Caption         =   "空中接龙"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   18
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Index           =   1
      Left            =   1440
      MaskColor       =   &H0080FFFF&
      MouseIcon       =   "game.frx":123C
      MousePointer    =   99  'Custom
      TabIndex        =   1
      Top             =   960
      Width           =   4215
   End
   Begin VB.CommandButton Command1 
      BackColor       =   &H0000C000&
      Caption         =   "空中接龙"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   18
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Index           =   0
      Left            =   1440
      MaskColor       =   &H0080FFFF&
      MouseIcon       =   "game.frx":1546
      MousePointer    =   99  'Custom
      TabIndex        =   0
      Top             =   240
      Width           =   4215
   End
End
Attribute VB_Name = "game"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function GetPrivateProfileString Lib "Kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, lpKeyName As Any, ByVal lpDefault As String, ByVal lpRetunedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "Kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lplFileName As String) As Long

Private r As Long
Private entry As String
Private iniPath As String
Function GetFromINI(AppName As String, KeyName As String, FileName As String) As String
   Dim RetStr As String
   RetStr = String(255, Chr(0))
   GetFromINI = Left(RetStr, GetPrivateProfileString(AppName, ByVal KeyName, "", RetStr, Len(RetStr), FileName))
End Function

Private Sub Command1_Click(Index As Integer)
On Error GoTo e:
Shell Command1(Index).ToolTipText
e:
MsgBox ("游戏不存在或其它错误")
End Sub

Private Sub Command2_Click()
If gamepage > 0 Then
gamepage = gamepage - 1
Call gamev
End If
End Sub

Private Sub Command3_Click()
If gamepage < 1 Then
gamepage = gamepage + 1
Call gamev
End If
End Sub

Private Sub Command4_Click()
Unload game
End Sub

Private Sub Form_Load()
Dim i
gamepage = 0
iniPath$ = App.Path + "\game.ini"
For i = 0 To 9
gamesz(i).gamename = GetFromINI("gamename", CStr(i + 1), iniPath)
gamesz(i).gamepath = GetFromINI("gameexe", CStr(i + 1), iniPath)
Next i
Call gamev
End Sub
Public Sub gamev()
Dim i
For i = 0 To 4
Command1(i).Caption = gamesz(i + gamepage * 5).gamename
Command1(i).ToolTipText = gamesz(i + gamepage * 5).gamepath
Next i
End Sub