Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » System

CLI Implementation

Lizenz:Erster Autor:Letzte Bearbeitung:
GPLMitgliedcsde_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 Mitgliedcsde_rats angelegt.
  • Die aktuellste Version wurde am 14.03.2008 von Mitgliedcsde_rats gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen