您所在位置：主题：Visual Fortran Console 彩色文本屏幕输出的方法
臭石头雪球
[专家分：23030] 发布于 2007-09-14 13:31:00
前几天看到有朋友讨论有关 Console 类型工程使用彩色字体输出的问题。
有人说 Fortran 这方面不在行，建议用 C 来实现，其实 C 也是使用外部的函数库的。如果单单为了这一点点东西就改用另一门语言，或者改用 QuickWin，似乎有点小题大做了。
仔细想想，其实彩色文字这方面平常我们也经常会需要的。比如程序碰到例外或出错了，我们都希望给出红色的错误提示，或者黄色的警告。于是就有了一个想法，写一个模块来实现彩色文本的窗口输出。（输出到文件当然就失效了）
翻了翻有关的 API 函数，大概能够实现了。拿出来大家共同探讨。
模块取名为 Colorized_Text_Mod 。使用了 Kernel32 这个 API 函数库的一些东西。所以，需要你的编译器有 API 的导入库。一般的 VF（CVF 和 IVF） 都是可以的，写程序的时候是在 IVF 下，如果 CVF 下通不过，一般把模块里的 Use Kernel32 改成 Use DFWin 就可以了。在 Linux 平台上跑的高手就不要笑话我了，那方面我还很欠缺。呵呵~~
先 Use Colorized_Text_Mod
使用之前必须先定义一个逻辑型变量来接收模块函数的返回值，比如：
[quote]Logical(kind=ctmKIND_LOGICAL) :: bRes[/quote]
调用 Colorized_Text_Mod 中的函数以后都可以判断失败或成功。失败时返回值为 ctmEXECUTE_ERROR 成功时则为 ctmEXECUTE_SUCCESS。
定义好以后需要初始化：
[quote]bRes = ctm_Init()[/quote]
通过调用函数 ctm_SetColor 来改变当前的颜色：
[quote]bRes = ctm_SetColor( iColorValue , wFlag )[/quote]
参数定义为：
[quote]Integer(kind=ctmKIND_COLOR) , Intent( IN ) :: iColorValue
Integer(kind=ctmKIND_FLAG) , Intent( IN ) :: wFlag[/quote]
iColorValue 为颜色索引值，一共有 16 种颜色可以选择，建议直接使用定义好的常量，使用其他量的时候应该定义为 Integer(kind=ctmKIND_COLOR)，并且小于等于16，大于等于0。十六个定义好的常量有：
[quote]ctmCOLOR_BLACK 0 黑色
ctmCOLOR_BLUE 1 蓝色
ctmCOLOR_GREEN 2 绿色
ctmCOLOR_CYAN 3 青色
ctmCOLOR_RED 4 红色
ctmCOLOR_MAGENTA 5 紫色
ctmCOLOR_BROWN 6 棕色
ctmCOLOR_LIGHTGRAY 7 浅灰色
ctmCOLOR_DARKGRAY 8 深灰色
ctmCOLOR_LIGHTBLUE 9 亮蓝色
ctmCOLOR_LIGHTGREEN 10 亮绿色
ctmCOLOR_LIGHTCYAN 11 亮青色
ctmCOLOR_LIGHTRED 12 亮红色
ctmCOLOR_LIGHTMAGENTA 13 亮紫色
ctmCOLOR_YELLOW 14 黄色
ctmCOLOR_WHITE 15 白色[/quote]
wFlag 指定需要设定的是文本颜色还是背景颜色。指定为 ctmSET_TEXT 代表要设定文本颜色，指定为 ctmSET_BG 代表要设定背景颜色。
测试发现改变背景颜色很不好看，建议就不要使用了。
通过调用 ctm_ResetColor( wFlag ) 恢复默认的显示方式
wFlag 可以指定为 ctmSET_TEXT 代表要恢复文本颜色，指定为 ctmSET_BG 代表要恢复背景颜色，指定为 ctmSET_BOTH 代表恢复文本和背景颜色。
最后调用 ctm_UnInit 结束 ：
[quote]bRes = ctm_UnInit()[/quote]
ctm_UnInit 内部会调用 ctm_ResetColor( ctm_SET_BOTH ) 恢复文本和背景颜色的显示。
举一个例子：
[quote]
Program Main
Use Colorized_Text_Mod
Implicit None
Logical(kind=ctmKIND_LOGICAL) :: bRes
bRes = ctm_Init()
If ( .Not.bRes ) then
write(*,*) '初始化失败！'
EndIf
bRes = ctm_SetColor( ctmCOLOR_BLUE , ctmSET_TEXT )
Write(*,*) '蓝色文字'
bRes = ctm_ResetColor( ctmSET_TEXT )
Write(*,*) '恢复文字显示颜色'
bRes = ctm_SetColor( ctmCOLOR_RED , ctmSET_TEXT )
Write(*,*) '红色文字'
bRes = ctm_SetColor( ctmCOLOR_YELLOW , ctmSET_BG )
Write(*,*) '黄色背景'
bRes = ctm_ResetColor( ctmSET_BG )
Write(*,*) '恢复背景显示颜色，保留字体颜色'
bRes = ctm_SetColor( ctmCOLOR_GREEN , ctmSET_BG )
Write(*,*) '绿色背景'
bRes = ctm_UnInit()
Write(*,*) '恢复默认样式'
Read(*,*)
End Program Main[/quote]
源码和例子都在附件中，喜欢的朋友可以拿去。
有人说 Fortran 这方面不在行，建议用 C 来实现，其实 C 也是使用外部的函数库的。如果单单为了这一点点东西就改用另一门语言，或者改用 QuickWin，似乎有点小题大做了。
仔细想想，其实彩色文字这方面平常我们也经常会需要的。比如程序碰到例外或出错了，我们都希望给出红色的错误提示，或者黄色的警告。于是就有了一个想法，写一个模块来实现彩色文本的窗口输出。（输出到文件当然就失效了）
翻了翻有关的 API 函数，大概能够实现了。拿出来大家共同探讨。
模块取名为 Colorized_Text_Mod 。使用了 Kernel32 这个 API 函数库的一些东西。所以，需要你的编译器有 API 的导入库。一般的 VF（CVF 和 IVF） 都是可以的，写程序的时候是在 IVF 下，如果 CVF 下通不过，一般把模块里的 Use Kernel32 改成 Use DFWin 就可以了。在 Linux 平台上跑的高手就不要笑话我了，那方面我还很欠缺。呵呵~~
先 Use Colorized_Text_Mod
使用之前必须先定义一个逻辑型变量来接收模块函数的返回值，比如：
[quote]Logical(kind=ctmKIND_LOGICAL) :: bRes[/quote]
调用 Colorized_Text_Mod 中的函数以后都可以判断失败或成功。失败时返回值为 ctmEXECUTE_ERROR 成功时则为 ctmEXECUTE_SUCCESS。
定义好以后需要初始化：
[quote]bRes = ctm_Init()[/quote]
通过调用函数 ctm_SetColor 来改变当前的颜色：
[quote]bRes = ctm_SetColor( iColorValue , wFlag )[/quote]
参数定义为：
[quote]Integer(kind=ctmKIND_COLOR) , Intent( IN ) :: iColorValue
Integer(kind=ctmKIND_FLAG) , Intent( IN ) :: wFlag[/quote]
iColorValue 为颜色索引值，一共有 16 种颜色可以选择，建议直接使用定义好的常量，使用其他量的时候应该定义为 Integer(kind=ctmKIND_COLOR)，并且小于等于16，大于等于0。十六个定义好的常量有：
[quote]ctmCOLOR_BLACK 0 黑色
ctmCOLOR_BLUE 1 蓝色
ctmCOLOR_GREEN 2 绿色
ctmCOLOR_CYAN 3 青色
ctmCOLOR_RED 4 红色
ctmCOLOR_MAGENTA 5 紫色
ctmCOLOR_BROWN 6 棕色
ctmCOLOR_LIGHTGRAY 7 浅灰色
ctmCOLOR_DARKGRAY 8 深灰色
ctmCOLOR_LIGHTBLUE 9 亮蓝色
ctmCOLOR_LIGHTGREEN 10 亮绿色
ctmCOLOR_LIGHTCYAN 11 亮青色
ctmCOLOR_LIGHTRED 12 亮红色
ctmCOLOR_LIGHTMAGENTA 13 亮紫色
ctmCOLOR_YELLOW 14 黄色
ctmCOLOR_WHITE 15 白色[/quote]
wFlag 指定需要设定的是文本颜色还是背景颜色。指定为 ctmSET_TEXT 代表要设定文本颜色，指定为 ctmSET_BG 代表要设定背景颜色。
测试发现改变背景颜色很不好看，建议就不要使用了。
通过调用 ctm_ResetColor( wFlag ) 恢复默认的显示方式
wFlag 可以指定为 ctmSET_TEXT 代表要恢复文本颜色，指定为 ctmSET_BG 代表要恢复背景颜色，指定为 ctmSET_BOTH 代表恢复文本和背景颜色。
最后调用 ctm_UnInit 结束 ：
[quote]bRes = ctm_UnInit()[/quote]
ctm_UnInit 内部会调用 ctm_ResetColor( ctm_SET_BOTH ) 恢复文本和背景颜色的显示。
举一个例子：
[quote]
Program Main
Use Colorized_Text_Mod
Implicit None
Logical(kind=ctmKIND_LOGICAL) :: bRes
bRes = ctm_Init()
If ( .Not.bRes ) then
write(*,*) '初始化失败！'
EndIf
bRes = ctm_SetColor( ctmCOLOR_BLUE , ctmSET_TEXT )
Write(*,*) '蓝色文字'
bRes = ctm_ResetColor( ctmSET_TEXT )
Write(*,*) '恢复文字显示颜色'
bRes = ctm_SetColor( ctmCOLOR_RED , ctmSET_TEXT )
Write(*,*) '红色文字'
bRes = ctm_SetColor( ctmCOLOR_YELLOW , ctmSET_BG )
Write(*,*) '黄色背景'
bRes = ctm_ResetColor( ctmSET_BG )
Write(*,*) '恢复背景显示颜色，保留字体颜色'
bRes = ctm_SetColor( ctmCOLOR_GREEN , ctmSET_BG )
Write(*,*) '绿色背景'
bRes = ctm_UnInit()
Write(*,*) '恢复默认样式'
Read(*,*)
End Program Main[/quote]
源码和例子都在附件中，喜欢的朋友可以拿去。
