VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form Mainfrm 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Экономист"
   ClientHeight    =   9210
   ClientLeft      =   150
   ClientTop       =   900
   ClientWidth     =   9060
   Icon            =   "Mainfrm.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   9210
   ScaleWidth      =   9060
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   240
      Top             =   7800
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      Filter          =   "*.sav"
   End
   Begin VB.CommandButton NextDay 
      Caption         =   "Следующий день"
      Height          =   975
      Left            =   1463
      TabIndex        =   51
      ToolTipText     =   "Нажмите эту кнопку, когда вы закончите все дела в этом дне."
      Top             =   7920
      Width           =   6135
   End
   Begin VB.Frame Frames 
      Height          =   5895
      Index           =   3
      Left            =   480
      TabIndex        =   22
      Top             =   1680
      Visible         =   0   'False
      Width           =   8175
      Begin MSComCtl2.UpDown Flatud 
         Height          =   375
         Left            =   5880
         TabIndex        =   78
         Top             =   3960
         Width           =   270
         _ExtentX        =   476
         _ExtentY        =   661
         _Version        =   393216
         Enabled         =   -1  'True
      End
      Begin VB.CommandButton SellHousebtn 
         Caption         =   "Продать дом"
         Height          =   375
         Left            =   360
         TabIndex        =   44
         Top             =   5400
         Width           =   2655
      End
      Begin VB.CommandButton SellFlatbtn 
         Caption         =   "Продать квартиру"
         Height          =   375
         Left            =   360
         TabIndex        =   43
         Top             =   4200
         Width           =   2655
      End
      Begin VB.CommandButton SellCarbtn 
         Caption         =   "Продать машину"
         Height          =   375
         Left            =   240
         TabIndex        =   42
         Top             =   1920
         Width           =   2655
      End
      Begin VB.CommandButton UpgradeHouse 
         Caption         =   "Улучшить дом"
         Height          =   495
         Left            =   3840
         TabIndex        =   39
         ToolTipText     =   "Улучшить ваш дом"
         Top             =   4800
         Width           =   2175
      End
      Begin VB.TextBox Flattxb 
         Height          =   375
         Left            =   3840
         TabIndex        =   36
         ToolTipText     =   "Здесь отображается количество комнат у вашей квартиры."
         Top             =   3960
         Width           =   2055
      End
      Begin VB.CommandButton ByCar 
         Caption         =   "Роллс-Ройс"
         Height          =   495
         Index           =   4
         Left            =   3840
         TabIndex        =   29
         Top             =   2880
         Width           =   2055
      End
      Begin VB.CommandButton ByCar 
         Caption         =   "Мерседес"
         Height          =   495
         Index           =   3
         Left            =   3840
         TabIndex        =   28
         Top             =   2280
         Width           =   2055
      End
      Begin VB.CommandButton ByCar 
         Caption         =   "Kia"
         Height          =   495
         Index           =   2
         Left            =   3840
         TabIndex        =   27
         Top             =   1680
         Width           =   2055
      End
      Begin VB.CommandButton ByCar 
         Caption         =   "Жигули"
         Height          =   495
         Index           =   1
         Left            =   3840
         TabIndex        =   26
         Top             =   1080
         Width           =   2055
      End
      Begin VB.CommandButton ByCar 
         Caption         =   "Ока"
         Height          =   495
         Index           =   0
         Left            =   3840
         TabIndex        =   25
         Top             =   480
         Width           =   2055
      End
      Begin VB.Label FlatUpgrade 
         Caption         =   "700000"
         Height          =   375
         Left            =   6240
         TabIndex        =   41
         Top             =   3960
         Width           =   1455
      End
      Begin VB.Label PriceUpgradeHouselbl 
         Caption         =   "15000"
         Height          =   495
         Left            =   6360
         TabIndex        =   40
         Top             =   4920
         Width           =   1095
      End
      Begin VB.Label Houselbl 
         Height          =   495
         Left            =   360
         TabIndex        =   38
         Top             =   5040
         Width           =   3495
      End
      Begin VB.Label Label7 
         Caption         =   "Дом (цена):"
         Height          =   495
         Left            =   360
         TabIndex        =   37
         Top             =   4680
         Width           =   3375
      End
      Begin VB.Label Label6 
         Caption         =   "Квартира. Количество комнат:"
         Height          =   495
         Left            =   360
         TabIndex        =   35
         Top             =   3960
         Width           =   3375
      End
      Begin VB.Label Bcar 
         Caption         =   "1500000"
         Height          =   495
         Index           =   4
         Left            =   6120
         TabIndex        =   34
         Top             =   3000
         Width           =   1695
      End
      Begin VB.Label Bcar 
         Caption         =   "600000"
         Height          =   495
         Index           =   3
         Left            =   6120
         TabIndex        =   33
         Top             =   2400
         Width           =   1695
      End
      Begin VB.Label Bcar 
         Caption         =   "350000"
         Height          =   495
         Index           =   2
         Left            =   6120
         TabIndex        =   32
         Top             =   1800
         Width           =   1695
      End
      Begin VB.Label Bcar 
         Caption         =   "210000"
         Height          =   495
         Index           =   1
         Left            =   6120
         TabIndex        =   31
         Top             =   1200
         Width           =   1695
      End
      Begin VB.Label Bcar 
         Caption         =   "100000"
         Height          =   495
         Index           =   0
         Left            =   6120
         TabIndex        =   30
         Top             =   600
         Width           =   1695
      End
      Begin VB.Label MyCarlbl 
         Height          =   615
         Left            =   360
         TabIndex        =   24
         Top             =   600
         Width           =   2055
      End
      Begin VB.Label Label5 
         Caption         =   "Машина:"
         Height          =   495
         Left            =   360
         TabIndex        =   23
         Top             =   360
         Width           =   1815
      End
   End
   Begin VB.Frame Frames 
      Height          =   5895
      Index           =   2
      Left            =   480
      TabIndex        =   19
      Top             =   1680
      Visible         =   0   'False
      Width           =   8175
      Begin VB.CommandButton praybtn 
         Caption         =   "Помолиться"
         Height          =   495
         Left            =   2280
         TabIndex        =   21
         ToolTipText     =   "Помолиться господу Богу."
         Top             =   2520
         Width           =   3135
      End
      Begin VB.CommandButton Donatebtn 
         Caption         =   "Пожертвовать 10"
         Height          =   495
         Left            =   2280
         TabIndex        =   20
         ToolTipText     =   "Пожертвовать 10. Вдруг это принесёт вам удачу."
         Top             =   1680
         Width           =   3135
      End
   End
   Begin VB.Frame Frames 
      Height          =   5895
      Index           =   1
      Left            =   480
      TabIndex        =   17
      Top             =   1680
      Visible         =   0   'False
      Width           =   8175
      Begin VB.Frame TapeMeasurefrm 
         Caption         =   "Рулетка"
         Height          =   4215
         Left            =   2760
         TabIndex        =   58
         Top             =   240
         Width           =   5175
         Begin VB.CommandButton TapeMeasureRatecmd 
            Caption         =   "Нечётные"
            Height          =   495
            Index           =   3
            Left            =   3480
            TabIndex        =   67
            ToolTipText     =   "Поставить на все нечётные"
            Top             =   3120
            Width           =   1575
         End
         Begin VB.CommandButton TapeMeasureRatecmd 
            Caption         =   "Чётные"
            Height          =   495
            Index           =   2
            Left            =   3480
            TabIndex        =   66
            ToolTipText     =   "Поставить на все чётные"
            Top             =   2520
            Width           =   1575
         End
         Begin VB.CommandButton TapeMeasureRatecmd 
            Caption         =   "Чёрные"
            Height          =   495
            Index           =   1
            Left            =   3480
            TabIndex        =   65
            ToolTipText     =   "Поставить на все чёрные"
            Top             =   1920
            Width           =   1575
         End
         Begin VB.CommandButton TapeMeasureRatecmd 
            Caption         =   "Красные"
            Height          =   495
            Index           =   0
            Left            =   3480
            TabIndex        =   64
            ToolTipText     =   "Поставить на все красные"
            Top             =   1320
            Width           =   1575
         End
         Begin VB.CommandButton StartRuletkabtn 
            Caption         =   "Запуск шарика"
            Height          =   495
            Left            =   240
            TabIndex        =   63
            ToolTipText     =   "Всё, ставки сделаны, можно запустить шарик."
            Top             =   3600
            Width           =   3135
         End
         Begin VB.PictureBox TapeMeasurePic 
            ForeColor       =   &H00FFFFFF&
            Height          =   2175
            Left            =   240
            ScaleHeight     =   141
            ScaleMode       =   3  'Pixel
            ScaleWidth      =   205
            TabIndex        =   62
            ToolTipText     =   "Щёлкните мышкой на числе, чтобы поставить на него."
            Top             =   1440
            Width           =   3135
         End
         Begin VB.TextBox ratetxb 
            Height          =   375
            Left            =   240
            TabIndex        =   60
            Text            =   "10"
            ToolTipText     =   $"Mainfrm.frx":030A
            Top             =   600
            Width           =   1575
         End
         Begin VB.Label RateInfolbl 
            Caption         =   "Вы ставите на:"
            Height          =   495
            Left            =   240
            TabIndex        =   61
            Top             =   1080
            Width           =   2415
         End
         Begin VB.Label Label4 
            Caption         =   "Ваша ставка:"
            Height          =   495
            Left            =   240
            TabIndex        =   59
            Top             =   360
            Width           =   1575
         End
      End
      Begin VB.Frame OneHandfrm 
         Caption         =   "Однорукий бандит"
         Height          =   2175
         Left            =   240
         TabIndex        =   18
         Top             =   480
         Width           =   1695
         Begin VB.CommandButton Start1HandBamdbtn 
            Caption         =   "Запуск"
            Height          =   375
            Left            =   120
            TabIndex        =   57
            ToolTipText     =   "Запустить однорукого бандита."
            Top             =   1680
            Width           =   1455
         End
         Begin VB.Label Label9 
            Caption         =   "Ставка - 10"
            Height          =   375
            Left            =   120
            TabIndex        =   54
            Top             =   240
            Width           =   1455
         End
         Begin VB.Image OneHand 
            Height          =   495
            Index           =   2
            Left            =   1080
            Top             =   720
            Width           =   495
         End
         Begin VB.Image OneHand 
            Height          =   495
            Index           =   1
            Left            =   600
            Top             =   720
            Width           =   495
         End
         Begin VB.Image OneHand 
            Height          =   495
            Index           =   0
            Left            =   120
            Top             =   720
            Width           =   495
         End
      End
      Begin VB.Label Label10 
         Caption         =   "Выигрыш:"
         Height          =   375
         Left            =   240
         TabIndex        =   56
         Top             =   4680
         Width           =   2175
      End
      Begin VB.Label WinInfolbl 
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   204
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   735
         Left            =   240
         TabIndex        =   55
         ToolTipText     =   "Здесь отображаются результаты игры."
         Top             =   5040
         Width           =   7575
      End
      Begin VB.Image OneHandimg 
         Height          =   480
         Index           =   0
         Left            =   240
         Picture         =   "Mainfrm.frx":03C6
         Top             =   2880
         Visible         =   0   'False
         Width           =   480
      End
      Begin VB.Image OneHandimg 
         Height          =   480
         Index           =   3
         Left            =   840
         Picture         =   "Mainfrm.frx":06D0
         Top             =   3600
         Visible         =   0   'False
         Width           =   480
      End
      Begin VB.Image OneHandimg 
         Height          =   480
         Index           =   2
         Left            =   240
         Picture         =   "Mainfrm.frx":09DA
         Top             =   3480
         Visible         =   0   'False
         Width           =   480
      End
      Begin VB.Image OneHandimg 
         Height          =   480
         Index           =   1
         Left            =   840
         Picture         =   "Mainfrm.frx":0CE4
         Top             =   3000
         Visible         =   0   'False
         Width           =   480
      End
   End
   Begin VB.Frame Frames 
      Height          =   5895
      Index           =   0
      Left            =   480
      TabIndex        =   1
      Top             =   1680
      Width           =   8175
      Begin VB.TextBox NumbersOfCountactToBuytxt 
         Height          =   495
         Left            =   3360
         TabIndex        =   76
         Text            =   "1"
         ToolTipText     =   "Введите здесь какое-нибудь число, и вы будете покупать по столько акций, сколько ввели в это окно"
         Top             =   5280
         Width           =   1695
      End
      Begin MSComCtl2.UpDown UpDownA 
         Height          =   375
         Index           =   0
         Left            =   6480
         TabIndex        =   69
         Top             =   1440
         Width           =   270
         _ExtentX        =   476
         _ExtentY        =   661
         _Version        =   393216
         Enabled         =   -1  'True
      End
      Begin VB.TextBox Countactxb 
         Enabled         =   0   'False
         Height          =   375
         Index           =   5
         Left            =   3600
         TabIndex        =   50
         Text            =   "0000"
         Top             =   4440
         Width           =   2900
      End
      Begin VB.TextBox Countactxb 
         Enabled         =   0   'False
         Height          =   375
         Index           =   4
         Left            =   3600
         TabIndex        =   46
         Text            =   "0000"
         Top             =   3840
         Width           =   2900
      End
      Begin VB.TextBox Countactxb 
         Enabled         =   0   'False
         Height          =   375
         Index           =   3
         Left            =   3600
         TabIndex        =   16
         Text            =   "0000"
         Top             =   3240
         Width           =   2900
      End
      Begin VB.TextBox Countactxb 
         Enabled         =   0   'False
         Height          =   375
         Index           =   2
         Left            =   3600
         TabIndex        =   15
         Text            =   "0000"
         Top             =   2640
         Width           =   2900
      End
      Begin VB.TextBox Countactxb 
         Enabled         =   0   'False
         Height          =   375
         Index           =   1
         Left            =   3600
         TabIndex        =   14
         Text            =   "0000"
         Top             =   2040
         Width           =   2900
      End
      Begin VB.TextBox Countactxb 
         Enabled         =   0   'False
         Height          =   375
         Index           =   0
         Left            =   3600
         TabIndex        =   13
         Text            =   "0000"
         Top             =   1440
         Width           =   2900
      End
      Begin MSComCtl2.UpDown UpDownA 
         Height          =   375
         Index           =   1
         Left            =   6480
         TabIndex        =   70
         Top             =   2040
         Width           =   270
         _ExtentX        =   476
         _ExtentY        =   661
         _Version        =   393216
         Enabled         =   -1  'True
      End
      Begin MSComCtl2.UpDown UpDownA 
         Height          =   375
         Index           =   2
         Left            =   6480
         TabIndex        =   71
         Top             =   2640
         Width           =   270
         _ExtentX        =   476
         _ExtentY        =   661
         _Version        =   393216
         Enabled         =   -1  'True
      End
      Begin MSComCtl2.UpDown UpDownA 
         Height          =   375
         Index           =   3
         Left            =   6480
         TabIndex        =   72
         Top             =   3240
         Width           =   270
         _ExtentX        =   476
         _ExtentY        =   661
         _Version        =   393216
         Enabled         =   -1  'True
      End
      Begin MSComCtl2.UpDown UpDownA 
         Height          =   375
         Index           =   4
         Left            =   6480
         TabIndex        =   73
         Top             =   3840
         Width           =   270
         _ExtentX        =   476
         _ExtentY        =   661
         _Version        =   393216
         Enabled         =   -1  'True
      End
      Begin MSComCtl2.UpDown UpDownA 
         Height          =   375
         Index           =   5
         Left            =   6480
         TabIndex        =   74
         ToolTipText     =   "С помощью этих кнопок вы можете покупать и продавать акции"
         Top             =   4440
         Width           =   270
         _ExtentX        =   476
         _ExtentY        =   661
         _Version        =   393216
         Enabled         =   -1  'True
      End
      Begin VB.Label Label12 
         Caption         =   "акций"
         Height          =   495
         Left            =   5160
         TabIndex        =   77
         Top             =   5280
         Width           =   1455
      End
      Begin VB.Label Label11 
         Caption         =   "Покупать по"
         Height          =   375
         Left            =   1680
         TabIndex        =   75
         Top             =   5280
         Width           =   1575
      End
      Begin VB.Label Pricelbl 
         Caption         =   "7000"
         Height          =   495
         Index           =   5
         Left            =   2160
         TabIndex        =   49
         Top             =   4440
         Width           =   1335
      End
      Begin VB.Label Companieslbl 
         Caption         =   "ОАО ""Русская механика"""
         Height          =   735
         Index           =   5
         Left            =   240
         TabIndex        =   48
         Top             =   4440
         Width           =   1695
      End
      Begin VB.Label Pricelbl 
         Caption         =   "6000"
         Height          =   495
         Index           =   4
         Left            =   2160
         TabIndex        =   47
         Top             =   3840
         Width           =   1335
      End
      Begin VB.Label Companieslbl 
         Caption         =   "ОАО ""Слободская спичечная фабрика ""Белка"""""
         Height          =   735
         Index           =   4
         Left            =   240
         TabIndex        =   45
         Top             =   3720
         Width           =   1695
      End
      Begin VB.Label Label3 
         Caption         =   "У вас имеется"
         Height          =   495
         Left            =   3720
         TabIndex        =   12
         Top             =   720
         Width           =   1455
      End
      Begin VB.Label Pricelbl 
         Caption         =   "5000"
         Height          =   495
         Index           =   3
         Left            =   2160
         TabIndex        =   11
         Top             =   3240
         Width           =   1335
      End
      Begin VB.Label Pricelbl 
         Caption         =   "10000"
         Height          =   495
         Index           =   2
         Left            =   2160
         TabIndex        =   10
         Top             =   2640
         Width           =   1335
      End
      Begin VB.Label Pricelbl 
         Caption         =   "25000"
         Height          =   495
         Index           =   1
         Left            =   2160
         TabIndex        =   9
         Top             =   2040
         Width           =   1335
      End
      Begin VB.Label Pricelbl 
         Caption         =   "50000"
         Height          =   495
         Index           =   0
         Left            =   2160
         TabIndex        =   8
         Top             =   1440
         Width           =   1335
      End
      Begin VB.Label Label2 
         Caption         =   "цена 1 акции"
         Height          =   495
         Left            =   2160
         TabIndex        =   7
         Top             =   720
         Width           =   1455
      End
      Begin VB.Label Label1 
         Caption         =   "Компании:"
         Height          =   495
         Left            =   240
         TabIndex        =   6
         Top             =   720
         Width           =   2175
      End
      Begin VB.Label Companieslbl 
         Caption         =   "РосАвиаКосмос"
         Height          =   375
         Index           =   3
         Left            =   240
         TabIndex        =   5
         Top             =   3240
         Width           =   1935
      End
      Begin VB.Label Companieslbl 
         Caption         =   "ОАО ""Акконд"""
         Height          =   375
         Index           =   2
         Left            =   240
         TabIndex        =   4
         Top             =   2640
         Width           =   1935
      End
      Begin VB.Label Companieslbl 
         Caption         =   "АвтоВАЗ"
         Height          =   375
         Index           =   1
         Left            =   240
         TabIndex        =   3
         Top             =   2040
         Width           =   1935
      End
      Begin VB.Label Companieslbl 
         Caption         =   "Газпром"
         Height          =   375
         Index           =   0
         Left            =   240
         TabIndex        =   2
         Top             =   1440
         Width           =   1935
      End
   End
   Begin MSComctlLib.TabStrip Tabtsp 
      Height          =   6735
      Left            =   240
      TabIndex        =   0
      Tag             =   "1"
      Top             =   1080
      Width           =   8535
      _ExtentX        =   15055
      _ExtentY        =   11880
      MultiRow        =   -1  'True
      _Version        =   393216
      BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} 
         NumTabs         =   4
         BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "Биржа"
            Object.ToolTipText     =   "Здесь вы можете поиграть на бирже"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "Казино"
            Object.ToolTipText     =   "Здесь вы можете поиграть на рулетке и одноруком бандите и выиграть (или проиграть) огромную сумму денег"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "Храм"
            Object.ToolTipText     =   "Здесь вы можете помолиться господу Богу"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab4 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "Собственность"
            Object.ToolTipText     =   "Здесь вы можете купить себе машину, квартиру, дом"
            ImageVarType    =   2
         EndProperty
      EndProperty
   End
   Begin VB.Label CurrentDatelbl 
      Height          =   615
      Left            =   3840
      TabIndex        =   68
      ToolTipText     =   "Текущая дата в игре"
      Top             =   120
      Width           =   4935
   End
   Begin VB.Label Moneylbl 
      Height          =   495
      Left            =   240
      TabIndex        =   53
      ToolTipText     =   "Ваши деньги"
      Top             =   480
      Width           =   3375
   End
   Begin VB.Label Label8 
      Caption         =   "Деньги:"
      Height          =   375
      Left            =   240
      TabIndex        =   52
      Top             =   120
      Width           =   3375
   End
   Begin VB.Menu Game 
      Caption         =   "&Игра"
      Index           =   0
      Begin VB.Menu New 
         Caption         =   "&Новая"
         Index           =   2
         Shortcut        =   {F2}
      End
      Begin VB.Menu Load 
         Caption         =   "&Продолжить сохранённую ранее игру"
         Index           =   3
         Shortcut        =   ^O
      End
      Begin VB.Menu Save 
         Caption         =   "&Сохранить игру"
         Index           =   4
         Shortcut        =   ^S
      End
      Begin VB.Menu Exit 
         Caption         =   "Вы&ход"
         Index           =   5
         Shortcut        =   ^Q
      End
   End
   Begin VB.Menu Help 
      Caption         =   "&Помощь"
      Index           =   6
      Begin VB.Menu About 
         Caption         =   "О игре..."
         Index           =   7
         Shortcut        =   {F1}
      End
   End
