PureBoard

; English forum: http://purebasic.myforums.net/viewtopic.php?t=8121&highlight=
; Author: Psychophanta
; Date: 17. November 2003

Procedure.l Min(n1.l,n2.l)
  !mov eax,dword[p.v_n1]
  !cmp eax,dword[p.v_n2]
  !cmovnl eax,dword[p.v_n2] ;for i686 and above only
  ProcedureReturn
EndProcedure

;Try it:
Debug Min(20,178)
Debug Min(177,178)
Debug Min(170,20)



Procedure.l Max(n1.l,n2.l)
  !mov eax,dword[p.v_n1]
  !cmp eax,dword[p.v_n2]
  !cmovl eax,dword[p.v_n2];<-- NOTE: for i686 and above only
  ProcedureReturn
EndProcedure

;Try it:
Debug Max(20,-178)
Debug Max(-177,-178)
Debug Max(170,20)



Procedure.f MinF(n1.f,n2.f)
  !fld dword[p.v_n1]
  !fld dword[p.v_n2]
  !fstp st2
  !fcomi st1
  !fcmovnb st1
  ProcedureReturn
EndProcedure

;prove it:
Debug MinF(20,178)
Debug MinF(20.177,20.178)
Debug MinF(170,20)
For t=-20 To 20
  Debug MinF(0,t)
Next



Procedure.f MaxF(n1.f,n2.f)
  !fld dword[p.v_n1]
  !fld dword[p.v_n2]
  !fstp st2
  !fcomi st1
  !fcmovb st1
  ProcedureReturn
EndProcedure

;prove it:
Debug MaxF(20,178)
Debug MaxF(20.177,20.178)
Debug MaxF(170,20)
s.f=-5
While s.f<5
  Debug MaxF(s,-1.00202)
  s+0.269048
Wend
; ExecutableFormat=Windows
; EOF

; German forum: http://robsite.de/php/pureboard/viewtopic.php?t=1390&highlight=
; Author: Rings
; Date: 17. June 2003
; Translatet to PB4.0: leonhard

; Switch console to Full Screen Mode
; Windows only

CompilerIf #PB_Compiler_OS <> #PB_OS_Windows
  CompilerError "The Code 'Console in Fullscreen' is only for Windows"
CompilerEndIf


;/!!!
;/!!! Die kernel32.lib -Lib wurde nicht für PB4 optimiert
;/!!! The kernel32.lib -Lib wos not optimized for PB4.
;/!!!
;Import "kernel32.lib"
;  SetConsoleDisplayMode(hConsoleOutput.l, dwFlags.l, *lpNewScreenBufferDimensions.COORD)
;EndImport

#CONSOLE_FULLSCREEN_MODE = 1 ; Vollbild-Konsole
#CONSOLE_WINDOWED_MODE = 2 ; Windows-Fester-Konsole
Prototype.b SetConsoleDisplayMode(hConsoleOutput.l, dwFlags.l, *lpNewScreenBufferDimensions.COORD)

OpenLibrary(1, "kernel32.dll")
SetConsoleDisplayMode.SetConsoleDisplayMode = GetFunction(1, "SetConsoleDisplayMode")

