Code-Beispiel

CLI Implementation

Lizenz:	Erster Autor:	Letzte Bearbeitung:
GPL	csde_rats	14.03.2008

Hi!

Jeder der mal wissen möchte, wie eigentlich das FreeBasic'sche Print Funktioniert, mag sich das hier mal anschauen:

CLI.bi

#Include "windows.bi"



#Define ver "1.0.0.0"



Type CLI

    Declare Constructor Lib "CLI" (ByRef ret As Boolean)

    Declare Function SetFgColor Lib "CLI" (ByVal Col As Byte) As Boolean

    Declare Function SetBkColor Lib "CLI" (ByVal Col As Byte) As Boolean

    Declare Function Print Lib "CLI" (ByVal Text As String) As Boolean

    Declare Function Scroll Lib "CLI" (ByVal XScroll As Integer) As Boolean

    Declare Function Read Lib "CLI" (ByVal Chars As Integer, ByRef Buf As String) As Integer

    Declare Function CRLF Lib "CLI" () As Boolean

    Declare Function Cls Lib "CLI" () As Boolean

    Private:

    hStdIn As HANDLE

    hStdOut As HANDLE

    csbi As CONSOLE_SCREEN_BUFFER_INFO

    ColorAttr As Word

End Type

CLI.bas

#Include "CLI.bi"



Constructor CLI(ByRef ret As Boolean) Export

    this.hStdIn = GetStdHandle(STD_INPUT_HANDLE)

    this.hStdOut = GetStdHandle(STD_OUTPUT_HANDLE)

    If this.hStdIn = INVALID_HANDLE_VALUE Or _

        this.hStdOut = INVALID_HANDLE_VALUE Then

            ret=FALSE

            Exit Constructor

    EndIf



    If Not GetConsoleScreenBufferInfo(this.hStdOut, @this.csbi) Then

        ret=FALSE

        Exit Constructor

    EndIf



    this.ColorAttr=this.csbi.wAttributes



    this.Print("CLI Implementation v." & ver)

    this.CRLF()

    this.Print("Compiler: " & __FB_SIGNATURE__)



    ret=TRUE

End Constructor



Function CLI.SetFgColor (ByVal Col As Byte) As Boolean Export

    If Not SetConsoleTextAttribute(this.hStdOut, Col) Then

        Return FALSE

    EndIf

    Return TRUE

End Function



Function CLI.SetBkColor (ByVal Col As Byte) As Boolean Export

    If Not SetConsoleTextAttribute(this.hStdOut, Col) Then

        Return FALSE

    EndIf

    Return TRUE

End Function



Function CLI.Print (ByVal Text As String) As Boolean Export

    Dim As Integer written

    If Not WriteFile(_

        this.hStdOut, _

        StrPtr(Text), _

        Len(Text)   , _

        @written    , _

        NULL) Then

            Return FALSE

    EndIf

    If written = Not Len(Text) Then

        Return FALSE

    EndIf

    Return TRUE

End Function



Function CLI.Scroll (ByVal XScroll As Integer) As Boolean Export

    Dim As SMALL_RECT srctScrollRect, srctClipRect

    Dim As CHAR_INFO chiFill

    Dim As COORD coordDest



    srctScrollRect.Left = 0

   srctScrollRect.Top = 1

   srctScrollRect.Right = this.csbi.dwSize.X - XScroll

   srctScrollRect.Bottom = this.csbi.dwSize.Y - XScroll



   coordDest.X = 0

   coordDest.Y = 0



   srctClipRect = srctScrollRect



   chiFill.Attributes = FOREGROUND_RED Or FOREGROUND_INTENSITY

   chiFill.Char.UnicodeChar = Asc(" ")

   chiFill.Char.AsciiChar = Asc(" ")



   If Not ScrollConsoleScreenBuffer(_

           this.hStdOut         , _

           @srctScrollRect      , _

           @srctClipRect        , _

           coordDest            , _

           @chiFill) Then

        Return FALSE

    EndIf



    Return TRUE

End Function



Function CLI.Read (ByVal Chars As Integer, ByRef Buf As String) As Integer Export

    Dim As String Buffer

    Dim As Integer cRead

    If Not ReadFile(this.hStdIn, StrPtr(Buffer), Chars, @cRead, NULL) Then

        Return 0

    EndIf

    If cRead<Chars Then

        Return 0

    Else

        Buf=Buffer

        Return cRead

    EndIf

End Function



Function CLI.CRLF () As Boolean Export

    this.csbi.dwCursorPosition.X = 0



    If (this.csbi.dwSize.Y-1) = this.csbi.dwCursorPosition.Y Then

        this.Scroll(1)

    Else

        this.csbi.dwCursorPosition.Y += 1

        If Not SetConsoleCursorPosition(this.hStdOut, this.csbi.dwCursorPosition) Then

            Return FALSE

        EndIf

    EndIf

    Return TRUE

End Function



Function CLI.Cls () As Boolean

    Dim As COORD coordScreen = (0,0)

    Dim As Dword cCharsWritten

    Dim As Dword dwConSize



    dwConSize = this.csbi.dwSize.X * this.csbi.dwSize.Y



    If Not FillConsoleOutputCharacter(this.hStdOut, Asc(" "), dwConSize, coordScreen, @cCharsWritten) Then

        Return FALSE

    EndIf



    If Not GetConsoleScreenBufferInfo(this.hStdOut, @this.csbi) Then

        Return FALSE

    EndIf



    If Not FillConsoleOutputAttribute(this.hStdOut, this.csbi.wAttributes, dwConSize, coordScreen, @cCharsWritten) Then

        Return FALSE

    EndIf



    SetConsoleCursorPosition(this.hStdOut, coordScreen)



    Return TRUE

End Function

Einfach mit

fbc -exx -dll -export CLI.bas

kompilieren

Zusätzliche Informationen und Funktionen

Das Code-Beispiel wurde am 14.03.2008 von csde_rats angelegt.
Die aktuellste Version wurde am 14.03.2008 von csde_rats gespeichert.

Bearbeiten

Versionen