Option Explicit

' Windows API および 構造体宣言
Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Public Type POINT
    X As Long
    Y As Long
End Type

#If VBA7 Then
    Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hWnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal uFlags As Long) As Long
    Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hWnd As LongPtr, ByRef lpRect As RECT) As Long
    Private Declare PtrSafe Function ClientToScreen Lib "user32" (ByVal hWnd As LongPtr, ByRef lpPoint As POINT) As Long
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    
    ' ★タイマー用APIの追加宣言
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
    Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal uFlags As Long) As Long
    Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, ByRef lpRect As RECT) As Long
    Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, ByRef lpPoint As POINT) As Long
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    
    ' ★タイマー用APIの追加宣言
    Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
#End If

' 設定情報
Public RulerMode As Long ' 0: OFF, 1: 横のみ, 2: 縦のみ, 3: 縦横（十字）
Public LastRulerMode As Long ' 最後に使用したモードを記憶
Public RulerColor As Long
Public RulerOpacity As Byte

' インスタンスおよびタイマー状態保持用
Public AppEvents As clsAppEvents
Public oRulerHoriz As frmRuler
Public oRulerVert As frmRuler

#If VBA7 Then
    Private hTimer As LongPtr ' タイマーハンドル
#Else
    Private hTimer As Long
#End If

' 設定値の読み込み
Public Sub LoadSettings()
    RulerColor = RGB(0, 162, 232)
    RulerOpacity = 76
    LastRulerMode = 3 ' 初期デフォルトは十字
    
    Dim regColor As String, regOpacity As String, regMode As String
    regColor = GetSetting("ExcelRuler", "Settings", "Color", "")
    regOpacity = GetSetting("ExcelRuler", "Settings", "Opacity", "")
    regMode = GetSetting("ExcelRuler", "Settings", "LastMode", "")
    
    If regColor <> "" Then RulerColor = CLng(regColor)
    If regOpacity <> "" Then RulerOpacity = CByte(regOpacity)
    If regMode <> "" Then LastRulerMode = CLng(regMode)
End Sub

' ==============================================================
' シンプルな「ON / OFF」切り替え専用
' ==============================================================
Public Sub Ruler_SwitchOnOff()
    If RulerColor = 0 Then LoadSettings
    If RulerMode = 0 Then
        Ruler_ON
    Else
        Ruler_OFF
    End If
End Sub

' ==============================================================
' 表示モード（横/縦/十字）の切り替え専用
' ==============================================================
Public Sub Ruler_ChangeMode()
    If RulerColor = 0 Then LoadSettings
    If RulerMode = 0 Then
        Ruler_ON
        Exit Sub
    End If
    
    ' 1(横) -> 2(縦) -> 3(十字) -> 1(横) のループ（OFFにはならない）
    RulerMode = RulerMode + 1
    If RulerMode > 3 Then RulerMode = 1
    
    ' モード変更を即座に記憶して保存
    LastRulerMode = RulerMode
    SaveSetting "ExcelRuler", "Settings", "LastMode", CStr(LastRulerMode)
    
    UpdateRulerPosition
End Sub

' 旧トグルマクロ（互換用：ON/OFF＋モード切替全部入り）
Public Sub Ruler_Toggle()
    If RulerColor = 0 Then LoadSettings

    If RulerMode = 0 Then
        Ruler_ON ' OFFから復帰時は前回記憶したモードで
    Else
        RulerMode = RulerMode + 1
        If RulerMode > 3 Then
            Ruler_OFF
        Else
            LastRulerMode = RulerMode
            SaveSetting "ExcelRuler", "Settings", "LastMode", CStr(LastRulerMode)
            UpdateRulerPosition
        End If
    End If
End Sub

' 完全に機能をONにする
Public Sub Ruler_ON()
    If RulerColor = 0 Then LoadSettings
    If RulerMode = 0 Then
        If LastRulerMode = 0 Then LastRulerMode = 3
        RulerMode = LastRulerMode ' 最後に使っていたモードを復元
    End If

    If AppEvents Is Nothing Then
        Set AppEvents = New clsAppEvents
        Set AppEvents.App = Application
    End If

    If oRulerHoriz Is Nothing Then
        Set oRulerHoriz = New frmRuler
        oRulerHoriz.Caption = "ExcelRulerHoriz_" & Timer
        oRulerHoriz.Show vbModeless
        oRulerHoriz.ApplyStyles RulerOpacity, RulerColor
    End If

    If oRulerVert Is Nothing Then
        Set oRulerVert = New frmRuler
        oRulerVert.Caption = "ExcelRulerVert_" & (Timer + 1)
        oRulerVert.Show vbModeless
        oRulerVert.ApplyStyles RulerOpacity, RulerColor
    End If

    UpdateRulerPosition
    
    ' ★タイマーの起動 (100ミリ秒周期で変更監視)
    If hTimer = 0 Then
        hTimer = SetTimer(0, 0, 100, AddressOf TimerProc)
    End If
