CodeArchiv für PB v4 - aktueller Status & Mithelfer gesu

Deeem2031 · Beitrag von **Deeem2031** » 31.10.2006 17:22

Nu kommt schon, so schwer ist das doch nich... will nich alles alleine machen.

http://www.purearea.net/pb/CodeArchiv/M ... Min&Max.pb

Code: Alles auswählen

; 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

Leonhard · Beitrag von **Leonhard** » 31.10.2006 18:06

Optimierung fertig. Der Befehl 'SetConsoleDisplayMode(...)' wurde bei PB4.0 nicht richtig in die Lib eingeladen (oder überhauptnicht).

Input+Output - Console
http://www.purearea.net/pb/CodeArchiv/I ... lscreen.pb

Code: Alles auswählen

; 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

Leonhard · Beitrag von **Leonhard** » 31.10.2006 18:15

Input+Output - Console - XtendedConsole
http://www.purearea.net/pb/CodeArchiv/I ... onsole.pbi

Code: Alles auswählen

; 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

Andre · Beitrag von **Andre** » 01.11.2006 11:44

Hallo zusammen!

Danke an alle, die wieder neue Updates beigesteuert haben.

Ich habe auch zu folgendem Code ein Update (per Email) erhalten:
http://www.purearea.net/pb/CodeArchiv/G ... +Rotate.pb

Leider lässt sich dieses Update zwar jetzt kompilieren, ich sehe jedoch nur einen schwarzen WindowedScreen. Kann jemand helfen?

Der aktualisierte Code sieht wie folgt aus:

Code: Alles auswählen

; 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

Proton · Beitrag von **Proton** » 01.11.2006 12:38

>>...sehe jedoch nur einen schwarzen WindowedScreen

Läuft bei mir tadellos.Schwarzer Hintergrund und 2 sich drehende, (relativ
dunkle) braungelbe Vierecke.Vielleicht eine GraKa-Schwäche (Gamma) ?

Mach doch die Vierecke mal heller.

Andre · Beitrag von **Andre** » 01.11.2006 13:21

Proton hat geschrieben:>>...sehe jedoch nur einen schwarzen WindowedScreen

Läuft bei mir tadellos.Schwarzer Hintergrund und 2 sich drehende, (relativ
dunkle) braungelbe Vierecke.Vielleicht eine GraKa-Schwäche (Gamma) ?

Mach doch die Vierecke mal heller.

Das wars! Jetzt kann ich auch was sehen

Schön, wieder ein Code erledigt.

Andre · Beitrag von **Andre** » 01.11.2006 14:58

Habe die letzten Stunden nun noch den kompletten Ordner "Others" konvertiert. Ergebnisse siehe erster Beitrag in diesem Thread - erfreulich: nur ein neuer und noch nicht konvertierter Code hinzugekommen.

Kommt Leute, den Rest schaffen wir auch noch!

Andre · Beitrag von **Andre** » 01.11.2006 16:37

Nun sind auch die Ordner "Printer", "Requester", und "Search+Sort" vollständig konvertiert, davon sind 2 Problemfälle (sprich noch zu konvertierende Codes) in der Liste im ersten Beitrag hinzugekommen.

mardanny71 · Beitrag von **mardanny71** » 01.11.2006 16:49

Hallo zusammen,

zu:
http://www.purearea.net/pb/CodeArchiv/G ... nctions.pb

Habe es angepasst.
Nur der Link muß noch (ins Forenarchiv ?) gesetzt werden.

Code: Alles auswählen

; 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

Gruß
mardanny71

Andre · Beitrag von **Andre** » 01.11.2006 17:09

mardanny71 hat geschrieben:zu:
http://www.purearea.net/pb/CodeArchiv/G ... nctions.pb

Habe es angepasst.
Nur der Link muß noch (ins Forenarchiv ?) gesetzt werden.

Vielen Dank, schon aufgenommen.

Die Forum-Links bitte immer drin lassen. Werde diese nach Abschluss der Konvertierung mit einem kleinen Tool automatisch in die neuen richtigen Links umwandeln lassen.