Various functions to change colours on a MicroFocus Reflection for IBM session

ReflectionSessionColours.vba

Public CyanRGB As Double
Public RedRGB As Double
Public GreenRGB As Double
Public BlueRGB As Double
Public YellowRGB As Double
Public BlackRGB As Double
Public WhiteRGB As Double
Public CurrentScheme As Integer
Public WhiteR As Integer
Public WhiteG As Integer
Public WhiteB As Integer
Public RedR As Integer
Public RedG As Integer
Public RedB As Integer
Public GreenR As Integer
Public GreenG As Integer
Public GreenB As Integer
Public BlackR As Integer
Public BlackG As Integer
Public BlackB As Integer
Public BlueR As Integer
Public BlueG As Integer
Public BlueB As Integer
Public YellowR As Integer
Public YellowG As Integer
Public YellowB As Integer
Public CyanR As Integer
Public CyanG As Integer
Public CyanB As Integer

Sub ChangeColours()
Dim intScramble As Integer
    'intScramble = Int(Rnd() * 6)
    intScramble = (Mid(Session.GetButtonLabel(17), 22, 1) + 1) Mod 6

Call GenerateColours
        
WhiteRGB = SetColour(rcWhite, WhiteR, WhiteG, WhiteB, intScramble)
RedRGB = SetColour(rcRed, RedR, RedG, RedB, intScramble)
GreenRGB = SetColour(rcGreen, GreenR, GreenG, GreenB, intScramble)
BlackRGB = SetColour(rcBlack, BlackR, BlackG, BlackB, intScramble)
BlueRGB = SetColour(rcBlue, BlueR, BlueG, BlueB, intScramble)
YellowRGB = SetColour(rcYellow, YellowR, YellowG, YellowB, intScramble)
CyanRGB = SetColour(rcCyan, CyanR, CyanG, CyanB, intScramble)

