Характеристика логічних ігор. Комп’ютерні логічні ігри
До логічних ігор належать головоломки - пасьянси, кросворди, судоку, а також багато антагоністичних настільних ігор.
Настільні ігри проводяться з використанням певних ігрових комплектів - дошок та фігур. Серед популярних настільних ігор: шахи, шашки, нарди, го тощо. Зазвичай це антагоністичні ігри зі складною стратегією.
В комп'ютерних іграх правила закладені в комп'ютерній програмі, а супротивником виступає або сама програма або, при грі через комп'ютерну мережу, інші люди.
Комп'ютерна гра, як різновид звичайних ігор, має широке поширення.
Класифікація комп'ютерних ігор детально не розроблена, проте з всього їх різноманіття можна виділити:
- Логічні ігри (стратегії, "квести");
- Навчальні та розвиваючі ігри (головоломки, мозаїки);
- Динамічні ігри типу ДІЙ ("стрілялки", RPG, гонки).
"Стрілялки", "гонки", "бродилки (RPG)", "стратегії", "квести" - спеціалізована термінологія створена для поділу на підгрупи основних видів комп'ютерних ігор. Дана термінологія використовувалася в багатьох наукових статтях і неодноразово згадувалася в глобальній мережі Інтернет, а кампанії зі створення комп'ютерних ігор нерідко використовують її для опису гри.
Переважна більшість комп'ютерних ігор має позитивний вплив на розвиток дітей. Дитина вчиться координувати свої дії в мінливій ситуації, виробляти відповідні тактику і стратегію гри. Крім того, сама гра може бути спрямована на навчання гравця або використовуватися як тренажер. Однак у комп'ютерних ігор є і негативні сторони. Підліток, поглинений віртуальними фокусами, може мати проблеми в спілкуванні з однолітками. Надмірне захоплення іграми може призвести до зниження у дитини її здатності до вольового зусилля. У збуджуваних дітей комп'ютерні ігри можуть створювати психологічні перевантаження, так як багато ігор досить складні і не завжди відповідають віку дитини. У таких іграх дитина рідко добивається добрих результатів, що викликає у них дискомфорт і відчуття власної неповноцінності.
|
|
Аналізуючи все вищесказане, можна сказати, що комп'ютерні ігри з часом стають невід'ємною частиною життя сучасної людини. Вони мають свої позитивні і негативні сторони. Серед комп'ютерних ігор логічні ігри мають безліч плюсів в порівнянні з іншими. До логічних ігор відносяться різні стратегії і "квести" (у перекладі з англійської - "питання"). Стратегії відносяться до ділових ігор, а квести до дидактичних.
У математиці ігри – це клас математичних задач, предметом яких є прийняття рішень. Вивченню ігр присвячений розділ математики Теорія ігор. Характерним для даного класу задач завданням є вибір стратегії, яка забезпечила б найкращий результат для умовних гравців.
|
|
Логічна настільна гра 15
П'ятнашки - популярна головоломка, придумана в 1878 році Ноєм Чепмен. Являє собою набір однакових квадратних кісточок з нанесеними числами, укладених в квадратну коробку. Довжина сторони коробки в чотири рази більше довжини сторони кісточок для набору з 15 елементів (і в три рази більше для набору в 8 елементів), відповідно в коробці залишається незаповненим одне квадратне поле. Мета гри - переміщаючи кісточки по коробці домогтися упорядкування їх за номерами, бажано зробивши якомога менше перемещеній.
Історія створення
З 1891 року до самої смерті Семюель Лойд вважав, що винайшов головоломку саме він. Проте існують докази того, що він був непричетний до створення «пятнашек». Справжнім винахідником був Ной Палмер Чепмен, поштмейстер з Канастоти, який ще в 1874 році показував друзям головоломку, що складається з шістнадцяти пронумерованих квадратиків, які треба було скласти в ряди по чотири штуки так, щоб сума чисел в кожному рядку була рівна 34. Потім син Ноя Чепмена, Френк Чепмен привіз допрацьовані головоломки в Сіракузи (штат Нью-Йорк), а потім в Хартфорд (Коннектикут), де слухачі Американської школи для слабочуючих почали виробництво головоломки. До 1879 року вона вже продавалася не тільки в Хартфорді, але і в Бостоні. Тоді про «п'ятнашки» дізнався художник по дереву Маттіас Райс. У грудні 1879 року він почав бізнес з виробництва нової головоломки під назвою «Дорогоцінна головоломка» (англ. Gem Puzzle). На початку 1880 року якийсь Чарльз Певі, дантист з Вустера, привернув увагу громадськості, запропонував грошову винагороду за вирішення завдання збирання головоломки, що додало популярності нової забаві. Навесні того ж року гра досягла Європи. 21 лютого 1880 Ной Чепмен спробував оформити патент на свій винахід (патент називався «Головоломка з діамантових блоків», «Блок Пасьянс Puzzle»), проте заявка на патент була відхилена, так як мало відрізнялася від вже оформленого трьома роками раніше патенту «Хитрі блоки »,« Puzzle-Blocks».
|
|
Математичний опис
П'ятнашки представляють собою класичну задачу для моделювання евристичних алгоритмів. Зазвичай задачу вирішують через кількість переміщень і пошук манхеттенської відстані між кожною кісточкою та її позицією у зібраній головоломці. Для розв’язування використовуються алгоритми на зразок алгоритму А*.
|
|
Можна показати, що рівно половину з усіх можливих 1 307 674 368 000 (= 15!) початкових положень п’ятнашок неможливо привести до зібраного увазі: нехай квадратик з числом i розташований до (якщо вважати зліва направо і зверху вниз) до k квадратиків з числами меншими i . Будемо вважати ni = k, тобто якщо після кісточки з i-м числом немає чисел, менших i, то k = 0. Також введемо число e - номер ряду порожньої клітини (рахуючи з 1). Якщо сума є непарною, то рішення головоломки не існує.
Якщо допустити поворот коробки на 90 градусів, при якому зображення цифр виявляться лежачими на боці, то можна перевести нерозв'язні комбінації в розв'язні (і навпаки). Таким чином, якщо замість цифр на кісточки нанести точки і не фіксувати положення коробки, то нерозв'язних комбінацій взагалі не знайдеться.
РОЗДІЛ ІІІ. ВИКОРИСТАННЯ VISUAL BASIC 6.0 ПРИ СТВОРЕННІ ПРОГРАМНИХ ЛОГІЧНИХ ІГОР
(на прикладі гри «пятнашки»)
Загальні положення
Для моделювання процесу гри було обрано класичний її варіант: квадратна таблиця 4х4, одна з клітинок порожня, інші пронумеровані від 1 до 15.
Мета гри – переставляючи числа в клітинках, використовуючи порожню, добитися такого розміщення чисел в клітинках, щоб клітинки були пронумеровані за зростанням в порядку зліва направо і зверху вниз. Для моделювання таблиці вибрано компонент вікно форми. Для моделювання фішок або кісточок – пронумерованих елементів, – обрано елемент «кнопка», напис на якій відповідає номеру фішки.
Функціональність програми:
– при завантаженні програми кнопки «випадковим» чином нумеруються;
– при натисканні кнопки, що межує з порожнім місцем, вона «пересувається » на порожнє місце, і її попередня позиція стає вільною;
– при встановленні фішок–кнопок на свої місця виводиться відповідне повідомлення;
Загальний алгоритм програми можна описати так:
1. Початкові налаштування:
– встановлюється режим арабських цифр;
– відстань між кнопками;
– ініціалізується генератор випадкових чисел.
2. загальний цикл програми, в якому здійснюється виклик процедур за такими подіями:
Подія | Опис | Підпрограма |
Зміна розміру вікна програми | Змінюється розмір всіх кнопок | Form_Resize() |
Натиснення на кнопку | «Пересування» кнопки на вільне місце | Command1_Click(Index As Integer) |
Обрання пункту меню Гра|Почати | Кнопки розташовуються в початковому стані(вільне місце справа знизу) і нумеруються випадковим чином за поточним режимом нумерації | itemGameNew_Click() |
Обрання пункту меню Гра|Вихід | Закінчення роботи програми | itemGameExit_Click() |
Обрання пункту меню Параметри|Символи|1,2,3,4 | Змінюється режим виведення нумерації кнопок на арабські цифри | itemParamSymbolDigit_Click() |
Обрання пункту меню Параметри|Символи|I,II,III,IV | Змінюється режим виведення нумерації кнопок на римську нумерацію | itemParamSymbolRom_Click() |
Обрання пункту меню Параметри|Символи|A,B,C,D | Змінюється режим виведення нумерації кнопок на латинські літери | itemParamSymbolEnglish_Click() |
Обрання пункту меню Довідка|Про програму | Виведення вікна з відомостями про програму | itemHelpProg_Click() |
Обрання пункту меню Довідка|Про гру | Виведення вікна з відомостями про гру | itemHelpGame_Click() |
Структура проекту
Проект складається з таких файлів:
Назва файла | Опис вмісту |
15.vbp 15.vbw | Дані, які описують проект в цілому: які форми задіяні, як під’єднуються, параметри робочої області |
frmMain.frm | Властивості головної форми, константи, змінні величини, тексти процедур та функцій |
frmAboutProg.frm | Властивості форми про програму, константи, змінні величини, тексти процедур та функцій |
frmAboutProg.frx | Дані про малюнок, який виводиться на формі |
frmAboutGame.frm | Властивості форми про гру, константи, змінні величини, тексти процедур та функцій |
frmAboutGame.frx | Дані про малюнок, який виводиться на формі |
Хід роботи програми
Після запуску програми перед нами з’являється головне вікно.
Рисунок 3.3.1. Головне вікно програми
За замовчуванням нумерація кнопок здійснюється арабськими цифрами, кнопки нумеруються «випадковим чином», вікно програми позиціонується в центрі екрану і має стиль «нормальний», тобто займає не увесь екран а лише частину.
Розміри вікна можна змінювати як за допомогою меж вікна, так і за допомогою системних кнопок заголовка. При цьому, розміри кнопок відповідно змінюються, так як і розмір шрифту написів нумерації.
Рисунок 3.3.2. Вікно програми, розкрите на весь екран
При натисненні на кнопку, яка межує з вільним місцем, відбувається її «переміщення»: де була кнопка місце звільняється, сама кнопка стає на вільне місце. Якщо натиснута кнопка не межує з вільним місцем, нічого не відбувається.
Можна змінювати написи на кнопках, обираючи відповідний пункт меню Параметри|Символи…
Рисунок 3.3.3. Нумерація кнопок римськими цифрами
Рисунок 3.3.4. Нумерація кнопок латинськими літерами
При обранні пункту меню Гра|Почати нумерація кнопок здійснюється випадковим чином саме в тому режимі, який був до цього обраний.
Обравши пункти меню Допомога, можна отримати відомості про програму, і про саму гру.
Рисунок 3.3.5. Відомості про програму і її автора
Рисунок 3.3.6. Історичні відомості про гру 15
Після правильного розставлення кнопок, на екран виводить вікно з відомостями про кількість виконаних пересувань кнопок.
Для завершення роботи програми потрібно обрати пункт меню Гра|Вихід.
Програмні і апаратні вимоги
Для забезпечення нормальної роботи програми необхідні такі мінімальні вимоги до програмного і апаратного забезпечення:
- процесор з тактовою частотою 1ГГц, 32-розрядний(x86);
- оперативна пам`ять 512 мегабайт (МБ) або більше;
- 500 Мбайт вільного місця на жорсткому диску;
- операційна система Windows XP/Vista/7.
ВИСНОВКИ
Під час роботи над дослідженням здійснено:
– поглиблення знань з мови програмування Visual Basic;
– набуто практичних навиків і уміння роботи в середовищі розробки Microsoft Visual Basic 6.0;
– опрацювання літературних і інтернет джерел з теми гри, знайдено відомі класифікації ігор взагалі, окремо комп’ютерних ігор, логічних ігор;
– опрацьовано відомості щодо логічної гри 15, її історичний розвиток, математичне обґрунтування існування розв’язку;
В результаті виконання вище описаних дій було створено комп’ютерну програму, яка моделює гру 15. На основі отриманих відомостей про умови існування розв’язку про розстановки фішок, у програмі передбачено правильну їх нумерацію перед початком гри, та відслідковування закінчення гри.
Комп’ютерна програма написана в середовищі програмування Microsoft Visual Basic 6.0 з використанням основ об’єктно-орієнтованого програмування. При написанні програми, велику увагу приділено простоті та зручності її використання.
СПИСОК ВИКОРИСТАНИХ ДЖЕРЕЛ
1. Интерактивный учебник по Visual Basic http://msdn.microsoft.com/ru-ru/library/90h82b3x(v=vs.90).aspx
2. Великий тлумачний словник сучасної української мови/Уклад. І голов. Ред.. В.Т. Бусел.–К., Ірпінь: ВТФ «Перун», 2004.–1440 с.
3. Український Радянський Енциклопедичний Словник. У 3-х т. / За ред. М. Бажана. – 1966—1968.
4. Йоган Гейзинга. Homo Ludens. Досвід визначення ігрового елемента культури., Київ: «Основи», 1994 (укр.)
5. http://www.ru.wikipedia.org/wiki/Пятнашки
6. http://uk.wikipedia.org/wiki/Настільна гра
7. Использование Visual Basic 6. Классическое издание | Брайан Сайлер, Джефф Споттс.2007.
8. С.Браун. Visual Basic 6: учебный курс /Пер. с англ. — С-Пб.: "Питер", 1999. — 576 с., ISBN 5-8046-0054-0
ДОДАТКИ
Файл 15.vbp
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\system32\stdole2.tlb#OLE Automation
Form=frmMain.frm
Form=frmAboutGame.frm
Form=frmAboutProg.frm
IconForm="frmMain"
Startup="frmMain"
HelpFile=""
Title="15"
Command32=""
Name="prj15"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="вфвф"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
DebugStartupOption=0
Файл 15.vbw
frmMain = 29, 39, 785, 684, , 217, 13, 1001, 526, C
frmAboutGame = 234, 73, 878, 476, C, -55, 286, 685, 908, C
frmAboutProg = 66, 87, 657, 535, , 124, 35, 657, 481, C
Файл frmMain.frm
VERSION 5.00
Begin VB.Form frmMain
BackColor = &H80000013&
Caption = "15"
ClientHeight = 3975
ClientLeft = 165
ClientTop = 450
ClientWidth = 5340
LinkTopic = "Form1"
ScaleHeight = 198.75
ScaleMode = 2 'Point
ScaleWidth = 267
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton Command1
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Index = 15
Left = 3960
TabIndex = 15
Tag = "16"
Top = 3000
Visible = 0 'False
Width = 1200
End
Begin VB.CommandButton Command1
Caption = "15"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Index = 14
Left = 2640
TabIndex = 14
Tag = "15"
Top = 3000
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "14"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Index = 13
Left = 1320
TabIndex = 13
Tag = "14"
Top = 3000
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "13"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Index = 12
Left = 0
TabIndex = 12
Tag = "13"
Top = 3000
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "12"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Index = 11
Left = 3960
TabIndex = 11
Tag = "12"
Top = 2040
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "11"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Index = 10
Left = 2640
TabIndex = 10
Tag = "11"
Top = 2040
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "10"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Index = 9
Left = 1320
TabIndex = 9
Tag = "10"
Top = 2040
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "9"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Index = 8
Left = 0
TabIndex = 8
Tag = "9"
Top = 2040
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "8"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Index = 7
Left = 3960
TabIndex = 7
Tag = "8"
Top = 1080
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "7"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Index = 6
Left = 2640
TabIndex = 6
Tag = "7"
Top = 1080
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "6"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Index = 5
Left = 1320
TabIndex = 5
Tag = "6"
Top = 1080
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "5"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Index = 4
Left = 0
TabIndex = 4
Tag = "5"
Top = 1080
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "4"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Index = 3
Left = 3960
TabIndex = 3
Tag = "4"
Top = 120
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "3"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Index = 2
Left = 2640
TabIndex = 2
Tag = "3"
Top = 120
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "2"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Index = 1
Left = 1320
TabIndex = 1
Tag = "2"
Top = 120
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "1"
BeginProperty Font
Name = "Times New Roman"
Size = 8.25
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Index = 0
Left = 0
TabIndex = 0
Tag = "1"
Top = 120
Width = 1215
End
Begin VB.Menu itemGame
Caption = "Гра"
Begin VB.Menu itemGameNew
Caption = "Почати"
End
Begin VB.Menu itemGameExit
Caption = "Вихід"
End
End
Begin VB.Menu itemParam
Caption = "Параметри"
Begin VB.Menu itemParamSymbol
Caption = "Символи"
Begin VB.Menu itemParamSymbolDigit
Caption = "1, 2, 3, 4..."
End
Begin VB.Menu itemParamSymbolRom
Caption = "I, II, III,IV..."
End
Begin VB.Menu itemParamSymbolEnglish
Caption = "A, B, C, D..."
End
End
End
Begin VB.Menu itemHelp
Caption = "Довідка"
Begin VB.Menu itemHelpProg
Caption = "Про програму"
End
Begin VB.Menu itemHelpGame
Caption = "Про гру"
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim modeS As Integer
'1 - digit
'2 - roma
'3 - latin
Dim dist As Integer
Private Sub it_Click()
End Sub
Private Sub itemParamSymbolEnglish_Click()
modeS = 3
For Each t In Command1
If t.Visible Then t.Caption = Chr(t.Tag + 64)
Next t
End Sub
Private Sub Command1_Click(Index As Integer)
Dim n As Integer
Dim s As String
Dim w As Integer
n = -1
If ((Index + 1) Mod 4) <> 0 Then
If Not Command1(Index + 1).Visible Then n = Index + 1
End If
If (Index Mod 4) <> 0 Then
If Not Command1(Index - 1).Visible Then n = Index - 1
End If
If Index > 3 Then
If Not Command1(Index - 4).Visible Then n = Index - 4
End If
If Index < 12 Then
If Not Command1(Index + 4).Visible Then n = Index + 4
End If
If n >= 0 Then
Command1(n).Visible = True
Command1(Index).Visible = False
s = Command1(n).Caption
w = Command1(n).Tag
Command1(n).Caption = Command1(Index).Caption
Command1(n).Tag = Command1(Index).Tag
Command1(Index).Caption = s
Command1(Index).Tag = w
End If
End Sub
Private Sub itemGameExit_Click()
End
End Sub
Private Sub Form_Load()
Randomize
modeS = 1
dist = 5
itemGameNew_Click
End Sub
Private Sub Form_Resize()
Dim w, h, i, j As Integer
w = (frmMain.ScaleWidth - 5 * dist) \ 4
h = (frmMain.ScaleHeight - 5 * dist) \ 4
For i = 1 To 4
For j = 1 To 4
Command1((i - 1) * 4 + j - 1).Left = j * dist + w * (j - 1)
Command1((i - 1) * 4 + j - 1).Top = i * dist + h * (i - 1)
Command1((i - 1) * 4 + j - 1).Width = w
Command1((i - 1) * 4 + j - 1).Height = h
Next j
Next i
Dim k As Integer
For k = 0 To 15
Command1(k).FontSize = Command1(k).Height / 2
Next k
End Sub
Private Sub itemGameNew_Click()
Dim a(1 To 16) As Integer
Dim x As Integer
Dim i As Integer
Dim k As Integer
Dim t As Integer
Dim yes As Boolean
For i = 0 To 14
Command1(i).Visible = True
Next i
Command1(15).Visible = False
For x = 1 To 16
a(x) = 0
Next x
k = 0
For t = 1 To 15
yes = True
Do While yes
x = Int(15 * Rnd + 1)
yes = False
For i = 1 To k
If a(i) = x Then yes = True
Next i
Loop
k = k + 1
a(k) = x
Command1(t - 1).Caption = x
Command1(t - 1).Tag = x
Next t
Select Case modeS
Case 1
itemParamSymbolDigit_Click
Case 2
itemParamSymbolRom_Click
Case 3
itemParamSymbolEnglish_Click
End Select
End Sub
Private Sub itemParamSymbolDigit_Click()
modeS = 1
For Each t In Command1
t.Caption = t.Tag
Next t
End Sub
Private Sub hist_Click()
Label1.Visible = True
End Sub
Private Sub Text1_Change()
End Sub
Private Sub itemHelpGame_Click()
frmAboutGame.Visible = True
End Sub
Private Sub itemHelpProg_Click()
frmAboutProg.Visible = True
End Sub
Private Sub itemParamSymbolRom_Click()
Dim n As Integer
modeS = 2
For Each t In Command1
If t.Visible Then
n = t.Tag
Select Case n
Case 1
t.Caption = "I"
Case 2
t.Caption = "II"
Case 3
t.Caption = "III"
Case 4
t.Caption = "IV"
Case 5
t.Caption = "V"
Case 6
t.Caption = "VI"
Case 7
t.Caption = "VII"
Case 8
t.Caption = "VIII"
Case 9
t.Caption = "IX"
Case 10
t.Caption = "X"
Case 11
t.Caption = "XI"
Case 12
t.Caption = "XII"
Case 13
t.Caption = "XIII"
Case 14
t.Caption = "XIV"
Case 15
t.Caption = "XV"
End Select
End If
Next t
End Sub
Файл frmAboutProg.frm
VERSION 5.00
Begin VB.Form frmAboutProg
BorderStyle = 3 'Fixed Dialog
Caption = "About MyApp"
ClientHeight = 3090
ClientLeft = 2340
ClientTop = 1935
ClientWidth = 5730
ClipControls = 0 'False
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2132.773
ScaleMode = 0 'User
ScaleWidth = 5380.766
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin VB.PictureBox picIcon
AutoSize = -1 'True
ClipControls = 0 'False
Height = 1260
Left = 120
Negotiate = -1 'True
Picture = "frmAboutProg.frx":0000
ScaleHeight = 80
ScaleMode = 3 'Pixel
ScaleWidth = 80
TabIndex = 1
Top = 240
Width = 1260
End
Begin VB.CommandButton cmdOK
Cancel = -1 'True
Caption = "OK"
Default = -1 'True
Height = 345
Left = 4320
TabIndex = 0
Top = 2625
Width = 1260
End
Begin VB.Line Line1
BorderColor = &H00808080&
BorderStyle = 6 'Inside Solid
Index = 1
X1 = 84.515
X2 = 5309.398
Y1 = 1687.583
Y2 = 1687.583
End
Begin VB.Label lblDescription
Caption = "Програмний засіб розроблено 2011 року."
ForeColor = &H00000000&
Height = 450
Left = 1530
TabIndex = 2
Top = 1125
Width = 3885
End
Begin VB.Label lblTitle
ForeColor = &H00000000&
Height = 480
Left = 1560
TabIndex = 4
Top = 240
Width = 3885
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
BorderWidth = 2
Index = 0
X1 = 98.6
X2 = 5309.398
Y1 = 1697.936
Y2 = 1697.936
End
Begin VB.Label lblVersion
Height = 225
Left = 1530
TabIndex = 5
Top = 780
Width = 3885
End
Begin VB.Label lblDisclaimer
Caption = "Автор програми Чорноморець Роман В'ячеславович"
ForeColor = &H00000000&
Height = 345
Left = 1440
TabIndex = 3
Top = 1920
Width = 4215
End
End
Attribute VB_Name = "frmAboutProg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' Reg Key Security Options...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
' 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 cmdSysInfo_Click()
Call StartSysInfo
End Sub
Private Sub cmdOK_Click()
Unload Me
End Sub
Private Sub Form_Load()
Me.Caption = "About " & App.Title
lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
lblTitle.Caption = App.Title
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
If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 Adds Null Terminated String...
tmpVal = Left(tmpVal, KeyValSize - 1) ' Null Found, Extract From String
Else ' WinNT Does NOT Null Terminate String...
tmpVal = Left(tmpVal, KeyValSize) ' Null Not Found, Extract String Only
End If
'------------------------------------------------------------
' 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
Файл frmAboutProg.frm
VERSION 5.00
Begin VB.Form frmAboutGame
BorderStyle = 3 'Fixed Dialog
Caption = "Про програму"
ClientHeight = 6525
ClientLeft = 2340
ClientTop = 1935
ClientWidth = 10530
ClipControls = 0 'False
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4503.671
ScaleMode = 0 'User
ScaleWidth = 9888.215
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Visible = 0 'False
Begin VB.PictureBox picIcon
AutoSize = -1 'True
ClipControls = 0 'False
Height = 3360
Left = 120
Picture = "frmAboutGame.frx":0000
ScaleHeight = 2317.7
ScaleMode = 0 'User
ScaleWidth = 2317.7
TabIndex = 1
Top = 120
Width = 3360
End
Begin VB.CommandButton cmdOK
Cancel = -1 'True
Caption = "OK"
Default = -1 'True
Height = 345
Left = 8520
TabIndex = 0
Top = 6000
Width = 1260
End
Begin VB.Label Label2
Caption = $"frmAboutGame.frx":2F482
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2055
Left = 240
TabIndex = 3
Top = 3720
Width = 10215
End
Begin VB.Label Label1
Caption = $"frmAboutGame.frx":2F706
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3255
Left = 3960
TabIndex = 2
Top = 120
Width = 6375
End
End
Attribute VB_Name = "frmAboutGame"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' Reg Key Security Options...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
' 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 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
If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 Adds Null Terminated String...
tmpVal = Left(tmpVal, KeyValSize - 1) ' Null Found, Extract From String
Else ' WinNT Does NOT Null Terminate String...
tmpVal = Left(tmpVal, KeyValSize) ' Null Not Found, Extract String Only
End If
'------------------------------------------------------------
' 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 lblDescription_Click()
nd Sub
Private Sub lblDisclaimer_Click()
End Sub
Дата добавления: 2018-06-27; просмотров: 427; Мы поможем в написании вашей работы! |
Мы поможем в написании ваших работ!