console.cls

VB 加密----------能够加密解密控件

'
Public Property Get WindowTop() As Long
    WindowTop = GetBufferInfo.srWindow.Top
End Property

''
' Sets the top of the viewable windwo within the screen buffer.
'
' @param RHS The new top position in characters, starting with 0.
'
Public Property Let WindowTop(ByVal RHS As Long)
    Call SetWindowPosition(WindowLeft, RHS)
End Property

''
' Returns the width of the window in characters.
'
' @return The width of the viewable window.
'
Public Property Get WindowWidth() As Long
    With GetBufferInfo.srWindow
        WindowWidth = .Right - .Left + 1
    End With
End Property

''
' Sets the width of the viewable window within the screen buffer.
'
' @param RHS The new width of the window in characters.
'
Public Property Let WindowWidth(ByVal RHS As Long)
    Call SetWindowSize(RHS, WindowHeight)
End Property

''
' Returns the height of the viewable window in the screen buffer.
'
' @return The height of the window in characters.
'
Public Property Get WindowHeight() As Long
    With GetBufferInfo.srWindow
        WindowHeight = .Bottom - .Top + 1
    End With
End Property

''
' Sets the height of the viewable window in the screen buffer.
'
' @param RHS The new window height in characters.
'
Public Property Let WindowHeight(ByVal RHS As Long)
    Call SetWindowSize(WindowWidth, RHS)
End Property

''
' Returns the largest width the viewable window could be set to.
'
' @return The largest possible window width.
'
Public Property Get LargestWindowWidth() As Long
    LargestWindowWidth = GetLargestConsoleWindowSize(mOutputHandle).x
End Property

''
' Returns the largest height the viewable window could be set to.
'
' @return The largest possible window height.
'
Public Property Get largestWindowHeight() As Long
    largestWindowHeight = GetLargestConsoleWindowSize(mOutputHandle).y
End Property

''
' Returns the console title of the current process.
'
' @return The console title.
' @remarks This method support Unicode characters on NT platforms.
'
Public Property Get Title() As String
    Dim Buf As String
    Dim Size As Long
    
    Buf = String$(MAX_TITLE_LENGTH, 0)
    If Environment.IsNT Then
        Size = GetConsoleTitleW(StrPtr(Buf), MAX_TITLE_LENGTH)
    Else
        Size = GetConsoleTitleA(Buf, MAX_TITLE_LENGTH)
    End If
    Select Case Size
        Case 0
            Dim e As Long
            e = Err.LastDllError
            If e <> 0 Then IOError e
        Case Is > MAX_TITLE_LENGTH
            Throw Cor.NewInvalidOperationException("Cannot retrieve title longer that 24500 characters.")
    End Select
    Title = Left$(Buf, Size)
End Property

''
' Sets the title for the console of the current process.
'
' @param RHS The title to set the console to.
' @remarks This method supports Unicode characters on NT platforms.
'
Public Property Let Title(ByVal RHS As String)
    If Len(RHS) > MAX_TITLE_LENGTH Then _
        Throw Cor.NewArgumentOutOfRangeException("Title cannot be longer than 24500 characters.", "Title")
    
    If cString.IsNull(RHS) Then RHS = ""
    
    If Environment.IsNT Then
        If SetConsoleTitleW(StrPtr(RHS)) = BOOL_FALSE Then IOError Err.LastDllError
    Else
        If SetConsoleTitleA(RHS) = BOOL_FALSE Then IOError Err.LastDllError
    End If
End Property

''
' Returns the current background color.
'
' @return The current background color for text.
' @remarks The background color is painted individually for each
' text characters displayed. This is not the same as the entire
' window background color.
'
Public Property Get BackgroundColor() As ConsoleColor
    BackgroundColor = (GetBufferInfo.wAttributes And &HF0) \ &H10
End Property