End Sub

' 完全に機能をOFFにする
Public Sub Ruler_OFF()
    ' ★タイマーの停止
    If hTimer <> 0 Then
        KillTimer 0, hTimer
        hTimer = 0
    End If

    ' OFFにする直前に現在のモードを記憶してレジストリに保存
    If RulerMode <> 0 Then
        LastRulerMode = RulerMode
        SaveSetting "ExcelRuler", "Settings", "LastMode", CStr(LastRulerMode)
    End If

    Set AppEvents = Nothing
    If Not oRulerHoriz Is Nothing Then
        Unload oRulerHoriz
        Set oRulerHoriz = Nothing
    End If
    If Not oRulerVert Is Nothing Then
        Unload oRulerVert
        Set oRulerVert = Nothing
    End If
    RulerMode = 0
    Application.StatusBar = False
End Sub


' 設定メニューマクロ
Public Sub Ruler_Settings()
    On Error Resume Next
    Dim msgColor As String
    msgColor = "ラインの色を選択してください（番号を入力）:" & vbCrLf & _
               "1: ライトブルー (涼しげで人気)" & vbCrLf & _
               "2: ライトグリーン (目に優しい)" & vbCrLf & _
               "3: ソフトオレンジ (目立たせたい時)" & vbCrLf & _
               "4: クールグレー (邪魔にならない)" & vbCrLf & _
               "5: クールイエロー (警告色風)" & vbCrLf & _
               "6: カスタム (RGB値を手動入力)"
               
    Dim choiceColor As String
    choiceColor = InputBox(msgColor, "ルーラー - カラー設定", "1")
    If choiceColor = "" Then Exit Sub
    
    Dim newColor As Long
    Select Case choiceColor
        Case "1": newColor = RGB(0, 162, 232)
        Case "2": newColor = RGB(34, 177, 76)
        Case "3": newColor = RGB(255, 127, 39)
        Case "4": newColor = RGB(128, 128, 128)
        Case "5": newColor = RGB(255, 242, 0)
        Case "6"
            Dim customRGB As String
            customRGB = InputBox("R,G,B の順にカンマ区切りで 0-255 の値を入力してください (例: 100,150,250):", "カスタムRGB色設定", "100,150,250")
            If customRGB = "" Then Exit Sub
            Dim parts() As String
            parts = Split(customRGB, ",")
            If UBound(parts) = 2 Then
                newColor = RGB(CInt(parts(0)), CInt(parts(1)), CInt(parts(2)))
            Else
                newColor = RGB(0, 162, 232)
            End If
        Case Else
            newColor = RGB(0, 162, 232)
    End Select
    
    Dim choiceOpacity As String
    choiceOpacity = InputBox("ラインの不透明度をパーセントで入力してください (10 ～ 90):", "ルーラー - 不透明度設定", "30")
    If choiceOpacity = "" Then Exit Sub
    
    Dim opVal As Long
    opVal = Val(choiceOpacity)
    If opVal < 5 Then opVal = 5
    If opVal > 95 Then opVal = 95
    
    RulerColor = newColor
    RulerOpacity = CByte((opVal / 100) * 255)
    SaveSetting "ExcelRuler", "Settings", "Color", CStr(RulerColor)
    SaveSetting "ExcelRuler", "Settings", "Opacity", CStr(RulerOpacity)
    
    If RulerMode <> 0 Then
        Ruler_OFF
        Ruler_ON
    End If
    MsgBox "設定を保存しました！", vbInformation
End Sub

