The Crypt - Printable Version

Code: (Select All)

'Cryptogram.bas for QB64 version 1106 just before 1.2 number change

' first test of Inform beta 7, B+ 2018-06-02

' now to figure out all the files that are needed to distribute this tiny little test



': This program uses

': InForm - GUI library for QB64 - Beta version 7

': Fellippe Heitor, 2016-2018 - fellippe@qb64.org - [url=https://qb64phoenix.com/forum/member.php?action=profile&uid=325]@fellippeheitor[/url]

': https://github.com/FellippeHeitor/InForm

'-----------------------------------------------------------



': Controls' IDs: ------------------------------------------------------------------

Rem NOTICE: THIS FORM HAS BEEN RECENTLY EDITED

'>> The controls in the list below may have been added or renamed,

'>> and previously existing controls may have been deleted since

'>> this program's structure was first generated.

'>> Make sure to check your code in the events SUBs so that

'>> you can take your recent edits into consideration.



' and I lost all the following code!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

'Secret Santa 3.bas for QB64 B+ 2018-05-01

' based on versions of Secret Santa I did in JB  2016-12-03

' the letters and digits want to give each other presents at Christmas

' if A is Santa to B, then B can't also be Santa to A (or B)



'To keep Code more secret randomize with a secret seed known only to you and intended reciever

secret## = 3254760 '< user and reciever should Enter this number

Randomize secret##



Dim Shared letters$, Reform$, Code$

letters$ = "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz1234567890"

L = Len(letters$)

Dim LS$(L)

'laod array

For i = 1 To L

    LS$(i) = Mid$(letters$, i, 1)

Next

'scramble array   Knuth Shuffle method

For i = L To 2 Step -1

    R = Int(i * Rnd) + 1

    Swap LS$(i), LS$(R)

Next

'now reform the Letters

Reform$ = ""

For i = 1 To L

    Reform$ = Reform$ + LS$(i)

Next



' Here is simple trick to non repetition > pair the letter with the next one up!!!

Code$ = ""

For i = 1 To L - 1

    Code$ = Code$ + Mid$(Reform$, i + 1, 1)

Next

'catch last letter pair to first

Code$ = Code$ + Mid$(Reform$, 1, 1)





': ---------------------------------------------------------------------------------

Dim Shared Cryptogram As Long

Dim Shared lbMessage As Long

Dim Shared tbMessage As Long

Dim Shared btCode As Long

Dim Shared lbCoded As Long

Dim Shared tbCode As Long

Dim Shared btDecode As Long

Dim Shared lbCodeMessage As Long

Dim Shared lbDecodedMessage As Long



': External modules: ---------------------------------------------------------------

'$Include:'InForm\InForm.bi'

'$Include:'InForm\xp.uitheme'

'$Include:'Cryptogram.frm'





Function encrypt$ (codeThis$)

    For i = 1 To Len(codeThis$)

        c$ = Mid$(codeThis$, i, 1)

        If InStr(letters$, c$) = 0 Then coded$ = coded$ + c$ Else coded$ = coded$ + encryptChar$(Mid$(codeThis$, i, 1))

    Next

    encrypt$ = coded$

End Function



Function decode$ (This$)

    For i = 1 To Len(This$)

        c$ = Mid$(This$, i, 1)

        If InStr(letters$, c$) = 0 Then dc$ = dc$ + c$ Else dc$ = dc$ + decodeChar$(Mid$(This$, i, 1))

    Next

    decode$ = dc$

End Function



Function encryptChar$ (forLetter$)

    p = InStr(Reform$, forLetter$)

    encryptChar$ = Mid$(Code$, p, 1)

End Function



Function decodeChar$ (Letter$)

    p = InStr(Code$, Letter$)

    decodeChar$ = Mid$(Reform$, p, 1)

End Function





': Event procedures: ---------------------------------------------------------------

Sub __UI_BeforeInit



End Sub



Sub __UI_OnLoad



End Sub



Sub __UI_BeforeUpdateDisplay

    'This event occurs at approximately 30 frames per second.

    'You can change the update frequency by calling SetFrameRate DesiredRate%



End Sub



Sub __UI_BeforeUnload

    'If you set __UI_UnloadSignal = False here you can

    'cancel the user's request to close.



End Sub



Sub __UI_Click (id As Long)

    Select Case id

        Case Cryptogram



        Case lbMessage



        Case tbMessage



        Case btCode

            Caption(lbCodeMessage) = encrypt$(Text(tbMessage))



        Case lbCoded



        Case tbCode



        Case btDecode

            Caption(lbDecodedMessage) = decode$(Text(tbCode))

            'SetFocus tbMessage  works



    End Select

End Sub



Sub __UI_MouseEnter (id As Long)

    Select Case id

        Case Cryptogram



        Case lbMessage



        Case tbMessage



        Case btCode



        Case lbCoded



        Case tbCode



        Case btDecode



    End Select

End Sub



Sub __UI_MouseLeave (id As Long)

    Select Case id

        Case Cryptogram



        Case lbMessage



        Case tbMessage



        Case btCode



        Case lbCoded



        Case tbCode



        Case btDecode



    End Select

End Sub



Sub __UI_FocusIn (id As Long)

    Select Case id

        Case tbMessage



        Case btCode



        Case tbCode



        Case btDecode



    End Select

End Sub



