akaGM
Platinum Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
module ColorConsole
use kernel32
use ifwinty
implicit none
integer, parameter :: CON_FIRST_COLOR = 0
integer, parameter :: CON_BLACK = 0
integer, parameter :: CON_BLUE = 1
integer, parameter :: CON_GREEN = 2
integer, parameter :: CON_CYAN = 3
integer, parameter :: CON_RED = 4
integer, parameter :: CON_MAGENTA = 5
integer, parameter :: CON_BROWN = 6
integer, parameter :: CON_LIGHTGRAY = 7
integer, parameter :: CON_DARKGRAY = 8
integer, parameter :: CON_LIGHTBLUE = 9
integer, parameter :: CON_LIGHTGREEN = 10
integer, parameter :: CON_LIGHTCYAN = 11
integer, parameter :: CON_LIGHTRED = 12
integer, parameter :: CON_LIGHTMAGENTA = 13
integer, parameter :: CON_YELLOW = 14
integer, parameter :: CON_WHITE = 15
integer, parameter :: CON_LAST_COLOR = 15
integer, parameter :: CON_DEFAULT = #07
integer(WORD) currentColor/CON_DEFAULT/ ! current color attribute
integer(WORD) saveColor
integer(HANDLE) hConsoleOutput
contains
subroutine resetColor()
use kernel32
use ifwinty
implicit none
integer(BOOL) res
res = SetConsoleTextAttribute(hConsoleOutput, CON_DEFAULT)
currentColor = CON_DEFAULT
end subroutine resetColor
subroutine setColorEx(color)
use kernel32
use ifwinty
implicit none
integer color
integer(BOOL) res
currentColor = color
res = SetConsoleTextAttribute(hConsoleOutput, currentColor)
end subroutine setColorEx
subroutine setColor(Color)
use kernel32
use ifwinty
implicit none
integer Color
integer(BOOL) res
currentColor = ior(iand(color, #0f), iand(currentColor, #f0))
res = SetConsoleTextAttribute(hConsoleOutput, currentColor)
end subroutine setColor
subroutine setBackground(Color)
use kernel32
use ifwinty
implicit none
integer Color
integer(BOOL) res
currentColor = ior(ishft(color, 4), iand(currentColor, #0f))
res = SetConsoleTextAttribute(hConsoleOutput, currentColor)
end subroutine setBackground
subroutine initConsole
use kernel32
use ifwinty
implicit none
type(T_CONSOLE_SCREEN_BUFFER_INFO) lpCSBI
integer(BOOL) res
res = GetConsoleScreenBufferInfo(hConsoleOutput, lpCSBI)
saveColor = lpCSBI%wAttributes
currentColor = saveColor
hConsoleOutput = GetStdHandle(STD_OUTPUT_HANDLE)
end subroutine initConsole
subroutine restoreConsole()
use kernel32
use ifwinty
implicit none
integer(BOOL) res
currentColor = saveColor
res = SetConsoleTextAttribute(hConsoleOutput, saveColor)
end subroutine restoreConsole
end module ColorConsole |