''
' Sets the background color.
'
' @param RHS The new background color.
' @remarks The new background color will only affect text displayed
' after the changing of the background color.
'
Public Property Let BackgroundColor(ByVal RHS As ConsoleColor)
    If RHS < 0 Or RHS > 15 Then _
        Throw Cor.NewArgumentOutOfRangeException("Invalid Console Color value.", "BackgroundColor", RHS)
    
    If SetConsoleTextAttribute(mOutputHandle, (GetBufferInfo.wAttributes And &HFF0F) Or (RHS * &H10)) = BOOL_FALSE Then IOError Err.LastDllError
End Property

''
' Returns the current foreground color.
'
' @return The current foreground color for text.
' @remarks The foreground color is painted individually for each
' text characters displayed.
'
Public Property Get ForegroundColor() As ConsoleColor
    ForegroundColor = GetBufferInfo.wAttributes And &HF
End Property

''
' Sets the foreground color.
'
' @param RHS The new foreground color.
' @remarks The new foreground color will only affect text that is
' displayed after the color has been changed.
'
Public Property Let ForegroundColor(ByVal RHS As ConsoleColor)
    If RHS < 0 Or RHS > 15 Then _
        Throw Cor.NewArgumentOutOfRangeException("Invalid Console Color value.", "ForegroundColor", RHS)
    
    If SetConsoleTextAttribute(mOutputHandle, (GetBufferInfo.wAttributes And &HFFF0) Or RHS) = BOOL_FALSE Then IOError Err.LastDllError
End Property

''
' Sets the position of the cursor within the screen buffer.
'
' @param Left The number of characters from the left of the screen buffer.
' @param Top The number of characters from the top of the screen buffer.
' @remarks The positions start at 0,0 and go to BufferWidth - 1, BufferHeight - 1.
'
Public Sub SetCursorPosition(ByVal Left As Long, ByVal Top As Long)
    With GetBufferInfo.dwSize
        If Left < 0 Or Left >= .x Then _
            Throw Cor.NewArgumentOutOfRangeException("Cannot set cursor outside of screen buffer.", "Left", Left)
        If Top < 0 Or Top >= .y Then _
            Throw Cor.NewArgumentOutOfRangeException("Cannot set cursor outside of screen buffer.", "Top", Top)
    End With
    
    Dim NewPosition As COORD
    With NewPosition
        .x = Left
        .y = Top
    End With
    If SetConsoleCursorPosition(mOutputHandle, ByVal AsLong(NewPosition)) = BOOL_FALSE Then IOError Err.LastDllError
End Sub

''
' Returns the left coordinate of the cursor position.
'
' @return The left coordinate.
'
Public Property Get CursorLeft() As Long
    CursorLeft = GetBufferInfo.dwCursorPosition.x
End Property

''
' Sets the left coordinate of the cursor position.
'
' @param RHS The new left coordinate.
'
Public Property Let CursorLeft(ByVal RHS As Long)
    Call SetCursorPosition(RHS, CursorTop)
End Property

''
' Returns the top coordinate of the cursor position.
'
' @return The top coordinate.
'
Public Property Get CursorTop() As Long
    CursorTop = GetBufferInfo.dwCursorPosition.y
End Property

''
' Sets the top coordinate for the cursor position
'
' @param RHS The top coordinate.
'
Public Property Let CursorTop(ByVal RHS As Long)
    Call SetCursorPosition(CursorLeft, RHS)
End Property

''
' Returns the size (height) of the cursor.
'
' @return The size of the cursor.
' @remarks the size of the cursor is a value 1 to 100, 1 being
' 1% the full block, and 100 beign 100% a full block.
'
Public Property Get CursorSize() As Long
    CursorSize = GetCursorInfo.dwSize
End Property

''
' Sets the size (height) of the cursor.
'
' @param RHS The new cursor size.
' @remarks the size of the cursor is a value 1 to 100, 1 being
' 1% the full block, and 100 being 100% a full block.
'
Public Property Let CursorSize(ByVal RHS As Long)
    If RHS < 1 Or RHS > 100 Then _
        Throw Cor.NewArgumentOutOfRangeException("Cursor size must be between 1 and 100.", "CursorSize", RHS)
    
    Dim Info As CONSOLE_CURSOR_INFO
    With Info
        .bVisible = GetCursorInfo.bVisible
        .dwSize = RHS
    End With
    If SetConsoleCursorInfo(mOutputHandle, Info) = BOOL_FALSE Then IOError Err.LastDllError