End
Attribute VB_Name = "Mainfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim LastSelecteditem As Byte, inflation As Currency, money As Long, TapeMeasureRate As Byte
Const MAX_SHARE = 5
Dim PriceShare(MAX_SHARE) As Long, ShareCount(MAX_SHARE) As Long
Const NumberSize = 26, MAX_FLAT = 10
Dim Fortune As Byte, MyCar As Integer, Flat As Byte, House As Long
Dim PlayerName As String * 80
Dim CurrentDate As Date
Option Explicit

Private Sub Birga_DragDrop(Source As Control, X As Single, Y As Single)

End Sub

Private Sub StatusBar1_PanelClick(ByVal Panel As MSComctlLib.Panel)

End Sub

Private Sub Image1_Click()

End Sub

Private Sub About_Click(Index As Integer)
    frmAbout.Show
End Sub

'Private Sub About_Click()
'    frmAbout.Show
'End Sub

Private Sub ByCar_Click(Index As Integer)
If MyCar >= 0 Then money = money + Val(Bcar(MyCar).Caption):
    If money >= Val(Bcar(Index).Caption) Then
        MyCar = Index: money = money - Val(Bcar(Index).Caption)
        SellCarbtn.Enabled = True
    Else
        MsgBox "У вас не хватает денег.", vbOKOnly, "У вас мало денег."
        If MyCar >= 0 Then money = money - Val(Bcar(MyCar).Caption)
    End If
   If MyCar >= 0 Then MyCarlbl.Caption = ByCar(MyCar).Caption
    Moneylbl.Caption = Str(money)