OpenConsole()
  dwOldMode.COORD
  Result=GetConsoleDisplayMode_(@dwOldMode)
  hOut=GetStdHandle_(#STD_OUTPUT_HANDLE)
  SetConsoleDisplayMode(hOut, #CONSOLE_FULLSCREEN_MODE, @dwOldMode)
 
  ConsoleColor(14,3)
  ConsoleLocate(10,10)
  Print("FULL SCREENMODE ! - Press RETURN")
  Input()
 
  SetConsoleDisplayMode(hOut, #CONSOLE_WINDOWED_MODE, @dwOldMode)
 
  ClearConsole()
  ConsoleColor(10,2)
  ConsoleLocate(10,10)
  Print("Windowed MODE ! - Press RETURN")
 
  Input()
CloseConsole()

End

; ExecutableFormat=Windows
; CursorPosition=5
; FirstLine=1
; EOF

; German forum: http://robsite.de/php/pureboard/viewtopic.php?t=2577&highlight=
; Author: NoOneKnows
; Date: 17. October 2003
; Translated to PB4.0 by: leonhard

;/***************************************************/;
;/**         Xtended Console Version 1.1.0         **/;
;/**  (c) 2003 by NoOneKnows <NoOneKnows@Gmx.de>   **/;
;/***************************************************/;

#XTENDEDCONSOLE_MAXINPUTCHARS       = 400
#XTENDEDCONSOLE_LIBRARY             = 900

Global gStdOut.l
Global gStdIn.l

Structure COORDEX
    StructureUnion
        Value.l
        coord.COORD
    EndStructureUnion
EndStructure

Structure INPUT_RECORD
    wEventType.w
    StructureUnion
        KeyEvent.KEY_EVENT_RECORD
        MouseEvent.MOUSE_EVENT_RECORD
        WindowBufferSizeEvent.WINDOW_BUFFER_SIZE_RECORD
        MenuEvent.MENU_EVENT_RECORD
        FocusEvent.FOCUS_EVENT_RECORD
    EndStructureUnion
EndStructure

#CONSOLE_FULLSCREEN_MODE = 1 ; Vollbild-Konsole
#CONSOLE_WINDOWED_MODE = 2 ; Windows-Fester-Konsole
Prototype.b SetConsoleDisplayMode(hConsoleOutput.l, dwFlags.l, *lpNewScreenBufferDimensions.COORD)

OpenLibrary(1, "kernel32.dll")
Global SetConsoleDisplayMode.SetConsoleDisplayMode = GetFunction(1, "SetConsoleDisplayMode")

;-Allgemeines
;* alle Funktionen die mit "Ex" enden haben die gleiche Funktionalität wie
;  die originalen PureBasic funktionen...
;* bei Vergrößerung der Konsole kann diese niemals größer werden als ihr Buffer
;* größter Vorteil dieser manuellen Konsole ist, das sie scrollbar ist im
;  Gegensatz zur PureBasic-StandardKonsole
;* hiermit lassen sich auch mehr 80 Zeichen per Input einlesen,
;  also auch Zeilenübergreifend (evtl. MAXINPUTCHARS anpassen)

;-Funktions-Beschreibung

Declare     PrintNEx(text$)
;siehe PureBasic-Hilfe

Declare     PrintEx(text$)
;siehe PureBasic-Hilfe

Declare.l   OpenConsoleEx()
;siehe PureBasic-Hilfe. Das AllocConsole_() kann in der Funktion durch
;OpenConsole() ersetzt werden. Dadurch funktionieren auch die
;PureBasic-Standardfunktionen kann unter Umständen aber zu Problemen führen

Declare.s   InputN()
;siehe PureBasic-Hilfe, jedoch mit dem Zusatz, das ein Zeilenumbruch stattfindet

Declare.s   InputEx()
;siehe PureBasic-Hilfe

Declare.s   InkeyEx()
;siehe PureBasic-Hilfe

Declare     GetConsoleWindowPosition(*rect.RECT)
;gibt die Position des Konsolen-Fensters als RECT referenziert zurück

Declare.l   GetConsoleWindowCharSize(*windowSize.COORD)
;gibt referenziert die größe des Fensters der Konsole in Konsolen-Zeichen an

Declare.l   GetConsoleWindowCharArea(*windowArea.SMALL_RECT)
;gibt referenziert den aktuellen Ausschnitt der Konsole in Konsolen-Zeichen an

Declare.s   GetConsoleTitle()
;gibt den ConsolenTitel zurück

Declare.l   GetConsoleCursorLocation(*cursorPos.COORD)
;gibt die Position des Cursors als COORD referenziert zurück

Declare.w   GetCursorY()
;gibt die Y-Position des Cursors zurück

Declare.w   GetCursorX()
;gibt die X-Position des Cursors zurück

Declare     ConsoleWindowSize(width.l, height.l)
;ändert die Breite und die Höhe der Konsole (Angabe in Pixel)

Declare     ConsoleWindowShow()
;holt das Fenster aus dem minimierten Zustand zurück und zeigt es an

Declare     ConsoleWindowPosition(x.l, y.l, width.l, height.l)
;ändert Position und Größe der Konsole (Angabe in Pixel)

Declare     ConsoleWindowOnTop()
;das Konsolenfenster wird in den Vordergrund gerückt

Declare     ConsoleWindowMove(x.l, y.l)
;ändert die X(Y-Position des Konsolenfensters (Angabe in Pixel)

Declare     ConsoleWindowMaximize()
;maximiert die Konsole entsprechend der Buffer- bzw. Bildschirmgröße.
;ist der Bildschirm größer als der Buffer, so gilt der Buffer als Maß,
;andernfalls der Bildschirm

Declare     ConsoleWindowCharSize(characterWidth.l, characterHeight.l)
;#ndert die Breite und Höhe der Konsole (Angabe in Konsolen-Zeichen)

Declare     ConsoleTitleEx(title$)
;siehe PureBasic-Hilfe

Declare     ConsoleMoveLocation(x.l, y.l)
;bewegt den Cursor relativ zur aktuellen Position

Declare     ConsoleLocateEx(x.l, y.l)
;siehe PureBasic-Hilfe

Declare     ConsoleFullScreen(fullscreen.b)
;setzt die Konsole in den Fullscreen-Modus.
;da die Funtkion von Microsoft aus net dokumentiert ist, weiß ich nicht
;ob sie wirklich von alle Windows-Betriebssystemen unterstützt wird
;1 ist fullscreen an und 0 bedeutetd fullscrenn aus

Declare     ConsoleFlash(times.l)
;lässt die Konsole ein paar mal aufblinken (je nach times)

Declare     ConsoleCursorEx(height.l)
;siehe PureBasic-Hilfe

Declare     ConsoleColorBuffer(characterColor.l, backgroundColor.l)
;färbt die gesamte Konsole mit einschlißlich dem gesamten Buffer
;in der angegebenen Farbkombination

Declare     ConsoleColorEx(characterColor.l, backgroundColor.l)
;siehe PureBasic-Hilfe

Declare     ConsoleBufferSize(characterWidth.l, characterHeight.l)
;legt die Größe des Buffers fest (Angabe in Konsolen-Zeichen)

Declare     CloseConsoleEx()
;siehe PureBasic-Hilfe

Declare     ClearConsoleEx()
;siehe PureBasic-Hilfe


;nur intern
Declare.l   GetConsoleWindowHandle()
Declare     GetColorValue(foreColor.l, backColor.l)
Declare.l   GetConsoleLocationDirect()
Declare     FlashConsoleWindow(hwnd.l)

;-Intern Funktionen

Procedure FlashConsoleWindow(hwnd.l)
    Shared sharedTimes.l

    For J.l = 1 To sharedTimes
        FlashWindow_(hwnd, 1)
        Delay(1500)
    Next J
EndProcedure

Procedure.l GetConsoleLocationDirect()
    consoleInfo.CONSOLE_SCREEN_BUFFER_INFO
    GetConsoleScreenBufferInfo_(gStdOut, @consoleInfo)
    ProcedureReturn consoleInfo\dwCursorPosition\x + consoleInfo\dwCursorPosition\y * 65536
EndProcedure

Procedure GetColorValue(foreColor.l, backColor.l)
    Select foreColor
        Case 0
            foreColor = 0
        Case 1
            foreColor = #FOREGROUND_BLUE
        Case 2
            foreColor = #FOREGROUND_GREEN
        Case 3
            foreColor = #FOREGROUND_GREEN | #FOREGROUND_BLUE
        Case 4
            foreColor = #FOREGROUND_RED
        Case 5
            foreColor = #FOREGROUND_RED | #FOREGROUND_BLUE
        Case 6
            foreColor = #FOREGROUND_RED | #FOREGROUND_GREEN
        Case 7
            foreColor = #FOREGROUND_RED | #FOREGROUND_GREEN | #FOREGROUND_BLUE
        Case 8
            foreColor = #FOREGROUND_INTENSITY
        Case 9
            foreColor = #FOREGROUND_BLUE | #FOREGROUND_INTENSITY
        Case 10
            foreColor = #FOREGROUND_GREEN | #FOREGROUND_INTENSITY
        Case 11
            foreColor = #FOREGROUND_GREEN | #FOREGROUND_BLUE | #FOREGROUND_INTENSITY
        Case 12
            foreColor = #FOREGROUND_RED | #FOREGROUND_INTENSITY
        Case 13
            foreColor = #FOREGROUND_RED | #FOREGROUND_BLUE | #FOREGROUND_INTENSITY
        Case 14
            foreColor = #FOREGROUND_RED | #FOREGROUND_GREEN | #FOREGROUND_INTENSITY
        Case 15
            foreColor = #FOREGROUND_RED | #FOREGROUND_GREEN | #FOREGROUND_BLUE | #FOREGROUND_INTENSITY
    EndSelect

    Select backColor
        Case 0
            backColor = 0
        Case 1
            backColor = #BACKGROUND_BLUE
        Case 2
            backColor = #BACKGROUND_GREEN
        Case 3
            backColor = #BACKGROUND_GREEN | #BACKGROUND_BLUE
        Case 4
            backColor = #BACKGROUND_RED
        Case 5
            backColor = #BACKGROUND_RED | #BACKGROUND_BLUE
        Case 6
            backColor = #BACKGROUND_RED | #BACKGROUND_GREEN
        Case 7
            backColor = #BACKGROUND_RED | #BACKGROUND_GREEN | #BACKGROUND_BLUE
        Case 8
            backColor = #BACKGROUND_INTENSITY
        Case 9
            backColor = #BACKGROUND_BLUE | #BACKGROUND_INTENSITY
        Case 10
            backColor = #BACKGROUND_GREEN | #BACKGROUND_INTENSITY
        Case 11
            backColor = #BACKGROUND_GREEN | #BACKGROUND_BLUE | #BACKGROUND_INTENSITY
        Case 12
            backColor = #BACKGROUND_RED | #BACKGROUND_INTENSITY
        Case 13
            backColor = #BACKGROUND_RED | #BACKGROUND_BLUE | #BACKGROUND_INTENSITY
        Case 14
            backColor = #BACKGROUND_RED | #BACKGROUND_GREEN | #BACKGROUND_INTENSITY
        Case 15
            backColor = #BACKGROUND_RED | #BACKGROUND_GREEN | #BACKGROUND_BLUE | #BACKGROUND_INTENSITY
    EndSelect

    ProcedureReturn foreColor | backColor
EndProcedure

Procedure.l GetConsoleWindowHandle()
    If OSVersion() = #PB_OS_Windows_2000 Or OSVersion() = #PB_OS_Windows_XP
        OpenLibrary(#XTENDEDCONSOLE_LIBRARY, "kernel32.dll")
        hwnd = CallFunction(#XTENDEDCONSOLE_LIBRARY, "GetConsoleWindow")
        CloseLibrary(#XTENDEDCONSOLE_LIBRARY)
        ProcedureReturn hwnd
    Else
        title$ = GetConsoleTitle()
        currentProcessID.l = GetCurrentProcessId_()
   
        hwnd.l = FindWindow_(#Null, title$)
        GetWindowThreadProcessId_(hwnd, @processID.l)
        If processID = currentProcessID
            ProcedureReturn hwnd
        Else
            first.l = GetWindow_(hwnd, #GW_HWNDFIRST)
            GetWindowThreadProcessId_(first, @processID.l)
            If processID = currentProcessID
                Debug first
                ProcedureReturn first
            EndIf
           
            hwnd = first
            Repeat
                hwnd = GetWindow_(hwnd, #GW_HWNDNEXT)
                GetWindowThreadProcessId_(first, @processID.l)
                If processID = currentProcessID
                    Debug hwnd
                    ProcedureReturn hwnd
                EndIf
            Until hwnd = first Or hwnd = 0
        EndIf
    EndIf

    ProcedureReturn 0
EndProcedure

;-Externe Funktionen

Procedure ClearConsoleEx()
    consoleInfo.CONSOLE_SCREEN_BUFFER_INFO
    GetConsoleScreenBufferInfo_(gStdOut, @consoleInfo)
    size.l = consoleInfo\dwSize\x * consoleInfo\dwSize\y

    FillConsoleOutputCharacter_(gStdOut, 32, size, #Null, @written.l)

    GetConsoleScreenBufferInfo_(gStdOut, @consoleInfo)
    size.l = consoleInfo\dwSize\x * consoleInfo\dwSize\y
   
    FillConsoleOutputAttribute_(gStdOut, consoleInfo\wAttributes, size, #Null, @written.l)
   
    SetConsoleCursorPosition_(gStdOut, #Null)
EndProcedure

Procedure CloseConsoleEx()
    CloseHandle_(gStdOut)
    CloseHandle_(gStdIn)
    FreeConsole_()
EndProcedure

Procedure ConsoleBufferSize(characterWidth.l, characterHeight.l)
    GetConsoleScreenBufferInfo_(gStdOut, @consoleInfo.CONSOLE_SCREEN_BUFFER_INFO)
   
    Debug consoleInfo\dwSize\x
    Debug consoleInfo\dwSize\y
    If characterWidth < consoleInfo\dwSize\x Or characterHeight < consoleInfo\dwSize\y
        rect.SMALL_RECT
        If characterWidth < 13 ;kleinere Buzffer-Breite geht scheinbar net
            rect\right = 13 - 1
            characterWidth = 13
        ElseIf characterWidth < consoleInfo\dwSize\x
            rect\right = characterWidth - 1
        Else
            rect\right = consoleInfo\dwSize\x - 1
        EndIf
       
        If characterHeight <= 0
            rect\bottom = 1 - 1
            characterHeight = 1
        ElseIf characterHeight < consoleInfo\dwSize\y
            rect\bottom = characterHeight - 1
        Else
            rect\bottom = consoleInfo\dwSize\y - 1
        EndIf
       
        Debug rect\right
        Debug rect\bottom
        SetConsoleWindowInfo_(gStdOut, 1, @rect)
    EndIf
   

    SetConsoleScreenBufferSize_(gStdOut, characterWidth + (65536 * characterHeight))
EndProcedure

Procedure ConsoleColorEx(characterColor.l, backgroundColor.l)
    SetConsoleTextAttribute_(gStdOut, GetColorValue(characterColor, backgroundColor))
EndProcedure

Procedure ConsoleColorBuffer(characterColor.l, backgroundColor.l)
    GetConsoleScreenBufferInfo_(gStdOut, @consoleInfo.CONSOLE_SCREEN_BUFFER_INFO)
    size.l = consoleInfo\dwSize\x * consoleInfo\dwSize\y
    consoleInfo\wAttributes = GetColorValue(characterColor, backgroundColor)
   
    FillConsoleOutputAttribute_(gStdOut, consoleInfo\wAttributes, size, #Null, @written.l)
EndProcedure

Procedure ConsoleCursorEx(height.l)
    cursorInfo.CONSOLE_CURSOR_INFO
    If height <= 0
        cursorInfo\bVisible = 0
        height = 1
    ElseIf height > 10
        cursorInfo\bVisible = 1
        height = 10
    Else
        cursorInfo\bVisible = 1
    EndIf
   
    cursorInfo\dwSize = height * 10
    SetConsoleCursorInfo_(gStdOut, @cursorInfo)
EndProcedure

Procedure ConsoleFlash(times.l)
    Shared sharedTimes.l

    hwnd.l = GetConsoleWindowHandle()
    If hwnd
        If times <= 1
            FlashWindow_(hwnd, 1)
        Else
            sharedTimes = times
            CreateThread(@FlashConsoleWindow(), hwnd)
        EndIf
    EndIf
EndProcedure

Procedure ConsoleFullScreen(fullscreen.b)
    If fullscreen
        SetConsoleDisplayMode(gStdOut, 1, @oldMode.l)
    Else
        SetConsoleDisplayMode(gStdOut, 0, @oldMode.l)
    EndIf
EndProcedure

Procedure ConsoleLocateEx(x.l, y.l)
    SetConsoleCursorPosition_(gStdOut, x + (65536 * y))
EndProcedure

Procedure ConsoleMoveLocation(x.l, y.l)
    GetConsoleCursorLocation(@cursorPos.COORD)
    SetConsoleCursorPosition_(gStdOut, (cursorPos\x + x) + (65536 * (cursorPos\y + y)))
EndProcedure

Procedure ConsoleTitleEx(title$)
    SetConsoleTitle_(title$)
EndProcedure

Procedure ConsoleWindowCharSize(characterWidth.l, characterHeight.l)
    consoleInfo.CONSOLE_SCREEN_BUFFER_INFO
    GetConsoleScreenBufferInfo_(gStdOut, @consoleInfo)

    rect.SMALL_RECT
    rect\bottom = characterHeight - 1
    rect\right = characterWidth - 1

    If rect\bottom > consoleInfo\dwSize\y
        rect\bottom = consoleInfo\dwSize\y - 1
    EndIf
    If rect\right > consoleInfo\dwSize\x
        rect\right = consoleInfo\dwSize\x - 1
    EndIf
    SetConsoleWindowInfo_(gStdOut, 1, @rect)
EndProcedure

Procedure ConsoleWindowMaximize()
    maxSize.COORDEX\Value = GetLargestConsoleWindowSize_(gStdOut)
    ConsoleWindowCharSize(maxSize\coord\x, maxSize\coord\y)
EndProcedure

Procedure ConsoleWindowMinimize()
    hwnd.l = GetConsoleWindowHandle()
    If hwnd
        ShowWindow_(hwnd, #SW_MINIMIZE)
    EndIf
EndProcedure

Procedure ConsoleWindowMove(x.l, y.l)
    hwnd.l = GetConsoleWindowHandle()
    If hwnd
        SetWindowPos_(hwnd, 0, x, y, 0, 0, #SWP_NOSIZE)
    EndIf
EndProcedure

Procedure ConsoleWindowOnTop()
    hwnd.l = GetConsoleWindowHandle()
    If hwnd
        SetWindowPos_(hwnd, #HWND_TOP, 0, 0, 0, 0, #SWP_NOMOVE | #SWP_NOSIZE | #SWP_SHOWWINDOW)
    EndIf
EndProcedure

Procedure ConsoleWindowPosition(x.l, y.l, width.l, height.l)
    hwnd.l = GetConsoleWindowHandle()
    If hwnd
        MoveWindow_(hwnd, x, y, width, height, 1)
    EndIf
EndProcedure

Procedure ConsoleWindowShow()
    hwnd.l = GetConsoleWindowHandle()
    If hwnd
        ShowWindow_(hwnd, #SW_SHOWNORMAL)
    EndIf
EndProcedure

Procedure ConsoleWindowSize(width.l, height.l)
    hwnd.l = GetConsoleWindowHandle()
    If hwnd
        SetWindowPos_(hwnd, #HWND_TOP, 0, 0, width, height, #SWP_NOMOVE)
    EndIf
EndProcedure

Procedure.l GetConsoleCursorLocation(*cursorPos.COORD)
    consoleInfo.CONSOLE_SCREEN_BUFFER_INFO
    GetConsoleScreenBufferInfo_(gStdOut, @consoleInfo)
    *cursorPos\x = consoleInfo\dwCursorPosition\x
    *cursorPos\y = consoleInfo\dwCursorPosition\y
EndProcedure

Procedure.s GetConsoleTitle()
    title$ = LSet("", 150, Chr(0))
    GetConsoleTitle_(@title$, 150)
    ProcedureReturn title$
EndProcedure

Procedure.l GetConsoleWindowCharArea(*windowArea.SMALL_RECT)
    consoleInfo.CONSOLE_SCREEN_BUFFER_INFO
    GetConsoleScreenBufferInfo_(gStdOut, @consoleInfo)
    CopyMemory(consoleInfo\srWindow, *windowArea, 8)
EndProcedure

Procedure.l GetConsoleWindowCharSize(*windowSize.COORD)
    consoleInfo.CONSOLE_SCREEN_BUFFER_INFO
    GetConsoleScreenBufferInfo_(gStdOut, @consoleInfo)
    CopyMemory(consoleInfo\dwSize, *windowSize, 8)
EndProcedure

Procedure GetConsoleWindowPosition(*rect.RECT)
    hwnd = GetConsoleWindowHandle()
    If hwnd
        placement.WINDOWPLACEMENT\Length = SizeOf(WINDOWPLACEMENT)
        GetWindowPlacement_(hwnd, @placement)
        CopyMemory(@placement\rcNormalPosition, *rect, 16)
    EndIf
EndProcedure

Procedure.w GetCursorX()
    consoleInfo.CONSOLE_SCREEN_BUFFER_INFO
    GetConsoleScreenBufferInfo_(gStdOut, @consoleInfo)
    ProcedureReturn consoleInfo\dwCursorPosition\x
EndProcedure

Procedure.w GetCursorY()
    consoleInfo.CONSOLE_SCREEN_BUFFER_INFO
    GetConsoleScreenBufferInfo_(gStdOut, @consoleInfo)
    ProcedureReturn consoleInfo\dwCursorPosition\y
EndProcedure

Procedure.s InkeyEx()
    inputRecord.INPUT_RECORD
    PeekConsoleInput_(gStdIn, @inputRecord, 1, @readed.l)
   
    If inputRecord\wEventType = #KEY_EVENT
        ReadConsoleInput_(gStdIn, @inputRecord, 1, @readed.l)
        If PeekB(@inputRecord\KeyEvent\bKeyDown + 2)
            Char.b = (inputRecord\KeyEvent\wVirtualScanCode | inputRecord\KeyEvent\dwControlKeyState) & inputRecord\KeyEvent\dwControlKeyState
            ;aus Kompatibilität zu PureBasic-Inkey()
            If Char = 0 : Char = 255 : EndIf
            ProcedureReturn Chr(Char) + Chr(inputRecord\KeyEvent\uChar)
        EndIf
    ElseIf inputRecord\wEventType > 0
        ReadConsoleInput_(gStdIn, @inputRecord, 1, @readed.l)
    EndIf

    ProcedureReturn ""
EndProcedure

Procedure.s InputEx()
    GetConsoleCursorLocation(@cursorPos.COORD)

    GetConsoleScreenBufferInfo_(gStdOut, @consoleInfo.CONSOLE_SCREEN_BUFFER_INFO)

    inputBuffer$ = LSet("", #XTENDEDCONSOLE_MAXINPUTCHARS, Chr(0))
    ReadConsole_(gStdIn, @inputBuffer$, #XTENDEDCONSOLE_MAXINPUTCHARS, @readed.l, #Null)
    ;CRLF nicht zurückgeben
    If Mid(inputBuffer$, readed, 1) = Chr(10)
        readed - 1
    EndIf
    If Mid(inputBuffer$, readed, 1) = Chr(13)
        readed - 1
    EndIf
   
    y.l = cursorPos\y + (cursorPos\x + readed) / consoleInfo\dwSize\x
    x.l = (cursorPos\x + readed) % consoleInfo\dwSize\x
    ConsoleLocateEx(x, y)
   
    ProcedureReturn Left(inputBuffer$, readed)
EndProcedure

Procedure.s InputN()
    inputBuffer$ = LSet("", #XTENDEDCONSOLE_MAXINPUTCHARS, Chr(0))
    ReadConsole_(gStdIn, @inputBuffer$, #XTENDEDCONSOLE_MAXINPUTCHARS, @readed.l, #Null)
    ;CRLF nicht zurückgeben
    If Mid(inputBuffer$, readed, 1) = Chr(10)
        readed - 1
    EndIf
    If Mid(inputBuffer$, readed, 1) = Chr(13)
        readed - 1
    EndIf
   
    ProcedureReturn Left(inputBuffer$, readed)
EndProcedure

Procedure.l OpenConsoleEx()
    AllocConsole_()
    ;Alternativ auch möglich um die Standardfunktionen zu nutzen
    ;kann jedoch zu verschiedenen Fehlern führen
    ;OpenConsole()
   
    gStdOut.l = GetStdHandle_(#STD_OUTPUT_HANDLE)
    gStdIn.l = GetStdHandle_(#STD_INPUT_HANDLE)

    If gStdIn = #INVALID_HANDLE_VALUE Or gStdOut = #INVALID_HANDLE_VALUE
        ProcedureReturn 0
    Else
        ProcedureReturn 1
    EndIf
EndProcedure

Procedure PrintEx(text$)
    WriteConsole_(gStdOut, @text$, Len(text$), @written.l, #Null)
EndProcedure

Procedure PrintNEx(text$)
    text$ + Chr(13) + Chr(10)
    WriteConsole_(gStdOut, @text$, Len(text$), @written.l, #Null)
EndProcedure

; ExecutableFormat=Windows
; EOF

; German forum: http://robsite.de/php/pureboard/viewtopic.php?t=1501&start=10
; Author: Danilo (updated for PB 4.00 by ste123)
; Date: 05. July 2003
; OS: Windows
; Demo: Yes

If InitEngine3D() And InitSprite() And InitKeyboard()
  OpenWindow(0,0,0,640,480,"3D Mesh Test",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  OpenWindowedScreen(WindowID(0),0,0,640,480,0,0,0)
  BigFont = LoadFont(1,"Arial",38)

    CreateTexture(0,100,100)
    StartDrawing(TextureOutput(0))
      Box(0,0,100,100,$00FFFF)
      LineXY(0,0,100,100,$000000)
      LineXY(100,0,0,100,$000000)
      FrontColor(RGB($00,$00,$FF))
      DrawingMode(1)
      DrawingFont(BigFont)
      DrawText(0,0,"123")
    StopDrawing()
   
    CreateMaterial(0, TextureID(0))

    ; Viereck 1
    CreateMesh(1,30)
    SetMeshData(1,#PB_Mesh_Vertex       ,?Ecken            , 4) ; 4 Ecken
    SetMeshData(1,#PB_Mesh_Face         ,?Viereck_1        , 2) ; 2 Dreicke
    SetMeshData(1,#PB_Mesh_UVCoordinate ,?TexturKoordinaten, 4)

    CreateEntity(1, MeshID(1), MaterialID(0))


    ; Viereck 2
    CreateMesh(2,30)
    SetMeshData(2,#PB_Mesh_Vertex       ,?Ecken            , 4) ; 4 Ecken
    SetMeshData(2,#PB_Mesh_Face         ,?Viereck_2        , 2) ; 2 Dreiecke
    SetMeshData(2,#PB_Mesh_UVCoordinate ,?TexturKoordinaten, 4)

    CreateEntity(2, MeshID(2), MaterialID(0))


    ; Viereck 3
    CreateMesh(3,30)
    SetMeshData(3,#PB_Mesh_Vertex       ,?Ecken            , 4) ; 4 Ecken
    SetMeshData(3,#PB_Mesh_Face         ,?Viereck_3        , 4) ; 4 Dreiecke (Vorder- und Rueckseite)
    SetMeshData(3,#PB_Mesh_UVCoordinate ,?TexturKoordinaten, 4)

    CreateEntity(3, MeshID(3), MaterialID(0))


    MoveEntity(1,-3,0,0)
    MoveEntity(3, 3,0,0)
   
    CreateCamera(0, 0, 0, 100, 100)
    CameraLocate(0,0,0,10)
   
    Repeat
       ClearScreen( RGB(0,0,0) )
      ExamineKeyboard()
      Select WindowEvent()
        Case #PB_Event_CloseWindow
          Quit = #True
      EndSelect

         rot+1
         If rot>=360 : rot=0 : EndIf

      RotateEntity(1, rot, rot, 0)
      RotateEntity(2, rot, rot, 0)
      RotateEntity(3, rot, rot, 0)
      RenderWorld()
      FlipBuffers()
    Until KeyboardPushed(#PB_Key_Escape) Or Quit
Else
  MessageRequester("Error", "Cant init DirectX 3D Engine",0)
EndIf
 
End


DataSection

  Ecken:
    Data.f -1, -1,  0 ; Ecke 0             3-----2
    Data.f  1, -1,  0 ; Ecke 1             |  .  |
    Data.f  1,  1,  0 ; Ecke 2             |     |
    Data.f -1,  1,  0 ; Ecke 3             0-----1

  TexturKoordinaten:
    Data.f 0.0, 0.0 ; Vertex 0
    Data.f 1.0, 0.0 ; Vertex 1
    Data.f 1.0, 1.0 ; Vertex 2
    Data.f 0.0, 1.0 ; Vertex 3

  Viereck_1:
    Data.w 0, 1, 2  ; Dreieck 1 besteht aus den Ecken 0, 1 und 2
    Data.w 2, 3, 0  ; Dreieck 2 besteht aus den Ecken 2, 3 und 0
                    ; = 1 Viereck

  Viereck_2:
    Data.w 0, 3, 2  ; Dreieck 1 besteht aus den Ecken 0, 3 und 2
    Data.w 2, 1, 0  ; Dreieck 2 besteht aus den Ecken 2, 1 und 0
                    ; = 1 Viereck

  Viereck_3:
    Data.w 0, 1, 2  ; Dreieck 1 besteht aus den Ecken 0, 1 und 2
    Data.w 2, 3, 0  ; Dreieck 2 besteht aus den Ecken 2, 3 und 0
                    ; = 1 Viereck Vorderseite
    Data.w 0, 3, 2  ; Dreieck 1 besteht aus den Ecken 0, 3 und 2
    Data.w 2, 1, 0  ; Dreieck 2 besteht aus den Ecken 2, 1 und 0
                    ; = 1 Viereck Rueckseite

EndDataSection

; German forum:
; Author: CS2001
; Date:  25. May 2003/2006
; Demo:Yes
; PureBasic: 4.0

#Window_0 = 0

;- Gadget Constants
 
#Gadget_0 = 0
#Gadget_1 = 1


Procedure Open_Window_0()
  If OpenWindow(#Window_0, 216, 0, 600, 300, "TreeGadget with Functions", #PB_Window_TitleBar  )
    If CreateGadgetList(WindowID(#Window_0))
      TreeGadget(#Gadget_0, 10, 10, 270, 190)
      StringGadget(#Gadget_1, 300, 10, 280, 40, "")
      AddGadgetItem(#Gadget_0, 0, "Login")
      AddGadgetItem(#Gadget_0, 1, "Logoff")
      AddGadgetItem(#Gadget_0, 2, "End")
    EndIf
  EndIf
EndProcedure

Open_Window_0()
 
Repeat
 
  Event = WaitWindowEvent()
    If Event=#PB_Event_Gadget
      Select EventGadget()
        Case #Gadget_0
          Eintrag=GetGadgetState(#Gadget_0)
          If Eintrag=0
           SetGadgetText(#Gadget_1, "Login")
          ElseIf Eintrag=1
           SetGadgetText(#Gadget_1, "Logoff")
          EndIf
      EndSelect
    EndIf
 
Until Eintrag=2

; ExecutableFormat=Windows
; FirstLine=1
; EnableXP
; EOF