fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
Lügendetektor ;)

Uploader:	raph ael
Datum/Zeit:	14.03.2008 13:12:43
'______________________________________________________________________

'           Lügendetektor nach dem Raphael- Verfahren

'                     (c) by Raphael R.

'

' Leertaste kurz drücken:   WAHRHEIT

' Leertaste länger drücken: LÜGE

'______________________________________________________________________



    enum

        SC_ESCAPE     = &h01

        SC_1

        SC_2

        SC_3

        SC_4

        SC_5

        SC_6

        SC_7

        SC_8

        SC_9

        SC_0

        SC_MINUS

        SC_EQUALS

        SC_BACKSPACE

        SC_TAB

        SC_Q

        SC_W

        SC_E

        SC_R

        SC_T

        SC_Y

        SC_U

        SC_I

        SC_O

        SC_P

        SC_LEFTBRACKET

        SC_RIGHTBRACKET

        SC_ENTER

        SC_CONTROL

        SC_A

        SC_S

        SC_D

        SC_F

        SC_G

        SC_H

        SC_J

        SC_K

        SC_L

        SC_SEMICOLON

        SC_QUOTE

        SC_TILDE

        SC_LSHIFT

        SC_BACKSLASH

        SC_Z

        SC_X

        SC_C

        SC_V

        SC_B

        SC_N

        SC_M

        SC_COMMA

        SC_PERIOD

        SC_SLASH

        SC_RSHIFT

        SC_MULTIPLY

        SC_ALT

        SC_SPACE

        SC_CAPSLOCK

        SC_F1

        SC_F2

        SC_F3

        SC_F4

        SC_F5

        SC_F6

        SC_F7

        SC_F8

        SC_F9

        SC_F10

        SC_NUMLOCK

        SC_SCROLLLOCK

        SC_HOME

        SC_UP

        SC_PAGEUP

        SC_LEFT       = &h4B

        SC_RIGHT      = &h4D

        SC_PLUS

        SC_END

        SC_DOWN

        SC_PAGEDOWN

        SC_INSERT

        SC_DELETE

        SC_F11        = &h57

        SC_F12

        SC_LWIN       = &h5B

        SC_RWIN

        SC_MENU

    end Enum



Declare Sub PrintLuege

Declare Sub PrintWahr

Declare Sub headline

Declare Sub thread_random(apply As Integer)

Declare Sub thread_watchout(apply As Integer)



Sub PrintLuege

    Cls

    Locate 0, 0

    headline

    Print

    Print

    Print "    __         _   _         ______         ______"

    Print "   / /        (_) (_)       / ____/        / ____/"

    Print "  / /        / / / /       / / __         / __/   "

    Print " / /___     / /_/ /       / /_/ /        / /___   "

    Print "/_____/     \____/        \____/        /_____/   "

    Print "                                                  "

End Sub



Sub PrintWahr

    Cls

    Locate 0, 0

    headline

    Print

    Print

    Print " _       __            __              __            _    __ "

    Print "| |     / /  ____ _   / /_    _____   / /_   ___    (_)  / /_"

    Print "| | /| / /  / __ `/  / __ \  / ___/  / __ \ / _ \  / /  / __/"

    Print "| |/ |/ /  / /_/ /  / / / / / /     / / / //  __/ / /  / /_  "

    Print "|__/|__/   \__,_/  /_/ /_/ /_/     /_/ /_/ \___/ /_/   \__/  "

    Print "                                                             "

End Sub



Sub headline

    Print " _        _   _                              _          _            _      _                   "

    Print "| |      (_) (_)                            | |        | |          | |    | |                  "

    Print "| |       _   _    __ _    ___   _ __     __| |   ___  | |_    ___  | | __ | |_    ___    _ __  "

    Print "| |      | | | |  / _` |  / _ \ | '_ \   / _` |  / _ \ | __|  / _ \ | |/ / | __|  / _ \  | '__| "

    Print "| |____  | |_| | | (_| | |  __/ | | | | | (_| | |  __/ | |_  |  __/ |   |  | |_  | (_) | | |    "

    Print "|______|  \__,_|  \__, |  \___| |_| |_|  \__,_|  \___|  \__|  \___| |_|\_\  \__|  \___/  |_|    "

    Print "                   __/ |                                                                        "

    Print "                  |___/                                                                         "

    Print "Nach dem Raphael- Verfahren"

    Print

End Sub



Randomize Timer

Width 97, 25

headline



    Dim k As String

    Dim NewTimer As ULong

    Dim jup As Byte

    Dim As UInteger oldy, oldx

    Dim Shared timing As UInteger



    Do

        While InKey <> "" : Wend

        NewTimer = Timer

        jup = 0

        If MultiKey(SC_SPACE) Then

            jup = 1

            while MultiKey(SC_SPACE)

                While InKey <> "" : Wend

            Wend

        EndIf

        timing = Timer

        timing = timing - NewTimer

        If jup = 1 Then

            If timing <= 1/18 Then

                oldy = CsrLin

                oldx = Pos

                Locate 15

                PrintWahr

                Locate oldy, oldx

            Else

                oldy = CsrLin

                oldx = Pos

                Locate 15

                PrintLuege

            End If

        EndIf

        While InKey <> "" : Wend

        Sleep 1

    Loop Until MultiKey(SC_ESCAPE)