﻿Attribute VB_Name = "SquareClickCore"
Option Explicit

' SquareClick 1.2: auto-detect two-item square-symbol validation lists.
' Runtime overlays are removed by SquareClickSession before normal Excel saves.
' No network calls, Shell, or external file access.
Private Const PREFIX As String = "SQCLICK1_R"
Private Const MAX_VALIDATION_CELLS As Long = 5000
Private Const MAX_OVERLAYS_PER_SHEET As Long = 400

Private mBusy As Boolean

Public Sub SquareClick_Start()
    Dim ws As Excel.Worksheet
    Dim active As Object
    On Error Resume Next
    Set active = Application.ActiveSheet
    On Error GoTo 0
    If active Is Nothing Then Exit Sub
    If TypeOf active Is Excel.Worksheet Then Set ws = active
    If Not ws Is Nothing Then SquareClick_PrepareSheet ws
End Sub

Public Sub SquareClick_PrepareSheet(ByVal ws As Excel.Worksheet)
    Dim allRules As Excel.Range
    Dim candidates As Excel.Range
    Dim c As Excel.Range
    Dim a As String, b As String
    Dim oldScreen As Boolean
    Dim total As Long

    If mBusy Then Exit Sub
    If ws Is Nothing Then Exit Sub
    If ws.Parent Is ThisWorkbook Then Exit Sub
    If Not SquareClickStandard.SCStd_AllowListForWorkbook(ws.Parent) Then Exit Sub
    If ws.ProtectContents Or ws.ProtectDrawingObjects Then Exit Sub
    If ws.Visible <> xlSheetVisible Then Exit Sub

    On Error GoTo CleanUp
    mBusy = True
    oldScreen = Application.ScreenUpdating

    On Error Resume Next
    Set allRules = ws.Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo CleanUp
    If allRules Is Nothing Then GoTo CleanUp

    Set candidates = Application.Intersect(allRules, ws.UsedRange)
    If candidates Is Nothing Then GoTo CleanUp
    If candidates.CountLarge > MAX_VALIDATION_CELLS Then GoTo CleanUp

    Application.ScreenUpdating = False
    total = 0
    For Each c In candidates.Cells
        If total >= MAX_OVERLAYS_PER_SHEET Then Exit For
        If SquareClick_GetPair(c, a, b) Then
            If Not IsError(c.Value2) Then
                If CStr(c.Value2) = a Or CStr(c.Value2) = b Then
                    If SquareClick_EnsureOverlay(c) Then total = total + 1
                End If
            End If
        End If
    Next c

CleanUp:
    Application.ScreenUpdating = oldScreen
    mBusy = False
End Sub

Private Function SquareClick_IsWhite(ByVal s As String) As Boolean
    If Len(s) <> 1 Then Exit Function
    Select Case AscW(s)
        Case &H25A1, &H25A2, &H2610, &H25FB, &H2B1C, &H25AB
            SquareClick_IsWhite = True
    End Select
End Function

Private Function SquareClick_IsBlack(ByVal s As String) As Boolean
    If Len(s) <> 1 Then Exit Function
    Select Case AscW(s)
        Case &H25A0, &H25FC, &H2B1B, &H25AA, &H2611
            SquareClick_IsBlack = True
    End Select
End Function

Private Function SquareClick_ValidPair(ByVal a As String, ByVal b As String) As Boolean
    SquareClick_ValidPair = (SquareClick_IsWhite(a) And SquareClick_IsBlack(b)) Or _
                            (SquareClick_IsBlack(a) And SquareClick_IsWhite(b))
End Function