End Sub

Private Sub Donatebtn_Click()
Randomize Timer
    money = money - 10
    Moneylbl.Caption = Str(money)
    If Rnd() > 0.995 Then
        MsgBox "И ВЫ УСЛЫШАЛИ ГЛАСЪ БОЖИЙ: ""Получи божью благодать, сыне мой..."" ", vbOKOnly, "ГЛАС БОЖИЙ": MsgBox "В тот же вечер вы нашли 1000 денег", vbOKOnly, "Вот удача": money = money + 1000: Moneylbl.Caption = Str(money)
    Else
        If Rnd() > 0.995 Then MsgBox """И да будет сопутствовать тебе удача, сын мой."" - сказал священник,"
    End If
    
    
End Sub
Sub Flatud_MyChange(UD As Integer)
    If money >= UD * Val(FlatUpgrade.Caption) And Flat + UD < MAX_FLAT Then Flat = Flat + UD: money = money - UD * Val(FlatUpgrade.Caption)
Moneylbl.Caption = Str(money)
Flattxb.Text = Str(Flat)
End Sub

Private Sub Exit_Click(Index As Integer)
    End
End Sub

Private Sub Flattxb_Change()
If Val(Flattxb.Text) > 0 Then SellFlatbtn.Enabled = True
End Sub

Private Sub flatud_DownClick()
If Flat > 0 Then Call Flatud_MyChange(-1)
End Sub

Private Sub flatud_UpClick()
Call Flatud_MyChange(1)

End Sub

Private Sub Form_Load()
LastSelecteditem = 1

Dim n As Integer
For n = 1 To MAX_SHARE
UpDownA(n).ToolTipText = UpDownA(0).ToolTipText
Next
NewGame
End Sub
Sub NewGame()
money = 100000
Start1HandBamdbtn.Enabled = True
StartRuletkabtn.Enabled = True

CurrentDate = Now
Fortune = 0
ratetxb.Text = 10
WinInfolbl = ""
MyCar = -1
MyCarlbl.Caption = ""
SellCarbtn.Enabled = False
SellFlatbtn.Enabled = False
SellHousebtn.Enabled = True
Flat = 0
House = 1
praybtn.Enabled = True
Moneylbl.Caption = Str(money)
Dim n As Integer
    PriceShare(0) = 50000
    PriceShare(1) = 25000
    PriceShare(2) = 10000
    PriceShare(3) = 5000
    PriceShare(4) = 6000
    PriceShare(5) = 7000
    
    For n = 0 To MAX_SHARE
    Pricelbl(n).Caption = Str(PriceShare(n))
    Next
    
    Bcar(0).Caption = Str(100000)
    Bcar(1).Caption = Str(210000)
    Bcar(2).Caption = Str(350000)
    Bcar(3).Caption = Str(600000)
    Bcar(4).Caption = Str(1500000)
    
    FlatUpgrade.Caption = Str(700000)
    PriceUpgradeHouselbl.Caption = Str(15000)
    Houselbl.Caption = Str(House * Val(PriceUpgradeHouselbl.Caption))
End Sub

Private Sub Houselbl_Change()
If House > 0 Then SellHousebtn.Enabled = True
End Sub

Private Sub Load_Click(Index As Integer)
CommonDialog1.CancelError = True
On Error GoTo errorLoad_click
    CommonDialog1.CancelError = True
    Call CommonDialog1.ShowOpen
    
    
    If CommonDialog1.FileName = "" Then Exit Sub
        LoadGame (CommonDialog1.FileName)
        UpdatePricelbl
        UpgradeShareCount
        Moneylbl.Caption = Str(money)
        If MyCar >= 0 Then
            MyCarlbl.Caption = ByCar(MyCar).Caption
        Else
            MyCarlbl.Caption = ""
        End If
        SellCarbtn.Enabled = False
        If MyCar >= 0 Then SellCarbtn.Enabled = True
        Flattxb.Text = Str(Flat)
        Houselbl.Caption = Str(House * Val(PriceUpgradeHouselbl.Caption))
errorLoad_click:
End Sub
Sub LoadGame(fname As String)
On Error GoTo LoadError
    Dim fnum1 As Integer, n As Integer, m As Integer
n = 1
fnum1 = FreeFile
        Open fname For Binary As fnum1
            Get #fnum1, n, money: n = n + Len(money)
            Get #fnum1, n, MyCar: n = n + Len(MyCar)
            Get #fnum1, n, Fortune: n = n + Len(Fortune)
            Get #fnum1, n, Flat: n = n + Len(Flat)
            Get #fnum1, n, House: n = n + Len(House)
            For m = 0 To MAX_SHARE
            Get #fnum1, n, ShareCount(m): n = n + Len(ShareCount(m))
            Get #fnum1, n, PriceShare(m): n = n + Len(PriceShare(m))
            Next m
            Get #fnum1, n, inflation: n = n + Len(inflation)
            Get #fnum1, n, CurrentDate: n = n + Len(CurrentDate)
            Get #fnum1, n, PlayerName
            
            
        Close (fnum1)
        MsgBox "Загрузка завершена: """ + fname + """", vbOKOnly, "Игра загружена"
Exit Sub
LoadError:
MsgBox fname, vbOKOnly, "При загрузке игры произошла ошибка.", "Ошибка."
End Sub

Private Sub New_Click(Index As Integer)

    PlayerName = InputBox("Введите ваше имя: ", "Вход в игру")
    Call NewGame
End Sub

Private Sub NextDay_Click()
Randomize Timer
Fortune = 0
StartRuletkabtn.Enabled = True
Start1HandBamdbtn.Enabled = True
If (Rnd() > 0.1) Then
    inflation = Rnd() * 0.002 + 1
Else
    inflation = Rnd() * 0.02 + 0.99
End If

Dim n As Integer, ThisShareChange As Currency
For n = 0 To MAX_SHARE
    ThisShareChange = 1 + (-0.5 + Rnd()) * 0.01
    If Rnd() > 0.999 Then
        ThisShareChange = 2 * Rnd():
        If ThisShareChange > 1.1 Then MsgBox "Из-за удачно проведённой рекламной кампании стоимость акции " + Companieslbl(n).Caption + " резко выросла."
        If ThisShareChange < 0.9 Then MsgBox "Из-за забастовки рабочих стоимость акции  " + Companieslbl(n).Caption + " резко упала."
    End If
    PriceShare(n) = PriceShare(n) * inflation * ThisShareChange
Next n
Dim ThisShare As Long
For n = 0 To 4
ThisShareChange = 1 + (-0.5 + Rnd()) * 0.0001
ThisShare = Val(Bcar(n).Caption) * inflation * ThisShareChange
    Bcar(n).Caption = Str(ThisShare)
Next
ThisShareChange = 1 + (-0.5 + Rnd()) * 0.00001
ThisShare = Val(FlatUpgrade.Caption * inflation * ThisShareChange)
FlatUpgrade.Caption = Str(ThisShare)


money = money - CInt(100 * Rnd())
If Moneylbl.Caption < -500 - 500 * Rnd() Then MsgBox "У вас закончились деньги. Вы попытались занять у знакомых, но вам никто не одолжил, так как вы не вернули прошлые долги.": End
Moneylbl.Caption = Str(money)
UpdatePricelbl
praybtn.Enabled = True
CurrentDate = CurrentDate + 1
CurrentDatelbl.Caption = "Сегодня: " + Str(Day(CurrentDate)) + Str(Month(CurrentDate)) + Str(Year(CurrentDate)) + "г."
If (Month(CurrentDate) = 1 And Day(CurrentDate) = 1) Then
    Dim fname As String
    'Answer = MsgBox("Наступил новый, " + Str(Year(CurrentDate)) + " год. Хотите ли вы сохранить игру.", vbYesNo, "Новый год")
    If (MsgBox("Наступил новый, " + Str(Year(CurrentDate)) + " год. Хотите ли вы сохранить игру.", vbYesNo, "Новый год") = vbYes) Then
        CommonDialog1.ShowSave
        fname = CommonDialog1.FileName: If (Right(fname, 4) <> ".sav") Then fname = fname + ".sav"
        SaveGame (fname)

    End If
End If
End Sub
Sub SaveGame(fname As String)
On Error GoTo SaveError
Dim fnum1 As Integer, n As Integer, m As Integer
n = 1
fnum1 = FreeFile
        Open fname For Binary As fnum1
            Put #fnum1, n, money: n = n + Len(money)
            Put #fnum1, n, MyCar: n = n + Len(MyCar)
            Put #fnum1, n, Fortune: n = n + Len(Fortune)
            Put #fnum1, n, Flat: n = n + Len(Flat)
            Put #fnum1, n, House: n = n + Len(House)
            For m = 0 To MAX_SHARE
            Put #fnum1, n, ShareCount(m): n = n + Len(ShareCount(m))
            Put #fnum1, n, PriceShare(m): n = n + Len(PriceShare(m))
            Next m
            Put #fnum1, n, inflation: n = n + Len(inflation)
            Put #fnum1, n, CurrentDate: n = n + Len(CurrentDate)
            Put #fnum1, n, PlayerName
            
            MsgBox "Игра сохранена: """ + fname + """", vbOKOnly, "Сохранение успешно."
        Close (fnum1)
Exit Sub
SaveError:
MsgBox "При сохранении произошла ошибка. Сохранение не удалось.", vbOKOnly, "Ошибка"
End Sub
Sub UpdatePricelbl()
Dim n As Integer
For n = 0 To MAX_SHARE
    Pricelbl(n).Caption = Str(PriceShare(n))
Next n
End Sub

Private Sub Picture1_Click()

End Sub

Private Sub OLE1_Updated(Code As Integer)

End Sub

Private Sub praybtn_Click()
    Rem If Rnd() > 0.99 Then MsgBox "Вы помолились Богу и он простил ваши грехи.", vbOKOnly, "**************"
    If Rnd() > 0.9 Then MsgBox "И ВЫ УСЛЫШАЛИ ГЛАС С НЕБА: ""И да будет сопутствовать тебе удача...""", vbOKOnly, "Фортуна"
    praybtn.Enabled = False