End Property

''
' Returns whether or not the cursor is currently invisible.
'
' @returns The visibility of the cursor.
'
Public Property Get CursorVisible() As Boolean
    CursorVisible = GetCursorInfo.bVisible
End Property

''
' Sets if the cursor is visible or not.
'
' @param RHS The visibility of the cursor.
'
Public Property Let CursorVisible(ByVal RHS As Boolean)
    Dim Info As CONSOLE_CURSOR_INFO
    
    With Info
        .bVisible = RHS
        .dwSize = CursorSize
    End With
    If SetConsoleCursorInfo(mOutputHandle, Info) = BOOL_FALSE Then IOError Err.LastDllError
End Property

''
' Clears the console screen and window.
'
Public Sub Clear()
    Dim CharsToWrite As Long
    With GetBufferInfo.dwSize
        CharsToWrite = .x * .y
    End With
    
    Dim StartPosition As COORD
    If FillConsoleOutputCharacter(mOutputHandle, 32, CharsToWrite, ByVal AsLong(StartPosition), 0) = BOOL_FALSE Then IOError Err.LastDllError
    If FillConsoleOutputAttribute(mOutputHandle, GetBufferInfo.wAttributes, CharsToWrite, ByVal AsLong(StartPosition), 0) = BOOL_FALSE Then IOError Err.LastDllError
    If SetConsoleCursorPosition(mOutputHandle, ByVal AsLong(StartPosition)) = BOOL_FALSE Then IOError Err.LastDllError
End Sub

''
' Moves one section of the screen buffer to another location within the screen buffer.
'
' @param SourceLeft The left side of the area to be moved.
' @param SourceTop The top side of the area to be moved.
' @param SourceWidth The width of the area to be moved.
' @param SourceHeight The height of the area to be moved.
' @param TargetLeft The starting left position to move the area to.
' @param TargetTop The starting top position to move the area to.
' @param SourceChar The character to fill the moved area in with. This can be a String or Ascii value.
' @param SourceForeColor The forecolor used when filling in the original moved area.
' @param SourceBackColor The backcolor used when filling in the original moved area.
'
Public Sub MoveBufferArea(ByVal SourceLeft As Long, ByVal SourceTop As Long, ByVal SourceWidth As Long, ByVal SourceHeight As Long, ByVal TargetLeft As Long, ByVal TargetTop As Long, Optional ByVal SourceChar As Variant = " ", Optional ByVal SourceForeColor As ConsoleColor = ConsoleColor.Black, Optional ByVal SourceBackColor As ConsoleColor = CurrentColor)
    Dim Buffer() As CHAR_INFO
    Dim BufferSize As COORD
    Dim Region As SMALL_RECT
    
    With GetBufferInfo.dwSize
        If SourceLeft < 0 Or SourceLeft >= .x Then _
            Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_OutsideConsoleBoundry), "SourceLeft", SourceLeft)
        If SourceTop < 0 Or SourceTop >= .y Then _
            Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_OutsideConsoleBoundry), "SourceTop", SourceTop)
        If SourceWidth < 0 Or SourceWidth > (.x - SourceLeft) Then _
            Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_OutsideConsoleBoundry), "SourceWidth", SourceWidth)
        If SourceWidth < 0 Or SourceWidth > (.y - SourceTop) Then _
            Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_OutsideConsoleBoundry), "SourceHeight", SourceHeight)
        If TargetLeft < 0 Or TargetLeft >= .x Then _
            Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_OutsideConsoleBoundry), "TargetLeft", TargetLeft)
        If TargetTop < 0 Or TargetTop >= .y Then _
            Throw Cor.NewArgumentOutOfRangeException(Environment.GetResourceString(ArgumentOutOfRange_OutsideConsoleBoundry), "TargetTop", TargetTop)
    End With
        
    If SourceWidth = 0 Or SourceHeight = 0 Then Exit Sub
    
    ReDim Buffer(SourceWidth * SourceHeight - 1)
    With BufferSize
        .x = SourceWidth
        .y = SourceHeight
    End With
    With Region