Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
CLI (Command Line Interface)
| Uploader: |  csde_rats |
| Datum/Zeit: | 02.01.2010 00:45:18 |
' Schon sehr alt, Ende '07
#Include "windows.bi"
#Define ver "1.0.0.0"
Type CLI
Public:
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
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