End Sub

Private Sub Save_Click(Index As Integer)
CommonDialog1.CancelError = True
On Error GoTo errorSave_click
CommonDialog1.ShowSave
If CommonDialog1.FileName = "" Then Exit Sub
SaveGame (CommonDialog1.FileName)
errorSave_click:
End Sub

Private Sub SellCarbtn_Click()
 If MyCar >= 0 Then
    money = money + Val(Bcar(MyCar).Caption)
    MyCar = -1
  
   UpdateMyCarlbl
   Moneylbl.Caption = Str(money)
   SellCarbtn.Enabled = False
End If
End Sub
Sub UpdateMyCarlbl()
   If MyCar >= 0 Then
    MyCarlbl.Caption = ByCar(MyCar).Caption
Else
    MyCarlbl.Caption = ""
End If
End Sub

Private Sub SellFlatbtn_Click()
    money = money + Flat * Val(FlatUpgrade.Caption)
    Moneylbl.Caption = Str(money)
    Flat = 0
    Flattxb.Text = Str(Flat)
    SellFlatbtn.Enabled = False
End Sub

Private Sub SellHousebtn_Click()
    money = money + House * Val(PriceUpgradeHouselbl.Caption)
    House = 0
    Moneylbl.Caption = Str(money)
    Houselbl.Caption = Str(House)
    SellHousebtn.Enabled = False
