|
|
|
|
|
The Microsoft Visual Basic 6.0 member of
the Microsoft Visual Studio 6.0 |
|
Face Game application ..., describe how to use Microsoft
Visual Basic 6.0 to create game application
The
References
used by system for this application
From the
Project
menu, choose References
..., The
References Face Game.vbp
dialog box appears - List of references available -
cheked ...
|
- Name -
Face Game VB
Net
- Game
Software.
- Developed with
Microsoft Visual Basic 6.0.
- Functions
...
- Arrange boxes
using the mouse
- Demo
Game
|
- Requirements:
Microsoft Visual Basic 6.0.
If
you want to run it:
- Remove the
read-only attribute of all files in the
folder - C:\Face Game VB6
- Run the
Microsoft Visual Basic 6.0
- From
File menu, choose Open Project ..., the
Open Project dialog box appears,
select the project file Face
Game.vbp -
(C:\Face Game VB6\Face
Game .vbp)
and then click Open.
- From Run menu, choose and click
Start.
|
Project - FaceGame and Forms
items
|
|
|
1. |
Create new Visual Basic 6.0 project -
Face Game.vbp
|
1st Step,
the beginning ...
C:\Face Game VB6\Face
Game .vbp
- Create the
folder Face Game VB6 in the C:
drive, C:\Face Game VB6
- Create the
folder Pic in the folder Face Game VB6,
C:\Face Game VB6\Pic.
- Copy all pictures files, from the
...\Face Game VB6\Pic folder, to the
folder C:\Face Game VB6\Pic and remove the read-only
attribute of all files C:\Face Game VB6\Pic - (if exist).
|
2nd Step,
create the wizard Application .
Microsoft Visual Basic Application Wizard:
Programmatically, a Wizard is a form which contains a
variable number of frames (or "steps"), each of which
comprises a step to completing a Wizard’s task.
The Wizard steps ...:
First, run the Microsoft Visual Basic 6
- From the File
menu, choose New Project.
The New
Project dialog box appears, select the VB
Application Wizard icon and then click OK.
- In the Application
Wizard - Introduction dialog box:
- Click
Next.
|
- In the Application
Wizard - Interface Type dialog box:
- Select
Single Document Interface (SDI).
- In
the 'What name do you want for
the application' box, type FaceGame.
- Click
Next.
|
- In the Application
Wizard - Menus dialog box:
- Remove
the 'Edit, View, Window and
Help' Menus. (clear
the check boxes)
- From
File Menu, remove the
Sub Menu items - New, Open,
Close, Save, Save As, Save All,
Properties, Page setup, Print Preview,
Print, Send and MRUList. (clear the check
boxes)
- Click
Next.
|
- In the Applicaction
Wizard - Customize Toolbar dialog box:
- Select 4 Toolbar items
only.
- Click
Next.
|
- In the Applicaction
Wizard - Resource dialog box:
- Select
No. (Would
you like to use a Resource file ...)
- Click
Next.
|
- In the Application
Wizard - Internet Connectivity dialog box:
- Select
No. (Do
you want your user to be able to access
the Internet ...)
- Click
Next.
|
- In the Application
Wizard - Standard Forms dialog box:
- Check
About Box
- Click
Next.
|
- In the Application
Wizard - Data Access Forms dialog box:
- Click Next
|
- In the Data
Form Wizard -Finished! dialog box:
- Click
Finish.
|
-
Application Created
- Click OK.
|
- The application has
been created.
-
Project - FaceGame and Forms
items created by wizard operation
-
frmMain - Form item created
The View Code of frmMain
created
Private Sub Form_Load()
Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer
'close all sub forms
For i = Forms.Count - 1 To 1 Step -1
Unload Forms(i)
Next
If Me.WindowState <> vbMinimized Then
SaveSetting App.Title, "Settings", "MainLeft", Me.Left
SaveSetting App.Title, "Settings", "MainTop", Me.Top
SaveSetting App.Title, "Settings", "MainWidth", Me.Width
SaveSetting App.Title, "Settings", "MainHeight", Me.Height
End If
End Sub
Private Sub tbToolBar_ButtonClick(ByVal Button As MSComCtlLib.Button)
On Error Resume Next
Select Case Button.Key
Case "New"
'ToDo: Add 'New' button code.
MsgBox "Add 'New' button code."
Case "Open"
mnuFileOpen_Click
Case "Paste"
'ToDo: Add 'Paste' button code.
MsgBox "Add 'Paste' button code."
Case "Save"
mnuFileSave_Click
Case "Print"
mnuFilePrint_Click
End Select
End Sub
Private Sub mnuFileExit_Click()
'unload the form
Unload Me
End Sub
Private Sub mnuFileSend_Click()
'ToDo: Add 'mnuFileSend_Click' code.
MsgBox "Add 'mnuFileSend_Click' code."
End Sub
Private Sub mnuFilePrint_Click()
'ToDo: Add 'mnuFilePrint_Click' code.
MsgBox "Add 'mnuFilePrint_Click' code."
End Sub
Private Sub mnuFilePrintPreview_Click()
'ToDo: Add 'mnuFilePrintPreview_Click' code.
MsgBox "Add 'mnuFilePrintPreview_Click' code."
End Sub
Private Sub mnuFilePageSetup_Click()
On Error Resume Next
With dlgCommonDialog
.DialogTitle = "Page Setup"
.CancelError = True
.ShowPrinter
End With
End Sub
Private Sub mnuFileProperties_Click()
'ToDo: Add 'mnuFileProperties_Click' code.
MsgBox "Add 'mnuFileProperties_Click' code."
End Sub
Private Sub mnuFileSaveAll_Click()
'ToDo: Add 'mnuFileSaveAll_Click' code.
MsgBox "Add 'mnuFileSaveAll_Click' code."
End Sub
Private Sub mnuFileSaveAs_Click()
'ToDo: Add 'mnuFileSaveAs_Click' code.
MsgBox "Add 'mnuFileSaveAs_Click' code."
End Sub
Private Sub mnuFileSave_Click()
'ToDo: Add 'mnuFileSave_Click' code.
MsgBox "Add 'mnuFileSave_Click' code."
End Sub
Private Sub mnuFileClose_Click()
'ToDo: Add 'mnuFileClose_Click' code.
MsgBox "Add 'mnuFileClose_Click' code."
End Sub
Private Sub mnuFileOpen_Click()
Dim sFile As String
With dlgCommonDialog
.DialogTitle = "Open"
.CancelError = False
'ToDo: set the flags and attributes of the common dialog control
.Filter = "All Files (*.*)|*.*"
.ShowOpen
If Len(.FileName) = 0 Then
Exit Sub
End If
sFile = .FileName
End With
'ToDo: add code to process the opened file
End Sub
Private Sub mnuFileNew_Click()
'ToDo: Add 'mnuFileNew_Click' code.
MsgBox "Add 'mnuFileNew_Click' code."
End Sub
|
-
frmAbout - Form item created
The View Code of
frmAbout created
' Reg Key
Security Options...
Const KEY_ALL_ACCESS = &H2003F
' Reg Key ROOT Types...
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_DWORD = 4 ' 32-bit number
Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
Const gREGVALSYSINFOLOC = "MSINFO"
Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
Const gREGVALSYSINFO = "PATH"
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA"
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As
Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA"
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As
Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As
Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As
Long) As Long
Private Sub Form_Load()
lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." &
App.Revision
lblTitle.Caption = App.Title
End Sub
Private Sub cmdSysInfo_Click()
Call StartSysInfo
End Sub
Private Sub cmdOK_Click()
Unload Me
End Sub
Public Sub StartSysInfo()
On Error GoTo SysInfoErr
Dim rc As Long
Dim SysInfoPath As String
' Try To Get System Info Program Path\Name From Registry...
If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO,
SysInfoPath) Then
' Try To Get System Info Program Path Only From Registry...
ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC,
gREGVALSYSINFOLOC, SysInfoPath) Then
' Validate Existance Of Known 32 Bit File Version
If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
' Error - File Can Not Be Found...
Else
GoTo SysInfoErr
End If
' Error - Registry Entry Can Not Be Found...
Else
GoTo SysInfoErr
End If
Call Shell(SysInfoPath, vbNormalFocus)
Exit Sub
SysInfoErr:
MsgBox "System Information Is Unavailable At This Time", vbOKOnly
End Sub
Public Function GetKeyValue(KeyRoot As Long, KeyName As String,
SubKeyRef As String, ByRef KeyVal As String) As Boolean
Dim i As Long ' Loop Counter
Dim rc As Long ' Return Code
Dim hKey As Long ' Handle To An Open Registry Key
Dim hDepth As Long '
Dim KeyValType As Long ' Data Type Of A Registry Key
Dim tmpVal As String ' Tempory Storage For A Registry Key Value
Dim KeyValSize As Long ' Size Of Registry Key Variable
'------------------------------------------------------------
' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
'------------------------------------------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open
Registry Key
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Error...
tmpVal = String$(1024, 0) ' Allocate Variable Space
KeyValSize = 1024 ' Mark Variable Size
'------------------------------------------------------------
' Retrieve Registry Key Value...
'------------------------------------------------------------
rc = RegQueryValueEx(hKey, SubKeyRef, 0, KeyValType, tmpVal,
KeyValSize) ' Get/Create Key Value
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Errors
tmpVal = VBA.Left(tmpVal, InStr(tmpVal, VBA.Chr(0)) - 1)
'------------------------------------------------------------
' Determine Key Value Type For Conversion...
'------------------------------------------------------------
Select Case KeyValType ' Search Data Types...
Case REG_SZ ' String Registry Key Data Type
KeyVal = tmpVal ' Copy String Value
Case REG_DWORD ' Double Word Registry Key Data Type
For i = Len(tmpVal) To 1 Step -1 ' Convert Each Bit
KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Build Value Char. By
Char.
Next
KeyVal = Format$("&h" + KeyVal) ' Convert Double Word To String
End Select
GetKeyValue = True ' Return Success
rc = RegCloseKey(hKey) ' Close Registry Key
Exit Function ' Exit
GetKeyError: ' Cleanup After An Error Has Occured...
KeyVal = "" ' Set Return Val To Empty String
GetKeyValue = False ' Return Failure
rc = RegCloseKey(hKey) ' Close Registry Key
End Function
|
- Module1
-Module
item created
Public fMainForm
As frmMain
Sub Main()
Set fMainForm = New frmMain
fMainForm.Show
End Sub |
- Rename the Form items using
the Properties window
From the View menu, click Properties window, the
Properties window
appears
- Rename the Form :
frmMain
to
GameForm
- Rename the Form : frmAbout
to
About_FaceGame
Project - FaceGame and Forms
items
after rename
|
- From the File
menu, choose Save Project, the
Save File As dialog box appears, locate
and select the folder
Face Game VB6 (C:\Face Game VB6 ), and then
click Save - (Book).
Repeat this operation to save all files: About_FaceGame,
GameForm,
Module1 and FaceGame
Note:
if the Source Code
Control dialog box appears, click No.
List of files created - (Working with Projects):
File |
Description |
GameForm.frm |
The main form for the
sample application. |
About_FaceGame.frm |
The form file |
Module1.bas |
Module containing shared
code. |
FaceGame.vbp |
Project file for this
application. |
- To run it; From Run
menu, choose and click Start.
|
| |
2. |
Modify
the Module -
Module1.bas
The Module stores information about all
public variables used in this
application.
delete all code created by wizard and type the following data
|
The codes
delete all
codes created by wizard and type the following data
Public
fGameForm As GameForm
Sub Main()
Set fGameForm = New GameForm
fGameForm.Show
End Sub |
|
|
Set Startup object - Sub
Main
- On the
Project menu , click , the
FaceGame,
Project Property
dialog box appears
- In the
Startup Object combo box, choose and
select Sub Main
- Click
OK
- To save this
application; From File menu, choose and
click Save Project.
| |
3. |
GameForm
a. |
After running, the
following designs display by
order
|
b. |
The Object or
design..
GameForm Form,
delete or replace
all controls created by wizard
list of controls :
From the Toolbox window
add the following controls 1 ImageList
control, 39 Label controls ,1 MainMenu
controls, 10 Frame controls,
2 PictureBox
controls, 1 Image
control, 1 ToolBar
control, 4 Button controls,
1 TextBox control and 7 Timer
controls.
The Functions
...
Arrange boxes using the
mouse
|
c. |
The Codes
...
(delete
all codes created by wizard and type the following codes)
| | |
1. |
DemoForm
a. |
After running, the
following design display when you select
the Toolbar Button DemoForm from GameForm.
|
|
|
b. |
DemoForm,
object and codes
|
|
1. |
Create
new Form
From the Project menu, click Add Form, the Add Form
dialog box appears, select Icon Form
and then click Open, new Form created - name
Form1
Project - FaceGame and Forms
items ...
Rename the Form item - Form1 created using the Properties
window
Rename the Form : Form1
to
DemoForm
Project - FaceGame and Forms
items ...
|
2. |
To DemoForm Form,
add list of
controls :
From the Toolbox window
add the following controls
37 Label controls,
10 Frame controls,
1 PictureBox
control, 1 Image control,
1 Button control, 1 TextBox
control and 3 Timer
controls.
The Functions
... Demo
sample - Show
how this Game work .
|
3. |
The Codes
...
(delete
all codes created by wizard and type the following
codes) |
|
|
|
|
|
|
|
2. |
About_FaceGame Form
a- After running, the following design
display when you select
the Toolbar Button About from
GameForm.
b- The Object or
design..
About_FaceGame Form,
delete or replace all
controls created by wizard
list of controls :
From the Toolbox window
add the following controls 4 Label controls,
3 PictureBox
controls, 2 Button controls,
1 TextBox control and 1 Timer
control.
Click the Button ok,
the current Form
unload
Click the Button System Info,
the information data about system display
c-
The Codes ...
Option Explicit
Dim IcoNmbr As Integer
Const MsglblTitle = "Face Game"
Const MsglblDescription = "Copyright 2003, Chucri S.
Zouein "
Const MsglbPhone = "Lebanon, 01-691436"
Const Msglblres = "Allrights Reserved"
' Reg Key Security Options...
Const KEY_ALL_ACCESS = &H2003F
' Reg Key ROOT Types...
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_DWORD = 4 ' 32-bit number
Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools
Location"
Const gREGVALSYSINFOLOC = "MSINFO"
Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
Const gREGVALSYSINFO = "PATH"
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias
"RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As
String, ByVal ulOptions As Long, ByVal samDesired As Long,
ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32"
Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal
lpValueName As String, ByVal lpReserved As Long, ByRef
lpType As Long, ByVal lpData As String, ByRef lpcbData As
Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal
hKey As Long) As Long
Private Sub cmdOK_Click()
Unload Me
End Sub
Private Sub Form_Load()
'Load icon
Me.Icon = LoadPicture(App.Path & "\Pic\Face.ico")
'Load picture
picico.Picture = LoadPicture(App.Path & "\Pic\Face_Design1.bmp")
picicoOrg(1).Picture = LoadPicture(App.Path & "\Pic\Face_Design2.bmp")
picicoOrg(2).Picture = LoadPicture(App.Path & "\Pic\Face_Design3.bmp")
lblTitle.Caption = MsglblTitle
lblDescription.Caption = MsglblDescription
lbPhone.Caption = MsglbPhone
lblres.Caption = Msglblres
IcoNmbr = 1
Timer1.Interval = 100
Timer1.Enabled = True
End Sub
Private Sub cmdSysInfo_Click()
Call StartSysInfo
End Sub
Public Sub StartSysInfo()
On Error GoTo SysInfoErr
Dim rc As Long
Dim SysInfoPath As String
' Try To Get System Info Program Path\Name From
Registry...
If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO,
gREGVALSYSINFO, SysInfoPath) Then
' Try To Get System Info Program Path Only From
Registry...
ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC,
gREGVALSYSINFOLOC, SysInfoPath) Then
' Validate Existance Of Known 32 Bit File Version
If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
' Error - File Can Not Be Found...
Else
GoTo SysInfoErr
End If
' Error - Registry Entry Can Not Be Found...
Else
GoTo SysInfoErr
End If
Call Shell(SysInfoPath, vbNormalFocus)
Exit Sub
SysInfoErr:
MsgBox "System Information Is Unavailable At This Time",
vbOKOnly
End Sub
Public Function GetKeyValue(KeyRoot As Long, KeyName As
String, SubKeyRef As String, ByRef KeyVal As String) As
Boolean
Dim i As Long ' Loop Counter
Dim rc As Long ' Return Code
Dim hKey As Long ' Handle To An Open Registry Key
Dim hDepth As Long '
Dim KeyValType As Long ' Data Type Of A Registry Key
Dim tmpVal As String ' Tempory Storage For A Registry Key
Value
Dim KeyValSize As Long ' Size Of Registry Key Variable
'------------------------------------------------------------
' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
'------------------------------------------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS,
hKey) ' Open Registry Key
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle
Error...
tmpVal = String$(1024, 0) ' Allocate Variable Space
KeyValSize = 1024 ' Mark Variable Size
'------------------------------------------------------------
' Retrieve Registry Key Value...
'------------------------------------------------------------
rc = RegQueryValueEx(hKey, SubKeyRef, 0, KeyValType,
tmpVal, KeyValSize) ' Get/Create Key Value
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle
Errors
tmpVal = VBA.Left(tmpVal, InStr(tmpVal, VBA.Chr(0)) - 1)
'------------------------------------------------------------
' Determine Key Value Type For Conversion...
'------------------------------------------------------------
Select Case KeyValType ' Search Data Types...
Case REG_SZ ' String Registry Key Data Type
KeyVal = tmpVal ' Copy String Value
Case REG_DWORD ' Double Word Registry Key Data Type
For i = Len(tmpVal) To 1 Step -1 ' Convert Each Bit
KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Build
Value Char. By Char.
Next
KeyVal = Format$("&h" + KeyVal) ' Convert Double Word To
String
End Select
GetKeyValue = True ' Return Success
rc = RegCloseKey(hKey) ' Close Registry Key
Exit Function ' Exit
GetKeyError: ' Cleanup After An Error Has Occured...
KeyVal = "" ' Set Return Val To Empty String
GetKeyValue = False ' Return Failure
rc = RegCloseKey(hKey) ' Close Registry Key
End Function
Private Sub Timer1_Timer()
picico.Picture = picicoOrg(IcoNmbr).Picture
If IcoNmbr = 1 Then
IcoNmbr = 2
ElseIf IcoNmbr = 2 Then
IcoNmbr = 1
End If
End Sub
|
| |
Save and
Run this Game application
- To save this
application; From File menu, choose and
click Save Project.
- To run it; From Run
menu, choose and click Start.
|
|