With Session
' Redefine the colour scheme button
.RemoveButton (17)
.DefineToolbarButton "Standard", 17, rcNo, "", 0, "", 0, "New Colours (Current:" & intScramble & ")", "Click here for new colours", "", "RunMacro ""NewMacros.ChangeColours"", """""
End With
CurrentScheme = intScramble
End Sub

Sub RandomiseColors()
Dim intScramble As Integer
    
    ' Randomises the same colours within a theme
    'intScramble = Int(Rnd() * 6)
    intScramble = CurrentScheme

Call GenerateColours
        
WhiteRGB = SetColour(rcWhite, WhiteR, WhiteG, WhiteB, intScramble)
RedRGB = SetColour(rcRed, RedR, RedG, RedB, intScramble)
GreenRGB = SetColour(rcGreen, GreenR, GreenG, GreenB, intScramble)
BlackRGB = SetColour(rcBlack, BlackR, BlackG, BlackB, intScramble)
BlueRGB = SetColour(rcBlue, BlueR, BlueG, BlueB, intScramble)
YellowRGB = SetColour(rcYellow, YellowR, YellowG, YellowB, intScramble)
CyanRGB = SetColour(rcCyan, CyanR, CyanG, CyanB, intScramble)
End Sub

Sub InvertColours()
WhiteRGB = InvertColour(rcWhite, WhiteRGB)
RedRGB = InvertColour(rcRed, RedRGB)
GreenRGB = InvertColour(rcGreen, GreenRGB)
BlackRGB = InvertColour(rcBlack, BlackRGB)
BlueRGB = InvertColour(rcBlue, BlueRGB)
YellowRGB = InvertColour(rcYellow, YellowRGB)
CyanRGB = InvertColour(rcCyan, CyanRGB)
End Sub

Sub ResetColours()
    Session.RestoreDefaults rcColors
End Sub

Sub GenerateColours()
    ' 1 - Blue/Green
    ' 0 - Blue/Green
    ' 2/5 - Autumnal
    ' 3/4 - Vibrant
        ' Work out a way to have the levels randomly assigned to each value rather than sticking on R/G/B
WhiteR = RndGen(255, 10)
WhiteG = RndGen(255, 10)
WhiteB = RndGen(255, 10)
RedR = RndGen(205, 100)
RedG = RndGen(50, 50)
RedB = RndGen(112, 75)
GreenR = RndGen(50, 50)
GreenG = RndGen(205, 100)
GreenB = RndGen(112, 75)
CyanR = RndGen(12, 25)
CyanG = RndGen(205, 100)
CyanB = RndGen(205, 100)
BlueR = RndGen(12, 25)
BlueG = RndGen(115, 100)
BlueB = RndGen(205, 100)
BlackR = RndGen(15, 30)
BlackG = RndGen(15, 30)
BlackB = RndGen(15, 30)
YellowR = RndGen(232, 45)
YellowG = RndGen(232, 45)
YellowB = RndGen(25, 50)
End Sub

' Cyan - Comments
' Blue - Header *** Top of Data ***, JCL instream data
' Red - Keywords
' Green - Literals
' White - Strings
' Black - Background
' Yellow - SNOWEXT header, REXX Operators

Function InvertColour(ScreenColour As Integer, RGB As Double) As Double
    InvertR = 255 - CLng("&H" & Mid(Right("000000" & Hex(RGB), 6), 1, 2))
    InvertG = 255 - CLng("&H" & Mid(Right("000000" & Hex(RGB), 6), 3, 2))
    InvertB = 255 - CLng("&H" & Mid(Right("000000" & Hex(RGB), 6), 5, 2))
    Session.SetColorRGB ScreenColour, InvertR, InvertG, InvertB
    InvertColour = CLng("&H" & Right("00" & Hex(InvertR), 2) & Right("00" & Hex(InvertG), 2) & Right("00" & Hex(InvertB), 2))
End Function


Function RGBtoNum(intR As Integer, intG As Integer, intB As Integer) As Double
    RGBtoNum = CLng("&H" & Right("00" & Hex(intR), 2) & Right("00" & Hex(intG), 2) & Right("00" & Hex(intB), 2))
End Function

Function SetColour(ScreenColour As Integer, intR As Integer, intG As Integer, intB As Integer, intScram As Integer) As Double
With Session
Select Case intScram
Case Is = 0
SSC = SetStoreColour(ScreenColour, intR, intG, intB)
Case Is = 1
SSC = SetStoreColour(ScreenColour, intR, intB, intG)
Case Is = 2
SSC = SetStoreColour(ScreenColour, intB, intG, intR)
Case Is = 3
SSC = SetStoreColour(ScreenColour, intB, intR, intG)
Case Is = 4
SSC = SetStoreColour(ScreenColour, intG, intR, intB)
Case Is = 5
SSC = SetStoreColour(ScreenColour, intG, intB, intR)
End Select
End With
SetColour = SSC
End Function

Function SetStoreColour(ScreenColour As Integer, intR As Integer, intG As Integer, intB As Integer) As Double
With Session
.SetColorRGB ScreenColour, intR, intG, intB
SetStoreColour = RGBtoNum(intR, intG, intB)
End With
End Function

Sub FuncTest()
RedRGB = SetColour(rcBlue, 255, 0, 255, 1)
End Sub

' Generate a colour value that centres around a midpoint with a range value indiciting variation from that midpoint
Function RndGen(intMid As Integer, intRange As Integer)
intStart = Int(intMid - (intRange / 2))
intR = intStart + (Rnd() * intRange)
If intR > 255 Then
    RndGen = 255
ElseIf intR < 0 Then
    RndGen = 0
Else
    RndGen = intR
End If
End Function

Sub ChristmasColours()
WhiteRGB = SetColour(rcWhite, 255, 255, 255, 0)
RedRGB = SetColour(rcRed, RndGen(158, 7), 11, 11, 0)
GreenRGB = SetColour(rcGreen, RndGen(2, 50), RndGen(155, 100), RndGen(2, 50), 0)
BlackRGB = SetColour(rcBlack, RndGen(0, 30), 0, 0, 0)
BlueRGB = SetColour(rcBlue, 19, RndGen(155, 100), 42, 0)
YellowRGB = SetColour(rcYellow, 255, 36, 19, 0)
CyanRGB = SetColour(rcCyan, RndGen(255, 75), 11, 11, 0)
End Sub