End Sub

Private Sub Start1HandBamdbtn_Click()
Dim n As Byte, m As Byte
Dim rate As Integer
rate = 10
If money < 10 Then
    MsgBox "У вас недостаточно денег.", vbOKOnly, "Нехватка ресурсов"
    Exit Sub
End If
money = money - rate
Dim Win As Integer
Randomize Timer
Dim Status(2) As Byte
For m = 0 To 254
    For n = 0 To 2
        Status(n) = CInt(3 * Rnd())
        If Rnd < Fortune / 255 Then
            Status(0) = 3
            Status(1) = 3
            Status(2) = 3
        End If
        OneHand(n).Picture = OneHandimg(Status(n)).Picture
    Next
    DoEvents
Next
If Status(0) = Status(1) And Status(1) = Status(2) Then
    If Status(0) = 0 Then Win = rate * 100
    If Status(0) = 1 Then Win = rate * 50
    If Status(0) = 2 Then Win = rate * 3
    If Status(0) = 3 Then Win = rate * 2
Else
    Win = 0
End If
If Win > 0 Then
    WinInfolbl.Caption = Str(Win)
Else
    WinInfolbl.Caption = "Вы проиграли."
End If
money = money + Win
Moneylbl.Caption = Str(money)
If Rnd > 0.95 Then MsgBox "К вам подошли крутые ребята и отогнали от игрального автомата.", vbOKOnly, "Вас отогнали от игрального автомата.": Start1HandBamdbtn.Enabled = False
End Sub

