' ============================================================
'
'    UnLimitted Bright Blue. v0.01 for Win10
'
'    Cpoy Right Miyama. 2025 May
' 
'    http://kazutomimiyama.sakura.ne.jp
'    KazutomiMiyamaSub@gmail.com
'
' ============================================================

Imports System
Imports System.IO

Public Class Form1

    Private BaseHSCB() As HScrollBar

    Private _scrCap As Bitmap
    Private showColor As Color
    Private ColorGlobalFixed As Color
    Private tuneRateReso As Single = 1.75

    Private fW As Integer = 480 'Me.Width
    Private fH As Integer = 300 'Me.Height

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load

        Dim i As Integer

        initControlsOnForm()

        With Me
            .Width = fW
            .Height = fH
        End With

        initLBL(BaseColorLBL, Color.Khaki)
        initLBL(tuneLBL, Color.LemonChiffon)

        For i = 0 To 4 - 1
            With BaseHSCB(i)
                Select Case i
                    Case 4 - 1
                        .Top = 120
                        initSCB(BaseHSCB(i), 30)
                    '---
                    Case 1 - 1
                        .Top = 170
                        initSCB(BaseHSCB(i), 20)
                    Case 2 - 1
                        .Top = 195
                        initSCB(BaseHSCB(i), 20)
                    Case 3 - 1
                        .Top = 220
                        initSCB(BaseHSCB(i), 20)
                End Select
            End With

        Next i

        With CodeTXT
            HiResoCHK.Left = .Left
            HiResoCHK.Width = .Width
            tuneRateResoBTN.Left = .Left
            tuneRateResoBTN.Width = .Width
        End With

        displayCodeToTXT()


    End Sub

    Private Sub initControlsOnForm()

        Dim I, J As Integer

        With Me
            .BaseHSCB = New HScrollBar(4 - 1) {}
            .SuspendLayout()

            For I = 0 To 4 - 1
                .BaseHSCB(I) = New HScrollBar
            Next I
            .Controls.AddRange(.BaseHSCB)
            For J = 0 To 4 - 1
                With BaseHSCB(J)

                    If J = 3 Then
                        AddHandler .Scroll, AddressOf TTBarLogic
                    Else
                        AddHandler .Scroll, AddressOf RGBBarLogic
                    End If

                End With
            Next j

        End With


    End Sub


    Private Sub HiResoCHK_Click(sender As Object, e As EventArgs) Handles HiResoCHK.Click

        With HiResoCHK
            Select Case .Checked
                Case True
                    tuneRateReso = 1.75
                Case False
                    tuneRateReso = 1
            End Select
        End With


    End Sub

    Private Sub tuneRateResoBTN_click(sender As Object, e As EventArgs) Handles tuneRateResoBTN.Click

        Dim Ratelocal As Single
        HiResoCHK.Visible = False

        While Ratelocal <= 0 Or 5 < Ratelocal
            Ratelocal = CInt(
                Val(
                InputBox(
                "now is " +
                CStr(tuneRateReso) +
                ". new rate please.")
                )
                )
        End While

        tuneRateReso = Ratelocal


    End Sub

    Private Sub initSCB(SCB As ScrollBar, H As Integer)

        With SCB
            With CodeTXT
                SCB.Left = .Left + .Width
            End With

            .Width = Int(fW * 0.8 + 0.5)
            .Height = H
            'Int(fH * 0.08 + 0.5)

            .Minimum = 0
            .Maximum = 255

            .SmallChange = 1
            .LargeChange = 1

            .Value = 128
        End With


    End Sub

    Private Sub initLBL(LBL As Label, CL As Color)

        With LBL
            .Visible = True

            .BackColor = CL
            .ForeColor = CL
        End With


    End Sub

    Private Sub Form1_Shown(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Shown
        REM --Special thanks komozo sama---

        _scrCap = New Bitmap(1, 1)

        '描画ループ
        While (Not Me.IsDisposed)

            Dim g As Graphics = Graphics.FromImage(_scrCap)
            'カーソル先端1ピクセルのスクリーンをコピー
            g.CopyFromScreen(CInt(Cursor.Position.X * tuneRateReso),
                             CInt(Cursor.Position.Y * tuneRateReso), 0, 0, _scrCap.Size)

            g.Dispose()

            'コピーした画像から色を取得
            showColor = _scrCap.GetPixel(0, 0)

            With showLBL
                .BackColor = showColor
                .ForeColor = showColor
            End With

            Application.DoEvents()
        End While


    End Sub

    Private Sub GetColorBTN_Click(sender As Object, e As EventArgs) Handles GetColorBTN.Click

        get256codefromCLROBJ()


    End Sub

    Private Sub get256codefromCLROBJ()

        ColorGlobalFixed = showColor
        reflectBaseColorLBL()

        With ColorGlobalFixed
            'RedBar.Value = .R
            'GrnBar.Value = .G
            ''BluBar.Value = .B

            displayCodeToTXT()
        End With


    End Sub

    Private Sub RGBBarLogic()
        'RedBar_Scroll(sender As Object, e As ScrollEventArgs) Handles RedBar.Scroll
        reflectOBJandCoMPfrom256code()


    End Sub

    Private Sub reflectOBJandCoMPfrom256code()

        Dim RGB(3 - 1) As Integer
        Dim i As Integer

        For i = 0 To 3 - 1
            RGB(i) = BaseHSCB(i).Value
        Next i

        ColorGlobalFixed = Color.FromArgb(RGB(1 - 1), RGB(2 - 1), RGB(3 - 1))
        reflectBaseColorLBL()

        displayCodeToTXT()


    End Sub

    Sub reflectBaseColorLBL()

        With BaseColorLBL
            .BackColor = ColorGlobalFixed
            .ForeColor = ColorGlobalFixed
        End With


    End Sub

    Private Sub displayCodeToTXT()

        Dim tmpSTR As String = ""

        With BaseColorLBL.BackColor
            tmpSTR = "-BaseColor" + vbCrLf +
        CStr(.R) + vbCrLf +
        CStr(.G) + vbCrLf +
        CStr(.B) + vbCrLf +
        mFFc(.R) + mFFc(.G) + mFFc(.B) + vbCrLf
        End With

        With tuneLBL.BackColor
            tmpSTR = tmpSTR +
        "-TunedColor" + vbCrLf +
        CStr(.R) + vbCrLf +
        CStr(.G) + vbCrLf +
        CStr(.B) + vbCrLf +
        mFFc(.R) + mFFc(.G) + mFFc(.B) + vbCrLf

        End With
        CodeTXT.Text = tmpSTR


    End Sub

    Private Sub TTBarLogic()
        'Thick and Thin tune scrollbar

        Dim localColor As Color
        Dim TTV As Integer = BaseHSCB(4 - 1).Value
        'TTbar Value

        With BaseColorLBL.BackColor
            localColor = Color.FromArgb(
            RateExec(.R, TTV),
            RateExec(.G, TTV),
            RateExec(.B, TTV))
        End With

        With tuneLBL
            .BackColor = localColor
            .ForeColor = localColor
        End With

        displayCodeToTXT()


    End Sub

    Private Function RateExec(eleColorBarValue As Integer,
                              TTV As Integer) As Integer

        '  v0          v128       v255
        ' |------------|-----------| ThickThinBar
        '              | | | ... steps 128
        '                                 *segment, one by one
        '                 ||| ... steps 128, same steps
        ' |---------------|--------| RedBar :ex.
        '                 R
        '                 < 255 -R >
        '
        ' *SegmentRateRedBar
        '
        '       255 - R
        ' SRR = -------
        '         128
        '   
        ' *AreaLengthTTBar
        '
        ' aLTT = valueTT - 128
        '
        '* ResultRValue
        '
        ' RRV = R + SRR * aLTT
        '
        ' :then
        '
        '       255  - R
        ' = R + -------- * (valueTT - 128)
        '         128
        '
        ' 255 = 256 aboutly
        '
        '             R
        ' = R + (2 - --- ) * valueTT  - 255 + R
        '            128
        '                        valueTT
        ' = 2R + 2valueTT - R *  ------- - 255
        '                          128
        '
        '                          R
        ' = 2(R + valueTT) -255 - --- * valueTT
        '                         128
        '
        ' if valueTT = 255
        '
        ' = 2(R + 255) -255 - 2R = 255 as FF

        Dim avoidOverINT As Integer

        avoidOverINT =
                Int(
                2 * (eleColorBarValue + TTV) - 255 -
                eleColorBarValue * TTV / 128
                )

        If avoidOverINT < 0 Then avoidOverINT = 0
        If 255 < avoidOverINT Then avoidOverINT = 255

        RateExec = avoidOverINT


    End Function

    Private Function mFFc(X16 As Integer) As String
        'makeFFcode

        'no chk input num value

        Dim i As Integer = 0
        Dim j As Integer = 0

        Dim ResultI As Integer = 0
        Dim ResultJ As Integer = 0

        Dim tmpCHR As String = ""
        Dim StakeOutSTR As String = ""

        ResultI = 0
        For i = 0 To 16 - 1
            If X16 < 16 ^ i And
                    16 ^ (i - 1) <= X16 Then
                ResultI = i - 1
            End If
        Next i

        While Not ResultI < 0

            For j = 0 To 16 - 1
                If X16 < (j + 1) * 16 ^ ResultI And
                            j * 16 ^ ResultI <= X16 Then
                    ResultJ = j
                End If
            Next j

            tmpCHR = CStr(ResultJ)

            If 10 <= ResultJ Then
                Select Case ResultJ
                    Case 10 : tmpCHR = "A"
                    Case 11 : tmpCHR = "B"
                    Case 12 : tmpCHR = "C"
                    Case 13 : tmpCHR = "D"
                    Case 14 : tmpCHR = "E"
                    Case 15 : tmpCHR = "F"
                End Select
            End If

            StakeOutSTR = StakeOutSTR + tmpCHR

            X16 = X16 - ResultJ * 16 ^ ResultI

            ResultI = ResultI - 1
            ResultJ = 0

        End While

        If Len(StakeOutSTR) = 1 Then
            StakeOutSTR = "0" + StakeOutSTR
        End If

        mFFc = StakeOutSTR


    End Function

    Private Sub ExitBTN_Click(sender As Object, e As EventArgs) Handles ExitBTN.Click

        Me.Close()


    End Sub

End Class
' ============================================================
'  End Of File.
' ============================================================