HOPE2021

回复 5# cmd1152
当然可以

cmd1152

回复 4# HOPE2021


    声明 部分的代码一直报错误，谁能给我一个正版VB6.0？？？？

cmd1152

回复 4# HOPE2021


    我可否把他改成16BT颜色？

HOPE2021

回复 3# HOPE2021
源码:

Option Explicit
Public Declare Function FreeConsole Lib "kernel32" () As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Public Declare Function LstrLen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function SetConsoleTextAttribute Lib "kernel32" (ByVal hConsoleOutput As Long, ByVal wAttributes As Long) As Long
Public Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, ByVal lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long
Public Const STD_OUTPUT_HANDLE = -11&
Public hConsoleOut As Long
Public Sub Initialize()
    hConsoleOut = GetStdHandle(STD_OUTPUT_HANDLE)
End Sub
Public Sub Terminate()
    Call FreeConsole
    Call CloseHandle(hConsoleOut)
End Sub
Public Sub Echo(ByVal szOut As String)
    WriteConsole hConsoleOut, szOut, LstrLen(szOut), vbNull, vbNull
End Sub

Sub Main()
    On Error Resume Next
    Dim Cmd
    Dim i
    Dim j
    Call Initialize
    Dim Color___ As Long
    If Command = "" Then
        Call Echo(vbCrLf & "没有命令参数,操作失败" & vbCrLf)
        Call Help_
    End If
    If Left(UCase(Command), 2) = "/H" Then
        Call Help_
        Call Terminate
        Exit Sub
    End If
    If Left(UCase(Command), 2) = "/?" Then
        Call Help_
        Call Terminate
        Exit Sub
    End If
    Color___ = Command
    If Not Left(UCase(Command), 2) = "/H" Then
        Dim Handle
        Handle = GetStdHandle(STD_OUTPUT_HANDLE)
        If IsNumeric(Color___) = True Then
            Call SetConsoleTextAttribute(Handle, Color___)
            Call Terminate
            End
        End If
    Call Echo("命令参数不正确" & vbCrLf)
    Call Terminate
    End If
End Sub

Function Help_()
    Call Echo(vbCrLf & "Hope Colour [Version 1.0.0000]" & vbCrLf)
    Call Echo("(C) Copyright 2016-2021 Hope Corp." & vbCrLf & vbCrLf)
    Call Echo("本程序用于让命令行实现彩色显示" & vbCrLf & vbCrLf)
    Call Echo("Colour /H                   - 查询帮助" & vbCrLf & vbCrLf)
    Call Echo("Colour /?                   - 查询帮助" & vbCrLf & vbCrLf)
    Call Echo("Colour ColourCode           - 从下一行命令开始,进行与ColourCode关联的颜色" & vbCrLf)
    Call Echo("                            - ColourCode是颜色代码,可以是任意一个0~255的正整数" & vbCrLf)
    Call Echo("                            - 下面是ColourCode的色卡" & vbCrLf & vbCrLf)
    Dim i
    For i = 0 To 255
        Dim Handle
        Handle = GetStdHandle(STD_OUTPUT_HANDLE)
        Call SetConsoleTextAttribute(Handle, i)
        Call Echo(" " & i & " ")
        Call SetConsoleTextAttribute(Handle, 0)
        Call Echo(Chr(9))
    Next
    Call Echo(vbCrLf)
    Call SetConsoleTextAttribute(Handle, 7)
    Call Terminate
    End
End Function
复制代码

HOPE2021

回复 2# HOPE2021
FindStr做不到的事:彩色显示重定向符：

@Echo off
Mode Con: Cols=80 Lines=25
Title Colour Test
Set "Line="
Set "Line2="
For /l %%i in (1,1,80) do (
	Call :Line
	Call :Line2
)
For /l %%i in (0,1,255) do (
	Colour %%i
	Call :Echo2
)
@Pause > nul
@Exit /b

:Line
	Set "Line=%Line%^<"
@Goto :eof

:Line2
	Set "Line2=%Line2%^>"
@Goto :eof

:Echo2
	Set /a Rand=%Random%%%2
	If %Rand% Equ 0	(
		Set /p Str=%Line%<nul
	)
	If %Rand% Equ 1	(
		Set /p Str=%Line2%<nul
	)
@Goto :eof
复制代码

HOPE2021

回复 1# HOPE2021
使用Colour.Exe制作的彩虹:

@Echo off
Mode Con: Cols=80 Lines=25
Title Colour Test
Set "Line="
For /l %%i in (1,1,80) do (
	Call :Line
)
For /l %%i in (0,1,255) do (
	Colour %%i
	Set /p Str=%Line%<nul
)
@Pause > nul
@Exit /b

:Line
	Set "Line=%Line%#"
@Goto :eof
复制代码