Private Sub StartRuletkabtn_Click()
Randomize Timer
   If Val(ratetxb.Text) <= 0 Then MsgBox "Ставка должна быть больше нуля", vbOKOnly, "Введено неверное число.": Exit Sub
If money < Str(ratetxb) Then MsgBox "Вы не можете поставить такую сумму, поскольку у вас нет столько денег.", vbOKOnly, "У вас не хватает денег.": Exit Sub
money = money - Str(ratetxb)
Dim TapeMeasureNumber As Byte
TapeMeasureNumber = CInt(Rnd() * 39 + 1)
Rem MsgBox "Вы поставили на " + Str(TapeMeasureRate) + " а выиграло: " + Str(TapeMeasureNumber), vbOKOnly, "Рулетка"
WinInfolbl.Caption = "Вышло число: " + Str(TapeMeasureNumber) + ". "
If (TapeMeasureNumber <= 20 And TapeMeasureRate = 100) Or (TapeMeasureNumber > 20 And TapeMeasureRate = 101) Then WinInfolbl.Caption = WinInfolbl.Caption + "Вы выиграли " + Str(Val(ratetxb.Text) * 2): money = money + Str(Val(ratetxb.Text) * 2)
If (TapeMeasureNumber Mod 2 = 0 And TapeMeasureRate = 201) Or (TapeMeasureNumber Mod 2 = 1 And TapeMeasureRate = 200) Then WinInfolbl.Caption = WinInfolbl.Caption + "Вы выиграли " + Str(Val(ratetxb.Text) * 2): money = money + Str(Val(ratetxb.Text) * 2)
If TapeMeasureRate = TapeMeasureNumber Then WinInfolbl.Caption = WinInfolbl.Caption + "Вы угадали!!! Ваш выигрышь: " + Str(Val(ratetxb.Text) * 40): money = money + Str(Val(ratetxb.Text) * 40)
Moneylbl.Caption = Str(money)
If Rnd > 0.99 Then MsgBox "Как подошёл какой-то качок и отогнал вас от рулетки, объяснив это тем, что и другие хотят поиграть.", vbOKOnly, "Вас отогнали от рулетки.": StartRuletkabtn.Enabled = False
End Sub