' リアルタイム位置・サイズ更新ルーチン
Public Sub UpdateRulerPosition()
    On Error Resume Next
    
    If RulerMode = 0 Then
        Ruler_OFF
        Exit Sub
    End If
    
    If ActiveWindow Is Nothing Or ActiveSheet Is Nothing Then
        If Not oRulerHoriz Is Nothing Then oRulerHoriz.Hide
        If Not oRulerVert Is Nothing Then oRulerVert.Hide
        Exit Sub
    End If
    
    If ActiveWindow.WindowState = xlMinimized Then
        If Not oRulerHoriz Is Nothing Then oRulerHoriz.Hide
        If Not oRulerVert Is Nothing Then oRulerVert.Hide
        Exit Sub
    End If
    
    If oRulerHoriz Is Nothing Or oRulerVert Is Nothing Then
        Ruler_ON
        Exit Sub
    End If
    
    Dim ac As Range
    Set ac = ActiveCell
    If ac Is Nothing Then Exit Sub
    
    Dim targetPane As Pane
    Set targetPane = ActiveWindow.ActivePane
    If targetPane Is Nothing Then Set targetPane = ActiveWindow.Panes(1)
    If targetPane Is Nothing Then Exit Sub
    
    ' -------------------------------------------------------------
    ' 1. グリッドの正確な起点（上・左）の取得
    ' -------------------------------------------------------------
    Dim firstPane As Pane
    Set firstPane = ActiveWindow.Panes(1)
    Dim vr As Range
    Set vr = firstPane.VisibleRange
    If vr Is Nothing Then Exit Sub
    
    Dim gridLeftPx As Long, gridTopPx As Long
    gridLeftPx = firstPane.PointsToScreenPixelsX(vr.Left)
    gridTopPx = firstPane.PointsToScreenPixelsY(vr.Top)
    
    ' -------------------------------------------------------------
    ' 2. 限界終点（右・下）の取得
    ' -------------------------------------------------------------
    #If VBA7 Then
        Dim hwndDesk As LongPtr, hwndExcel7 As LongPtr
    #Else
        Dim hwndDesk As Long, hwndExcel7 As Long
    #End If
    
    hwndDesk = FindWindowEx(Application.hWnd, 0, "XLDESK", vbNullString)
    If hwndDesk = 0 Then hwndDesk = FindWindowEx(ActiveWindow.hWnd, 0, "XLDESK", vbNullString)
    hwndExcel7 = FindWindowEx(hwndDesk, 0, "EXCEL7", vbNullString)
    
    Dim maxRightPx As Long, maxBottomPx As Long
    If hwndExcel7 <> 0 Then
        Dim pt As POINT
        pt.X = 0: pt.Y = 0
        ClientToScreen hwndExcel7, pt
        
        Dim zoomFac As Double
        zoomFac = ActiveWindow.Zoom / 100#
        
        Dim pxPerPointX As Double, pxPerPointY As Double
        pxPerPointX = (targetPane.PointsToScreenPixelsX(10000) - targetPane.PointsToScreenPixelsX(0)) / (10000# * zoomFac)
        pxPerPointY = (targetPane.PointsToScreenPixelsY(10000) - targetPane.PointsToScreenPixelsY(0)) / (10000# * zoomFac)
        
        Dim usableW_Px As Long, usableH_Px As Long
        usableW_Px = CLng(ActiveWindow.UsableWidth * pxPerPointX)
        usableH_Px = CLng(ActiveWindow.UsableHeight * pxPerPointY)
        
        maxRightPx = pt.X + usableW_Px + 2
        maxBottomPx = pt.Y + usableH_Px
    Else
        maxRightPx = firstPane.PointsToScreenPixelsX(vr.Left + ActiveWindow.UsableWidth) + 2
        maxBottomPx = firstPane.PointsToScreenPixelsY(vr.Top + ActiveWindow.UsableHeight)
    End If
    
    ' -------------------------------------------------------------
    ' 3. 現在のアクティブセルの座標を取得
    ' -------------------------------------------------------------
    Dim cellLeftPx As Long, cellTopPx As Long
    Dim cellWidthPx As Long, cellHeightPx As Long
    
    cellLeftPx = targetPane.PointsToScreenPixelsX(ac.Left)
    cellTopPx = targetPane.PointsToScreenPixelsY(ac.Top)
    cellWidthPx = targetPane.PointsToScreenPixelsX(ac.Left + ac.Width) - cellLeftPx
    cellHeightPx = targetPane.PointsToScreenPixelsY(ac.Top + ac.Height) - cellTopPx

    ' -------------------------------------------------------------
    ' 4. 完全クリッピング配置
    ' -------------------------------------------------------------
    Dim flags As Long
    flags = &H10 Or &H40 ' SWP_NOACTIVATE | SWP_SHOWWINDOW
    
    ' --- 横ライン ---
    If RulerMode = 1 Or RulerMode = 3 Then
        Dim hLeft As Long, hTop As Long, hWidth As Long, hHeight As Long
        
        hLeft = gridLeftPx
        hTop = cellTopPx
        hHeight = cellHeightPx
        hWidth = maxRightPx - gridLeftPx
        
        If hTop < gridTopPx Then
            hHeight = hHeight - (gridTopPx - hTop)
            hTop = gridTopPx
        End If
        If hTop + hHeight > maxBottomPx Then
            hHeight = maxBottomPx - hTop
        End If
        
        If hWidth > 0 And hHeight > 0 Then
            If Not oRulerHoriz.Visible Then oRulerHoriz.Show vbModeless
            SetWindowPos oRulerHoriz.hWnd, 0, hLeft, hTop, hWidth, hHeight, flags
        Else
            If oRulerHoriz.Visible Then oRulerHoriz.Hide
        End If
    Else
        If Not oRulerHoriz Is Nothing Then If oRulerHoriz.Visible Then oRulerHoriz.Hide
    End If
    
    ' --- 縦ライン ---
    If RulerMode = 2 Or RulerMode = 3 Then
        Dim vLeft As Long, vTop As Long, vWidth As Long, vHeight As Long
        
        vTop = gridTopPx
        vLeft = cellLeftPx
        vWidth = cellWidthPx
        vHeight = maxBottomPx - gridTopPx
        
        If vLeft < gridLeftPx Then
            vWidth = vWidth - (gridLeftPx - vLeft)
            vLeft = gridLeftPx
        End If
        If vLeft + vWidth > maxRightPx Then
            vWidth = maxRightPx - vLeft
        End If
        
        If vWidth > 0 And vHeight > 0 Then
            If Not oRulerVert.Visible Then oRulerVert.Show vbModeless
            SetWindowPos oRulerVert.hWnd, 0, vLeft, vTop, vWidth, vHeight, flags
        Else
            If oRulerVert.Visible Then oRulerVert.Hide
        End If
    Else
        If Not oRulerVert Is Nothing Then If oRulerVert.Visible Then oRulerVert.Hide
    End If
End Sub

' ==============================================================
' ★APIタイマー用コールバック関数
' ==============================================================
#If VBA7 Then
Public Sub TimerProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal idEvent As LongPtr, ByVal dwTime As Long)
#Else
Public Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
#End If
    On Error Resume Next
    
    ' 1. セル編集モード中やExcelがビジー状態の時は処理を回避して強制終了を防止する
    If Not Application.Ready Then Exit Sub
    
    If ActiveWindow Is Nothing Then Exit Sub
    
    Dim targetPane As Pane
    Set targetPane = ActiveWindow.ActivePane
    If targetPane Is Nothing Then Set targetPane = ActiveWindow.Panes(1)
    If targetPane Is Nothing Then Exit Sub
    
    Dim ac As Range
    Set ac = ActiveCell
    If ac Is Nothing Then Exit Sub
    
    ' 前回測定時の状態を静的変数に保持
    Static lastCellLeft As Long
    Static lastCellTop As Long
    Static lastCellWidth As Long
    Static lastCellHeight As Long
    Static lastScrollRow As Long
    Static lastScrollCol As Long
    Static lastWinLeft As Double
    Static lastWinTop As Double
    
    ' 2. 現在の「アクティブセルのピクセル座標」「表示スクロール行/列」「ウィンドウ自体の位置」を取得
    Dim curLeft As Long, curTop As Long, curWidth As Long, curHeight As Long
    curLeft = targetPane.PointsToScreenPixelsX(ac.Left)
    curTop = targetPane.PointsToScreenPixelsY(ac.Top)
    curWidth = targetPane.PointsToScreenPixelsX(ac.Left + ac.Width) - curLeft
    curHeight = targetPane.PointsToScreenPixelsY(ac.Top + ac.Height) - curTop
    
    Dim curScrollRow As Long, curScrollCol As Long
    curScrollRow = ActiveWindow.ScrollRow
    curScrollCol = ActiveWindow.ScrollColumn
    
    Dim curWinLeft As Double, curWinTop As Double
    curWinLeft = ActiveWindow.Left
    curWinTop = ActiveWindow.Top
    
    ' 3. いずれかの情報に変更があった場合のみ位置情報を再計算する
    If curLeft <> lastCellLeft Or curTop <> lastCellTop Or _
       curWidth <> lastCellWidth Or curHeight <> lastCellHeight Or _
       curScrollRow <> lastScrollRow Or curScrollCol <> lastScrollCol Or _
       curWinLeft <> lastWinLeft Or curWinTop <> lastWinTop Then
        
        UpdateRulerPosition
        
        ' キャッシュを更新
        lastCellLeft = curLeft
        lastCellTop = curTop
        lastCellWidth = curWidth
        lastCellHeight = curHeight
        lastScrollRow = curScrollRow
        lastScrollCol = curScrollCol
        lastWinLeft = curWinLeft
        lastWinTop = curWinTop
    End If
End Sub