' Reads either a literal list (comma/semicolon) or a two-cell list range.
' Names/formulas are resolved through Worksheet.Evaluate when possible.
Public Function SquareClick_GetPair(ByVal c As Excel.Range, _
                                    ByRef a As String, ByRef b As String) As Boolean
    Dim spec As String, sep As String
    Dim parts As Variant, ev As Variant, item As Variant
    Dim sourceRange As Excel.Range
    Dim n As Long

    On Error GoTo NotPair
    a = vbNullString: b = vbNullString
    If c.Cells.CountLarge <> 1 Then Exit Function
    If c.HasFormula Then Exit Function
    If c.Validation.Type <> xlValidateList Then Exit Function
    spec = c.Validation.Formula1
    If Len(spec) = 0 Then Exit Function
    If Len(spec) >= 2 Then
        If Left$(spec, 1) = Chr$(34) And Right$(spec, 1) = Chr$(34) Then
            spec = Mid$(spec, 2, Len(spec) - 2)
        End If
    End If

    If Left$(spec, 1) = "=" Then
        On Error Resume Next
        Set sourceRange = c.Worksheet.Evaluate(spec)
        Err.Clear
        On Error GoTo NotPair
        If Not sourceRange Is Nothing Then
            If sourceRange.Cells.CountLarge <> 2 Then Exit Function
            If IsError(sourceRange.Cells(1).Value2) Or _
               IsError(sourceRange.Cells(2).Value2) Then Exit Function
            a = CStr(sourceRange.Cells(1).Value2)
            b = CStr(sourceRange.Cells(2).Value2)
        Else
            ev = c.Worksheet.Evaluate(spec)
            If IsArray(ev) Then
                n = 0
                For Each item In ev
                    If IsError(item) Then Exit Function
                    n = n + 1
                    If n = 1 Then a = CStr(item)
                    If n = 2 Then b = CStr(item)
                    If n > 2 Then Exit Function
                Next item
                If n <> 2 Then Exit Function
            Else
                Exit Function
            End If
        End If
    Else
        sep = ","
        If InStr(1, spec, sep, vbBinaryCompare) = 0 Then
            sep = ";"
        End If
        parts = Split(spec, sep)
        If UBound(parts) <> 1 Then Exit Function
        a = Trim$(CStr(parts(0)))
        b = Trim$(CStr(parts(1)))
    End If

    SquareClick_GetPair = SquareClick_ValidPair(a, b)
    Exit Function
NotPair:
    SquareClick_GetPair = False
End Function

Private Function SquareClick_EnsureOverlay(ByVal c As Excel.Range) As Boolean
    Dim ws As Excel.Worksheet
    Dim anchor As Excel.Range
    Dim shp As Excel.Shape
    Dim name As String, actionText As String
    Dim widthPts As Double, heightPts As Double
    Dim created As Boolean

    On Error GoTo Failed
    Set ws = c.Worksheet
    Set anchor = c
    If c.MergeCells Then Set anchor = c.MergeArea
    If anchor.Width < 12 Or anchor.Height < 8 Then Exit Function
    If c.EntireRow.Hidden Or c.EntireColumn.Hidden Then Exit Function

    name = PREFIX & c.Row & "C" & c.Column
    actionText = "'" & ThisWorkbook.name & "'!SquareClick_OnShape"

    On Error Resume Next
    Set shp = ws.Shapes(name)
    On Error GoTo Failed

    widthPts = anchor.Width
    If widthPts > 42 Then widthPts = widthPts - 13 ' Leave room for list arrow.
    heightPts = anchor.Height

    If shp Is Nothing Then
        Set shp = ws.Shapes.AddShape(msoShapeRectangle, anchor.Left + 0.4, _
                                    anchor.Top + 0.4, widthPts - 0.8, heightPts - 0.8)
        created = True
        shp.name = name
        With shp
            .Fill.Visible = msoTrue
            .Fill.ForeColor.RGB = RGB(255, 255, 255)
            .Fill.Transparency = 0.99
            .Line.Visible = msoFalse
            .Placement = xlMoveAndSize
            .OnAction = actionText
            ' A non-printing click target; the cell text is what is printed.
            .ControlFormat.PrintObject = False
        End With
    Else
        ' Rebind if a saved document was opened on another PC / version.
        If shp.OnAction <> actionText Then shp.OnAction = actionText
        If shp.ControlFormat.PrintObject Then shp.ControlFormat.PrintObject = False
    End If

    SquareClick_EnsureOverlay = True
    Exit Function
Failed:
    ' Never leave a newly made printable shape on a sheet if setup failed.
    On Error Resume Next
    If Not shp Is Nothing Then
        If created Then shp.Delete
    End If
    SquareClick_EnsureOverlay = False
End Function

Public Sub SquareClick_OnShape()
    Dim ws As Excel.Worksheet
    Dim s As Excel.Shape
    Dim c As Excel.Range
    Dim shapeName As String
    Dim a As String, b As String
    Dim oldEvents As Boolean
    Dim active As Object

    If mBusy Then Exit Sub
    On Error GoTo Done
    shapeName = CStr(Application.Caller)
    If Left$(shapeName, Len(PREFIX)) <> PREFIX Then Exit Sub
    Set active = Application.ActiveSheet
    If active Is Nothing Then Exit Sub
    If Not TypeOf active Is Excel.Worksheet Then Exit Sub
    Set ws = active
    If Not SquareClickStandard.SCStd_AllowListForWorkbook(ws.Parent) Then Exit Sub
    Set s = ws.Shapes(shapeName)
    Set c = s.TopLeftCell
    If c.MergeCells Then Set c = c.MergeArea.Cells(1, 1)
    If ws.ProtectContents Then Exit Sub
    If Not SquareClick_GetPair(c, a, b) Then Exit Sub

    oldEvents = Application.EnableEvents
    mBusy = True
    Application.EnableEvents = False
    If CStr(c.Value2) = a Then
        c.Value2 = b
    ElseIf CStr(c.Value2) = b Then
        c.Value2 = a
    End If