Private Sub Tabtsp_Click()
  Frames(LastSelecteditem - 1).Visible = False
    Frames(Tabtsp.SelectedItem.Index - 1).Visible = True
  Rem MsgBox Str(Tabtsp.SelectedItem.Index - 1), vbOKOnly, "Сообщение"
    LastSelecteditem = Tabtsp.SelectedItem.Index
End Sub
Private Sub TapeMeasurePic_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim n As Integer
Call TapeMeasurePic_Paint
    If Y < TapeMeasurePic.Height \ 15 - NumberSize Then
        TapeMeasurePic.Line ((X \ NumberSize) * NumberSize, (Y \ NumberSize) * NumberSize)-((X \ NumberSize) * NumberSize + NumberSize, (Y \ NumberSize) * NumberSize + NumberSize), vbGreen, B
        If X < TapeMeasurePic.Width \ 30 Then TapeMeasureRate = (X \ NumberSize + 1) + (Y \ NumberSize) * 4
        If X > TapeMeasurePic.Width \ 30 Then TapeMeasureRate = 20 + ((X - (TapeMeasurePic.Width \ 30)) \ NumberSize + 1) + (Y \ NumberSize) * 4
        Rem End If
    Else
    If Shift = vbCtrlMask Then
            TapeMeasurePic.Line ((X \ (TapeMeasurePic.Width \ 30)) * (TapeMeasurePic.Width \ 30), 0)-((X \ (TapeMeasurePic.Width \ 30)) * (TapeMeasurePic.Width \ 30) + TapeMeasurePic.Width \ 30, TapeMeasurePic.Height \ 15 - NumberSize), vbGreen, B
            If X < TapeMeasurePic.Width \ 30 Then
                TapeMeasureRate = 100
            Else:
                TapeMeasureRate = 101
            End If
    Else
    Dim startN
        If (X \ NumberSize) Mod 2 = 0 Then
            startN = 0
            TapeMeasureRate = 200
        Else
            startN = NumberSize
            TapeMeasureRate = 201
        End If
            For n = startN To TapeMeasurePic.Width \ 2 Step NumberSize * 2
                Rem TapeMeasurePic.FillStyle = 7
                TapeMeasurePic.FillColor = vbYellow
                TapeMeasurePic.Line (n, 0)-(n + NumberSize, TapeMeasurePic.Height \ 15 - NumberSize), vbGreen, B
            Next n
        Rem End If
    End If
    End If
    TapeMeasurePic.FillStyle = 1