Sub __UI_FocusOut (id As Long)

    'This event occurs right before a control loses focus.

    'To prevent a control from losing focus, set __UI_KeepFocus = True below.

    Select Case id

        Case tbMessage



        Case btCode



        Case tbCode



        Case btDecode



    End Select

End Sub



Sub __UI_MouseDown (id As Long)

    Select Case id

        Case Cryptogram



        Case lbMessage



        Case tbMessage



        Case btCode



        Case lbCoded



        Case tbCode



        Case btDecode



    End Select

End Sub



Sub __UI_MouseUp (id As Long)

    Select Case id

        Case Cryptogram



        Case lbMessage



        Case tbMessage



        Case btCode



        Case lbCoded



        Case tbCode



        Case btDecode



    End Select

End Sub



Sub __UI_KeyPress (id As Long)

    'When this event is fired, __UI_KeyHit will contain the code of the key hit.

    'You can change it and even cancel it by making it = 0

    Select Case id

        Case tbMessage



        Case btCode



        Case tbCode



        Case btDecode



    End Select

End Sub



Sub __UI_TextChanged (id As Long)

    Select Case id

        Case tbMessage



        Case tbCode



    End Select

End Sub



Sub __UI_ValueChanged (id As Long)

    Select Case id

    End Select

End Sub



Sub __UI_FormResized



End Sub



'$Include:'InForm\InForm.ui'

Code: (Select All)

': This form was generated by

': InForm - GUI library for QB64 - Beta version 7

': Fellippe Heitor, 2016-2018 - fellippe@qb64.org - [url=https://qb64phoenix.com/forum/member.php?action=profile&uid=325]@fellippeheitor[/url]

': https://github.com/FellippeHeitor/InForm

'-----------------------------------------------------------

SUB __UI_LoadForm



    $RESIZE:ON

    DIM __UI_NewID AS LONG



    __UI_NewID = __UI_NewControl(__UI_Type_Form, "Cryptogram", 800, 300, 0, 0, 0)

    SetCaption __UI_NewID, "The Crypt"

    Control(__UI_NewID).Stretch = False

    Control(__UI_NewID).Font = SetFont("segoeui.ttf", 12)

    Control(__UI_NewID).CenteredWindow = True

    Control(__UI_NewID).CanResize = True



    __UI_NewID = __UI_NewControl(__UI_Type_Label, "lbMessage", 49, 21, 10, 10, 0)

    SetCaption __UI_NewID, "Message:"

    Control(__UI_NewID).Stretch = False

    Control(__UI_NewID).VAlign = __UI_Middle



    __UI_NewID = __UI_NewControl(__UI_Type_TextBox, "tbMessage", 780, 23, 10, 36, 0)

    SetCaption __UI_NewID, "Tell me a secret"

    Control(__UI_NewID).Stretch = False

    Control(__UI_NewID).HasBorder = True

    Control(__UI_NewID).CanHaveFocus = True



    __UI_NewID = __UI_NewControl(__UI_Type_Button, "btCode", 80, 23, 10, 64, 0)

    SetCaption __UI_NewID, "Code"

    Control(__UI_NewID).Stretch = False

    Control(__UI_NewID).CanHaveFocus = True



    __UI_NewID = __UI_NewControl(__UI_Type_Label, "lbCoded", 38, 21, 10, 175, 0)

    SetCaption __UI_NewID, "Coded:"

    Control(__UI_NewID).Stretch = False

    Control(__UI_NewID).VAlign = __UI_Middle



    __UI_NewID = __UI_NewControl(__UI_Type_TextBox, "tbCode", 780, 23, 10, 201, 0)

    SetCaption __UI_NewID, "???????????????????"

    Control(__UI_NewID).Stretch = False

    Control(__UI_NewID).HasBorder = True

    Control(__UI_NewID).CanHaveFocus = True



    __UI_NewID = __UI_NewControl(__UI_Type_Button, "btDecode", 80, 23, 10, 229, 0)

    SetCaption __UI_NewID, "Decode"

    Control(__UI_NewID).Stretch = False

    Control(__UI_NewID).CanHaveFocus = True



    __UI_NewID = __UI_NewControl(__UI_Type_Label, "lbCodeMessage", 780, 21, 10, 92, 0)

    SetCaption __UI_NewID, " "

    Control(__UI_NewID).Stretch = False

    Control(__UI_NewID).HasBorder = True

    Control(__UI_NewID).VAlign = __UI_Middle



    __UI_NewID = __UI_NewControl(__UI_Type_Label, "lbDecodedMessage", 780, 21, 10, 257, 0)

    SetCaption __UI_NewID, " "

    Control(__UI_NewID).Stretch = False

    Control(__UI_NewID).HasBorder = True

    Control(__UI_NewID).VAlign = __UI_Middle



END SUB



SUB __UI_AssignIDs

    Cryptogram = __UI_GetID("Cryptogram")

    lbMessage = __UI_GetID("lbMessage")

    tbMessage = __UI_GetID("tbMessage")

    btCode = __UI_GetID("btCode")

    lbCoded = __UI_GetID("lbCoded")

    tbCode = __UI_GetID("tbCode")

    btDecode = __UI_GetID("btDecode")

    lbCodeMessage = __UI_GetID("lbCodeMessage")

    lbDecodedMessage = __UI_GetID("lbDecodedMessage")

END SUB