Done:
    If mBusy Then
        Application.EnableEvents = oldEvents
        mBusy = False
    End If
End Sub


' Lightweight refresh for a small direct edit (e.g., choosing a list value).
Public Sub SquareClick_RefreshEditedRange(ByVal edited As Excel.Range)
    Dim c As Excel.Range
    Dim a As String, b As String
    On Error GoTo Finished
    If mBusy Then Exit Sub
    If edited Is Nothing Then Exit Sub
    If Not SquareClickStandard.SCStd_AllowListForWorkbook(edited.Worksheet.Parent) Then Exit Sub
    If edited.CountLarge > 30 Then Exit Sub
    If edited.Worksheet.ProtectContents Then Exit Sub
    For Each c In edited.Cells
        If SquareClick_GetPair(c, a, b) Then
            If Not IsError(c.Value2) Then
                If CStr(c.Value2) = a Or CStr(c.Value2) = b Then
                    SquareClick_EnsureOverlay c
                End If
            End If
        End If
    Next c
Finished:
End Sub

' Manual repair if cells are added / validation is changed during an open session.
Public Sub SquareClick_RescanActiveSheet()
    Dim ws As Excel.Worksheet
    Dim active As Object
    On Error GoTo NoSheet
    Set active = Application.ActiveSheet
    If active Is Nothing Then Exit Sub
    If TypeOf active Is Excel.Worksheet Then
        Set ws = active
        SquareClick_PrepareSheet ws
    End If
    Exit Sub
NoSheet:
    MsgBox "SquareClick: no accessible worksheet.", vbExclamation
End Sub

' Read-only check of the selected cell, helpful for local diagnostics.
Public Sub SquareClick_InspectActiveCell()
    Dim c As Excel.Range
    Dim a As String, b As String
    Dim t As String
    On Error GoTo Failed
    Set c = Application.ActiveCell
    If SquareClick_GetPair(c, a, b) Then
        t = "Recognized square list" & vbCrLf & _
            "1: " & a & " (U+" & Hex$(AscW(a)) & ")" & vbCrLf & _
            "2: " & b & " (U+" & Hex$(AscW(b)) & ")"
    Else
        t = "This cell is not a supported two-square validation list."
    End If
    MsgBox t, vbInformation, "SquareClick"
    Exit Sub
Failed:
    MsgBox "Could not inspect selected cell.", vbExclamation, "SquareClick"
End Sub

' Removes ONLY shapes created by this add-in, leaving the cell values intact.
Public Sub SquareClick_RemoveOverlaysActiveSheet()
    Dim ws As Excel.Worksheet
    Dim active As Object
    Dim i As Long
    On Error GoTo Failed
    Set active = Application.ActiveSheet
    If active Is Nothing Then Exit Sub
    If Not TypeOf active Is Excel.Worksheet Then Exit Sub
    Set ws = active
    If ws.ProtectDrawingObjects Then Exit Sub
    For i = ws.Shapes.Count To 1 Step -1
        If Left$(ws.Shapes(i).name, Len(PREFIX)) = PREFIX Then
            ws.Shapes(i).Delete
        End If
    Next i
    Exit Sub
Failed:
    MsgBox "Could not remove all click targets.", vbExclamation, "SquareClick"
End Sub

' Returns a clean sheet without this add-in's list click targets.
' Checked square values and validation rules in cells are never modified.
Public Function SquareClick_CleanSheet(ByVal ws As Excel.Worksheet) As Boolean
    Dim i As Long
    Dim shp As Excel.Shape
    On Error GoTo Fail
    SquareClick_CleanSheet = False
    If ws Is Nothing Then Exit Function
    For i = ws.Shapes.Count To 1 Step -1
        Set shp = ws.Shapes(i)
        If Left$(shp.name, Len(PREFIX)) = PREFIX Then
            shp.Delete
        End If
    Next i
    SquareClick_CleanSheet = True
    Exit Function
Fail:
    SquareClick_CleanSheet = False
End Function