End Sub

Private Sub TapeMeasurePic_Paint()

Dim n As Integer
TapeMeasurePic.Line (0, 0)-(TapeMeasurePic.Width \ 2 \ 15, TapeMeasurePic.Height \ 15), vbRed, BF
TapeMeasurePic.Line (TapeMeasurePic.Width \ 15 \ 2, 0)-(TapeMeasurePic.Width \ 15, TapeMeasurePic.Height \ 15), vbBlack, BF

Rem For n = 0 To TapeMeasurePic.Width Step NumberSize
Rem     TapeMeasurePic.Line (NumberSize + n, 0)-(NumberSize + n, TapeMeasurePic.Height), vbRed
Rem     TapeMeasurePic.Line (0, NumberSize + n)-(TapeMeasurePic.Width, NumberSize + n), vbRed
Rem Next
Dim left As Integer, top As Integer
 For n = 0 To 39
     

     If left >= TapeMeasurePic.Width \ 2 \ 15 And n <= 19 Then left = 0: top = top + NumberSize
       
     TapeMeasurePic.CurrentX = left
     TapeMeasurePic.CurrentY = top
     TapeMeasurePic.Print n + 1
      
      left = left + NumberSize
     If left >= TapeMeasurePic.Width \ 15 And n >= 19 Then left = TapeMeasurePic.Width \ 2 \ 15 + 5: top = top + NumberSize
      If n = 19 Then top = 0: left = TapeMeasurePic.Width \ 2 \ 15 + 5:
 Next
End Sub


Private Sub TapeMeasureRatecmd_Click(Index As Integer)
Select Case (Index)
Case 0: Call TapeMeasurePic_MouseDown(vbLeftButton, vbCtrlMask, 10, TapeMeasurePic.Height - NumberSize)
Case 1: Call TapeMeasurePic_MouseDown(vbLeftButton, vbCtrlMask, TapeMeasurePic.Width \ 30 + NumberSize, TapeMeasurePic.Height - NumberSize)
Case 2: Call TapeMeasurePic_MouseDown(vbLeftButton, 0, NumberSize, TapeMeasurePic.Height - NumberSize)
Case 3: Call TapeMeasurePic_MouseDown(vbLeftButton, 0, 2 * NumberSize, TapeMeasurePic.Height - NumberSize)
End Select



End Sub



Private Sub UpDownA_DownClick(Index As Integer)
Dim Count As Integer, n As Integer
Count = Val(NumbersOfCountactToBuytxt.Text)
For n = 1 To Count
    Call UpDownAMyChange(Index, ShareCount(Index) - 1)
Next
End Sub


Private Sub UpDownA_UpClick(Index As Integer)
Dim Count As Long, n As Long
Count = Val(NumbersOfCountactToBuytxt.Text)
For n = 1 To Count
    Call UpDownAMyChange(Index, ShareCount(Index) + 1)
Next
End Sub

Sub UpDownAMyChange(Index As Integer, NewShareCount As Long)
Rem MsgBox Str(NewShareCount), vbOKOnly, ""


    If NewShareCount >= 0 Then
            If money - (NewShareCount - ShareCount(Index)) * PriceShare(Index) >= 0 Or money - (NewShareCount - ShareCount(Index)) * PriceShare(Index) >= money Then
                money = money - (NewShareCount - ShareCount(Index)) * PriceShare(Index)
                Rem UpDownA(Index).Value = NewShareCount
                ShareCount(Index) = NewShareCount
            Else
                Rem UpDownA(Index).Value = ShareCount(Index)
                Rem MsgBox "Не хватает денег для осуществления операции.", vbOKOnly, "Внимание"
            End If
    End If
    Countactxb(Index).Text = Str(ShareCount(Index))
    Moneylbl.Caption = Str(money)

End Sub

Private Sub UpgradeHouse_Click()
    If money >= PriceUpgradeHouselbl.Caption Then House = House + 1: money = money - PriceUpgradeHouselbl.Caption
    Moneylbl.Caption = Str(money)
    Houselbl.Caption = Str(House * Val(PriceUpgradeHouselbl.Caption))
End Sub

Sub UpgradeShareCount()
Dim n As Integer
For n = 0 To MAX_SHARE
    Countactxb(n).Text = Str(ShareCount(n))
Next
End Sub
