[[20250423153058]]　『改良案があればも』（モけ）　ページの最後に飛ぶ

『改良案があればも』（モけ）

Option Explicit

' スロットのシンボルと確率
Private Symbols() As String
Private Probabilities() As Double
Private SymbolCount As Integer

' 当たりパターン
Private WinPatterns() As Variant
Private WinMessages() As String
Private WinPatternCount As Integer

' スロットの状態管理
Private Reel1Stopped As Boolean, Reel2Stopped As Boolean, Reel3Stopped As Boolean
Private Reel1Value As String, Reel2Value As String, Reel3Value As String

' 設定シートの読み込み
Sub LoadSettings()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Settings")

    ' シンボルと確率の読み込み
    SymbolCount = Application.CountA(ws.Range("A2:A100"))
    ReDim Symbols(0 To SymbolCount - 1)
    ReDim Probabilities(0 To SymbolCount - 1)

    Dim i As Integer
    For i = 0 To SymbolCount - 1
        Symbols(i) = ws.Range("A2").Offset(i, 0).Value
        Probabilities(i) = ws.Range("B2").Offset(i, 0).Value
    Next i

    ' 当たりパターンの読み込み
    WinPatternCount = Application.CountA(ws.Range("D3:D100"))
    ReDim WinPatterns(0 To WinPatternCount - 1, 0 To 2)
    ReDim WinMessages(0 To WinPatternCount - 1)

    For i = 0 To WinPatternCount - 1
        WinPatterns(i, 0) = ws.Range("D3").Offset(i, 0).Value
        WinPatterns(i, 1) = ws.Range("E3").Offset(i, 0).Value
        WinPatterns(i, 2) = ws.Range("F3").Offset(i, 0).Value
        WinMessages(i) = ws.Range("G3").Offset(i, 0).Value
    Next i
End Sub

' 初期化
Sub InitializeSlot()

    Call LoadSettings

    ' スロットエリアの初期化
    With ThisWorkbook.Sheets("Sheet1").Range("A1:C1")
        .ClearContents
        .Interior.Color = vbWhite
        .Font.Size = 20
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With

    ' ランプエリアの初期化
    With ThisWorkbook.Sheets("Sheet1").Range("A3:C3")
        .ClearContents
        .Interior.Color = vbBlack
        .Value = "LAMP"
        .Font.Size = 12
        .Font.Bold = True
        .Font.Color = vbWhite
        .HorizontalAlignment = xlCenter
    End With

    ' 状態リセット
    Reel1Stopped = False
    Reel2Stopped = False
    Reel3Stopped = False
End Sub

' スロット開始
Sub StartSlot()

    Call InitializeSlot

    Dim spinCount As Long
    Dim delay As Double
    Dim baseDelay As Double: baseDelay = 0.05 ' 初期回転速度（秒）

    ' スロット回転ループ
    For spinCount = 1 To 100 ' 最大回転数
        delay = baseDelay * (1 + spinCount / 50) ' 徐々に遅く
        If Reel1Stopped And Reel2Stopped And Reel3Stopped Then Exit For

        ' リール1
        If Not Reel1Stopped Then
            Reel1Value = GetRandomSymbol
            Range("A1").Value = Reel1Value
            Range("A1").Interior.Color = RGB(255, 255, Rnd * 255)
        End If

        ' リール2
        If Not Reel2Stopped Then
            Reel2Value = GetRandomSymbol
            Range("B1").Value = Reel2Value
            Range("B1").Interior.Color = RGB(255, 255, Rnd * 255)
        End If

        ' リール3
        If Not Reel3Stopped Then
            Reel3Value = GetRandomSymbol
            Range("C1").Value = Reel3Value
            Range("C1").Interior.Color = RGB(255, 255, Rnd * 255)
        End If

        ' 自動停止判定
        If spinCount = 30 Then Reel1Stopped = True
        If spinCount = 40 Then Reel2Stopped = True
        If spinCount = 50 Then Reel3Stopped = True

        Application.Wait Now + TimeValue("00:00:01") * delay
        DoEvents
    Next spinCount

    ' 当たり判定
    Call CheckWin
End Sub

' ランダムシンボル取得（確率考慮）
Function GetRandomSymbol() As String

    Dim rand As Double
    rand = Rnd
    Dim cumulative As Double
    Dim i As Integer

    For i = 0 To SymbolCount - 1
        cumulative = cumulative + Probabilities(i)
        If rand <= cumulative Then
            GetRandomSymbol = Symbols(i)
            Exit Function
        End If
    Next i
    GetRandomSymbol = Symbols(SymbolCount - 1) ' フォールバック
End Function

' 各リールを個別に停止
Sub StopReel1()

    If Not Reel1Stopped Then
        Reel1Stopped = True
        Range("A1").Interior.Color = vbYellow
    End If
End Sub

Sub StopReel2()

    If Not Reel2Stopped Then
        Reel2Stopped = True
        Range("B1").Interior.Color = vbYellow
    End If
End Sub

Sub StopReel3()

    If Not Reel3Stopped Then
        Reel3Stopped = True
        Range("C1").Interior.Color = vbYellow
    End If
End Sub

' 当たり判定
Sub CheckWin()

    Dim message As String
    Dim i As Integer

    For i = 0 To WinPatternCount - 1
        If Reel1Value = WinPatterns(i, 0) And _
           Reel2Value = WinPatterns(i, 1) And _
           Reel3Value = WinPatterns(i, 2) Then
            message = WinMessages(i)
            Call FlashEffect ' リール点滅
            Call LampLightEffect ' ランプ点灯
            MsgBox message, vbInformation, "スロット結果"
            Exit Sub
        End If
    Next i

    message = "ハズレ... もう一度挑戦！"
    Call LampReset ' ランプリセット
    MsgBox message, vbInformation, "スロット結果"
End Sub

' リール点滅エフェクト（大当たり時）
Sub FlashEffect()

    Dim i As Integer
    For i = 1 To 5
        Range("A1:C1").Interior.Color = vbRed
        Application.Wait Now + TimeValue("00:00:00.3")
        Range("A1:C1").Interior.Color = vbYellow
        Application.Wait Now + TimeValue("00:00:00.3")
        DoEvents
    Next i
    Range("A1:C1").Interior.Color = vbWhite
End Sub

' ランプ点灯（大当たり時）
Sub LampLightEffect()

    With Range("A3:C3")
        .Interior.Color = vbRed ' 赤色で点灯
        .Font.Color = vbWhite
    End With
End Sub

' ランプリセット（ハズレ時）
Sub LampReset()

    With Range("A3:C3")
        .Interior.Color = vbBlack
        .Font.Color = vbWhite
        .Value = "LAMP"
    End With
End Sub

＜使用 Excel：unknown、使用 OS：Windows10 ＞